Merged
authorManuel Eberl <eberlm@in.tum.de>
Fri Sep 30 10:00:49 2016 +0200 (2016-09-30)
changeset 63966957ba35d1338
parent 63965 d510b816ea41
parent 63964 9f0308e80366
child 63967 2aa42596edc3
Merged
     1.1 --- a/CONTRIBUTORS	Thu Sep 29 16:49:42 2016 +0200
     1.2 +++ b/CONTRIBUTORS	Fri Sep 30 10:00:49 2016 +0200
     1.3 @@ -30,6 +30,12 @@
     1.4    Algebraic foundation for primes; generalization from nat
     1.5    to general factorial rings
     1.6  
     1.7 +* September 2016: Sascha Boehme
     1.8 +  Proof method 'argo' based on SMT technology for a combination of
     1.9 +  quantifier-free propositional logic, equality and linear real
    1.10 +  arithmetic
    1.11 +
    1.12 +
    1.13  Contributions to Isabelle2016
    1.14  -----------------------------
    1.15  
     2.1 --- a/NEWS	Thu Sep 29 16:49:42 2016 +0200
     2.2 +++ b/NEWS	Fri Sep 30 10:00:49 2016 +0200
     2.3 @@ -240,6 +240,13 @@
     2.4  
     2.5  *** HOL ***
     2.6  
     2.7 +* New proof method "argo" using the built-in Argo solver based on SMT technology.
     2.8 +The method can be used to prove goals of quantifier-free propositional logic,
     2.9 +goals based on a combination of quantifier-free propositional logic with equality,
    2.10 +and goals based on a combination of quantifier-free propositional logic with
    2.11 +linear real arithmetic including min/max/abs. See HOL/ex/Argo_Examples.thy for
    2.12 +examples.
    2.13 +
    2.14  * Type class "div" with operation "mod" renamed to type class "modulo" with
    2.15  operation "modulo", analogously to type class "divide".  This eliminates the
    2.16  need to qualify any of those names in the presence of infix "mod" syntax.
     3.1 --- a/src/HOL/Analysis/Cauchy_Integral_Theorem.thy	Thu Sep 29 16:49:42 2016 +0200
     3.2 +++ b/src/HOL/Analysis/Cauchy_Integral_Theorem.thy	Fri Sep 30 10:00:49 2016 +0200
     3.3 @@ -129,24 +129,28 @@
     3.4      have "(\<lambda>x. if x \<le> c then f x else g x) differentiable at x within {a..b}" (is "?diff_fg")
     3.5      proof (cases x c rule: le_cases)
     3.6        case le show ?diff_fg
     3.7 -        apply (rule differentiable_transform_within [where d = "dist x c" and f = f])
     3.8 -        using x le st
     3.9 -        apply (simp_all add: dist_real_def)
    3.10 -        apply (rule differentiable_at_withinI)
    3.11 -        apply (rule differentiable_within_open [where s = "{a<..<c} - s", THEN iffD1], simp_all)
    3.12 -        apply (blast intro: open_greaterThanLessThan finite_imp_closed)
    3.13 -        apply (force elim!: differentiable_subset)+
    3.14 -        done
    3.15 +      proof (rule differentiable_transform_within [where d = "dist x c" and f = f])
    3.16 +        have "f differentiable at x within ({a<..<c} - s)"
    3.17 +          apply (rule differentiable_at_withinI)
    3.18 +          using x le st
    3.19 +          by (metis (no_types, lifting) DiffD1 DiffD2 DiffI UnCI atLeastAtMost_diff_ends atLeastAtMost_iff at_within_interior insert_iff interior_atLeastAtMost le st(3) x)
    3.20 +        moreover have "open ({a<..<c} - s)"
    3.21 +          by (blast intro: open_greaterThanLessThan \<open>finite s\<close> finite_imp_closed)
    3.22 +        ultimately show "f differentiable at x within {a..b}"
    3.23 +          using x le by (auto simp add: at_within_open_NO_MATCH differentiable_at_withinI) 
    3.24 +      qed (use x le st dist_real_def in auto)
    3.25      next
    3.26        case ge show ?diff_fg
    3.27 -        apply (rule differentiable_transform_within [where d = "dist x c" and f = g])
    3.28 -        using x ge st
    3.29 -        apply (simp_all add: dist_real_def)
    3.30 -        apply (rule differentiable_at_withinI)
    3.31 -        apply (rule differentiable_within_open [where s = "{c<..<b} - t", THEN iffD1], simp_all)
    3.32 -        apply (blast intro: open_greaterThanLessThan finite_imp_closed)
    3.33 -        apply (force elim!: differentiable_subset)+
    3.34 -        done
    3.35 +      proof (rule differentiable_transform_within [where d = "dist x c" and f = g])
    3.36 +        have "g differentiable at x within ({c<..<b} - t)"
    3.37 +          apply (rule differentiable_at_withinI)
    3.38 +          using x ge st
    3.39 +          by (metis DiffD1 DiffD2 DiffI UnCI atLeastAtMost_diff_ends atLeastAtMost_iff at_within_interior insert_iff interior_atLeastAtMost)
    3.40 +        moreover have "open ({c<..<b} - t)"
    3.41 +          by (blast intro: open_greaterThanLessThan \<open>finite t\<close> finite_imp_closed)
    3.42 +        ultimately show "g differentiable at x within {a..b}"
    3.43 +          using x ge by (auto simp add: at_within_open_NO_MATCH differentiable_at_withinI) 
    3.44 +      qed (use x ge st dist_real_def in auto)
    3.45      qed
    3.46    }
    3.47    then have "\<exists>s. finite s \<and>
    3.48 @@ -3801,7 +3805,7 @@
    3.49    moreover have "{a<..<b} - k \<subseteq> {a..b} - k"
    3.50      by force
    3.51    ultimately have g_diff_at: "\<And>x. \<lbrakk>x \<notin> k; x \<in> {a<..<b}\<rbrakk> \<Longrightarrow> \<gamma> differentiable at x"
    3.52 -    by (metis Diff_iff differentiable_on_subset C1_diff_imp_diff [OF g_C1_diff] differentiable_on_def differentiable_within_open)
    3.53 +    by (metis Diff_iff differentiable_on_subset C1_diff_imp_diff [OF g_C1_diff] differentiable_on_def at_within_open)
    3.54    { fix w
    3.55      assume "w \<noteq> z"
    3.56      have "continuous_on (ball w (cmod (w - z))) (\<lambda>w. 1 / (w - z))"
    3.57 @@ -7527,4 +7531,32 @@
    3.58  by (metis Cauchy_theorem_global assms winding_number_zero_in_outside valid_path_imp_path)
    3.59  
    3.60  
    3.61 +lemma simply_connected_imp_winding_number_zero:
    3.62 +  assumes "simply_connected s" "path g"
    3.63 +           "path_image g \<subseteq> s" "pathfinish g = pathstart g" "z \<notin> s"
    3.64 +    shows "winding_number g z = 0"
    3.65 +proof -
    3.66 +  have "winding_number g z = winding_number(linepath (pathstart g) (pathstart g)) z"
    3.67 +    apply (rule winding_number_homotopic_paths)
    3.68 +    apply (rule homotopic_loops_imp_homotopic_paths_null [where a = "pathstart g"])
    3.69 +    apply (rule homotopic_loops_subset [of s])
    3.70 +    using assms
    3.71 +    apply (auto simp: homotopic_paths_imp_homotopic_loops path_defs simply_connected_eq_contractible_path)
    3.72 +    done
    3.73 +  also have "... = 0"
    3.74 +    using assms by (force intro: winding_number_trivial)
    3.75 +  finally show ?thesis .
    3.76 +qed
    3.77 +
    3.78 +lemma Cauchy_theorem_simply_connected:
    3.79 +  assumes "open s" "simply_connected s" "f holomorphic_on s" "valid_path g"
    3.80 +           "path_image g \<subseteq> s" "pathfinish g = pathstart g"
    3.81 +    shows "(f has_contour_integral 0) g"
    3.82 +using assms
    3.83 +apply (simp add: simply_connected_eq_contractible_path)
    3.84 +apply (auto intro!: Cauchy_theorem_null_homotopic [where a = "pathstart g"]
    3.85 +                         homotopic_paths_imp_homotopic_loops)
    3.86 +using valid_path_imp_path by blast
    3.87 +
    3.88 +
    3.89  end
     4.1 --- a/src/HOL/Analysis/Complete_Measure.thy	Thu Sep 29 16:49:42 2016 +0200
     4.2 +++ b/src/HOL/Analysis/Complete_Measure.thy	Fri Sep 30 10:00:49 2016 +0200
     4.3 @@ -85,6 +85,9 @@
     4.4    "A \<in> sets M \<Longrightarrow> A \<in> sets (completion M)"
     4.5    unfolding sets_completion by force
     4.6  
     4.7 +lemma measurable_completion: "f \<in> M \<rightarrow>\<^sub>M N \<Longrightarrow> f \<in> completion M \<rightarrow>\<^sub>M N"
     4.8 +  by (auto simp: measurable_def)
     4.9 +
    4.10  lemma null_sets_completion:
    4.11    assumes "N' \<in> null_sets M" "N \<subseteq> N'" shows "N \<in> sets (completion M)"
    4.12    using assms by (intro sets_completionI[of N "{}" N N']) auto
    4.13 @@ -305,9 +308,6 @@
    4.14  lemma null_sets_completion_iff: "N \<in> sets M \<Longrightarrow> N \<in> null_sets (completion M) \<longleftrightarrow> N \<in> null_sets M"
    4.15    by (auto simp: null_sets_def)
    4.16  
    4.17 -lemma AE_completion_iff: "{x\<in>space M. P x} \<in> sets M \<Longrightarrow> (AE x in M. P x) \<longleftrightarrow> (AE x in completion M. P x)"
    4.18 -  by (simp add: AE_iff_null null_sets_completion_iff)
    4.19 -
    4.20  lemma sets_completion_AE: "(AE x in M. \<not> P x) \<Longrightarrow> Measurable.pred (completion M) P"
    4.21    unfolding pred_def sets_completion eventually_ae_filter
    4.22    by auto
    4.23 @@ -339,6 +339,12 @@
    4.24    "B \<subseteq> A \<Longrightarrow> A \<in> null_sets (completion M) \<Longrightarrow> B \<in> null_sets (completion M)"
    4.25    unfolding null_sets_completion_iff2 by auto
    4.26  
    4.27 +interpretation completion: complete_measure "completion M" for M
    4.28 +proof
    4.29 +  show "B \<subseteq> A \<Longrightarrow> A \<in> null_sets (completion M) \<Longrightarrow> B \<in> sets (completion M)" for B A
    4.30 +    using null_sets_completion_subset[of B A M] by (simp add: null_sets_def)
    4.31 +qed
    4.32 +
    4.33  lemma null_sets_restrict_space:
    4.34    "\<Omega> \<in> sets M \<Longrightarrow> A \<in> null_sets (restrict_space M \<Omega>) \<longleftrightarrow> A \<subseteq> \<Omega> \<and> A \<in> null_sets M"
    4.35    by (auto simp: null_sets_def emeasure_restrict_space sets_restrict_space)
    4.36 @@ -416,6 +422,16 @@
    4.37      by (intro bexI[of _ s]) (auto simp: simple_integral_completion simple_function_completion)
    4.38  qed
    4.39  
    4.40 +lemma integrable_completion:
    4.41 +  fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
    4.42 +  shows "f \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> integrable (completion M) f \<longleftrightarrow> integrable M f"
    4.43 +  by (rule integrable_subalgebra[symmetric]) auto
    4.44 +
    4.45 +lemma integral_completion:
    4.46 +  fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
    4.47 +  assumes f: "f \<in> M \<rightarrow>\<^sub>M borel" shows "integral\<^sup>L (completion M) f = integral\<^sup>L M f"
    4.48 +  by (rule integral_subalgebra[symmetric]) (auto intro: f)
    4.49 +
    4.50  locale semifinite_measure =
    4.51    fixes M :: "'a measure"
    4.52    assumes semifinite:
    4.53 @@ -685,6 +701,291 @@
    4.54    finally show ?thesis .
    4.55  qed
    4.56  
    4.57 +lemma (in complete_measure) complete_sets_sandwich_fmeasurable:
    4.58 +  assumes [measurable]: "A \<in> fmeasurable M" "C \<in> fmeasurable M" and subset: "A \<subseteq> B" "B \<subseteq> C"
    4.59 +    and measure: "measure M A = measure M C"
    4.60 +  shows "B \<in> fmeasurable M"
    4.61 +proof (rule fmeasurableI2)
    4.62 +  show "B \<subseteq> C" "C \<in> fmeasurable M" by fact+
    4.63 +  show "B \<in> sets M"
    4.64 +  proof (rule complete_sets_sandwich)
    4.65 +    show "A \<in> sets M" "C \<in> sets M" "A \<subseteq> B" "B \<subseteq> C"
    4.66 +      using assms by auto
    4.67 +    show "emeasure M A < \<infinity>"
    4.68 +      using \<open>A \<in> fmeasurable M\<close> by (auto simp: fmeasurable_def)
    4.69 +    show "emeasure M A = emeasure M C"
    4.70 +      using assms by (simp add: emeasure_eq_measure2)
    4.71 +  qed
    4.72 +qed
    4.73 +
    4.74 +lemma AE_completion_iff: "(AE x in completion M. P x) \<longleftrightarrow> (AE x in M. P x)"
    4.75 +proof
    4.76 +  assume "AE x in completion M. P x"
    4.77 +  then obtain N where "N \<in> null_sets (completion M)" and P: "{x\<in>space M. \<not> P x} \<subseteq> N"
    4.78 +    unfolding eventually_ae_filter by auto
    4.79 +  then obtain N' where N': "N' \<in> null_sets M" and "N \<subseteq> N'"
    4.80 +    unfolding null_sets_completion_iff2 by auto
    4.81 +  from P \<open>N \<subseteq> N'\<close> have "{x\<in>space M. \<not> P x} \<subseteq> N'"
    4.82 +    by auto
    4.83 +  with N' show "AE x in M. P x"
    4.84 +    unfolding eventually_ae_filter by auto
    4.85 +qed (rule AE_completion)
    4.86 +
    4.87 +lemma null_part_null_sets: "S \<in> completion M \<Longrightarrow> null_part M S \<in> null_sets (completion M)"
    4.88 +  by (auto dest!: null_part intro: null_sets_completionI null_sets_completion_subset)
    4.89 +
    4.90 +lemma AE_notin_null_part: "S \<in> completion M \<Longrightarrow> (AE x in M. x \<notin> null_part M S)"
    4.91 +  by (auto dest!: null_part_null_sets AE_not_in simp: AE_completion_iff)
    4.92 +
    4.93 +lemma completion_upper:
    4.94 +  assumes A: "A \<in> sets (completion M)"
    4.95 +  shows "\<exists>A'\<in>sets M. A \<subseteq> A' \<and> emeasure (completion M) A = emeasure M A'"
    4.96 +proof -
    4.97 +  from AE_notin_null_part[OF A] obtain N where N: "N \<in> null_sets M" "null_part M A \<subseteq> N"
    4.98 +    unfolding eventually_ae_filter using null_part_null_sets[OF A, THEN null_setsD2, THEN sets.sets_into_space] by auto
    4.99 +  show ?thesis
   4.100 +  proof (intro bexI conjI)
   4.101 +    show "A \<subseteq> main_part M A \<union> N"
   4.102 +      using \<open>null_part M A \<subseteq> N\<close> by (subst main_part_null_part_Un[symmetric, OF A]) auto
   4.103 +    show "emeasure (completion M) A = emeasure M (main_part M A \<union> N)"
   4.104 +      using A \<open>N \<in> null_sets M\<close> by (simp add: emeasure_Un_null_set)
   4.105 +  qed (use A N in auto)
   4.106 +qed
   4.107 +
   4.108 +lemma AE_in_main_part:
   4.109 +  assumes A: "A \<in> completion M" shows "AE x in M. x \<in> main_part M A \<longleftrightarrow> x \<in> A"
   4.110 +  using AE_notin_null_part[OF A]
   4.111 +  by (subst (2) main_part_null_part_Un[symmetric, OF A]) auto
   4.112 +
   4.113 +lemma completion_density_eq:
   4.114 +  assumes ae: "AE x in M. 0 < f x" and [measurable]: "f \<in> M \<rightarrow>\<^sub>M borel"
   4.115 +  shows "completion (density M f) = density (completion M) f"
   4.116 +proof (intro measure_eqI)
   4.117 +  have "N' \<in> sets M \<and> (AE x\<in>N' in M. f x = 0) \<longleftrightarrow> N' \<in> null_sets M" for N'
   4.118 +  proof safe
   4.119 +    assume N': "N' \<in> sets M" and ae_N': "AE x\<in>N' in M. f x = 0"
   4.120 +    from ae_N' ae have "AE x in M. x \<notin> N'"
   4.121 +      by eventually_elim auto
   4.122 +    then show "N' \<in> null_sets M"
   4.123 +      using N' by (simp add: AE_iff_null_sets)
   4.124 +  next
   4.125 +    assume N': "N' \<in> null_sets M" then show "N' \<in> sets M" "AE x\<in>N' in M. f x = 0"
   4.126 +      using ae AE_not_in[OF N'] by (auto simp: less_le)
   4.127 +  qed
   4.128 +  then show sets_eq: "sets (completion (density M f)) = sets (density (completion M) f)"
   4.129 +    by (simp add: sets_completion null_sets_density_iff)
   4.130 +
   4.131 +  fix A assume A: \<open>A \<in> completion (density M f)\<close>
   4.132 +  moreover
   4.133 +  have "A \<in> completion M"
   4.134 +    using A unfolding sets_eq by simp
   4.135 +  moreover
   4.136 +  have "main_part (density M f) A \<in> M"
   4.137 +    using A main_part_sets[of A "density M f"] unfolding sets_density sets_eq by simp
   4.138 +  moreover have "AE x in M. x \<in> main_part (density M f) A \<longleftrightarrow> x \<in> A"
   4.139 +    using AE_in_main_part[OF \<open>A \<in> completion (density M f)\<close>] ae by (auto simp add: AE_density)
   4.140 +  ultimately show "emeasure (completion (density M f)) A = emeasure (density (completion M) f) A"
   4.141 +    by (auto simp add: emeasure_density measurable_completion nn_integral_completion intro!: nn_integral_cong_AE)
   4.142 +qed
   4.143 +
   4.144 +lemma null_sets_subset: "A \<subseteq> B \<Longrightarrow> A \<in> sets M \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> A \<in> null_sets M"
   4.145 +  using emeasure_mono[of A B M] by (simp add: null_sets_def)
   4.146 +
   4.147 +lemma (in complete_measure) complete2: "A \<subseteq> B \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> A \<in> null_sets M"
   4.148 +  using complete[of A B] null_sets_subset[of A B M] by simp
   4.149 +
   4.150 +lemma (in complete_measure) AE_iff_null_sets: "(AE x in M. P x) \<longleftrightarrow> {x\<in>space M. \<not> P x} \<in> null_sets M"
   4.151 +  unfolding eventually_ae_filter by (auto intro: complete2)
   4.152 +
   4.153 +lemma (in complete_measure) null_sets_iff_AE: "A \<in> null_sets M \<longleftrightarrow> ((AE x in M. x \<notin> A) \<and> A \<subseteq> space M)"
   4.154 +  unfolding AE_iff_null_sets by (auto cong: rev_conj_cong dest: sets.sets_into_space simp: subset_eq)
   4.155 +
   4.156 +lemma (in complete_measure) in_sets_AE:
   4.157 +  assumes ae: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B" and A: "A \<in> sets M" and B: "B \<subseteq> space M"
   4.158 +  shows "B \<in> sets M"
   4.159 +proof -
   4.160 +  have "(AE x in M. x \<notin> B - A \<and> x \<notin> A - B)"
   4.161 +    using ae by eventually_elim auto
   4.162 +  then have "B - A \<in> null_sets M" "A - B \<in> null_sets M"
   4.163 +    using A B unfolding null_sets_iff_AE by (auto dest: sets.sets_into_space)
   4.164 +  then have "A \<union> (B - A) - (A - B) \<in> sets M"
   4.165 +    using A by blast
   4.166 +  also have "A \<union> (B - A) - (A - B) = B"
   4.167 +    by auto
   4.168 +  finally show "B \<in> sets M" .
   4.169 +qed
   4.170 +
   4.171 +lemma (in complete_measure) vimage_null_part_null_sets:
   4.172 +  assumes f: "f \<in> M \<rightarrow>\<^sub>M N" and eq: "null_sets N \<subseteq> null_sets (distr M N f)"
   4.173 +    and A: "A \<in> completion N"
   4.174 +  shows "f -` null_part N A \<inter> space M \<in> null_sets M"
   4.175 +proof -
   4.176 +  obtain N' where "N' \<in> null_sets N" "null_part N A \<subseteq> N'"
   4.177 +    using null_part[OF A] by auto
   4.178 +  then have N': "N' \<in> null_sets (distr M N f)"
   4.179 +    using eq by auto
   4.180 +  show ?thesis
   4.181 +  proof (rule complete2)
   4.182 +    show "f -` null_part N A \<inter> space M \<subseteq> f -` N' \<inter> space M"
   4.183 +      using \<open>null_part N A \<subseteq> N'\<close> by auto
   4.184 +    show "f -` N' \<inter> space M \<in> null_sets M"
   4.185 +      using f N' by (auto simp: null_sets_def emeasure_distr)
   4.186 +  qed
   4.187 +qed
   4.188 +
   4.189 +lemma (in complete_measure) vimage_null_part_sets:
   4.190 +  "f \<in> M \<rightarrow>\<^sub>M N \<Longrightarrow> null_sets N \<subseteq> null_sets (distr M N f) \<Longrightarrow> A \<in> completion N \<Longrightarrow>
   4.191 +  f -` null_part N A \<inter> space M \<in> sets M"
   4.192 +  using vimage_null_part_null_sets[of f N A] by auto
   4.193 +
   4.194 +lemma (in complete_measure) measurable_completion2:
   4.195 +  assumes f: "f \<in> M \<rightarrow>\<^sub>M N" and null_sets: "null_sets N \<subseteq> null_sets (distr M N f)"
   4.196 +  shows "f \<in> M \<rightarrow>\<^sub>M completion N"
   4.197 +proof (rule measurableI)
   4.198 +  show "x \<in> space M \<Longrightarrow> f x \<in> space (completion N)" for x
   4.199 +    using f[THEN measurable_space] by auto
   4.200 +  fix A assume A: "A \<in> sets (completion N)"
   4.201 +  have "f -` A \<inter> space M = (f -` main_part N A \<inter> space M) \<union> (f -` null_part N A \<inter> space M)"
   4.202 +    using main_part_null_part_Un[OF A] by auto
   4.203 +  then show "f -` A \<inter> space M \<in> sets M"
   4.204 +    using f A null_sets by (auto intro: vimage_null_part_sets measurable_sets)
   4.205 +qed
   4.206 +
   4.207 +lemma (in complete_measure) completion_distr_eq:
   4.208 +  assumes X: "X \<in> M \<rightarrow>\<^sub>M N" and null_sets: "null_sets (distr M N X) = null_sets N"
   4.209 +  shows "completion (distr M N X) = distr M (completion N) X"
   4.210 +proof (rule measure_eqI)
   4.211 +  show eq: "sets (completion (distr M N X)) = sets (distr M (completion N) X)"
   4.212 +    by (simp add: sets_completion null_sets)
   4.213 +
   4.214 +  fix A assume A: "A \<in> completion (distr M N X)"
   4.215 +  moreover have A': "A \<in> completion N"
   4.216 +    using A by (simp add: eq)
   4.217 +  moreover have "main_part (distr M N X) A \<in> sets N"
   4.218 +    using main_part_sets[OF A] by simp
   4.219 +  moreover have "X -` A \<inter> space M = (X -` main_part (distr M N X) A \<inter> space M) \<union> (X -` null_part (distr M N X) A \<inter> space M)"
   4.220 +    using main_part_null_part_Un[OF A] by auto
   4.221 +  moreover have "X -` null_part (distr M N X) A \<inter> space M \<in> null_sets M"
   4.222 +    using X A by (intro vimage_null_part_null_sets) (auto cong: distr_cong)
   4.223 +  ultimately show "emeasure (completion (distr M N X)) A = emeasure (distr M (completion N) X) A"
   4.224 +    using X by (auto simp: emeasure_distr measurable_completion null_sets measurable_completion2
   4.225 +                     intro!: emeasure_Un_null_set[symmetric])
   4.226 +qed
   4.227 +
   4.228 +lemma distr_completion: "X \<in> M \<rightarrow>\<^sub>M N \<Longrightarrow> distr (completion M) N X = distr M N X"
   4.229 +  by (intro measure_eqI) (auto simp: emeasure_distr measurable_completion)
   4.230 +
   4.231 +proposition (in complete_measure) fmeasurable_inner_outer:
   4.232 +  "S \<in> fmeasurable M \<longleftrightarrow>
   4.233 +    (\<forall>e>0. \<exists>T\<in>fmeasurable M. \<exists>U\<in>fmeasurable M. T \<subseteq> S \<and> S \<subseteq> U \<and> \<bar>measure M T - measure M U\<bar> < e)"
   4.234 +  (is "_ \<longleftrightarrow> ?approx")
   4.235 +proof safe
   4.236 +  let ?\<mu> = "measure M" let ?D = "\<lambda>T U . \<bar>?\<mu> T - ?\<mu> U\<bar>"
   4.237 +  assume ?approx
   4.238 +  have "\<exists>A. \<forall>n. (fst (A n) \<in> fmeasurable M \<and> snd (A n) \<in> fmeasurable M \<and> fst (A n) \<subseteq> S \<and> S \<subseteq> snd (A n) \<and>
   4.239 +    ?D (fst (A n)) (snd (A n)) < 1/Suc n) \<and> (fst (A n) \<subseteq> fst (A (Suc n)) \<and> snd (A (Suc n)) \<subseteq> snd (A n))"
   4.240 +    (is "\<exists>A. \<forall>n. ?P n (A n) \<and> ?Q (A n) (A (Suc n))")
   4.241 +  proof (intro dependent_nat_choice)
   4.242 +    show "\<exists>A. ?P 0 A"
   4.243 +      using \<open>?approx\<close>[THEN spec, of 1] by auto
   4.244 +  next
   4.245 +    fix A n assume "?P n A"
   4.246 +    moreover
   4.247 +    from \<open>?approx\<close>[THEN spec, of "1/Suc (Suc n)"]
   4.248 +    obtain T U where *: "T \<in> fmeasurable M" "U \<in> fmeasurable M" "T \<subseteq> S" "S \<subseteq> U" "?D T U < 1 / Suc (Suc n)"
   4.249 +      by auto
   4.250 +    ultimately have "?\<mu> T \<le> ?\<mu> (T \<union> fst A)" "?\<mu> (U \<inter> snd A) \<le> ?\<mu> U"
   4.251 +      "?\<mu> T \<le> ?\<mu> U" "?\<mu> (T \<union> fst A) \<le> ?\<mu> (U \<inter> snd A)"
   4.252 +      by (auto intro!: measure_mono_fmeasurable)
   4.253 +    then have "?D (T \<union> fst A) (U \<inter> snd A) \<le> ?D T U"
   4.254 +      by auto
   4.255 +    also have "?D T U < 1/Suc (Suc n)" by fact
   4.256 +    finally show "\<exists>B. ?P (Suc n) B \<and> ?Q A B"
   4.257 +      using \<open>?P n A\<close> *
   4.258 +      by (intro exI[of _ "(T \<union> fst A, U \<inter> snd A)"] conjI) auto
   4.259 +  qed
   4.260 +  then obtain A
   4.261 +    where lm: "\<And>n. fst (A n) \<in> fmeasurable M" "\<And>n. snd (A n) \<in> fmeasurable M"
   4.262 +      and set_bound: "\<And>n. fst (A n) \<subseteq> S" "\<And>n. S \<subseteq> snd (A n)"
   4.263 +      and mono: "\<And>n. fst (A n) \<subseteq> fst (A (Suc n))" "\<And>n. snd (A (Suc n)) \<subseteq> snd (A n)"
   4.264 +      and bound: "\<And>n. ?D (fst (A n)) (snd (A n)) < 1/Suc n"
   4.265 +    by metis
   4.266 +
   4.267 +  have INT_sA: "(\<Inter>n. snd (A n)) \<in> fmeasurable M"
   4.268 +    using lm by (intro fmeasurable_INT[of _ 0]) auto
   4.269 +  have UN_fA: "(\<Union>n. fst (A n)) \<in> fmeasurable M"
   4.270 +    using lm order_trans[OF set_bound(1) set_bound(2)[of 0]] by (intro fmeasurable_UN[of _ _ "snd (A 0)"]) auto
   4.271 +
   4.272 +  have "(\<lambda>n. ?\<mu> (fst (A n)) - ?\<mu> (snd (A n))) \<longlonglongrightarrow> 0"
   4.273 +    using bound
   4.274 +    by (subst tendsto_rabs_zero_iff[symmetric])
   4.275 +       (intro tendsto_sandwich[OF _ _ tendsto_const LIMSEQ_inverse_real_of_nat];
   4.276 +        auto intro!: always_eventually less_imp_le simp: divide_inverse)
   4.277 +  moreover
   4.278 +  have "(\<lambda>n. ?\<mu> (fst (A n)) - ?\<mu> (snd (A n))) \<longlonglongrightarrow> ?\<mu> (\<Union>n. fst (A n)) - ?\<mu> (\<Inter>n. snd (A n))"
   4.279 +  proof (intro tendsto_diff Lim_measure_incseq Lim_measure_decseq)
   4.280 +    show "range (\<lambda>i. fst (A i)) \<subseteq> sets M" "range (\<lambda>i. snd (A i)) \<subseteq> sets M"
   4.281 +      "incseq (\<lambda>i. fst (A i))" "decseq (\<lambda>n. snd (A n))"
   4.282 +      using mono lm by (auto simp: incseq_Suc_iff decseq_Suc_iff intro!: measure_mono_fmeasurable)
   4.283 +    show "emeasure M (\<Union>x. fst (A x)) \<noteq> \<infinity>" "emeasure M (snd (A n)) \<noteq> \<infinity>" for n
   4.284 +      using lm(2)[of n] UN_fA by (auto simp: fmeasurable_def)
   4.285 +  qed
   4.286 +  ultimately have eq: "0 = ?\<mu> (\<Union>n. fst (A n)) - ?\<mu> (\<Inter>n. snd (A n))"
   4.287 +    by (rule LIMSEQ_unique)
   4.288 +
   4.289 +  show "S \<in> fmeasurable M"
   4.290 +    using UN_fA INT_sA
   4.291 +  proof (rule complete_sets_sandwich_fmeasurable)
   4.292 +    show "(\<Union>n. fst (A n)) \<subseteq> S" "S \<subseteq> (\<Inter>n. snd (A n))"
   4.293 +      using set_bound by auto
   4.294 +    show "?\<mu> (\<Union>n. fst (A n)) = ?\<mu> (\<Inter>n. snd (A n))"
   4.295 +      using eq by auto
   4.296 +  qed
   4.297 +qed (auto intro!: bexI[of _ S])
   4.298 +
   4.299 +lemma (in complete_measure) fmeasurable_measure_inner_outer:
   4.300 +   "(S \<in> fmeasurable M \<and> m = measure M S) \<longleftrightarrow>
   4.301 +      (\<forall>e>0. \<exists>T\<in>fmeasurable M. T \<subseteq> S \<and> m - e < measure M T) \<and>
   4.302 +      (\<forall>e>0. \<exists>U\<in>fmeasurable M. S \<subseteq> U \<and> measure M U < m + e)"
   4.303 +    (is "?lhs = ?rhs")
   4.304 +proof
   4.305 +  assume RHS: ?rhs
   4.306 +  then have T: "\<And>e. 0 < e \<longrightarrow> (\<exists>T\<in>fmeasurable M. T \<subseteq> S \<and> m - e < measure M T)"
   4.307 +        and U: "\<And>e. 0 < e \<longrightarrow> (\<exists>U\<in>fmeasurable M. S \<subseteq> U \<and> measure M U < m + e)"
   4.308 +    by auto
   4.309 +  have "S \<in> fmeasurable M"
   4.310 +  proof (subst fmeasurable_inner_outer, safe)
   4.311 +    fix e::real assume "0 < e"
   4.312 +    with RHS obtain T U where T: "T \<in> fmeasurable M" "T \<subseteq> S" "m - e/2 < measure M T"
   4.313 +                          and U: "U \<in> fmeasurable M" "S \<subseteq> U" "measure M U < m + e/2"
   4.314 +      by (meson half_gt_zero)+
   4.315 +    moreover have "measure M U - measure M T < (m + e/2) - (m - e/2)"
   4.316 +      by (intro diff_strict_mono) fact+
   4.317 +    moreover have "measure M T \<le> measure M U"
   4.318 +      using T U by (intro measure_mono_fmeasurable) auto
   4.319 +    ultimately show "\<exists>T\<in>fmeasurable M. \<exists>U\<in>fmeasurable M. T \<subseteq> S \<and> S \<subseteq> U \<and> \<bar>measure M T - measure M U\<bar> < e"
   4.320 +      apply (rule_tac bexI[OF _ \<open>T \<in> fmeasurable M\<close>])
   4.321 +      apply (rule_tac bexI[OF _ \<open>U \<in> fmeasurable M\<close>])
   4.322 +      by auto
   4.323 +  qed
   4.324 +  moreover have "m = measure M S"
   4.325 +    using \<open>S \<in> fmeasurable M\<close> U[of "measure M S - m"] T[of "m - measure M S"]
   4.326 +    by (cases m "measure M S" rule: linorder_cases)
   4.327 +       (auto simp: not_le[symmetric] measure_mono_fmeasurable)
   4.328 +  ultimately show ?lhs
   4.329 +    by simp
   4.330 +qed (auto intro!: bexI[of _ S])
   4.331 +
   4.332 +lemma (in complete_measure) null_sets_outer:
   4.333 +  "S \<in> null_sets M \<longleftrightarrow> (\<forall>e>0. \<exists>T\<in>fmeasurable M. S \<subseteq> T \<and> measure M T < e)"
   4.334 +proof -
   4.335 +  have "S \<in> null_sets M \<longleftrightarrow> (S \<in> fmeasurable M \<and> 0 = measure M S)"
   4.336 +    by (auto simp: null_sets_def emeasure_eq_measure2 intro: fmeasurableI) (simp add: measure_def)
   4.337 +  also have "\<dots> = (\<forall>e>0. \<exists>T\<in>fmeasurable M. S \<subseteq> T \<and> measure M T < e)"
   4.338 +    unfolding fmeasurable_measure_inner_outer by auto
   4.339 +  finally show ?thesis .
   4.340 +qed
   4.341 +
   4.342  lemma (in cld_measure) notin_sets_outer_measure_of_cover:
   4.343    assumes E: "E \<subseteq> space M" "E \<notin> sets M"
   4.344    shows "\<exists>B\<in>sets M. 0 < emeasure M B \<and> emeasure M B < \<infinity> \<and>
     5.1 --- a/src/HOL/Analysis/Convex_Euclidean_Space.thy	Thu Sep 29 16:49:42 2016 +0200
     5.2 +++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy	Fri Sep 30 10:00:49 2016 +0200
     5.3 @@ -6417,6 +6417,26 @@
     5.4    unfolding segment_convex_hull
     5.5    by (auto intro!: hull_subset[unfolded subset_eq, rule_format])
     5.6  
     5.7 +lemma eventually_closed_segment:
     5.8 +  fixes x0::"'a::real_normed_vector"
     5.9 +  assumes "open X0" "x0 \<in> X0"
    5.10 +  shows "\<forall>\<^sub>F x in at x0 within U. closed_segment x0 x \<subseteq> X0"
    5.11 +proof -
    5.12 +  from openE[OF assms]
    5.13 +  obtain e where e: "0 < e" "ball x0 e \<subseteq> X0" .
    5.14 +  then have "\<forall>\<^sub>F x in at x0 within U. x \<in> ball x0 e"
    5.15 +    by (auto simp: dist_commute eventually_at)
    5.16 +  then show ?thesis
    5.17 +  proof eventually_elim
    5.18 +    case (elim x)
    5.19 +    have "x0 \<in> ball x0 e" using \<open>e > 0\<close> by simp
    5.20 +    from convex_ball[unfolded convex_contains_segment, rule_format, OF this elim]
    5.21 +    have "closed_segment x0 x \<subseteq> ball x0 e" .
    5.22 +    also note \<open>\<dots> \<subseteq> X0\<close>
    5.23 +    finally show ?case .
    5.24 +  qed
    5.25 +qed
    5.26 +
    5.27  lemma segment_furthest_le:
    5.28    fixes a b x y :: "'a::euclidean_space"
    5.29    assumes "x \<in> closed_segment a b"
    5.30 @@ -8697,6 +8717,59 @@
    5.31  apply (simp add: rel_frontier_def convex_affine_closure_Int frontier_def)
    5.32  by (metis Diff_Int_distrib2 Int_emptyI convex_affine_closure_Int convex_affine_rel_interior_Int empty_iff interior_rel_interior_gen)
    5.33  
    5.34 +lemma rel_interior_convex_Int_affine:
    5.35 +  fixes S :: "'a::euclidean_space set"
    5.36 +  assumes "convex S" "affine T" "interior S \<inter> T \<noteq> {}"
    5.37 +    shows "rel_interior(S \<inter> T) = interior S \<inter> T"
    5.38 +proof -
    5.39 +  obtain a where aS: "a \<in> interior S" and aT:"a \<in> T"
    5.40 +    using assms by force
    5.41 +  have "rel_interior S = interior S"
    5.42 +    by (metis (no_types) aS affine_hull_nonempty_interior equals0D rel_interior_interior)
    5.43 +  then show ?thesis
    5.44 +    by (metis (no_types) affine_imp_convex assms convex_rel_interior_inter_two hull_same rel_interior_affine_hull)
    5.45 +qed
    5.46 +
    5.47 +lemma closure_convex_Int_affine:
    5.48 +  fixes S :: "'a::euclidean_space set"
    5.49 +  assumes "convex S" "affine T" "rel_interior S \<inter> T \<noteq> {}"
    5.50 +  shows "closure(S \<inter> T) = closure S \<inter> T"
    5.51 +proof
    5.52 +  have "closure (S \<inter> T) \<subseteq> closure T"
    5.53 +    by (simp add: closure_mono)
    5.54 +  also have "... \<subseteq> T"
    5.55 +    by (simp add: affine_closed assms)
    5.56 +  finally show "closure(S \<inter> T) \<subseteq> closure S \<inter> T"
    5.57 +    by (simp add: closure_mono)
    5.58 +next
    5.59 +  obtain a where "a \<in> rel_interior S" "a \<in> T"
    5.60 +    using assms by auto
    5.61 +  then have ssT: "subspace ((\<lambda>x. (-a)+x) ` T)" and "a \<in> S"
    5.62 +    using affine_diffs_subspace rel_interior_subset assms by blast+
    5.63 +  show "closure S \<inter> T \<subseteq> closure (S \<inter> T)"
    5.64 +  proof
    5.65 +    fix x  assume "x \<in> closure S \<inter> T"
    5.66 +    show "x \<in> closure (S \<inter> T)"
    5.67 +    proof (cases "x = a")
    5.68 +      case True
    5.69 +      then show ?thesis
    5.70 +        using \<open>a \<in> S\<close> \<open>a \<in> T\<close> closure_subset by fastforce
    5.71 +    next
    5.72 +      case False
    5.73 +      then have "x \<in> closure(open_segment a x)"
    5.74 +        by auto
    5.75 +      then show ?thesis
    5.76 +        using \<open>x \<in> closure S \<inter> T\<close> assms convex_affine_closure_Int by blast
    5.77 +    qed
    5.78 +  qed
    5.79 +qed
    5.80 +
    5.81 +lemma rel_frontier_convex_Int_affine:
    5.82 +  fixes S :: "'a::euclidean_space set"
    5.83 +  assumes "convex S" "affine T" "interior S \<inter> T \<noteq> {}"
    5.84 +    shows "rel_frontier(S \<inter> T) = frontier S \<inter> T"
    5.85 +by (simp add: assms convex_affine_rel_frontier_Int)
    5.86 +
    5.87  lemma subset_rel_interior_convex:
    5.88    fixes S T :: "'n::euclidean_space set"
    5.89    assumes "convex S"
    5.90 @@ -10447,7 +10520,7 @@
    5.91  
    5.92  lemma collinear_3_expand:
    5.93     "collinear{a,b,c} \<longleftrightarrow> a = c \<or> (\<exists>u. b = u *\<^sub>R a + (1 - u) *\<^sub>R c)"
    5.94 -proof -                          
    5.95 +proof -
    5.96    have "collinear{a,b,c} = collinear{a,c,b}"
    5.97      by (simp add: insert_commute)
    5.98    also have "... = collinear {0, a - c, b - c}"
     6.1 --- a/src/HOL/Analysis/Derivative.thy	Thu Sep 29 16:49:42 2016 +0200
     6.2 +++ b/src/HOL/Analysis/Derivative.thy	Fri Sep 30 10:00:49 2016 +0200
     6.3 @@ -180,13 +180,6 @@
     6.4    shows "f differentiable F \<longleftrightarrow> (\<exists>d. (f has_derivative (\<lambda>x. x *\<^sub>R d)) F)"
     6.5    by (auto simp: differentiable_def dest: has_derivative_linear linear_imp_scaleR)
     6.6  
     6.7 -lemma differentiable_within_open: (* TODO: delete *)
     6.8 -  assumes "a \<in> s"
     6.9 -    and "open s"
    6.10 -  shows "f differentiable (at a within s) \<longleftrightarrow> f differentiable (at a)"
    6.11 -  using assms
    6.12 -  by (simp only: at_within_interior interior_open)
    6.13 -
    6.14  lemma differentiable_on_eq_differentiable_at:
    6.15    "open s \<Longrightarrow> f differentiable_on s \<longleftrightarrow> (\<forall>x\<in>s. f differentiable at x)"
    6.16    unfolding differentiable_on_def
    6.17 @@ -207,6 +200,15 @@
    6.18  lemma differentiable_on_id [simp, derivative_intros]: "id differentiable_on S"
    6.19    by (simp add: id_def)
    6.20  
    6.21 +lemma differentiable_on_const [simp, derivative_intros]: "(\<lambda>z. c) differentiable_on S"
    6.22 +  by (simp add: differentiable_on_def)
    6.23 +
    6.24 +lemma differentiable_on_mult [simp, derivative_intros]:
    6.25 +  fixes f :: "'M::real_normed_vector \<Rightarrow> 'a::real_normed_algebra"
    6.26 +  shows "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z * g z) differentiable_on S"
    6.27 +  apply (simp add: differentiable_on_def differentiable_def)
    6.28 +  using differentiable_def differentiable_mult by blast
    6.29 +
    6.30  lemma differentiable_on_compose:
    6.31     "\<lbrakk>g differentiable_on S; f differentiable_on (g ` S)\<rbrakk> \<Longrightarrow> (\<lambda>x. f (g x)) differentiable_on S"
    6.32  by (simp add: differentiable_in_compose differentiable_on_def)
     7.1 --- a/src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy	Thu Sep 29 16:49:42 2016 +0200
     7.2 +++ b/src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy	Fri Sep 30 10:00:49 2016 +0200
     7.3 @@ -22,12 +22,6 @@
     7.4      by simp
     7.5  qed
     7.6  
     7.7 -abbreviation lebesgue :: "'a::euclidean_space measure"
     7.8 -  where "lebesgue \<equiv> completion lborel"
     7.9 -
    7.10 -abbreviation lebesgue_on :: "'a set \<Rightarrow> 'a::euclidean_space measure"
    7.11 -  where "lebesgue_on \<Omega> \<equiv> restrict_space (completion lborel) \<Omega>"
    7.12 -
    7.13  lemma has_integral_implies_lebesgue_measurable_cbox:
    7.14    fixes f :: "'a :: euclidean_space \<Rightarrow> real"
    7.15    assumes f: "(f has_integral I) (cbox x y)"
    7.16 @@ -779,19 +773,6 @@
    7.17  
    7.18  end
    7.19  
    7.20 -lemma measurable_completion: "f \<in> M \<rightarrow>\<^sub>M N \<Longrightarrow> f \<in> completion M \<rightarrow>\<^sub>M N"
    7.21 -  by (auto simp: measurable_def)
    7.22 -
    7.23 -lemma integrable_completion:
    7.24 -  fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
    7.25 -  shows "f \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> integrable (completion M) f \<longleftrightarrow> integrable M f"
    7.26 -  by (rule integrable_subalgebra[symmetric]) auto
    7.27 -
    7.28 -lemma integral_completion:
    7.29 -  fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
    7.30 -  assumes f: "f \<in> M \<rightarrow>\<^sub>M borel" shows "integral\<^sup>L (completion M) f = integral\<^sup>L M f"
    7.31 -  by (rule integral_subalgebra[symmetric]) (auto intro: f)
    7.32 -
    7.33  context
    7.34  begin
    7.35  
    7.36 @@ -917,6 +898,11 @@
    7.37    shows "f integrable_on S" "LINT x:S | lebesgue. f x = integral S f"
    7.38    using has_integral_set_lebesgue[OF f] by (auto simp: integral_unique integrable_on_def)
    7.39  
    7.40 +lemma lmeasurable_iff_has_integral:
    7.41 +  "S \<in> lmeasurable \<longleftrightarrow> ((indicator S) has_integral measure lebesgue S) UNIV"
    7.42 +  by (subst has_integral_iff_nn_integral_lebesgue)
    7.43 +     (auto simp: ennreal_indicator emeasure_eq_measure2 borel_measurable_indicator_iff intro!: fmeasurableI)
    7.44 +
    7.45  abbreviation
    7.46    absolutely_integrable_on :: "('a::euclidean_space \<Rightarrow> 'b::{banach, second_countable_topology}) \<Rightarrow> 'a set \<Rightarrow> bool"
    7.47    (infixr "absolutely'_integrable'_on" 46)
    7.48 @@ -948,11 +934,205 @@
    7.49    qed
    7.50  qed
    7.51  
    7.52 +lemma absolutely_integrable_on_iff_nonneg:
    7.53 +  fixes f :: "'a :: euclidean_space \<Rightarrow> real"
    7.54 +  assumes "\<And>x. 0 \<le> f x" shows "f absolutely_integrable_on s \<longleftrightarrow> f integrable_on s"
    7.55 +proof -
    7.56 +  from assms have "(\<lambda>x. \<bar>f x\<bar>) = f"
    7.57 +    by (intro ext) auto
    7.58 +  then show ?thesis
    7.59 +    unfolding absolutely_integrable_on_def by simp
    7.60 +qed
    7.61 +
    7.62  lemma absolutely_integrable_onI:
    7.63    fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
    7.64    shows "f integrable_on s \<Longrightarrow> (\<lambda>x. norm (f x)) integrable_on s \<Longrightarrow> f absolutely_integrable_on s"
    7.65    unfolding absolutely_integrable_on_def by auto
    7.66  
    7.67 +lemma lmeasurable_iff_integrable_on: "S \<in> lmeasurable \<longleftrightarrow> (\<lambda>x. 1::real) integrable_on S"
    7.68 +  by (subst absolutely_integrable_on_iff_nonneg[symmetric])
    7.69 +     (simp_all add: lmeasurable_iff_integrable)
    7.70 +
    7.71 +lemma lmeasure_integral_UNIV: "S \<in> lmeasurable \<Longrightarrow> measure lebesgue S = integral UNIV (indicator S)"
    7.72 +  by (simp add: lmeasurable_iff_has_integral integral_unique)
    7.73 +
    7.74 +lemma lmeasure_integral: "S \<in> lmeasurable \<Longrightarrow> measure lebesgue S = integral S (\<lambda>x. 1::real)"
    7.75 +  by (auto simp add: lmeasure_integral_UNIV indicator_def[abs_def] lmeasurable_iff_integrable_on)
    7.76 +
    7.77 +lemma
    7.78 +  assumes \<D>: "\<D> division_of S"
    7.79 +  shows lmeasurable_division: "S \<in> lmeasurable" (is ?l)
    7.80 +    and content_divsion: "(\<Sum>k\<in>\<D>. measure lebesgue k) = measure lebesgue S" (is ?m)
    7.81 +proof -
    7.82 +  { fix d1 d2 assume *: "d1 \<in> \<D>" "d2 \<in> \<D>" "d1 \<noteq> d2"
    7.83 +    then obtain a b c d where "d1 = cbox a b" "d2 = cbox c d"
    7.84 +      using division_ofD(4)[OF \<D>] by blast
    7.85 +    with division_ofD(5)[OF \<D> *]
    7.86 +    have "d1 \<in> sets lborel" "d2 \<in> sets lborel" "d1 \<inter> d2 \<subseteq> (cbox a b - box a b) \<union> (cbox c d - box c d)"
    7.87 +      by auto
    7.88 +    moreover have "(cbox a b - box a b) \<union> (cbox c d - box c d) \<in> null_sets lborel"
    7.89 +      by (intro null_sets.Un null_sets_cbox_Diff_box)
    7.90 +    ultimately have "d1 \<inter> d2 \<in> null_sets lborel"
    7.91 +      by (blast intro: null_sets_subset) }
    7.92 +  then show ?l ?m
    7.93 +    unfolding division_ofD(6)[OF \<D>, symmetric]
    7.94 +    using division_ofD(1,4)[OF \<D>]
    7.95 +    by (auto intro!: measure_Union_AE[symmetric] simp: completion.AE_iff_null_sets Int_def[symmetric] pairwise_def null_sets_def)
    7.96 +qed
    7.97 +
    7.98 +text \<open>This should be an abbreviation for negligible.\<close>
    7.99 +lemma negligible_iff_null_sets: "negligible S \<longleftrightarrow> S \<in> null_sets lebesgue"
   7.100 +proof
   7.101 +  assume "negligible S"
   7.102 +  then have "(indicator S has_integral (0::real)) UNIV"
   7.103 +    by (auto simp: negligible)
   7.104 +  then show "S \<in> null_sets lebesgue"
   7.105 +    by (subst (asm) has_integral_iff_nn_integral_lebesgue)
   7.106 +        (auto simp: borel_measurable_indicator_iff nn_integral_0_iff_AE AE_iff_null_sets indicator_eq_0_iff)
   7.107 +next
   7.108 +  assume S: "S \<in> null_sets lebesgue"
   7.109 +  show "negligible S"
   7.110 +    unfolding negligible_def
   7.111 +  proof (safe intro!: has_integral_iff_nn_integral_lebesgue[THEN iffD2]
   7.112 +                      has_integral_restrict_univ[where s="cbox _ _", THEN iffD1])
   7.113 +    fix a b
   7.114 +    show "(\<lambda>x. if x \<in> cbox a b then indicator S x else 0) \<in> lebesgue \<rightarrow>\<^sub>M borel"
   7.115 +      using S by (auto intro!: measurable_If)
   7.116 +    then show "(\<integral>\<^sup>+ x. ennreal (if x \<in> cbox a b then indicator S x else 0) \<partial>lebesgue) = ennreal 0"
   7.117 +      using S[THEN AE_not_in] by (auto intro!: nn_integral_0_iff_AE[THEN iffD2])
   7.118 +  qed auto
   7.119 +qed
   7.120 +
   7.121 +lemma starlike_negligible:
   7.122 +  assumes "closed S"
   7.123 +      and eq1: "\<And>c x. \<lbrakk>(a + c *\<^sub>R x) \<in> S; 0 \<le> c; a + x \<in> S\<rbrakk> \<Longrightarrow> c = 1"
   7.124 +    shows "negligible S"
   7.125 +proof -
   7.126 +  have "negligible (op + (-a) ` S)"
   7.127 +  proof (subst negligible_on_intervals, intro allI)
   7.128 +    fix u v
   7.129 +    show "negligible (op + (- a) ` S \<inter> cbox u v)"
   7.130 +      unfolding negligible_iff_null_sets
   7.131 +      apply (rule starlike_negligible_compact)
   7.132 +       apply (simp add: assms closed_translation closed_Int_compact, clarify)
   7.133 +      by (metis eq1 minus_add_cancel)
   7.134 +  qed
   7.135 +  then show ?thesis
   7.136 +    by (rule negligible_translation_rev)
   7.137 +qed
   7.138 +
   7.139 +lemma starlike_negligible_strong:
   7.140 +  assumes "closed S"
   7.141 +      and star: "\<And>c x. \<lbrakk>0 \<le> c; c < 1; a+x \<in> S\<rbrakk> \<Longrightarrow> a + c *\<^sub>R x \<notin> S"
   7.142 +    shows "negligible S"
   7.143 +proof -
   7.144 +  show ?thesis
   7.145 +  proof (rule starlike_negligible [OF \<open>closed S\<close>, of a])
   7.146 +    fix c x
   7.147 +    assume cx: "a + c *\<^sub>R x \<in> S" "0 \<le> c" "a + x \<in> S"
   7.148 +    with star have "~ (c < 1)" by auto
   7.149 +    moreover have "~ (c > 1)"
   7.150 +      using star [of "1/c" "c *\<^sub>R x"] cx by force
   7.151 +    ultimately show "c = 1" by arith
   7.152 +  qed
   7.153 +qed
   7.154 +
   7.155 +subsection\<open>Applications\<close>
   7.156 +
   7.157 +lemma negligible_hyperplane:
   7.158 +  assumes "a \<noteq> 0 \<or> b \<noteq> 0" shows "negligible {x. a \<bullet> x = b}"
   7.159 +proof -
   7.160 +  obtain x where x: "a \<bullet> x \<noteq> b"
   7.161 +    using assms
   7.162 +    apply auto
   7.163 +     apply (metis inner_eq_zero_iff inner_zero_right)
   7.164 +    using inner_zero_right by fastforce
   7.165 +  show ?thesis
   7.166 +    apply (rule starlike_negligible [OF closed_hyperplane, of x])
   7.167 +    using x apply (auto simp: algebra_simps)
   7.168 +    done
   7.169 +qed
   7.170 +
   7.171 +lemma negligible_lowdim:
   7.172 +  fixes S :: "'N :: euclidean_space set"
   7.173 +  assumes "dim S < DIM('N)"
   7.174 +    shows "negligible S"
   7.175 +proof -
   7.176 +  obtain a where "a \<noteq> 0" and a: "span S \<subseteq> {x. a \<bullet> x = 0}"
   7.177 +    using lowdim_subset_hyperplane [OF assms] by blast
   7.178 +  have "negligible (span S)"
   7.179 +    using \<open>a \<noteq> 0\<close> a negligible_hyperplane by (blast intro: negligible_subset)
   7.180 +  then show ?thesis
   7.181 +    using span_inc by (blast intro: negligible_subset)
   7.182 +qed
   7.183 +
   7.184 +proposition negligible_convex_frontier:
   7.185 +  fixes S :: "'N :: euclidean_space set"
   7.186 +  assumes "convex S"
   7.187 +    shows "negligible(frontier S)"
   7.188 +proof -
   7.189 +  have nf: "negligible(frontier S)" if "convex S" "0 \<in> S" for S :: "'N set"
   7.190 +  proof -
   7.191 +    obtain B where "B \<subseteq> S" and indB: "independent B"
   7.192 +               and spanB: "S \<subseteq> span B" and cardB: "card B = dim S"
   7.193 +      by (metis basis_exists)
   7.194 +    consider "dim S < DIM('N)" | "dim S = DIM('N)"
   7.195 +      using dim_subset_UNIV le_eq_less_or_eq by blast
   7.196 +    then show ?thesis
   7.197 +    proof cases
   7.198 +      case 1
   7.199 +      show ?thesis
   7.200 +        by (rule negligible_subset [of "closure S"])
   7.201 +           (simp_all add: Diff_subset frontier_def negligible_lowdim 1)
   7.202 +    next
   7.203 +      case 2
   7.204 +      obtain a where a: "a \<in> interior S"
   7.205 +        apply (rule interior_simplex_nonempty [OF indB])
   7.206 +          apply (simp add: indB independent_finite)
   7.207 +         apply (simp add: cardB 2)
   7.208 +        apply (metis \<open>B \<subseteq> S\<close> \<open>0 \<in> S\<close> \<open>convex S\<close> insert_absorb insert_subset interior_mono subset_hull)
   7.209 +        done
   7.210 +      show ?thesis
   7.211 +      proof (rule starlike_negligible_strong [where a=a])
   7.212 +        fix c::real and x
   7.213 +        have eq: "a + c *\<^sub>R x = (a + x) - (1 - c) *\<^sub>R ((a + x) - a)"
   7.214 +          by (simp add: algebra_simps)
   7.215 +        assume "0 \<le> c" "c < 1" "a + x \<in> frontier S"
   7.216 +        then show "a + c *\<^sub>R x \<notin> frontier S"
   7.217 +          apply (clarsimp simp: frontier_def)
   7.218 +          apply (subst eq)
   7.219 +          apply (rule mem_interior_closure_convex_shrink [OF \<open>convex S\<close> a, of _ "1-c"], auto)
   7.220 +          done
   7.221 +      qed auto
   7.222 +    qed
   7.223 +  qed
   7.224 +  show ?thesis
   7.225 +  proof (cases "S = {}")
   7.226 +    case True then show ?thesis by auto
   7.227 +  next
   7.228 +    case False
   7.229 +    then obtain a where "a \<in> S" by auto
   7.230 +    show ?thesis
   7.231 +      using nf [of "(\<lambda>x. -a + x) ` S"]
   7.232 +      by (metis \<open>a \<in> S\<close> add.left_inverse assms convex_translation_eq frontier_translation
   7.233 +                image_eqI negligible_translation_rev)
   7.234 +  qed
   7.235 +qed
   7.236 +
   7.237 +corollary negligible_sphere: "negligible (sphere a e)"
   7.238 +  using frontier_cball negligible_convex_frontier convex_cball
   7.239 +  by (blast intro: negligible_subset)
   7.240 +
   7.241 +
   7.242 +lemma non_negligible_UNIV [simp]: "\<not> negligible UNIV"
   7.243 +  unfolding negligible_iff_null_sets by (auto simp: null_sets_def emeasure_lborel_UNIV)
   7.244 +
   7.245 +lemma negligible_interval:
   7.246 +  "negligible (cbox a b) \<longleftrightarrow> box a b = {}" "negligible (box a b) \<longleftrightarrow> box a b = {}"
   7.247 +   by (auto simp: negligible_iff_null_sets null_sets_def setprod_nonneg inner_diff_left box_eq_empty
   7.248 +                  not_le emeasure_lborel_cbox_eq emeasure_lborel_box_eq
   7.249 +            intro: eq_refl antisym less_imp_le)
   7.250 +
   7.251  lemma set_integral_norm_bound:
   7.252    fixes f :: "_ \<Rightarrow> 'a :: {banach, second_countable_topology}"
   7.253    shows "set_integrable M k f \<Longrightarrow> norm (LINT x:k|M. f x) \<le> LINT x:k|M. norm (f x)"
   7.254 @@ -1209,8 +1389,8 @@
   7.255        have sum_p': "(\<Sum>(x, k)\<in>p'. norm (integral k f)) = (\<Sum>k\<in>snd ` p'. norm (integral k f))"
   7.256          apply (subst setsum.over_tagged_division_lemma[OF p'',of "\<lambda>k. norm (integral k f)"])
   7.257          unfolding norm_eq_zero
   7.258 -        apply (rule integral_null)
   7.259 -        apply assumption
   7.260 +         apply (rule integral_null)
   7.261 +        apply (simp add: content_eq_0_interior)
   7.262          apply rule
   7.263          done
   7.264        note snd_p = division_ofD[OF division_of_tagged_division[OF p(1)]]
   7.265 @@ -1657,7 +1837,7 @@
   7.266            show "(\<Sum>(x, k)\<in>p. norm (integral k f)) \<le> ?S"
   7.267              using partial_division_of_tagged_division[of p "cbox a b"] p(1)
   7.268              apply (subst setsum.over_tagged_division_lemma[OF p(1)])
   7.269 -            apply (simp add: integral_null)
   7.270 +            apply (simp add: content_eq_0_interior)
   7.271              apply (intro cSUP_upper2[OF D(2), of "snd ` p"])
   7.272              apply (auto simp: tagged_partial_division_of_def)
   7.273              done
     8.1 --- a/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy	Thu Sep 29 16:49:42 2016 +0200
     8.2 +++ b/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy	Fri Sep 30 10:00:49 2016 +0200
     8.3 @@ -6,179 +6,49 @@
     8.4  
     8.5  theory Henstock_Kurzweil_Integration
     8.6  imports
     8.7 -  Lebesgue_Measure
     8.8 +  Lebesgue_Measure Tagged_Division
     8.9  begin
    8.10  
    8.11 -lemmas scaleR_simps = scaleR_zero_left scaleR_minus_left scaleR_left_diff_distrib
    8.12 -  scaleR_zero_right scaleR_minus_right scaleR_right_diff_distrib scaleR_eq_0_iff
    8.13 -  scaleR_cancel_left scaleR_cancel_right scaleR_add_right scaleR_add_left real_vector_class.scaleR_one
    8.14 -
    8.15 -
    8.16 -subsection \<open>Sundries\<close>
    8.17 -
    8.18 -lemma conjunctD2: assumes "a \<and> b" shows a b using assms by auto
    8.19 -lemma conjunctD3: assumes "a \<and> b \<and> c" shows a b c using assms by auto
    8.20 -lemma conjunctD4: assumes "a \<and> b \<and> c \<and> d" shows a b c d using assms by auto
    8.21 -
    8.22 -lemma cond_cases: "(P \<Longrightarrow> Q x) \<Longrightarrow> (\<not> P \<Longrightarrow> Q y) \<Longrightarrow> Q (if P then x else y)"
    8.23 +(* BEGIN MOVE *)
    8.24 +lemma swap_continuous:
    8.25 +  assumes "continuous_on (cbox (a,c) (b,d)) (\<lambda>(x,y). f x y)"
    8.26 +    shows "continuous_on (cbox (c,a) (d,b)) (\<lambda>(x, y). f y x)"
    8.27 +proof -
    8.28 +  have "(\<lambda>(x, y). f y x) = (\<lambda>(x, y). f x y) \<circ> prod.swap"
    8.29 +    by auto
    8.30 +  then show ?thesis
    8.31 +    apply (rule ssubst)
    8.32 +    apply (rule continuous_on_compose)
    8.33 +    apply (simp add: split_def)
    8.34 +    apply (rule continuous_intros | simp add: assms)+
    8.35 +    done
    8.36 +qed
    8.37 +
    8.38 +
    8.39 +lemma norm_minus2: "norm (x1-x2, y1-y2) = norm (x2-x1, y2-y1)"
    8.40 +  by (simp add: norm_minus_eqI)
    8.41 +
    8.42 +lemma norm_diff2: "\<lbrakk>y = y1 + y2; x = x1 + x2; e = e1 + e2; norm(y1 - x1) \<le> e1; norm(y2 - x2) \<le> e2\<rbrakk>
    8.43 +  \<Longrightarrow> norm(y - x) \<le> e"
    8.44 +  using norm_triangle_mono [of "y1 - x1" "e1" "y2 - x2" "e2"]
    8.45 +  by (simp add: add_diff_add)
    8.46 +
    8.47 +lemma setcomp_dot1: "{z. P (z \<bullet> (i,0))} = {(x,y). P(x \<bullet> i)}"
    8.48    by auto
    8.49  
    8.50 -declare norm_triangle_ineq4[intro]
    8.51 -
    8.52 -lemma transitive_stepwise_le:
    8.53 -  assumes "\<And>x. R x x" "\<And>x y z. R x y \<Longrightarrow> R y z \<Longrightarrow> R x z" and "\<And>n. R n (Suc n)"
    8.54 -  shows "\<forall>n\<ge>m. R m n"
    8.55 -proof (intro allI impI)
    8.56 -  show "m \<le> n \<Longrightarrow> R m n" for n
    8.57 -    by (induction rule: dec_induct)
    8.58 -       (use assms in blast)+
    8.59 -qed
    8.60 -
    8.61 -subsection \<open>Some useful lemmas about intervals.\<close>
    8.62 +lemma setcomp_dot2: "{z. P (z \<bullet> (0,i))} = {(x,y). P(y \<bullet> i)}"
    8.63 +  by auto
    8.64 +
    8.65 +lemma Sigma_Int_Paircomp1: "(Sigma A B) \<inter> {(x, y). P x} = Sigma (A \<inter> {x. P x}) B"
    8.66 +  by blast
    8.67 +
    8.68 +lemma Sigma_Int_Paircomp2: "(Sigma A B) \<inter> {(x, y). P y} = Sigma A (\<lambda>z. B z \<inter> {y. P y})"
    8.69 +  by blast
    8.70  
    8.71  lemma empty_as_interval: "{} = cbox One (0::'a::euclidean_space)"
    8.72    using nonempty_Basis
    8.73    by (fastforce simp add: set_eq_iff mem_box)
    8.74 -
    8.75 -lemma interior_subset_union_intervals:
    8.76 -  assumes "i = cbox a b"
    8.77 -    and "j = cbox c d"
    8.78 -    and "interior j \<noteq> {}"
    8.79 -    and "i \<subseteq> j \<union> s"
    8.80 -    and "interior i \<inter> interior j = {}"
    8.81 -  shows "interior i \<subseteq> interior s"
    8.82 -proof -
    8.83 -  have "box a b \<inter> cbox c d = {}"
    8.84 -     using inter_interval_mixed_eq_empty[of c d a b] and assms(3,5)
    8.85 -     unfolding assms(1,2) interior_cbox by auto
    8.86 -  moreover
    8.87 -  have "box a b \<subseteq> cbox c d \<union> s"
    8.88 -    apply (rule order_trans,rule box_subset_cbox)
    8.89 -    using assms(4) unfolding assms(1,2)
    8.90 -    apply auto
    8.91 -    done
    8.92 -  ultimately
    8.93 -  show ?thesis
    8.94 -    unfolding assms interior_cbox
    8.95 -      by auto (metis IntI UnE empty_iff interior_maximal open_box subsetCE subsetI)
    8.96 -qed
    8.97 -
    8.98 -lemma interior_Union_subset_cbox:
    8.99 -  assumes "finite f"
   8.100 -  assumes f: "\<And>s. s \<in> f \<Longrightarrow> \<exists>a b. s = cbox a b" "\<And>s. s \<in> f \<Longrightarrow> interior s \<subseteq> t"
   8.101 -    and t: "closed t"
   8.102 -  shows "interior (\<Union>f) \<subseteq> t"
   8.103 -proof -
   8.104 -  have [simp]: "s \<in> f \<Longrightarrow> closed s" for s
   8.105 -    using f by auto
   8.106 -  define E where "E = {s\<in>f. interior s = {}}"
   8.107 -  then have "finite E" "E \<subseteq> {s\<in>f. interior s = {}}"
   8.108 -    using \<open>finite f\<close> by auto
   8.109 -  then have "interior (\<Union>f) = interior (\<Union>(f - E))"
   8.110 -  proof (induction E rule: finite_subset_induct')
   8.111 -    case (insert s f')
   8.112 -    have "interior (\<Union>(f - insert s f') \<union> s) = interior (\<Union>(f - insert s f'))"
   8.113 -      using insert.hyps \<open>finite f\<close> by (intro interior_closed_Un_empty_interior) auto
   8.114 -    also have "\<Union>(f - insert s f') \<union> s = \<Union>(f - f')"
   8.115 -      using insert.hyps by auto
   8.116 -    finally show ?case
   8.117 -      by (simp add: insert.IH)
   8.118 -  qed simp
   8.119 -  also have "\<dots> \<subseteq> \<Union>(f - E)"
   8.120 -    by (rule interior_subset)
   8.121 -  also have "\<dots> \<subseteq> t"
   8.122 -  proof (rule Union_least)
   8.123 -    fix s assume "s \<in> f - E"
   8.124 -    with f[of s] obtain a b where s: "s \<in> f" "s = cbox a b" "box a b \<noteq> {}"
   8.125 -      by (fastforce simp: E_def)
   8.126 -    have "closure (interior s) \<subseteq> closure t"
   8.127 -      by (intro closure_mono f \<open>s \<in> f\<close>)
   8.128 -    with s \<open>closed t\<close> show "s \<subseteq> t"
   8.129 -      by (simp add: closure_box)
   8.130 -  qed
   8.131 -  finally show ?thesis .
   8.132 -qed
   8.133 -
   8.134 -lemma inter_interior_unions_intervals:
   8.135 -    "finite f \<Longrightarrow> open s \<Longrightarrow> \<forall>t\<in>f. \<exists>a b. t = cbox a b \<Longrightarrow> \<forall>t\<in>f. s \<inter> (interior t) = {} \<Longrightarrow> s \<inter> interior (\<Union>f) = {}"
   8.136 -  using interior_Union_subset_cbox[of f "UNIV - s"] by auto
   8.137 -
   8.138 -lemma interval_split:
   8.139 -  fixes a :: "'a::euclidean_space"
   8.140 -  assumes "k \<in> Basis"
   8.141 -  shows
   8.142 -    "cbox a b \<inter> {x. x\<bullet>k \<le> c} = cbox a (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) c else b\<bullet>i) *\<^sub>R i)"
   8.143 -    "cbox a b \<inter> {x. x\<bullet>k \<ge> c} = cbox (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) c else a\<bullet>i) *\<^sub>R i) b"
   8.144 -  apply (rule_tac[!] set_eqI)
   8.145 -  unfolding Int_iff mem_box mem_Collect_eq
   8.146 -  using assms
   8.147 -  apply auto
   8.148 -  done
   8.149 -
   8.150 -lemma interval_not_empty: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow> cbox a b \<noteq> {}"
   8.151 -  by (simp add: box_ne_empty)
   8.152 -
   8.153 -subsection \<open>Bounds on intervals where they exist.\<close>
   8.154 -
   8.155 -definition interval_upperbound :: "('a::euclidean_space) set \<Rightarrow> 'a"
   8.156 -  where "interval_upperbound s = (\<Sum>i\<in>Basis. (SUP x:s. x\<bullet>i) *\<^sub>R i)"
   8.157 -
   8.158 -definition interval_lowerbound :: "('a::euclidean_space) set \<Rightarrow> 'a"
   8.159 -  where "interval_lowerbound s = (\<Sum>i\<in>Basis. (INF x:s. x\<bullet>i) *\<^sub>R i)"
   8.160 -
   8.161 -lemma interval_upperbound[simp]:
   8.162 -  "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow>
   8.163 -    interval_upperbound (cbox a b) = (b::'a::euclidean_space)"
   8.164 -  unfolding interval_upperbound_def euclidean_representation_setsum cbox_def
   8.165 -  by (safe intro!: cSup_eq) auto
   8.166 -
   8.167 -lemma interval_lowerbound[simp]:
   8.168 -  "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow>
   8.169 -    interval_lowerbound (cbox a b) = (a::'a::euclidean_space)"
   8.170 -  unfolding interval_lowerbound_def euclidean_representation_setsum cbox_def
   8.171 -  by (safe intro!: cInf_eq) auto
   8.172 -
   8.173 -lemmas interval_bounds = interval_upperbound interval_lowerbound
   8.174 -
   8.175 -lemma
   8.176 -  fixes X::"real set"
   8.177 -  shows interval_upperbound_real[simp]: "interval_upperbound X = Sup X"
   8.178 -    and interval_lowerbound_real[simp]: "interval_lowerbound X = Inf X"
   8.179 -  by (auto simp: interval_upperbound_def interval_lowerbound_def)
   8.180 -
   8.181 -lemma interval_bounds'[simp]:
   8.182 -  assumes "cbox a b \<noteq> {}"
   8.183 -  shows "interval_upperbound (cbox a b) = b"
   8.184 -    and "interval_lowerbound (cbox a b) = a"
   8.185 -  using assms unfolding box_ne_empty by auto
   8.186 -
   8.187 -lemma interval_upperbound_Times:
   8.188 -  assumes "A \<noteq> {}" and "B \<noteq> {}"
   8.189 -  shows "interval_upperbound (A \<times> B) = (interval_upperbound A, interval_upperbound B)"
   8.190 -proof-
   8.191 -  from assms have fst_image_times': "A = fst ` (A \<times> B)" by simp
   8.192 -  have "(\<Sum>i\<in>Basis. (SUP x:A \<times> B. x \<bullet> (i, 0)) *\<^sub>R i) = (\<Sum>i\<in>Basis. (SUP x:A. x \<bullet> i) *\<^sub>R i)"
   8.193 -      by (subst (2) fst_image_times') (simp del: fst_image_times add: o_def inner_Pair_0)
   8.194 -  moreover from assms have snd_image_times': "B = snd ` (A \<times> B)" by simp
   8.195 -  have "(\<Sum>i\<in>Basis. (SUP x:A \<times> B. x \<bullet> (0, i)) *\<^sub>R i) = (\<Sum>i\<in>Basis. (SUP x:B. x \<bullet> i) *\<^sub>R i)"
   8.196 -      by (subst (2) snd_image_times') (simp del: snd_image_times add: o_def inner_Pair_0)
   8.197 -  ultimately show ?thesis unfolding interval_upperbound_def
   8.198 -      by (subst setsum_Basis_prod_eq) (auto simp add: setsum_prod)
   8.199 -qed
   8.200 -
   8.201 -lemma interval_lowerbound_Times:
   8.202 -  assumes "A \<noteq> {}" and "B \<noteq> {}"
   8.203 -  shows "interval_lowerbound (A \<times> B) = (interval_lowerbound A, interval_lowerbound B)"
   8.204 -proof-
   8.205 -  from assms have fst_image_times': "A = fst ` (A \<times> B)" by simp
   8.206 -  have "(\<Sum>i\<in>Basis. (INF x:A \<times> B. x \<bullet> (i, 0)) *\<^sub>R i) = (\<Sum>i\<in>Basis. (INF x:A. x \<bullet> i) *\<^sub>R i)"
   8.207 -      by (subst (2) fst_image_times') (simp del: fst_image_times add: o_def inner_Pair_0)
   8.208 -  moreover from assms have snd_image_times': "B = snd ` (A \<times> B)" by simp
   8.209 -  have "(\<Sum>i\<in>Basis. (INF x:A \<times> B. x \<bullet> (0, i)) *\<^sub>R i) = (\<Sum>i\<in>Basis. (INF x:B. x \<bullet> i) *\<^sub>R i)"
   8.210 -      by (subst (2) snd_image_times') (simp del: snd_image_times add: o_def inner_Pair_0)
   8.211 -  ultimately show ?thesis unfolding interval_lowerbound_def
   8.212 -      by (subst setsum_Basis_prod_eq) (auto simp add: setsum_prod)
   8.213 -qed
   8.214 +(* END MOVE *)
   8.215  
   8.216  subsection \<open>Content (length, area, volume...) of an interval.\<close>
   8.217  
   8.218 @@ -300,1508 +170,34 @@
   8.219      by (auto simp: not_le)
   8.220  qed
   8.221  
   8.222 -subsection \<open>The notion of a gauge --- simply an open set containing the point.\<close>
   8.223 -
   8.224 -definition "gauge d \<longleftrightarrow> (\<forall>x. x \<in> d x \<and> open (d x))"
   8.225 -
   8.226 -lemma gaugeI:
   8.227 -  assumes "\<And>x. x \<in> g x"
   8.228 -    and "\<And>x. open (g x)"
   8.229 -  shows "gauge g"
   8.230 -  using assms unfolding gauge_def by auto
   8.231 -
   8.232 -lemma gaugeD[dest]:
   8.233 -  assumes "gauge d"
   8.234 -  shows "x \<in> d x"
   8.235 -    and "open (d x)"
   8.236 -  using assms unfolding gauge_def by auto
   8.237 -
   8.238 -lemma gauge_ball_dependent: "\<forall>x. 0 < e x \<Longrightarrow> gauge (\<lambda>x. ball x (e x))"
   8.239 -  unfolding gauge_def by auto
   8.240 -
   8.241 -lemma gauge_ball[intro]: "0 < e \<Longrightarrow> gauge (\<lambda>x. ball x e)"
   8.242 -  unfolding gauge_def by auto
   8.243 -
   8.244 -lemma gauge_trivial[intro!]: "gauge (\<lambda>x. ball x 1)"
   8.245 -  by (rule gauge_ball) auto
   8.246 -
   8.247 -lemma gauge_inter[intro]: "gauge d1 \<Longrightarrow> gauge d2 \<Longrightarrow> gauge (\<lambda>x. d1 x \<inter> d2 x)"
   8.248 -  unfolding gauge_def by auto
   8.249 -
   8.250 -lemma gauge_inters:
   8.251 -  assumes "finite s"
   8.252 -    and "\<forall>d\<in>s. gauge (f d)"
   8.253 -  shows "gauge (\<lambda>x. \<Inter>{f d x | d. d \<in> s})"
   8.254 -proof -
   8.255 -  have *: "\<And>x. {f d x |d. d \<in> s} = (\<lambda>d. f d x) ` s"
   8.256 -    by auto
   8.257 -  show ?thesis
   8.258 -    unfolding gauge_def unfolding *
   8.259 -    using assms unfolding Ball_def Inter_iff mem_Collect_eq gauge_def by auto
   8.260 -qed
   8.261 -
   8.262 -lemma gauge_existence_lemma:
   8.263 -  "(\<forall>x. \<exists>d :: real. p x \<longrightarrow> 0 < d \<and> q d x) \<longleftrightarrow> (\<forall>x. \<exists>d>0. p x \<longrightarrow> q d x)"
   8.264 -  by (metis zero_less_one)
   8.265 -
   8.266 -
   8.267 -subsection \<open>Divisions.\<close>
   8.268 -
   8.269 -definition division_of (infixl "division'_of" 40)
   8.270 -where
   8.271 -  "s division_of i \<longleftrightarrow>
   8.272 -    finite s \<and>
   8.273 -    (\<forall>k\<in>s. k \<subseteq> i \<and> k \<noteq> {} \<and> (\<exists>a b. k = cbox a b)) \<and>
   8.274 -    (\<forall>k1\<in>s. \<forall>k2\<in>s. k1 \<noteq> k2 \<longrightarrow> interior(k1) \<inter> interior(k2) = {}) \<and>
   8.275 -    (\<Union>s = i)"
   8.276 -
   8.277 -lemma division_ofD[dest]:
   8.278 -  assumes "s division_of i"
   8.279 -  shows "finite s"
   8.280 -    and "\<And>k. k \<in> s \<Longrightarrow> k \<subseteq> i"
   8.281 -    and "\<And>k. k \<in> s \<Longrightarrow> k \<noteq> {}"
   8.282 -    and "\<And>k. k \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
   8.283 -    and "\<And>k1 k2. k1 \<in> s \<Longrightarrow> k2 \<in> s \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior(k1) \<inter> interior(k2) = {}"
   8.284 -    and "\<Union>s = i"
   8.285 -  using assms unfolding division_of_def by auto
   8.286 -
   8.287 -lemma division_ofI:
   8.288 -  assumes "finite s"
   8.289 -    and "\<And>k. k \<in> s \<Longrightarrow> k \<subseteq> i"
   8.290 -    and "\<And>k. k \<in> s \<Longrightarrow> k \<noteq> {}"
   8.291 -    and "\<And>k. k \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
   8.292 -    and "\<And>k1 k2. k1 \<in> s \<Longrightarrow> k2 \<in> s \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
   8.293 -    and "\<Union>s = i"
   8.294 -  shows "s division_of i"
   8.295 -  using assms unfolding division_of_def by auto
   8.296 -
   8.297 -lemma division_of_finite: "s division_of i \<Longrightarrow> finite s"
   8.298 -  unfolding division_of_def by auto
   8.299 -
   8.300 -lemma division_of_self[intro]: "cbox a b \<noteq> {} \<Longrightarrow> {cbox a b} division_of (cbox a b)"
   8.301 -  unfolding division_of_def by auto
   8.302 -
   8.303 -lemma division_of_trivial[simp]: "s division_of {} \<longleftrightarrow> s = {}"
   8.304 -  unfolding division_of_def by auto
   8.305 -
   8.306 -lemma division_of_sing[simp]:
   8.307 -  "s division_of cbox a (a::'a::euclidean_space) \<longleftrightarrow> s = {cbox a a}"
   8.308 -  (is "?l = ?r")
   8.309 -proof
   8.310 -  assume ?r
   8.311 -  moreover
   8.312 -  { fix k
   8.313 -    assume "s = {{a}}" "k\<in>s"
   8.314 -    then have "\<exists>x y. k = cbox x y"
   8.315 -      apply (rule_tac x=a in exI)+
   8.316 -      apply (force simp: cbox_sing)
   8.317 -      done
   8.318 -  }
   8.319 -  ultimately show ?l
   8.320 -    unfolding division_of_def cbox_sing by auto
   8.321 -next
   8.322 -  assume ?l
   8.323 -  note * = conjunctD4[OF this[unfolded division_of_def cbox_sing]]
   8.324 -  {
   8.325 -    fix x
   8.326 -    assume x: "x \<in> s" have "x = {a}"
   8.327 -      using *(2)[rule_format,OF x] by auto
   8.328 -  }
   8.329 -  moreover have "s \<noteq> {}"
   8.330 -    using *(4) by auto
   8.331 -  ultimately show ?r
   8.332 -    unfolding cbox_sing by auto
   8.333 -qed
   8.334 -
   8.335 -lemma elementary_empty: obtains p where "p division_of {}"
   8.336 -  unfolding division_of_trivial by auto
   8.337 -
   8.338 -lemma elementary_interval: obtains p where "p division_of (cbox a b)"
   8.339 -  by (metis division_of_trivial division_of_self)
   8.340 -
   8.341 -lemma division_contains: "s division_of i \<Longrightarrow> \<forall>x\<in>i. \<exists>k\<in>s. x \<in> k"
   8.342 -  unfolding division_of_def by auto
   8.343 -
   8.344 -lemma forall_in_division:
   8.345 -  "d division_of i \<Longrightarrow> (\<forall>x\<in>d. P x) \<longleftrightarrow> (\<forall>a b. cbox a b \<in> d \<longrightarrow> P (cbox a b))"
   8.346 -  unfolding division_of_def by fastforce
   8.347 -
   8.348 -lemma division_of_subset:
   8.349 -  assumes "p division_of (\<Union>p)"
   8.350 -    and "q \<subseteq> p"
   8.351 -  shows "q division_of (\<Union>q)"
   8.352 -proof (rule division_ofI)
   8.353 -  note * = division_ofD[OF assms(1)]
   8.354 -  show "finite q"
   8.355 -    using "*"(1) assms(2) infinite_super by auto
   8.356 -  {
   8.357 -    fix k
   8.358 -    assume "k \<in> q"
   8.359 -    then have kp: "k \<in> p"
   8.360 -      using assms(2) by auto
   8.361 -    show "k \<subseteq> \<Union>q"
   8.362 -      using \<open>k \<in> q\<close> by auto
   8.363 -    show "\<exists>a b. k = cbox a b"
   8.364 -      using *(4)[OF kp] by auto
   8.365 -    show "k \<noteq> {}"
   8.366 -      using *(3)[OF kp] by auto
   8.367 -  }
   8.368 -  fix k1 k2
   8.369 -  assume "k1 \<in> q" "k2 \<in> q" "k1 \<noteq> k2"
   8.370 -  then have **: "k1 \<in> p" "k2 \<in> p" "k1 \<noteq> k2"
   8.371 -    using assms(2) by auto
   8.372 -  show "interior k1 \<inter> interior k2 = {}"
   8.373 -    using *(5)[OF **] by auto
   8.374 -qed auto
   8.375 -
   8.376 -lemma division_of_union_self[intro]: "p division_of s \<Longrightarrow> p division_of (\<Union>p)"
   8.377 -  unfolding division_of_def by auto
   8.378 -
   8.379  lemma division_of_content_0:
   8.380    assumes "content (cbox a b) = 0" "d division_of (cbox a b)"
   8.381    shows "\<forall>k\<in>d. content k = 0"
   8.382    unfolding forall_in_division[OF assms(2)]
   8.383    by (metis antisym_conv assms content_pos_le content_subset division_ofD(2))
   8.384  
   8.385 -lemma division_inter:
   8.386 -  fixes s1 s2 :: "'a::euclidean_space set"
   8.387 -  assumes "p1 division_of s1"
   8.388 -    and "p2 division_of s2"
   8.389 -  shows "{k1 \<inter> k2 | k1 k2. k1 \<in> p1 \<and> k2 \<in> p2 \<and> k1 \<inter> k2 \<noteq> {}} division_of (s1 \<inter> s2)"
   8.390 -  (is "?A' division_of _")
   8.391 -proof -
   8.392 -  let ?A = "{s. s \<in>  (\<lambda>(k1,k2). k1 \<inter> k2) ` (p1 \<times> p2) \<and> s \<noteq> {}}"
   8.393 -  have *: "?A' = ?A" by auto
   8.394 -  show ?thesis
   8.395 -    unfolding *
   8.396 -  proof (rule division_ofI)
   8.397 -    have "?A \<subseteq> (\<lambda>(x, y). x \<inter> y) ` (p1 \<times> p2)"
   8.398 -      by auto
   8.399 -    moreover have "finite (p1 \<times> p2)"
   8.400 -      using assms unfolding division_of_def by auto
   8.401 -    ultimately show "finite ?A" by auto
   8.402 -    have *: "\<And>s. \<Union>{x\<in>s. x \<noteq> {}} = \<Union>s"
   8.403 -      by auto
   8.404 -    show "\<Union>?A = s1 \<inter> s2"
   8.405 -      apply (rule set_eqI)
   8.406 -      unfolding * and UN_iff
   8.407 -      using division_ofD(6)[OF assms(1)] and division_ofD(6)[OF assms(2)]
   8.408 -      apply auto
   8.409 -      done
   8.410 -    {
   8.411 -      fix k
   8.412 -      assume "k \<in> ?A"
   8.413 -      then obtain k1 k2 where k: "k = k1 \<inter> k2" "k1 \<in> p1" "k2 \<in> p2" "k \<noteq> {}"
   8.414 -        by auto
   8.415 -      then show "k \<noteq> {}"
   8.416 -        by auto
   8.417 -      show "k \<subseteq> s1 \<inter> s2"
   8.418 -        using division_ofD(2)[OF assms(1) k(2)] and division_ofD(2)[OF assms(2) k(3)]
   8.419 -        unfolding k by auto
   8.420 -      obtain a1 b1 where k1: "k1 = cbox a1 b1"
   8.421 -        using division_ofD(4)[OF assms(1) k(2)] by blast
   8.422 -      obtain a2 b2 where k2: "k2 = cbox a2 b2"
   8.423 -        using division_ofD(4)[OF assms(2) k(3)] by blast
   8.424 -      show "\<exists>a b. k = cbox a b"
   8.425 -        unfolding k k1 k2 unfolding Int_interval by auto
   8.426 -    }
   8.427 -    fix k1 k2
   8.428 -    assume "k1 \<in> ?A"
   8.429 -    then obtain x1 y1 where k1: "k1 = x1 \<inter> y1" "x1 \<in> p1" "y1 \<in> p2" "k1 \<noteq> {}"
   8.430 -      by auto
   8.431 -    assume "k2 \<in> ?A"
   8.432 -    then obtain x2 y2 where k2: "k2 = x2 \<inter> y2" "x2 \<in> p1" "y2 \<in> p2" "k2 \<noteq> {}"
   8.433 -      by auto
   8.434 -    assume "k1 \<noteq> k2"
   8.435 -    then have th: "x1 \<noteq> x2 \<or> y1 \<noteq> y2"
   8.436 -      unfolding k1 k2 by auto
   8.437 -    have *: "interior x1 \<inter> interior x2 = {} \<or> interior y1 \<inter> interior y2 = {} \<Longrightarrow>
   8.438 -      interior (x1 \<inter> y1) \<subseteq> interior x1 \<Longrightarrow> interior (x1 \<inter> y1) \<subseteq> interior y1 \<Longrightarrow>
   8.439 -      interior (x2 \<inter> y2) \<subseteq> interior x2 \<Longrightarrow> interior (x2 \<inter> y2) \<subseteq> interior y2 \<Longrightarrow>
   8.440 -      interior (x1 \<inter> y1) \<inter> interior (x2 \<inter> y2) = {}" by auto
   8.441 -    show "interior k1 \<inter> interior k2 = {}"
   8.442 -      unfolding k1 k2
   8.443 -      apply (rule *)
   8.444 -      using assms division_ofD(5) k1 k2(2) k2(3) th apply auto
   8.445 -      done
   8.446 -  qed
   8.447 -qed
   8.448 -
   8.449 -lemma division_inter_1:
   8.450 -  assumes "d division_of i"
   8.451 -    and "cbox a (b::'a::euclidean_space) \<subseteq> i"
   8.452 -  shows "{cbox a b \<inter> k | k. k \<in> d \<and> cbox a b \<inter> k \<noteq> {}} division_of (cbox a b)"
   8.453 -proof (cases "cbox a b = {}")
   8.454 -  case True
   8.455 -  show ?thesis
   8.456 -    unfolding True and division_of_trivial by auto
   8.457 -next
   8.458 -  case False
   8.459 -  have *: "cbox a b \<inter> i = cbox a b" using assms(2) by auto
   8.460 -  show ?thesis
   8.461 -    using division_inter[OF division_of_self[OF False] assms(1)]
   8.462 -    unfolding * by auto
   8.463 -qed
   8.464 -
   8.465 -lemma elementary_inter:
   8.466 -  fixes s t :: "'a::euclidean_space set"
   8.467 -  assumes "p1 division_of s"
   8.468 -    and "p2 division_of t"
   8.469 -  shows "\<exists>p. p division_of (s \<inter> t)"
   8.470 -using assms division_inter by blast
   8.471 -
   8.472 -lemma elementary_inters:
   8.473 -  assumes "finite f"
   8.474 -    and "f \<noteq> {}"
   8.475 -    and "\<forall>s\<in>f. \<exists>p. p division_of (s::('a::euclidean_space) set)"
   8.476 -  shows "\<exists>p. p division_of (\<Inter>f)"
   8.477 -  using assms
   8.478 -proof (induct f rule: finite_induct)
   8.479 -  case (insert x f)
   8.480 -  show ?case
   8.481 -  proof (cases "f = {}")
   8.482 -    case True
   8.483 -    then show ?thesis
   8.484 -      unfolding True using insert by auto
   8.485 -  next
   8.486 -    case False
   8.487 -    obtain p where "p division_of \<Inter>f"
   8.488 -      using insert(3)[OF False insert(5)[unfolded ball_simps,THEN conjunct2]] ..
   8.489 -    moreover obtain px where "px division_of x"
   8.490 -      using insert(5)[rule_format,OF insertI1] ..
   8.491 -    ultimately show ?thesis
   8.492 -      by (simp add: elementary_inter Inter_insert)
   8.493 -  qed
   8.494 -qed auto
   8.495 -
   8.496 -lemma division_disjoint_union:
   8.497 -  assumes "p1 division_of s1"
   8.498 -    and "p2 division_of s2"
   8.499 -    and "interior s1 \<inter> interior s2 = {}"
   8.500 -  shows "(p1 \<union> p2) division_of (s1 \<union> s2)"
   8.501 -proof (rule division_ofI)
   8.502 -  note d1 = division_ofD[OF assms(1)]
   8.503 -  note d2 = division_ofD[OF assms(2)]
   8.504 -  show "finite (p1 \<union> p2)"
   8.505 -    using d1(1) d2(1) by auto
   8.506 -  show "\<Union>(p1 \<union> p2) = s1 \<union> s2"
   8.507 -    using d1(6) d2(6) by auto
   8.508 -  {
   8.509 -    fix k1 k2
   8.510 -    assume as: "k1 \<in> p1 \<union> p2" "k2 \<in> p1 \<union> p2" "k1 \<noteq> k2"
   8.511 -    moreover
   8.512 -    let ?g="interior k1 \<inter> interior k2 = {}"
   8.513 -    {
   8.514 -      assume as: "k1\<in>p1" "k2\<in>p2"
   8.515 -      have ?g
   8.516 -        using interior_mono[OF d1(2)[OF as(1)]] interior_mono[OF d2(2)[OF as(2)]]
   8.517 -        using assms(3) by blast
   8.518 -    }
   8.519 -    moreover
   8.520 -    {
   8.521 -      assume as: "k1\<in>p2" "k2\<in>p1"
   8.522 -      have ?g
   8.523 -        using interior_mono[OF d1(2)[OF as(2)]] interior_mono[OF d2(2)[OF as(1)]]
   8.524 -        using assms(3) by blast
   8.525 -    }
   8.526 -    ultimately show ?g
   8.527 -      using d1(5)[OF _ _ as(3)] and d2(5)[OF _ _ as(3)] by auto
   8.528 -  }
   8.529 -  fix k
   8.530 -  assume k: "k \<in> p1 \<union> p2"
   8.531 -  show "k \<subseteq> s1 \<union> s2"
   8.532 -    using k d1(2) d2(2) by auto
   8.533 -  show "k \<noteq> {}"
   8.534 -    using k d1(3) d2(3) by auto
   8.535 -  show "\<exists>a b. k = cbox a b"
   8.536 -    using k d1(4) d2(4) by auto
   8.537 -qed
   8.538 -
   8.539 -lemma partial_division_extend_1:
   8.540 -  fixes a b c d :: "'a::euclidean_space"
   8.541 -  assumes incl: "cbox c d \<subseteq> cbox a b"
   8.542 -    and nonempty: "cbox c d \<noteq> {}"
   8.543 -  obtains p where "p division_of (cbox a b)" "cbox c d \<in> p"
   8.544 -proof
   8.545 -  let ?B = "\<lambda>f::'a\<Rightarrow>'a \<times> 'a.
   8.546 -    cbox (\<Sum>i\<in>Basis. (fst (f i) \<bullet> i) *\<^sub>R i) (\<Sum>i\<in>Basis. (snd (f i) \<bullet> i) *\<^sub>R i)"
   8.547 -  define p where "p = ?B ` (Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)})"
   8.548 -
   8.549 -  show "cbox c d \<in> p"
   8.550 -    unfolding p_def
   8.551 -    by (auto simp add: box_eq_empty cbox_def intro!: image_eqI[where x="\<lambda>(i::'a)\<in>Basis. (c, d)"])
   8.552 -  {
   8.553 -    fix i :: 'a
   8.554 -    assume "i \<in> Basis"
   8.555 -    with incl nonempty have "a \<bullet> i \<le> c \<bullet> i" "c \<bullet> i \<le> d \<bullet> i" "d \<bullet> i \<le> b \<bullet> i"
   8.556 -      unfolding box_eq_empty subset_box by (auto simp: not_le)
   8.557 -  }
   8.558 -  note ord = this
   8.559 -
   8.560 -  show "p division_of (cbox a b)"
   8.561 -  proof (rule division_ofI)
   8.562 -    show "finite p"
   8.563 -      unfolding p_def by (auto intro!: finite_PiE)
   8.564 -    {
   8.565 -      fix k
   8.566 -      assume "k \<in> p"
   8.567 -      then obtain f where f: "f \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}" and k: "k = ?B f"
   8.568 -        by (auto simp: p_def)
   8.569 -      then show "\<exists>a b. k = cbox a b"
   8.570 -        by auto
   8.571 -      have "k \<subseteq> cbox a b \<and> k \<noteq> {}"
   8.572 -      proof (simp add: k box_eq_empty subset_box not_less, safe)
   8.573 -        fix i :: 'a
   8.574 -        assume i: "i \<in> Basis"
   8.575 -        with f have "f i = (a, c) \<or> f i = (c, d) \<or> f i = (d, b)"
   8.576 -          by (auto simp: PiE_iff)
   8.577 -        with i ord[of i]
   8.578 -        show "a \<bullet> i \<le> fst (f i) \<bullet> i" "snd (f i) \<bullet> i \<le> b \<bullet> i" "fst (f i) \<bullet> i \<le> snd (f i) \<bullet> i"
   8.579 -          by auto
   8.580 -      qed
   8.581 -      then show "k \<noteq> {}" "k \<subseteq> cbox a b"
   8.582 -        by auto
   8.583 -      {
   8.584 -        fix l
   8.585 -        assume "l \<in> p"
   8.586 -        then obtain g where g: "g \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}" and l: "l = ?B g"
   8.587 -          by (auto simp: p_def)
   8.588 -        assume "l \<noteq> k"
   8.589 -        have "\<exists>i\<in>Basis. f i \<noteq> g i"
   8.590 -        proof (rule ccontr)
   8.591 -          assume "\<not> ?thesis"
   8.592 -          with f g have "f = g"
   8.593 -            by (auto simp: PiE_iff extensional_def intro!: ext)
   8.594 -          with \<open>l \<noteq> k\<close> show False
   8.595 -            by (simp add: l k)
   8.596 -        qed
   8.597 -        then obtain i where *: "i \<in> Basis" "f i \<noteq> g i" ..
   8.598 -        then have "f i = (a, c) \<or> f i = (c, d) \<or> f i = (d, b)"
   8.599 -                  "g i = (a, c) \<or> g i = (c, d) \<or> g i = (d, b)"
   8.600 -          using f g by (auto simp: PiE_iff)
   8.601 -        with * ord[of i] show "interior l \<inter> interior k = {}"
   8.602 -          by (auto simp add: l k interior_cbox disjoint_interval intro!: bexI[of _ i])
   8.603 -      }
   8.604 -      note \<open>k \<subseteq> cbox a b\<close>
   8.605 -    }
   8.606 -    moreover
   8.607 -    {
   8.608 -      fix x assume x: "x \<in> cbox a b"
   8.609 -      have "\<forall>i\<in>Basis. \<exists>l. x \<bullet> i \<in> {fst l \<bullet> i .. snd l \<bullet> i} \<and> l \<in> {(a, c), (c, d), (d, b)}"
   8.610 -      proof
   8.611 -        fix i :: 'a
   8.612 -        assume "i \<in> Basis"
   8.613 -        with x ord[of i]
   8.614 -        have "(a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> c \<bullet> i) \<or> (c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i) \<or>
   8.615 -            (d \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> b \<bullet> i)"
   8.616 -          by (auto simp: cbox_def)
   8.617 -        then show "\<exists>l. x \<bullet> i \<in> {fst l \<bullet> i .. snd l \<bullet> i} \<and> l \<in> {(a, c), (c, d), (d, b)}"
   8.618 -          by auto
   8.619 -      qed
   8.620 -      then obtain f where
   8.621 -        f: "\<forall>i\<in>Basis. x \<bullet> i \<in> {fst (f i) \<bullet> i..snd (f i) \<bullet> i} \<and> f i \<in> {(a, c), (c, d), (d, b)}"
   8.622 -        unfolding bchoice_iff ..
   8.623 -      moreover from f have "restrict f Basis \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}"
   8.624 -        by auto
   8.625 -      moreover from f have "x \<in> ?B (restrict f Basis)"
   8.626 -        by (auto simp: mem_box)
   8.627 -      ultimately have "\<exists>k\<in>p. x \<in> k"
   8.628 -        unfolding p_def by blast
   8.629 -    }
   8.630 -    ultimately show "\<Union>p = cbox a b"
   8.631 -      by auto
   8.632 -  qed
   8.633 -qed
   8.634 -
   8.635 -lemma partial_division_extend_interval:
   8.636 -  assumes "p division_of (\<Union>p)" "(\<Union>p) \<subseteq> cbox a b"
   8.637 -  obtains q where "p \<subseteq> q" "q division_of cbox a (b::'a::euclidean_space)"
   8.638 -proof (cases "p = {}")
   8.639 -  case True
   8.640 -  obtain q where "q division_of (cbox a b)"
   8.641 -    by (rule elementary_interval)
   8.642 -  then show ?thesis
   8.643 -    using True that by blast
   8.644 -next
   8.645 -  case False
   8.646 -  note p = division_ofD[OF assms(1)]
   8.647 -  have div_cbox: "\<forall>k\<in>p. \<exists>q. q division_of cbox a b \<and> k \<in> q"
   8.648 -  proof
   8.649 -    fix k
   8.650 -    assume kp: "k \<in> p"
   8.651 -    obtain c d where k: "k = cbox c d"
   8.652 -      using p(4)[OF kp] by blast
   8.653 -    have *: "cbox c d \<subseteq> cbox a b" "cbox c d \<noteq> {}"
   8.654 -      using p(2,3)[OF kp, unfolded k] using assms(2)
   8.655 -      by (blast intro: order.trans)+
   8.656 -    obtain q where "q division_of cbox a b" "cbox c d \<in> q"
   8.657 -      by (rule partial_division_extend_1[OF *])
   8.658 -    then show "\<exists>q. q division_of cbox a b \<and> k \<in> q"
   8.659 -      unfolding k by auto
   8.660 -  qed
   8.661 -  obtain q where q: "\<And>x. x \<in> p \<Longrightarrow> q x division_of cbox a b" "\<And>x. x \<in> p \<Longrightarrow> x \<in> q x"
   8.662 -    using bchoice[OF div_cbox] by blast
   8.663 -  { fix x
   8.664 -    assume x: "x \<in> p"
   8.665 -    have "q x division_of \<Union>q x"
   8.666 -      apply (rule division_ofI)
   8.667 -      using division_ofD[OF q(1)[OF x]]
   8.668 -      apply auto
   8.669 -      done }
   8.670 -  then have "\<And>x. x \<in> p \<Longrightarrow> \<exists>d. d division_of \<Union>(q x - {x})"
   8.671 -    by (meson Diff_subset division_of_subset)
   8.672 -  then have "\<exists>d. d division_of \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p)"
   8.673 -    apply -
   8.674 -    apply (rule elementary_inters [OF finite_imageI[OF p(1)]])
   8.675 -    apply (auto simp: False elementary_inters [OF finite_imageI[OF p(1)]])
   8.676 -    done
   8.677 -  then obtain d where d: "d division_of \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p)" ..
   8.678 -  have "d \<union> p division_of cbox a b"
   8.679 -  proof -
   8.680 -    have te: "\<And>s f t. s \<noteq> {} \<Longrightarrow> \<forall>i\<in>s. f i \<union> i = t \<Longrightarrow> t = \<Inter>(f ` s) \<union> \<Union>s" by auto
   8.681 -    have cbox_eq: "cbox a b = \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p) \<union> \<Union>p"
   8.682 -    proof (rule te[OF False], clarify)
   8.683 -      fix i
   8.684 -      assume i: "i \<in> p"
   8.685 -      show "\<Union>(q i - {i}) \<union> i = cbox a b"
   8.686 -        using division_ofD(6)[OF q(1)[OF i]] using q(2)[OF i] by auto
   8.687 -    qed
   8.688 -    { fix k
   8.689 -      assume k: "k \<in> p"
   8.690 -      have *: "\<And>u t s. t \<inter> s = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<inter> t = {}"
   8.691 -        by auto
   8.692 -      have "interior (\<Inter>i\<in>p. \<Union>(q i - {i})) \<inter> interior k = {}"
   8.693 -      proof (rule *[OF inter_interior_unions_intervals])
   8.694 -        note qk=division_ofD[OF q(1)[OF k]]
   8.695 -        show "finite (q k - {k})" "open (interior k)" "\<forall>t\<in>q k - {k}. \<exists>a b. t = cbox a b"
   8.696 -          using qk by auto
   8.697 -        show "\<forall>t\<in>q k - {k}. interior k \<inter> interior t = {}"
   8.698 -          using qk(5) using q(2)[OF k] by auto
   8.699 -        show "interior (\<Inter>i\<in>p. \<Union>(q i - {i})) \<subseteq> interior (\<Union>(q k - {k}))"
   8.700 -          apply (rule interior_mono)+
   8.701 -          using k
   8.702 -          apply auto
   8.703 -          done
   8.704 -      qed } note [simp] = this
   8.705 -    show "d \<union> p division_of (cbox a b)"
   8.706 -      unfolding cbox_eq
   8.707 -      apply (rule division_disjoint_union[OF d assms(1)])
   8.708 -      apply (rule inter_interior_unions_intervals)
   8.709 -      apply (rule p open_interior ballI)+
   8.710 -      apply simp_all
   8.711 -      done
   8.712 -  qed
   8.713 -  then show ?thesis
   8.714 -    by (meson Un_upper2 that)
   8.715 -qed
   8.716 -
   8.717 -lemma elementary_bounded[dest]:
   8.718 -  fixes s :: "'a::euclidean_space set"
   8.719 -  shows "p division_of s \<Longrightarrow> bounded s"
   8.720 -  unfolding division_of_def by (metis bounded_Union bounded_cbox)
   8.721 -
   8.722 -lemma elementary_subset_cbox:
   8.723 -  "p division_of s \<Longrightarrow> \<exists>a b. s \<subseteq> cbox a (b::'a::euclidean_space)"
   8.724 -  by (meson elementary_bounded bounded_subset_cbox)
   8.725 -
   8.726 -lemma division_union_intervals_exists:
   8.727 -  fixes a b :: "'a::euclidean_space"
   8.728 -  assumes "cbox a b \<noteq> {}"
   8.729 -  obtains p where "(insert (cbox a b) p) division_of (cbox a b \<union> cbox c d)"
   8.730 -proof (cases "cbox c d = {}")
   8.731 -  case True
   8.732 -  show ?thesis
   8.733 -    apply (rule that[of "{}"])
   8.734 -    unfolding True
   8.735 -    using assms
   8.736 -    apply auto
   8.737 -    done
   8.738 -next
   8.739 -  case False
   8.740 -  show ?thesis
   8.741 -  proof (cases "cbox a b \<inter> cbox c d = {}")
   8.742 -    case True
   8.743 -    then show ?thesis
   8.744 -      by (metis that False assms division_disjoint_union division_of_self insert_is_Un interior_Int interior_empty)
   8.745 -  next
   8.746 -    case False
   8.747 -    obtain u v where uv: "cbox a b \<inter> cbox c d = cbox u v"
   8.748 -      unfolding Int_interval by auto
   8.749 -    have uv_sub: "cbox u v \<subseteq> cbox c d" using uv by auto
   8.750 -    obtain p where "p division_of cbox c d" "cbox u v \<in> p"
   8.751 -      by (rule partial_division_extend_1[OF uv_sub False[unfolded uv]])
   8.752 -    note p = this division_ofD[OF this(1)]
   8.753 -    have "interior (cbox a b \<inter> \<Union>(p - {cbox u v})) = interior(cbox u v \<inter> \<Union>(p - {cbox u v}))"
   8.754 -      apply (rule arg_cong[of _ _ interior])
   8.755 -      using p(8) uv by auto
   8.756 -    also have "\<dots> = {}"
   8.757 -      unfolding interior_Int
   8.758 -      apply (rule inter_interior_unions_intervals)
   8.759 -      using p(6) p(7)[OF p(2)] p(3)
   8.760 -      apply auto
   8.761 -      done
   8.762 -    finally have [simp]: "interior (cbox a b) \<inter> interior (\<Union>(p - {cbox u v})) = {}" by simp
   8.763 -    have cbe: "cbox a b \<union> cbox c d = cbox a b \<union> \<Union>(p - {cbox u v})"
   8.764 -      using p(8) unfolding uv[symmetric] by auto
   8.765 -    have "insert (cbox a b) (p - {cbox u v}) division_of cbox a b \<union> \<Union>(p - {cbox u v})"
   8.766 -    proof -
   8.767 -      have "{cbox a b} division_of cbox a b"
   8.768 -        by (simp add: assms division_of_self)
   8.769 -      then show "insert (cbox a b) (p - {cbox u v}) division_of cbox a b \<union> \<Union>(p - {cbox u v})"
   8.770 -        by (metis (no_types) Diff_subset \<open>interior (cbox a b) \<inter> interior (\<Union>(p - {cbox u v})) = {}\<close> division_disjoint_union division_of_subset insert_is_Un p(1) p(8))
   8.771 -    qed
   8.772 -    with that[of "p - {cbox u v}"] show ?thesis by (simp add: cbe)
   8.773 -  qed
   8.774 -qed
   8.775 -
   8.776 -lemma division_of_unions:
   8.777 -  assumes "finite f"
   8.778 -    and "\<And>p. p \<in> f \<Longrightarrow> p division_of (\<Union>p)"
   8.779 -    and "\<And>k1 k2. k1 \<in> \<Union>f \<Longrightarrow> k2 \<in> \<Union>f \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
   8.780 -  shows "\<Union>f division_of \<Union>\<Union>f"
   8.781 -  using assms
   8.782 -  by (auto intro!: division_ofI)
   8.783 -
   8.784 -lemma elementary_union_interval:
   8.785 -  fixes a b :: "'a::euclidean_space"
   8.786 -  assumes "p division_of \<Union>p"
   8.787 -  obtains q where "q division_of (cbox a b \<union> \<Union>p)"
   8.788 -proof -
   8.789 -  note assm = division_ofD[OF assms]
   8.790 -  have lem1: "\<And>f s. \<Union>\<Union>(f ` s) = \<Union>((\<lambda>x. \<Union>(f x)) ` s)"
   8.791 -    by auto
   8.792 -  have lem2: "\<And>f s. f \<noteq> {} \<Longrightarrow> \<Union>{s \<union> t |t. t \<in> f} = s \<union> \<Union>f"
   8.793 +lemma setsum_content_null:
   8.794 +  assumes "content (cbox a b) = 0"
   8.795 +    and "p tagged_division_of (cbox a b)"
   8.796 +  shows "setsum (\<lambda>(x,k). content k *\<^sub>R f x) p = (0::'a::real_normed_vector)"
   8.797 +proof (rule setsum.neutral, rule)
   8.798 +  fix y
   8.799 +  assume y: "y \<in> p"
   8.800 +  obtain x k where xk: "y = (x, k)"
   8.801 +    using surj_pair[of y] by blast
   8.802 +  note assm = tagged_division_ofD(3-4)[OF assms(2) y[unfolded xk]]
   8.803 +  from this(2) obtain c d where k: "k = cbox c d" by blast
   8.804 +  have "(\<lambda>(x, k). content k *\<^sub>R f x) y = content k *\<^sub>R f x"
   8.805 +    unfolding xk by auto
   8.806 +  also have "\<dots> = 0"
   8.807 +    using content_subset[OF assm(1)[unfolded k]] content_pos_le[of c d]
   8.808 +    unfolding assms(1) k
   8.809      by auto
   8.810 -  {
   8.811 -    presume "p = {} \<Longrightarrow> thesis"
   8.812 -      "cbox a b = {} \<Longrightarrow> thesis"
   8.813 -      "cbox a b \<noteq> {} \<Longrightarrow> interior (cbox a b) = {} \<Longrightarrow> thesis"
   8.814 -      "p \<noteq> {} \<Longrightarrow> interior (cbox a b)\<noteq>{} \<Longrightarrow> cbox a b \<noteq> {} \<Longrightarrow> thesis"
   8.815 -    then show thesis by auto
   8.816 -  next
   8.817 -    assume as: "p = {}"
   8.818 -    obtain p where "p division_of (cbox a b)"
   8.819 -      by (rule elementary_interval)
   8.820 -    then show thesis
   8.821 -      using as that by auto
   8.822 -  next
   8.823 -    assume as: "cbox a b = {}"
   8.824 -    show thesis
   8.825 -      using as assms that by auto
   8.826 -  next
   8.827 -    assume as: "interior (cbox a b) = {}" "cbox a b \<noteq> {}"
   8.828 -    show thesis
   8.829 -      apply (rule that[of "insert (cbox a b) p"],rule division_ofI)
   8.830 -      unfolding finite_insert
   8.831 -      apply (rule assm(1)) unfolding Union_insert
   8.832 -      using assm(2-4) as
   8.833 -      apply -
   8.834 -      apply (fast dest: assm(5))+
   8.835 -      done
   8.836 -  next
   8.837 -    assume as: "p \<noteq> {}" "interior (cbox a b) \<noteq> {}" "cbox a b \<noteq> {}"
   8.838 -    have "\<forall>k\<in>p. \<exists>q. (insert (cbox a b) q) division_of (cbox a b \<union> k)"
   8.839 -    proof
   8.840 -      fix k
   8.841 -      assume kp: "k \<in> p"
   8.842 -      from assm(4)[OF kp] obtain c d where "k = cbox c d" by blast
   8.843 -      then show "\<exists>q. (insert (cbox a b) q) division_of (cbox a b \<union> k)"
   8.844 -        by (meson as(3) division_union_intervals_exists)
   8.845 -    qed
   8.846 -    from bchoice[OF this] obtain q where "\<forall>x\<in>p. insert (cbox a b) (q x) division_of (cbox a b) \<union> x" ..
   8.847 -    note q = division_ofD[OF this[rule_format]]
   8.848 -    let ?D = "\<Union>{insert (cbox a b) (q k) | k. k \<in> p}"
   8.849 -    show thesis
   8.850 -    proof (rule that[OF division_ofI])
   8.851 -      have *: "{insert (cbox a b) (q k) |k. k \<in> p} = (\<lambda>k. insert (cbox a b) (q k)) ` p"
   8.852 -        by auto
   8.853 -      show "finite ?D"
   8.854 -        using "*" assm(1) q(1) by auto
   8.855 -      show "\<Union>?D = cbox a b \<union> \<Union>p"
   8.856 -        unfolding * lem1
   8.857 -        unfolding lem2[OF as(1), of "cbox a b", symmetric]
   8.858 -        using q(6)
   8.859 -        by auto
   8.860 -      fix k
   8.861 -      assume k: "k \<in> ?D"
   8.862 -      then show "k \<subseteq> cbox a b \<union> \<Union>p"
   8.863 -        using q(2) by auto
   8.864 -      show "k \<noteq> {}"
   8.865 -        using q(3) k by auto
   8.866 -      show "\<exists>a b. k = cbox a b"
   8.867 -        using q(4) k by auto
   8.868 -      fix k'
   8.869 -      assume k': "k' \<in> ?D" "k \<noteq> k'"
   8.870 -      obtain x where x: "k \<in> insert (cbox a b) (q x)" "x\<in>p"
   8.871 -        using k by auto
   8.872 -      obtain x' where x': "k'\<in>insert (cbox a b) (q x')" "x'\<in>p"
   8.873 -        using k' by auto
   8.874 -      show "interior k \<inter> interior k' = {}"
   8.875 -      proof (cases "x = x'")
   8.876 -        case True
   8.877 -        show ?thesis
   8.878 -          using True k' q(5) x' x by auto
   8.879 -      next
   8.880 -        case False
   8.881 -        {
   8.882 -          presume "k = cbox a b \<Longrightarrow> ?thesis"
   8.883 -            and "k' = cbox a b \<Longrightarrow> ?thesis"
   8.884 -            and "k \<noteq> cbox a b \<Longrightarrow> k' \<noteq> cbox a b \<Longrightarrow> ?thesis"
   8.885 -          then show ?thesis by linarith
   8.886 -        next
   8.887 -          assume as': "k  = cbox a b"
   8.888 -          show ?thesis
   8.889 -            using as' k' q(5) x' by blast
   8.890 -        next
   8.891 -          assume as': "k' = cbox a b"
   8.892 -          show ?thesis
   8.893 -            using as' k'(2) q(5) x by blast
   8.894 -        }
   8.895 -        assume as': "k \<noteq> cbox a b" "k' \<noteq> cbox a b"
   8.896 -        obtain c d where k: "k = cbox c d"
   8.897 -          using q(4)[OF x(2,1)] by blast
   8.898 -        have "interior k \<inter> interior (cbox a b) = {}"
   8.899 -          using as' k'(2) q(5) x by blast
   8.900 -        then have "interior k \<subseteq> interior x"
   8.901 -        using interior_subset_union_intervals
   8.902 -          by (metis as(2) k q(2) x interior_subset_union_intervals)
   8.903 -        moreover
   8.904 -        obtain c d where c_d: "k' = cbox c d"
   8.905 -          using q(4)[OF x'(2,1)] by blast
   8.906 -        have "interior k' \<inter> interior (cbox a b) = {}"
   8.907 -          using as'(2) q(5) x' by blast
   8.908 -        then have "interior k' \<subseteq> interior x'"
   8.909 -          by (metis as(2) c_d interior_subset_union_intervals q(2) x'(1) x'(2))
   8.910 -        ultimately show ?thesis
   8.911 -          using assm(5)[OF x(2) x'(2) False] by auto
   8.912 -      qed
   8.913 -    qed
   8.914 -  }
   8.915 -qed
   8.916 -
   8.917 -lemma elementary_unions_intervals:
   8.918 -  assumes fin: "finite f"
   8.919 -    and "\<And>s. s \<in> f \<Longrightarrow> \<exists>a b. s = cbox a (b::'a::euclidean_space)"
   8.920 -  obtains p where "p division_of (\<Union>f)"
   8.921 -proof -
   8.922 -  have "\<exists>p. p division_of (\<Union>f)"
   8.923 -  proof (induct_tac f rule:finite_subset_induct)
   8.924 -    show "\<exists>p. p division_of \<Union>{}" using elementary_empty by auto
   8.925 -  next
   8.926 -    fix x F
   8.927 -    assume as: "finite F" "x \<notin> F" "\<exists>p. p division_of \<Union>F" "x\<in>f"
   8.928 -    from this(3) obtain p where p: "p division_of \<Union>F" ..
   8.929 -    from assms(2)[OF as(4)] obtain a b where x: "x = cbox a b" by blast
   8.930 -    have *: "\<Union>F = \<Union>p"
   8.931 -      using division_ofD[OF p] by auto
   8.932 -    show "\<exists>p. p division_of \<Union>insert x F"
   8.933 -      using elementary_union_interval[OF p[unfolded *], of a b]
   8.934 -      unfolding Union_insert x * by metis
   8.935 -  qed (insert assms, auto)
   8.936 -  then show ?thesis
   8.937 -    using that by auto
   8.938 -qed
   8.939 -
   8.940 -lemma elementary_union:
   8.941 -  fixes s t :: "'a::euclidean_space set"
   8.942 -  assumes "ps division_of s" "pt division_of t"
   8.943 -  obtains p where "p division_of (s \<union> t)"
   8.944 -proof -
   8.945 -  have *: "s \<union> t = \<Union>ps \<union> \<Union>pt"
   8.946 -    using assms unfolding division_of_def by auto
   8.947 -  show ?thesis
   8.948 -    apply (rule elementary_unions_intervals[of "ps \<union> pt"])
   8.949 -    using assms apply auto
   8.950 -    by (simp add: * that)
   8.951 -qed
   8.952 -
   8.953 -lemma partial_division_extend:
   8.954 -  fixes t :: "'a::euclidean_space set"
   8.955 -  assumes "p division_of s"
   8.956 -    and "q division_of t"
   8.957 -    and "s \<subseteq> t"
   8.958 -  obtains r where "p \<subseteq> r" and "r division_of t"
   8.959 -proof -
   8.960 -  note divp = division_ofD[OF assms(1)] and divq = division_ofD[OF assms(2)]
   8.961 -  obtain a b where ab: "t \<subseteq> cbox a b"
   8.962 -    using elementary_subset_cbox[OF assms(2)] by auto
   8.963 -  obtain r1 where "p \<subseteq> r1" "r1 division_of (cbox a b)"
   8.964 -    using assms
   8.965 -    by (metis ab dual_order.trans partial_division_extend_interval divp(6))
   8.966 -  note r1 = this division_ofD[OF this(2)]
   8.967 -  obtain p' where "p' division_of \<Union>(r1 - p)"
   8.968 -    apply (rule elementary_unions_intervals[of "r1 - p"])
   8.969 -    using r1(3,6)
   8.970 -    apply auto
   8.971 -    done
   8.972 -  then obtain r2 where r2: "r2 division_of (\<Union>(r1 - p)) \<inter> (\<Union>q)"
   8.973 -    by (metis assms(2) divq(6) elementary_inter)
   8.974 -  {
   8.975 -    fix x
   8.976 -    assume x: "x \<in> t" "x \<notin> s"
   8.977 -    then have "x\<in>\<Union>r1"
   8.978 -      unfolding r1 using ab by auto
   8.979 -    then obtain r where r: "r \<in> r1" "x \<in> r"
   8.980 -      unfolding Union_iff ..
   8.981 -    moreover
   8.982 -    have "r \<notin> p"
   8.983 -    proof
   8.984 -      assume "r \<in> p"
   8.985 -      then have "x \<in> s" using divp(2) r by auto
   8.986 -      then show False using x by auto
   8.987 -    qed
   8.988 -    ultimately have "x\<in>\<Union>(r1 - p)" by auto
   8.989 -  }
   8.990 -  then have *: "t = \<Union>p \<union> (\<Union>(r1 - p) \<inter> \<Union>q)"
   8.991 -    unfolding divp divq using assms(3) by auto
   8.992 -  show ?thesis
   8.993 -    apply (rule that[of "p \<union> r2"])
   8.994 -    unfolding *
   8.995 -    defer
   8.996 -    apply (rule division_disjoint_union)
   8.997 -    unfolding divp(6)
   8.998 -    apply(rule assms r2)+
   8.999 -  proof -
  8.1000 -    have "interior s \<inter> interior (\<Union>(r1-p)) = {}"
  8.1001 -    proof (rule inter_interior_unions_intervals)
  8.1002 -      show "finite (r1 - p)" and "open (interior s)" and "\<forall>t\<in>r1-p. \<exists>a b. t = cbox a b"
  8.1003 -        using r1 by auto
  8.1004 -      have *: "\<And>s. (\<And>x. x \<in> s \<Longrightarrow> False) \<Longrightarrow> s = {}"
  8.1005 -        by auto
  8.1006 -      show "\<forall>t\<in>r1-p. interior s \<inter> interior t = {}"
  8.1007 -      proof
  8.1008 -        fix m x
  8.1009 -        assume as: "m \<in> r1 - p"
  8.1010 -        have "interior m \<inter> interior (\<Union>p) = {}"
  8.1011 -        proof (rule inter_interior_unions_intervals)
  8.1012 -          show "finite p" and "open (interior m)" and "\<forall>t\<in>p. \<exists>a b. t = cbox a b"
  8.1013 -            using divp by auto
  8.1014 -          show "\<forall>t\<in>p. interior m \<inter> interior t = {}"
  8.1015 -            by (metis DiffD1 DiffD2 as r1(1) r1(7) set_rev_mp)
  8.1016 -        qed
  8.1017 -        then show "interior s \<inter> interior m = {}"
  8.1018 -          unfolding divp by auto
  8.1019 -      qed
  8.1020 -    qed
  8.1021 -    then show "interior s \<inter> interior (\<Union>(r1-p) \<inter> (\<Union>q)) = {}"
  8.1022 -      using interior_subset by auto
  8.1023 -  qed auto
  8.1024 -qed
  8.1025 -
  8.1026 -lemma division_split_left_inj:
  8.1027 -  fixes type :: "'a::euclidean_space"
  8.1028 -  assumes "d division_of i"
  8.1029 -    and "k1 \<in> d"
  8.1030 -    and "k2 \<in> d"
  8.1031 -    and "k1 \<noteq> k2"
  8.1032 -    and "k1 \<inter> {x::'a. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  8.1033 -    and k: "k\<in>Basis"
  8.1034 -  shows "content(k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  8.1035 -proof -
  8.1036 -  note d=division_ofD[OF assms(1)]
  8.1037 -  have *: "\<And>(a::'a) b c. content (cbox a b \<inter> {x. x\<bullet>k \<le> c}) = 0 \<longleftrightarrow>
  8.1038 -    interior(cbox a b \<inter> {x. x\<bullet>k \<le> c}) = {}"
  8.1039 -    unfolding  interval_split[OF k] content_eq_0_interior by auto
  8.1040 -  guess u1 v1 using d(4)[OF assms(2)] by (elim exE) note uv1=this
  8.1041 -  guess u2 v2 using d(4)[OF assms(3)] by (elim exE) note uv2=this
  8.1042 -  have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
  8.1043 -    by auto
  8.1044 -  show ?thesis
  8.1045 -    unfolding uv1 uv2 *
  8.1046 -    apply (rule **[OF d(5)[OF assms(2-4)]])
  8.1047 -    apply (simp add: uv1)
  8.1048 -    using assms(5) uv1 by auto
  8.1049 -qed
  8.1050 -
  8.1051 -lemma division_split_right_inj:
  8.1052 -  fixes type :: "'a::euclidean_space"
  8.1053 -  assumes "d division_of i"
  8.1054 -    and "k1 \<in> d"
  8.1055 -    and "k2 \<in> d"
  8.1056 -    and "k1 \<noteq> k2"
  8.1057 -    and "k1 \<inter> {x::'a. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}"
  8.1058 -    and k: "k \<in> Basis"
  8.1059 -  shows "content (k1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
  8.1060 -proof -
  8.1061 -  note d=division_ofD[OF assms(1)]
  8.1062 -  have *: "\<And>a b::'a. \<And>c. content(cbox a b \<inter> {x. x\<bullet>k \<ge> c}) = 0 \<longleftrightarrow>
  8.1063 -    interior(cbox a b \<inter> {x. x\<bullet>k \<ge> c}) = {}"
  8.1064 -    unfolding interval_split[OF k] content_eq_0_interior by auto
  8.1065 -  guess u1 v1 using d(4)[OF assms(2)] by (elim exE) note uv1=this
  8.1066 -  guess u2 v2 using d(4)[OF assms(3)] by (elim exE) note uv2=this
  8.1067 -  have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
  8.1068 -    by auto
  8.1069 -  show ?thesis
  8.1070 -    unfolding uv1 uv2 *
  8.1071 -    apply (rule **[OF d(5)[OF assms(2-4)]])
  8.1072 -    apply (simp add: uv1)
  8.1073 -    using assms(5) uv1 by auto
  8.1074 +  finally show "(\<lambda>(x, k). content k *\<^sub>R f x) y = 0" .
  8.1075  qed
  8.1076  
  8.1077 -
  8.1078 -lemma division_split:
  8.1079 -  fixes a :: "'a::euclidean_space"
  8.1080 -  assumes "p division_of (cbox a b)"
  8.1081 -    and k: "k\<in>Basis"
  8.1082 -  shows "{l \<inter> {x. x\<bullet>k \<le> c} | l. l \<in> p \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}} division_of(cbox a b \<inter> {x. x\<bullet>k \<le> c})"
  8.1083 -      (is "?p1 division_of ?I1")
  8.1084 -    and "{l \<inter> {x. x\<bullet>k \<ge> c} | l. l \<in> p \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}} division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  8.1085 -      (is "?p2 division_of ?I2")
  8.1086 -proof (rule_tac[!] division_ofI)
  8.1087 -  note p = division_ofD[OF assms(1)]
  8.1088 -  show "finite ?p1" "finite ?p2"
  8.1089 -    using p(1) by auto
  8.1090 -  show "\<Union>?p1 = ?I1" "\<Union>?p2 = ?I2"
  8.1091 -    unfolding p(6)[symmetric] by auto
  8.1092 -  {
  8.1093 -    fix k
  8.1094 -    assume "k \<in> ?p1"
  8.1095 -    then guess l unfolding mem_Collect_eq by (elim exE conjE) note l=this
  8.1096 -    guess u v using p(4)[OF l(2)] by (elim exE) note uv=this
  8.1097 -    show "k \<subseteq> ?I1"
  8.1098 -      using l p(2) uv by force
  8.1099 -    show  "k \<noteq> {}"
  8.1100 -      by (simp add: l)
  8.1101 -    show  "\<exists>a b. k = cbox a b"
  8.1102 -      apply (simp add: l uv p(2-3)[OF l(2)])
  8.1103 -      apply (subst interval_split[OF k])
  8.1104 -      apply (auto intro: order.trans)
  8.1105 -      done
  8.1106 -    fix k'
  8.1107 -    assume "k' \<in> ?p1"
  8.1108 -    then guess l' unfolding mem_Collect_eq by (elim exE conjE) note l'=this
  8.1109 -    assume "k \<noteq> k'"
  8.1110 -    then show "interior k \<inter> interior k' = {}"
  8.1111 -      unfolding l l' using p(5)[OF l(2) l'(2)] by auto
  8.1112 -  }
  8.1113 -  {
  8.1114 -    fix k
  8.1115 -    assume "k \<in> ?p2"
  8.1116 -    then guess l unfolding mem_Collect_eq by (elim exE conjE) note l=this
  8.1117 -    guess u v using p(4)[OF l(2)] by (elim exE) note uv=this
  8.1118 -    show "k \<subseteq> ?I2"
  8.1119 -      using l p(2) uv by force
  8.1120 -    show  "k \<noteq> {}"
  8.1121 -      by (simp add: l)
  8.1122 -    show  "\<exists>a b. k = cbox a b"
  8.1123 -      apply (simp add: l uv p(2-3)[OF l(2)])
  8.1124 -      apply (subst interval_split[OF k])
  8.1125 -      apply (auto intro: order.trans)
  8.1126 -      done
  8.1127 -    fix k'
  8.1128 -    assume "k' \<in> ?p2"
  8.1129 -    then guess l' unfolding mem_Collect_eq by (elim exE conjE) note l'=this
  8.1130 -    assume "k \<noteq> k'"
  8.1131 -    then show "interior k \<inter> interior k' = {}"
  8.1132 -      unfolding l l' using p(5)[OF l(2) l'(2)] by auto
  8.1133 -  }
  8.1134 -qed
  8.1135 -
  8.1136 -subsection \<open>Tagged (partial) divisions.\<close>
  8.1137 -
  8.1138 -definition tagged_partial_division_of (infixr "tagged'_partial'_division'_of" 40)
  8.1139 -  where "s tagged_partial_division_of i \<longleftrightarrow>
  8.1140 -    finite s \<and>
  8.1141 -    (\<forall>x k. (x, k) \<in> s \<longrightarrow> x \<in> k \<and> k \<subseteq> i \<and> (\<exists>a b. k = cbox a b)) \<and>
  8.1142 -    (\<forall>x1 k1 x2 k2. (x1, k1) \<in> s \<and> (x2, k2) \<in> s \<and> (x1, k1) \<noteq> (x2, k2) \<longrightarrow>
  8.1143 -      interior k1 \<inter> interior k2 = {})"
  8.1144 -
  8.1145 -lemma tagged_partial_division_ofD[dest]:
  8.1146 -  assumes "s tagged_partial_division_of i"
  8.1147 -  shows "finite s"
  8.1148 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
  8.1149 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
  8.1150 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
  8.1151 -    and "\<And>x1 k1 x2 k2. (x1,k1) \<in> s \<Longrightarrow>
  8.1152 -      (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
  8.1153 -  using assms unfolding tagged_partial_division_of_def by blast+
  8.1154 -
  8.1155 -definition tagged_division_of (infixr "tagged'_division'_of" 40)
  8.1156 -  where "s tagged_division_of i \<longleftrightarrow> s tagged_partial_division_of i \<and> (\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
  8.1157 -
  8.1158 -lemma tagged_division_of_finite: "s tagged_division_of i \<Longrightarrow> finite s"
  8.1159 -  unfolding tagged_division_of_def tagged_partial_division_of_def by auto
  8.1160 -
  8.1161 -lemma tagged_division_of:
  8.1162 -  "s tagged_division_of i \<longleftrightarrow>
  8.1163 -    finite s \<and>
  8.1164 -    (\<forall>x k. (x, k) \<in> s \<longrightarrow> x \<in> k \<and> k \<subseteq> i \<and> (\<exists>a b. k = cbox a b)) \<and>
  8.1165 -    (\<forall>x1 k1 x2 k2. (x1, k1) \<in> s \<and> (x2, k2) \<in> s \<and> (x1, k1) \<noteq> (x2, k2) \<longrightarrow>
  8.1166 -      interior k1 \<inter> interior k2 = {}) \<and>
  8.1167 -    (\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
  8.1168 -  unfolding tagged_division_of_def tagged_partial_division_of_def by auto
  8.1169 -
  8.1170 -lemma tagged_division_ofI:
  8.1171 -  assumes "finite s"
  8.1172 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
  8.1173 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
  8.1174 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
  8.1175 -    and "\<And>x1 k1 x2 k2. (x1,k1) \<in> s \<Longrightarrow> (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow>
  8.1176 -      interior k1 \<inter> interior k2 = {}"
  8.1177 -    and "(\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
  8.1178 -  shows "s tagged_division_of i"
  8.1179 -  unfolding tagged_division_of
  8.1180 -  using assms
  8.1181 -  apply auto
  8.1182 -  apply fastforce+
  8.1183 -  done
  8.1184 -
  8.1185 -lemma tagged_division_ofD[dest]:  (*FIXME USE A LOCALE*)
  8.1186 -  assumes "s tagged_division_of i"
  8.1187 -  shows "finite s"
  8.1188 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
  8.1189 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
  8.1190 -    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
  8.1191 -    and "\<And>x1 k1 x2 k2. (x1, k1) \<in> s \<Longrightarrow> (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow>
  8.1192 -      interior k1 \<inter> interior k2 = {}"
  8.1193 -    and "(\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
  8.1194 -  using assms unfolding tagged_division_of by blast+
  8.1195 -
  8.1196 -lemma division_of_tagged_division:
  8.1197 -  assumes "s tagged_division_of i"
  8.1198 -  shows "(snd ` s) division_of i"
  8.1199 -proof (rule division_ofI)
  8.1200 -  note assm = tagged_division_ofD[OF assms]
  8.1201 -  show "\<Union>(snd ` s) = i" "finite (snd ` s)"
  8.1202 -    using assm by auto
  8.1203 -  fix k
  8.1204 -  assume k: "k \<in> snd ` s"
  8.1205 -  then obtain xk where xk: "(xk, k) \<in> s"
  8.1206 -    by auto
  8.1207 -  then show "k \<subseteq> i" "k \<noteq> {}" "\<exists>a b. k = cbox a b"
  8.1208 -    using assm by fastforce+
  8.1209 -  fix k'
  8.1210 -  assume k': "k' \<in> snd ` s" "k \<noteq> k'"
  8.1211 -  from this(1) obtain xk' where xk': "(xk', k') \<in> s"
  8.1212 -    by auto
  8.1213 -  then show "interior k \<inter> interior k' = {}"
  8.1214 -    using assm(5) k'(2) xk by blast
  8.1215 -qed
  8.1216 -
  8.1217 -lemma partial_division_of_tagged_division:
  8.1218 -  assumes "s tagged_partial_division_of i"
  8.1219 -  shows "(snd ` s) division_of \<Union>(snd ` s)"
  8.1220 -proof (rule division_ofI)
  8.1221 -  note assm = tagged_partial_division_ofD[OF assms]
  8.1222 -  show "finite (snd ` s)" "\<Union>(snd ` s) = \<Union>(snd ` s)"
  8.1223 -    using assm by auto
  8.1224 -  fix k
  8.1225 -  assume k: "k \<in> snd ` s"
  8.1226 -  then obtain xk where xk: "(xk, k) \<in> s"
  8.1227 -    by auto
  8.1228 -  then show "k \<noteq> {}" "\<exists>a b. k = cbox a b" "k \<subseteq> \<Union>(snd ` s)"
  8.1229 -    using assm by auto
  8.1230 -  fix k'
  8.1231 -  assume k': "k' \<in> snd ` s" "k \<noteq> k'"
  8.1232 -  from this(1) obtain xk' where xk': "(xk', k') \<in> s"
  8.1233 -    by auto
  8.1234 -  then show "interior k \<inter> interior k' = {}"
  8.1235 -    using assm(5) k'(2) xk by auto
  8.1236 -qed
  8.1237 -
  8.1238 -lemma tagged_partial_division_subset:
  8.1239 -  assumes "s tagged_partial_division_of i"
  8.1240 -    and "t \<subseteq> s"
  8.1241 -  shows "t tagged_partial_division_of i"
  8.1242 -  using assms
  8.1243 -  unfolding tagged_partial_division_of_def
  8.1244 -  using finite_subset[OF assms(2)]
  8.1245 -  by blast
  8.1246 -
  8.1247 -lemma (in comm_monoid_set) over_tagged_division_lemma:
  8.1248 -  assumes "p tagged_division_of i"
  8.1249 -    and "\<And>u v. cbox u v \<noteq> {} \<Longrightarrow> content (cbox u v) = 0 \<Longrightarrow> d (cbox u v) = \<^bold>1"
  8.1250 -  shows "F (\<lambda>(x,k). d k) p = F d (snd ` p)"
  8.1251 -proof -
  8.1252 -  have *: "(\<lambda>(x,k). d k) = d \<circ> snd"
  8.1253 -    unfolding o_def by (rule ext) auto
  8.1254 -  note assm = tagged_division_ofD[OF assms(1)]
  8.1255 -  show ?thesis
  8.1256 -    unfolding *
  8.1257 -  proof (rule reindex_nontrivial[symmetric])
  8.1258 -    show "finite p"
  8.1259 -      using assm by auto
  8.1260 -    fix x y
  8.1261 -    assume "x\<in>p" "y\<in>p" "x\<noteq>y" "snd x = snd y"
  8.1262 -    obtain a b where ab: "snd x = cbox a b"
  8.1263 -      using assm(4)[of "fst x" "snd x"] \<open>x\<in>p\<close> by auto
  8.1264 -    have "(fst x, snd y) \<in> p" "(fst x, snd y) \<noteq> y"
  8.1265 -      by (metis prod.collapse \<open>x\<in>p\<close> \<open>snd x = snd y\<close> \<open>x \<noteq> y\<close>)+
  8.1266 -    with \<open>x\<in>p\<close> \<open>y\<in>p\<close> have "interior (snd x) \<inter> interior (snd y) = {}"
  8.1267 -      by (intro assm(5)[of "fst x" _ "fst y"]) auto
  8.1268 -    then have "content (cbox a b) = 0"
  8.1269 -      unfolding \<open>snd x = snd y\<close>[symmetric] ab content_eq_0_interior by auto
  8.1270 -    then have "d (cbox a b) = \<^bold>1"
  8.1271 -      using assm(2)[of "fst x" "snd x"] \<open>x\<in>p\<close> ab[symmetric] by (intro assms(2)) auto
  8.1272 -    then show "d (snd x) = \<^bold>1"
  8.1273 -      unfolding ab by auto
  8.1274 -  qed
  8.1275 -qed
  8.1276 -
  8.1277 -lemma tag_in_interval: "p tagged_division_of i \<Longrightarrow> (x, k) \<in> p \<Longrightarrow> x \<in> i"
  8.1278 -  by auto
  8.1279 -
  8.1280 -lemma tagged_division_of_empty: "{} tagged_division_of {}"
  8.1281 -  unfolding tagged_division_of by auto
  8.1282 -
  8.1283 -lemma tagged_partial_division_of_trivial[simp]: "p tagged_partial_division_of {} \<longleftrightarrow> p = {}"
  8.1284 -  unfolding tagged_partial_division_of_def by auto
  8.1285 -
  8.1286 -lemma tagged_division_of_trivial[simp]: "p tagged_division_of {} \<longleftrightarrow> p = {}"
  8.1287 -  unfolding tagged_division_of by auto
  8.1288 -
  8.1289 -lemma tagged_division_of_self: "x \<in> cbox a b \<Longrightarrow> {(x,cbox a b)} tagged_division_of (cbox a b)"
  8.1290 -  by (rule tagged_division_ofI) auto
  8.1291 -
  8.1292 -lemma tagged_division_of_self_real: "x \<in> {a .. b::real} \<Longrightarrow> {(x,{a .. b})} tagged_division_of {a .. b}"
  8.1293 -  unfolding box_real[symmetric]
  8.1294 -  by (rule tagged_division_of_self)
  8.1295 -
  8.1296 -lemma tagged_division_union:
  8.1297 -  assumes "p1 tagged_division_of s1"
  8.1298 -    and "p2 tagged_division_of s2"
  8.1299 -    and "interior s1 \<inter> interior s2 = {}"
  8.1300 -  shows "(p1 \<union> p2) tagged_division_of (s1 \<union> s2)"
  8.1301 -proof (rule tagged_division_ofI)
  8.1302 -  note p1 = tagged_division_ofD[OF assms(1)]
  8.1303 -  note p2 = tagged_division_ofD[OF assms(2)]
  8.1304 -  show "finite (p1 \<union> p2)"
  8.1305 -    using p1(1) p2(1) by auto
  8.1306 -  show "\<Union>{k. \<exists>x. (x, k) \<in> p1 \<union> p2} = s1 \<union> s2"
  8.1307 -    using p1(6) p2(6) by blast
  8.1308 -  fix x k
  8.1309 -  assume xk: "(x, k) \<in> p1 \<union> p2"
  8.1310 -  show "x \<in> k" "\<exists>a b. k = cbox a b"
  8.1311 -    using xk p1(2,4) p2(2,4) by auto
  8.1312 -  show "k \<subseteq> s1 \<union> s2"
  8.1313 -    using xk p1(3) p2(3) by blast
  8.1314 -  fix x' k'
  8.1315 -  assume xk': "(x', k') \<in> p1 \<union> p2" "(x, k) \<noteq> (x', k')"
  8.1316 -  have *: "\<And>a b. a \<subseteq> s1 \<Longrightarrow> b \<subseteq> s2 \<Longrightarrow> interior a \<inter> interior b = {}"
  8.1317 -    using assms(3) interior_mono by blast
  8.1318 -  show "interior k \<inter> interior k' = {}"
  8.1319 -    apply (cases "(x, k) \<in> p1")
  8.1320 -    apply (meson "*" UnE assms(1) assms(2) p1(5) tagged_division_ofD(3) xk'(1) xk'(2))
  8.1321 -    by (metis "*" UnE assms(1) assms(2) inf_sup_aci(1) p2(5) tagged_division_ofD(3) xk xk'(1) xk'(2))
  8.1322 -qed
  8.1323 -
  8.1324 -lemma tagged_division_unions:
  8.1325 -  assumes "finite iset"
  8.1326 -    and "\<forall>i\<in>iset. pfn i tagged_division_of i"
  8.1327 -    and "\<forall>i1\<in>iset. \<forall>i2\<in>iset. i1 \<noteq> i2 \<longrightarrow> interior(i1) \<inter> interior(i2) = {}"
  8.1328 -  shows "\<Union>(pfn ` iset) tagged_division_of (\<Union>iset)"
  8.1329 -proof (rule tagged_division_ofI)
  8.1330 -  note assm = tagged_division_ofD[OF assms(2)[rule_format]]
  8.1331 -  show "finite (\<Union>(pfn ` iset))"
  8.1332 -    using assms by auto
  8.1333 -  have "\<Union>{k. \<exists>x. (x, k) \<in> \<Union>(pfn ` iset)} = \<Union>((\<lambda>i. \<Union>{k. \<exists>x. (x, k) \<in> pfn i}) ` iset)"
  8.1334 -    by blast
  8.1335 -  also have "\<dots> = \<Union>iset"
  8.1336 -    using assm(6) by auto
  8.1337 -  finally show "\<Union>{k. \<exists>x. (x, k) \<in> \<Union>(pfn ` iset)} = \<Union>iset" .
  8.1338 -  fix x k
  8.1339 -  assume xk: "(x, k) \<in> \<Union>(pfn ` iset)"
  8.1340 -  then obtain i where i: "i \<in> iset" "(x, k) \<in> pfn i"
  8.1341 -    by auto
  8.1342 -  show "x \<in> k" "\<exists>a b. k = cbox a b" "k \<subseteq> \<Union>iset"
  8.1343 -    using assm(2-4)[OF i] using i(1) by auto
  8.1344 -  fix x' k'
  8.1345 -  assume xk': "(x', k') \<in> \<Union>(pfn ` iset)" "(x, k) \<noteq> (x', k')"
  8.1346 -  then obtain i' where i': "i' \<in> iset" "(x', k') \<in> pfn i'"
  8.1347 -    by auto
  8.1348 -  have *: "\<And>a b. i \<noteq> i' \<Longrightarrow> a \<subseteq> i \<Longrightarrow> b \<subseteq> i' \<Longrightarrow> interior a \<inter> interior b = {}"
  8.1349 -    using i(1) i'(1)
  8.1350 -    using assms(3)[rule_format] interior_mono
  8.1351 -    by blast
  8.1352 -  show "interior k \<inter> interior k' = {}"
  8.1353 -    apply (cases "i = i'")
  8.1354 -    using assm(5) i' i(2) xk'(2) apply blast
  8.1355 -    using "*" assm(3) i' i by auto
  8.1356 -qed
  8.1357 -
  8.1358 -lemma tagged_partial_division_of_union_self:
  8.1359 -  assumes "p tagged_partial_division_of s"
  8.1360 -  shows "p tagged_division_of (\<Union>(snd ` p))"
  8.1361 -  apply (rule tagged_division_ofI)
  8.1362 -  using tagged_partial_division_ofD[OF assms]
  8.1363 -  apply auto
  8.1364 -  done
  8.1365 -
  8.1366 -lemma tagged_division_of_union_self:
  8.1367 -  assumes "p tagged_division_of s"
  8.1368 -  shows "p tagged_division_of (\<Union>(snd ` p))"
  8.1369 -  apply (rule tagged_division_ofI)
  8.1370 -  using tagged_division_ofD[OF assms]
  8.1371 -  apply auto
  8.1372 -  done
  8.1373 -
  8.1374 -subsection \<open>Functions closed on boxes: morphisms from boxes to monoids\<close>
  8.1375 -
  8.1376 -text \<open>This auxiliary structure is used to sum up over the elements of a division. Main theorem is
  8.1377 -  @{text operative_division}. Instances for the monoid are @{typ "'a option"}, @{typ real}, and
  8.1378 -  @{typ bool}.\<close>
  8.1379 -
  8.1380 -lemma property_empty_interval: "\<forall>a b. content (cbox a b) = 0 \<longrightarrow> P (cbox a b) \<Longrightarrow> P {}"
  8.1381 -  using content_empty unfolding empty_as_interval by auto
  8.1382 -
  8.1383 -paragraph \<open>Using additivity of lifted function to encode definedness.\<close>
  8.1384 -
  8.1385 -definition lift_option :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a option \<Rightarrow> 'b option \<Rightarrow> 'c option"
  8.1386 -where
  8.1387 -  "lift_option f a' b' = Option.bind a' (\<lambda>a. Option.bind b' (\<lambda>b. Some (f a b)))"
  8.1388 -
  8.1389 -lemma lift_option_simps[simp]:
  8.1390 -  "lift_option f (Some a) (Some b) = Some (f a b)"
  8.1391 -  "lift_option f None b' = None"
  8.1392 -  "lift_option f a' None = None"
  8.1393 -  by (auto simp: lift_option_def)
  8.1394 -
  8.1395 -lemma comm_monoid_lift_option:
  8.1396 -  assumes "comm_monoid f z"
  8.1397 -  shows "comm_monoid (lift_option f) (Some z)"
  8.1398 -proof -
  8.1399 -  from assms interpret comm_monoid f z .
  8.1400 -  show ?thesis
  8.1401 -    by standard (auto simp: lift_option_def ac_simps split: bind_split)
  8.1402 -qed
  8.1403 -
  8.1404 -lemma comm_monoid_and: "comm_monoid HOL.conj True"
  8.1405 -  by standard auto
  8.1406 -
  8.1407 -lemma comm_monoid_set_and: "comm_monoid_set HOL.conj True"
  8.1408 -  by (rule comm_monoid_set.intro) (fact comm_monoid_and)
  8.1409 -
  8.1410 -paragraph \<open>Operative\<close>
  8.1411 -
  8.1412 -definition (in comm_monoid) operative :: "('b::euclidean_space set \<Rightarrow> 'a) \<Rightarrow> bool"
  8.1413 -  where "operative g \<longleftrightarrow>
  8.1414 -    (\<forall>a b. content (cbox a b) = 0 \<longrightarrow> g (cbox a b) = \<^bold>1) \<and>
  8.1415 -    (\<forall>a b c. \<forall>k\<in>Basis. g (cbox a b) = g (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<^bold>* g (cbox a b \<inter> {x. x\<bullet>k \<ge> c}))"
  8.1416 -
  8.1417 -lemma (in comm_monoid) operativeD[dest]:
  8.1418 -  assumes "operative g"
  8.1419 -  shows "\<And>a b. content (cbox a b) = 0 \<Longrightarrow> g (cbox a b) = \<^bold>1"
  8.1420 -    and "\<And>a b c k. k \<in> Basis \<Longrightarrow> g (cbox a b) = g (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<^bold>* g (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  8.1421 -  using assms unfolding operative_def by auto
  8.1422 -
  8.1423 -lemma (in comm_monoid) operative_empty: "operative g \<Longrightarrow> g {} = \<^bold>1"
  8.1424 -  unfolding operative_def by (rule property_empty_interval) auto
  8.1425 -
  8.1426  lemma operative_content[intro]: "add.operative content"
  8.1427 -  by (force simp add: add.operative_def content_split[symmetric])
  8.1428 -
  8.1429 -definition "division_points (k::('a::euclidean_space) set) d =
  8.1430 -   {(j,x). j \<in> Basis \<and> (interval_lowerbound k)\<bullet>j < x \<and> x < (interval_upperbound k)\<bullet>j \<and>
  8.1431 -     (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  8.1432 -
  8.1433 -lemma division_points_finite:
  8.1434 -  fixes i :: "'a::euclidean_space set"
  8.1435 -  assumes "d division_of i"
  8.1436 -  shows "finite (division_points i d)"
  8.1437 -proof -
  8.1438 -  note assm = division_ofD[OF assms]
  8.1439 -  let ?M = "\<lambda>j. {(j,x)|x. (interval_lowerbound i)\<bullet>j < x \<and> x < (interval_upperbound i)\<bullet>j \<and>
  8.1440 -    (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  8.1441 -  have *: "division_points i d = \<Union>(?M ` Basis)"
  8.1442 -    unfolding division_points_def by auto
  8.1443 -  show ?thesis
  8.1444 -    unfolding * using assm by auto
  8.1445 -qed
  8.1446 -
  8.1447 -lemma division_points_subset:
  8.1448 -  fixes a :: "'a::euclidean_space"
  8.1449 -  assumes "d division_of (cbox a b)"
  8.1450 -    and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  8.1451 -    and k: "k \<in> Basis"
  8.1452 -  shows "division_points (cbox a b \<inter> {x. x\<bullet>k \<le> c}) {l \<inter> {x. x\<bullet>k \<le> c} | l . l \<in> d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}} \<subseteq>
  8.1453 -      division_points (cbox a b) d" (is ?t1)
  8.1454 -    and "division_points (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) {l \<inter> {x. x\<bullet>k \<ge> c} | l . l \<in> d \<and> ~(l \<inter> {x. x\<bullet>k \<ge> c} = {})} \<subseteq>
  8.1455 -      division_points (cbox a b) d" (is ?t2)
  8.1456 -proof -
  8.1457 -  note assm = division_ofD[OF assms(1)]
  8.1458 -  have *: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  8.1459 -    "\<forall>i\<in>Basis. a\<bullet>i \<le> (\<Sum>i\<in>Basis. (if i = k then min (b \<bullet> k) c else  b \<bullet> i) *\<^sub>R i) \<bullet> i"
  8.1460 -    "\<forall>i\<in>Basis. (\<Sum>i\<in>Basis. (if i = k then max (a \<bullet> k) c else a \<bullet> i) *\<^sub>R i) \<bullet> i \<le> b\<bullet>i"
  8.1461 -    "min (b \<bullet> k) c = c" "max (a \<bullet> k) c = c"
  8.1462 -    using assms using less_imp_le by auto
  8.1463 -  show ?t1 (*FIXME a horrible mess*)
  8.1464 -    unfolding division_points_def interval_split[OF k, of a b]
  8.1465 -    unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  8.1466 -    unfolding *
  8.1467 -    apply (rule subsetI)
  8.1468 -    unfolding mem_Collect_eq split_beta
  8.1469 -    apply (erule bexE conjE)+
  8.1470 -    apply (simp add: )
  8.1471 -    apply (erule exE conjE)+
  8.1472 -  proof
  8.1473 -    fix i l x
  8.1474 -    assume as:
  8.1475 -      "a \<bullet> fst x < snd x" "snd x < (if fst x = k then c else b \<bullet> fst x)"
  8.1476 -      "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  8.1477 -      "i = l \<inter> {x. x \<bullet> k \<le> c}" "l \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
  8.1478 -      and fstx: "fst x \<in> Basis"
  8.1479 -    from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this
  8.1480 -    have *: "\<forall>i\<in>Basis. u \<bullet> i \<le> (\<Sum>i\<in>Basis. (if i = k then min (v \<bullet> k) c else v \<bullet> i) *\<^sub>R i) \<bullet> i"
  8.1481 -      using as(6) unfolding l interval_split[OF k] box_ne_empty as .
  8.1482 -    have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
  8.1483 -      using l using as(6) unfolding box_ne_empty[symmetric] by auto
  8.1484 -    show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  8.1485 -      apply (rule bexI[OF _ \<open>l \<in> d\<close>])
  8.1486 -      using as(1-3,5) fstx
  8.1487 -      unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  8.1488 -      apply (auto split: if_split_asm)
  8.1489 -      done
  8.1490 -    show "snd x < b \<bullet> fst x"
  8.1491 -      using as(2) \<open>c < b\<bullet>k\<close> by (auto split: if_split_asm)
  8.1492 -  qed
  8.1493 -  show ?t2
  8.1494 -    unfolding division_points_def interval_split[OF k, of a b]
  8.1495 -    unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  8.1496 -    unfolding *
  8.1497 -    unfolding subset_eq
  8.1498 -    apply rule
  8.1499 -    unfolding mem_Collect_eq split_beta
  8.1500 -    apply (erule bexE conjE)+
  8.1501 -    apply (simp only: mem_Collect_eq inner_setsum_left_Basis simp_thms)
  8.1502 -    apply (erule exE conjE)+
  8.1503 -  proof
  8.1504 -    fix i l x
  8.1505 -    assume as:
  8.1506 -      "(if fst x = k then c else a \<bullet> fst x) < snd x" "snd x < b \<bullet> fst x"
  8.1507 -      "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  8.1508 -      "i = l \<inter> {x. c \<le> x \<bullet> k}" "l \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} \<noteq> {}"
  8.1509 -      and fstx: "fst x \<in> Basis"
  8.1510 -    from assm(4)[OF this(5)] guess u v by (elim exE) note l=this
  8.1511 -    have *: "\<forall>i\<in>Basis. (\<Sum>i\<in>Basis. (if i = k then max (u \<bullet> k) c else u \<bullet> i) *\<^sub>R i) \<bullet> i \<le> v \<bullet> i"
  8.1512 -      using as(6) unfolding l interval_split[OF k] box_ne_empty as .
  8.1513 -    have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
  8.1514 -      using l using as(6) unfolding box_ne_empty[symmetric] by auto
  8.1515 -    show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  8.1516 -      apply (rule bexI[OF _ \<open>l \<in> d\<close>])
  8.1517 -      using as(1-3,5) fstx
  8.1518 -      unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  8.1519 -      apply (auto split: if_split_asm)
  8.1520 -      done
  8.1521 -    show "a \<bullet> fst x < snd x"
  8.1522 -      using as(1) \<open>a\<bullet>k < c\<close> by (auto split: if_split_asm)
  8.1523 -   qed
  8.1524 -qed
  8.1525 -
  8.1526 -lemma division_points_psubset:
  8.1527 -  fixes a :: "'a::euclidean_space"
  8.1528 -  assumes "d division_of (cbox a b)"
  8.1529 -      and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  8.1530 -      and "l \<in> d"
  8.1531 -      and "interval_lowerbound l\<bullet>k = c \<or> interval_upperbound l\<bullet>k = c"
  8.1532 -      and k: "k \<in> Basis"
  8.1533 -  shows "division_points (cbox a b \<inter> {x. x\<bullet>k \<le> c}) {l \<inter> {x. x\<bullet>k \<le> c} | l. l\<in>d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}} \<subset>
  8.1534 -         division_points (cbox a b) d" (is "?D1 \<subset> ?D")
  8.1535 -    and "division_points (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) {l \<inter> {x. x\<bullet>k \<ge> c} | l. l\<in>d \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}} \<subset>
  8.1536 -         division_points (cbox a b) d" (is "?D2 \<subset> ?D")
  8.1537 -proof -
  8.1538 -  have ab: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  8.1539 -    using assms(2) by (auto intro!:less_imp_le)
  8.1540 -  guess u v using division_ofD(4)[OF assms(1,5)] by (elim exE) note l=this
  8.1541 -  have uv: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "\<forall>i\<in>Basis. a\<bullet>i \<le> u\<bullet>i \<and> v\<bullet>i \<le> b\<bullet>i"
  8.1542 -    using division_ofD(2,2,3)[OF assms(1,5)] unfolding l box_ne_empty
  8.1543 -    using subset_box(1)
  8.1544 -    apply auto
  8.1545 -    apply blast+
  8.1546 -    done
  8.1547 -  have *: "interval_upperbound (cbox a b \<inter> {x. x \<bullet> k \<le> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  8.1548 -          "interval_upperbound (cbox a b \<inter> {x. x \<bullet> k \<le> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  8.1549 -    unfolding l interval_split[OF k] interval_bounds[OF uv(1)]
  8.1550 -    using uv[rule_format, of k] ab k
  8.1551 -    by auto
  8.1552 -  have "\<exists>x. x \<in> ?D - ?D1"
  8.1553 -    using assms(3-)
  8.1554 -    unfolding division_points_def interval_bounds[OF ab]
  8.1555 -    apply -
  8.1556 -    apply (erule disjE)
  8.1557 -    apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI, force simp add: *)
  8.1558 -    apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI, force simp add: *)
  8.1559 -    done
  8.1560 -  moreover have "?D1 \<subseteq> ?D"
  8.1561 -    by (auto simp add: assms division_points_subset)
  8.1562 -  ultimately show "?D1 \<subset> ?D"
  8.1563 -    by blast
  8.1564 -  have *: "interval_lowerbound (cbox a b \<inter> {x. x \<bullet> k \<ge> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  8.1565 -    "interval_lowerbound (cbox a b \<inter> {x. x \<bullet> k \<ge> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  8.1566 -    unfolding l interval_split[OF k] interval_bounds[OF uv(1)]
  8.1567 -    using uv[rule_format, of k] ab k
  8.1568 -    by auto
  8.1569 -  have "\<exists>x. x \<in> ?D - ?D2"
  8.1570 -    using assms(3-)
  8.1571 -    unfolding division_points_def interval_bounds[OF ab]
  8.1572 -    apply -
  8.1573 -    apply (erule disjE)
  8.1574 -    apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI, force simp add: *)
  8.1575 -    apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI, force simp add: *)
  8.1576 -    done
  8.1577 -  moreover have "?D2 \<subseteq> ?D"
  8.1578 -    by (auto simp add: assms division_points_subset)
  8.1579 -  ultimately show "?D2 \<subset> ?D"
  8.1580 -    by blast
  8.1581 -qed
  8.1582 -
  8.1583 -lemma (in comm_monoid_set) operative_division:
  8.1584 -  fixes g :: "'b::euclidean_space set \<Rightarrow> 'a"
  8.1585 -  assumes g: "operative g" and d: "d division_of (cbox a b)" shows "F g d = g (cbox a b)"
  8.1586 -proof -
  8.1587 -  define C where [abs_def]: "C = card (division_points (cbox a b) d)"
  8.1588 -  then show ?thesis
  8.1589 -    using d
  8.1590 -  proof (induction C arbitrary: a b d rule: less_induct)
  8.1591 -    case (less a b d)
  8.1592 -    show ?case
  8.1593 -    proof cases
  8.1594 -      show "content (cbox a b) = 0 \<Longrightarrow> F g d = g (cbox a b)"
  8.1595 -        using division_of_content_0[OF _ less.prems] operativeD(1)[OF  g] division_ofD(4)[OF less.prems]
  8.1596 -        by (fastforce intro!: neutral)
  8.1597 -    next
  8.1598 -      assume "content (cbox a b) \<noteq> 0"
  8.1599 -      note ab = this[unfolded content_lt_nz[symmetric] content_pos_lt_eq]
  8.1600 -      then have ab': "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  8.1601 -        by (auto intro!: less_imp_le)
  8.1602 -      show "F g d = g (cbox a b)"
  8.1603 -      proof (cases "division_points (cbox a b) d = {}")
  8.1604 -        case True
  8.1605 -        { fix u v and j :: 'b
  8.1606 -          assume j: "j \<in> Basis" and as: "cbox u v \<in> d"
  8.1607 -          then have "cbox u v \<noteq> {}"
  8.1608 -            using less.prems by blast
  8.1609 -          then have uv: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "u\<bullet>j \<le> v\<bullet>j"
  8.1610 -            using j unfolding box_ne_empty by auto
  8.1611 -          have *: "\<And>p r Q. \<not> j\<in>Basis \<or> p \<or> r \<or> (\<forall>x\<in>d. Q x) \<Longrightarrow> p \<or> r \<or> Q (cbox u v)"
  8.1612 -            using as j by auto
  8.1613 -          have "(j, u\<bullet>j) \<notin> division_points (cbox a b) d"
  8.1614 -               "(j, v\<bullet>j) \<notin> division_points (cbox a b) d" using True by auto
  8.1615 -          note this[unfolded de_Morgan_conj division_points_def mem_Collect_eq split_conv interval_bounds[OF ab'] bex_simps]
  8.1616 -          note *[OF this(1)] *[OF this(2)] note this[unfolded interval_bounds[OF uv(1)]]
  8.1617 -          moreover
  8.1618 -          have "a\<bullet>j \<le> u\<bullet>j" "v\<bullet>j \<le> b\<bullet>j"
  8.1619 -            using division_ofD(2,2,3)[OF \<open>d division_of cbox a b\<close> as]
  8.1620 -            apply (metis j subset_box(1) uv(1))
  8.1621 -            by (metis \<open>cbox u v \<subseteq> cbox a b\<close> j subset_box(1) uv(1))
  8.1622 -          ultimately have "u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = a\<bullet>j \<or> u\<bullet>j = b\<bullet>j \<and> v\<bullet>j = b\<bullet>j \<or> u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = b\<bullet>j"
  8.1623 -            unfolding not_less de_Morgan_disj using ab[rule_format,of j] uv(2) j by force }
  8.1624 -        then have d': "\<forall>i\<in>d. \<exists>u v. i = cbox u v \<and>
  8.1625 -          (\<forall>j\<in>Basis. u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = a\<bullet>j \<or> u\<bullet>j = b\<bullet>j \<and> v\<bullet>j = b\<bullet>j \<or> u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = b\<bullet>j)"
  8.1626 -          unfolding forall_in_division[OF less.prems] by blast
  8.1627 -        have "(1/2) *\<^sub>R (a+b) \<in> cbox a b"
  8.1628 -          unfolding mem_box using ab by(auto intro!: less_imp_le simp: inner_simps)
  8.1629 -        note this[unfolded division_ofD(6)[OF \<open>d division_of cbox a b\<close>,symmetric] Union_iff]
  8.1630 -        then guess i .. note i=this
  8.1631 -        guess u v using d'[rule_format,OF i(1)] by (elim exE conjE) note uv=this
  8.1632 -        have "cbox a b \<in> d"
  8.1633 -        proof -
  8.1634 -          have "u = a" "v = b"
  8.1635 -            unfolding euclidean_eq_iff[where 'a='b]
  8.1636 -          proof safe
  8.1637 -            fix j :: 'b
  8.1638 -            assume j: "j \<in> Basis"
  8.1639 -            note i(2)[unfolded uv mem_box,rule_format,of j]
  8.1640 -            then show "u \<bullet> j = a \<bullet> j" and "v \<bullet> j = b \<bullet> j"
  8.1641 -              using uv(2)[rule_format,of j] j by (auto simp: inner_simps)
  8.1642 -          qed
  8.1643 -          then have "i = cbox a b" using uv by auto
  8.1644 -          then show ?thesis using i by auto
  8.1645 -        qed
  8.1646 -        then have deq: "d = insert (cbox a b) (d - {cbox a b})"
  8.1647 -          by auto
  8.1648 -        have "F g (d - {cbox a b}) = \<^bold>1"
  8.1649 -        proof (intro neutral ballI)
  8.1650 -          fix x
  8.1651 -          assume x: "x \<in> d - {cbox a b}"
  8.1652 -          then have "x\<in>d"
  8.1653 -            by auto note d'[rule_format,OF this]
  8.1654 -          then guess u v by (elim exE conjE) note uv=this
  8.1655 -          have "u \<noteq> a \<or> v \<noteq> b"
  8.1656 -            using x[unfolded uv] by auto
  8.1657 -          then obtain j where "u\<bullet>j \<noteq> a\<bullet>j \<or> v\<bullet>j \<noteq> b\<bullet>j" and j: "j \<in> Basis"
  8.1658 -            unfolding euclidean_eq_iff[where 'a='b] by auto
  8.1659 -          then have "u\<bullet>j = v\<bullet>j"
  8.1660 -            using uv(2)[rule_format,OF j] by auto
  8.1661 -          then have "content (cbox u v) = 0"
  8.1662 -            unfolding content_eq_0 using j
  8.1663 -            by force
  8.1664 -          then show "g x = \<^bold>1"
  8.1665 -            unfolding uv(1) by (rule operativeD(1)[OF g])
  8.1666 -        qed
  8.1667 -        then show "F g d = g (cbox a b)"
  8.1668 -          using division_ofD[OF less.prems]
  8.1669 -          apply (subst deq)
  8.1670 -          apply (subst insert)
  8.1671 -          apply auto
  8.1672 -          done
  8.1673 -      next
  8.1674 -        case False
  8.1675 -        then have "\<exists>x. x \<in> division_points (cbox a b) d"
  8.1676 -          by auto
  8.1677 -        then guess k c
  8.1678 -          unfolding split_paired_Ex division_points_def mem_Collect_eq split_conv
  8.1679 -          apply (elim exE conjE)
  8.1680 -          done
  8.1681 -        note this(2-4,1) note kc=this[unfolded interval_bounds[OF ab']]
  8.1682 -        from this(3) guess j .. note j=this
  8.1683 -        define d1 where "d1 = {l \<inter> {x. x\<bullet>k \<le> c} | l. l \<in> d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
  8.1684 -        define d2 where "d2 = {l \<inter> {x. x\<bullet>k \<ge> c} | l. l \<in> d \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
  8.1685 -        define cb where "cb = (\<Sum>i\<in>Basis. (if i = k then c else b\<bullet>i) *\<^sub>R i)"
  8.1686 -        define ca where "ca = (\<Sum>i\<in>Basis. (if i = k then c else a\<bullet>i) *\<^sub>R i)"
  8.1687 -        note division_points_psubset[OF \<open>d division_of cbox a b\<close> ab kc(1-2) j]
  8.1688 -        note psubset_card_mono[OF _ this(1)] psubset_card_mono[OF _ this(2)]
  8.1689 -        then have *: "F g d1 = g (cbox a b \<inter> {x. x\<bullet>k \<le> c})" "F g d2 = g (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  8.1690 -          unfolding interval_split[OF kc(4)]
  8.1691 -          apply (rule_tac[!] "less.hyps"[rule_format])
  8.1692 -          using division_split[OF \<open>d division_of cbox a b\<close>, where k=k and c=c]
  8.1693 -          apply (simp_all add: interval_split kc d1_def d2_def division_points_finite[OF \<open>d division_of cbox a b\<close>])
  8.1694 -          done
  8.1695 -        { fix l y
  8.1696 -          assume as: "l \<in> d" "y \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} = y \<inter> {x. x \<bullet> k \<le> c}" "l \<noteq> y"
  8.1697 -          from division_ofD(4)[OF \<open>d division_of cbox a b\<close> this(1)] guess u v by (elim exE) note leq=this
  8.1698 -          have "g (l \<inter> {x. x \<bullet> k \<le> c}) = \<^bold>1"
  8.1699 -            unfolding leq interval_split[OF kc(4)]
  8.1700 -            apply (rule operativeD[OF g])
  8.1701 -            unfolding interval_split[symmetric, OF kc(4)]
  8.1702 -            using division_split_left_inj less as kc leq by blast
  8.1703 -        } note fxk_le = this
  8.1704 -        { fix l y
  8.1705 -          assume as: "l \<in> d" "y \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} = y \<inter> {x. c \<le> x \<bullet> k}" "l \<noteq> y"
  8.1706 -          from division_ofD(4)[OF \<open>d division_of cbox a b\<close> this(1)] guess u v by (elim exE) note leq=this
  8.1707 -          have "g (l \<inter> {x. x \<bullet> k \<ge> c}) = \<^bold>1"
  8.1708 -            unfolding leq interval_split[OF kc(4)]
  8.1709 -            apply (rule operativeD(1)[OF g])
  8.1710 -            unfolding interval_split[symmetric,OF kc(4)]
  8.1711 -            using division_split_right_inj less leq as kc by blast
  8.1712 -        } note fxk_ge = this
  8.1713 -        have d1_alt: "d1 = (\<lambda>l. l \<inter> {x. x\<bullet>k \<le> c}) ` {l \<in> d. l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
  8.1714 -          using d1_def by auto
  8.1715 -        have d2_alt: "d2 = (\<lambda>l. l \<inter> {x. x\<bullet>k \<ge> c}) ` {l \<in> d. l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
  8.1716 -          using d2_def by auto
  8.1717 -        have "g (cbox a b) = F g d1 \<^bold>* F g d2" (is "_ = ?prev")
  8.1718 -          unfolding * using g kc(4) by blast
  8.1719 -        also have "F g d1 = F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<le> c})) d"
  8.1720 -          unfolding d1_alt using division_of_finite[OF less.prems] fxk_le
  8.1721 -          by (subst reindex_nontrivial) (auto intro!: mono_neutral_cong_left simp: operative_empty[OF g])
  8.1722 -        also have "F g d2 = F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<ge> c})) d"
  8.1723 -          unfolding d2_alt using division_of_finite[OF less.prems] fxk_ge
  8.1724 -          by (subst reindex_nontrivial) (auto intro!: mono_neutral_cong_left simp: operative_empty[OF g])
  8.1725 -        also have *: "\<forall>x\<in>d. g x = g (x \<inter> {x. x \<bullet> k \<le> c}) \<^bold>* g (x \<inter> {x. c \<le> x \<bullet> k})"
  8.1726 -          unfolding forall_in_division[OF \<open>d division_of cbox a b\<close>]
  8.1727 -          using g kc(4) by blast
  8.1728 -        have "F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<le> c})) d \<^bold>* F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<ge> c})) d = F g d"
  8.1729 -          using * by (simp add: distrib)
  8.1730 -        finally show ?thesis by auto
  8.1731 -      qed
  8.1732 -    qed
  8.1733 -  qed
  8.1734 -qed
  8.1735 -
  8.1736 -lemma (in comm_monoid_set) operative_tagged_division:
  8.1737 -  assumes f: "operative g" and d: "d tagged_division_of (cbox a b)"
  8.1738 -  shows "F (\<lambda>(x, l). g l) d = g (cbox a b)"
  8.1739 -  unfolding d[THEN division_of_tagged_division, THEN operative_division[OF f], symmetric]
  8.1740 -  by (simp add: f[THEN operativeD(1)] over_tagged_division_lemma[OF d])
  8.1741 +  by (force simp add: add.operative_def content_split[symmetric] content_eq_0_interior)
  8.1742  
  8.1743  lemma additive_content_division: "d division_of (cbox a b) \<Longrightarrow> setsum content d = content (cbox a b)"
  8.1744    by (metis operative_content setsum.operative_division)
  8.1745 @@ -1813,537 +209,8 @@
  8.1746  lemma content_real_eq_0: "content {a .. b::real} = 0 \<longleftrightarrow> a \<ge> b"
  8.1747    by (metis atLeastatMost_empty_iff2 content_empty content_real diff_self eq_iff le_cases le_iff_diff_le_0)
  8.1748  
  8.1749 -lemma interval_real_split:
  8.1750 -  "{a .. b::real} \<inter> {x. x \<le> c} = {a .. min b c}"
  8.1751 -  "{a .. b} \<inter> {x. c \<le> x} = {max a c .. b}"
  8.1752 -  apply (metis Int_atLeastAtMostL1 atMost_def)
  8.1753 -  apply (metis Int_atLeastAtMostL2 atLeast_def)
  8.1754 -  done
  8.1755 -
  8.1756 -lemma (in comm_monoid) operative_1_lt:
  8.1757 -  "operative (g :: real set \<Rightarrow> 'a) \<longleftrightarrow>
  8.1758 -    ((\<forall>a b. b \<le> a \<longrightarrow> g {a .. b} = \<^bold>1) \<and> (\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a .. c} \<^bold>* g {c .. b} = g {a .. b}))"
  8.1759 -  apply (simp add: operative_def content_real_eq_0 atMost_def[symmetric] atLeast_def[symmetric]
  8.1760 -              del: content_real_if)
  8.1761 -proof safe
  8.1762 -  fix a b c :: real
  8.1763 -  assume *: "\<forall>a b c. g {a..b} = g {a..min b c} \<^bold>* g {max a c..b}"
  8.1764 -  assume "a < c" "c < b"
  8.1765 -  with *[rule_format, of a b c] show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  8.1766 -    by (simp add: less_imp_le min.absorb2 max.absorb2)
  8.1767 -next
  8.1768 -  fix a b c :: real
  8.1769 -  assume as: "\<forall>a b. b \<le> a \<longrightarrow> g {a..b} = \<^bold>1"
  8.1770 -    "\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  8.1771 -  from as(1)[rule_format, of 0 1] as(1)[rule_format, of a a for a] as(2)
  8.1772 -  have [simp]: "g {} = \<^bold>1" "\<And>a. g {a} = \<^bold>1"
  8.1773 -    "\<And>a b c. a < c \<Longrightarrow> c < b \<Longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  8.1774 -    by auto
  8.1775 -  show "g {a..b} = g {a..min b c} \<^bold>* g {max a c..b}"
  8.1776 -    by (auto simp: min_def max_def le_less)
  8.1777 -qed
  8.1778 -
  8.1779 -lemma (in comm_monoid) operative_1_le:
  8.1780 -  "operative (g :: real set \<Rightarrow> 'a) \<longleftrightarrow>
  8.1781 -    ((\<forall>a b. b \<le> a \<longrightarrow> g {a..b} = \<^bold>1) \<and> (\<forall>a b c. a \<le> c \<and> c \<le> b \<longrightarrow> g {a .. c} \<^bold>* g {c .. b} = g {a .. b}))"
  8.1782 -  unfolding operative_1_lt
  8.1783 -proof safe
  8.1784 -  fix a b c :: real
  8.1785 -  assume as: "\<forall>a b c. a \<le> c \<and> c \<le> b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}" "a < c" "c < b"
  8.1786 -  show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  8.1787 -    apply (rule as(1)[rule_format])
  8.1788 -    using as(2-)
  8.1789 -    apply auto
  8.1790 -    done
  8.1791 -next
  8.1792 -  fix a b c :: real
  8.1793 -  assume "\<forall>a b. b \<le> a \<longrightarrow> g {a .. b} = \<^bold>1"
  8.1794 -    and "\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  8.1795 -    and "a \<le> c"
  8.1796 -    and "c \<le> b"
  8.1797 -  note as = this[rule_format]
  8.1798 -  show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  8.1799 -  proof (cases "c = a \<or> c = b")
  8.1800 -    case False
  8.1801 -    then show ?thesis
  8.1802 -      apply -
  8.1803 -      apply (subst as(2))
  8.1804 -      using as(3-)
  8.1805 -      apply auto
  8.1806 -      done
  8.1807 -  next
  8.1808 -    case True
  8.1809 -    then show ?thesis
  8.1810 -    proof
  8.1811 -      assume *: "c = a"
  8.1812 -      then have "g {a .. c} = \<^bold>1"
  8.1813 -        apply -
  8.1814 -        apply (rule as(1)[rule_format])
  8.1815 -        apply auto
  8.1816 -        done
  8.1817 -      then show ?thesis
  8.1818 -        unfolding * by auto
  8.1819 -    next
  8.1820 -      assume *: "c = b"
  8.1821 -      then have "g {c .. b} = \<^bold>1"
  8.1822 -        apply -
  8.1823 -        apply (rule as(1)[rule_format])
  8.1824 -        apply auto
  8.1825 -        done
  8.1826 -      then show ?thesis
  8.1827 -        unfolding * by auto
  8.1828 -    qed
  8.1829 -  qed
  8.1830 -qed
  8.1831 -
  8.1832 -subsection \<open>Fine-ness of a partition w.r.t. a gauge.\<close>
  8.1833 -
  8.1834 -definition fine  (infixr "fine" 46)
  8.1835 -  where "d fine s \<longleftrightarrow> (\<forall>(x,k) \<in> s. k \<subseteq> d x)"
  8.1836 -
  8.1837 -lemma fineI:
  8.1838 -  assumes "\<And>x k. (x, k) \<in> s \<Longrightarrow> k \<subseteq> d x"
  8.1839 -  shows "d fine s"
  8.1840 -  using assms unfolding fine_def by auto
  8.1841 -
  8.1842 -lemma fineD[dest]:
  8.1843 -  assumes "d fine s"
  8.1844 -  shows "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> d x"
  8.1845 -  using assms unfolding fine_def by auto
  8.1846 -
  8.1847 -lemma fine_inter: "(\<lambda>x. d1 x \<inter> d2 x) fine p \<longleftrightarrow> d1 fine p \<and> d2 fine p"
  8.1848 -  unfolding fine_def by auto
  8.1849 -
  8.1850 -lemma fine_inters:
  8.1851 - "(\<lambda>x. \<Inter>{f d x | d.  d \<in> s}) fine p \<longleftrightarrow> (\<forall>d\<in>s. (f d) fine p)"
  8.1852 -  unfolding fine_def by blast
  8.1853 -
  8.1854 -lemma fine_union: "d fine p1 \<Longrightarrow> d fine p2 \<Longrightarrow> d fine (p1 \<union> p2)"
  8.1855 -  unfolding fine_def by blast
  8.1856 -
  8.1857 -lemma fine_unions: "(\<And>p. p \<in> ps \<Longrightarrow> d fine p) \<Longrightarrow> d fine (\<Union>ps)"
  8.1858 -  unfolding fine_def by auto
  8.1859 -
  8.1860 -lemma fine_subset: "p \<subseteq> q \<Longrightarrow> d fine q \<Longrightarrow> d fine p"
  8.1861 -  unfolding fine_def by blast
  8.1862 -
  8.1863 -subsection \<open>Some basic combining lemmas.\<close>
  8.1864 -
  8.1865 -lemma tagged_division_unions_exists:
  8.1866 -  assumes "finite iset"
  8.1867 -    and "\<forall>i\<in>iset. \<exists>p. p tagged_division_of i \<and> d fine p"
  8.1868 -    and "\<forall>i1\<in>iset. \<forall>i2\<in>iset. i1 \<noteq> i2 \<longrightarrow> interior i1 \<inter> interior i2 = {}"
  8.1869 -    and "\<Union>iset = i"
  8.1870 -   obtains p where "p tagged_division_of i" and "d fine p"
  8.1871 -proof -
  8.1872 -  obtain pfn where pfn:
  8.1873 -    "\<And>x. x \<in> iset \<Longrightarrow> pfn x tagged_division_of x"
  8.1874 -    "\<And>x. x \<in> iset \<Longrightarrow> d fine pfn x"
  8.1875 -    using bchoice[OF assms(2)] by auto
  8.1876 -  show thesis
  8.1877 -    apply (rule_tac p="\<Union>(pfn ` iset)" in that)
  8.1878 -    using assms(1) assms(3) assms(4) pfn(1) tagged_division_unions apply force
  8.1879 -    by (metis (mono_tags, lifting) fine_unions imageE pfn(2))
  8.1880 -qed
  8.1881 -
  8.1882 -
  8.1883 -subsection \<open>The set we're concerned with must be closed.\<close>
  8.1884 -
  8.1885 -lemma division_of_closed:
  8.1886 -  fixes i :: "'n::euclidean_space set"
  8.1887 -  shows "s division_of i \<Longrightarrow> closed i"
  8.1888 -  unfolding division_of_def by fastforce
  8.1889 -
  8.1890 -subsection \<open>General bisection principle for intervals; might be useful elsewhere.\<close>
  8.1891 -
  8.1892 -lemma interval_bisection_step:
  8.1893 -  fixes type :: "'a::euclidean_space"
  8.1894 -  assumes "P {}"
  8.1895 -    and "\<forall>s t. P s \<and> P t \<and> interior(s) \<inter> interior(t) = {} \<longrightarrow> P (s \<union> t)"
  8.1896 -    and "\<not> P (cbox a (b::'a))"
  8.1897 -  obtains c d where "\<not> P (cbox c d)"
  8.1898 -    and "\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> c\<bullet>i \<le> d\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i \<and> 2 * (d\<bullet>i - c\<bullet>i) \<le> b\<bullet>i - a\<bullet>i"
  8.1899 -proof -
  8.1900 -  have "cbox a b \<noteq> {}"
  8.1901 -    using assms(1,3) by metis
  8.1902 -  then have ab: "\<And>i. i\<in>Basis \<Longrightarrow> a \<bullet> i \<le> b \<bullet> i"
  8.1903 -    by (force simp: mem_box)
  8.1904 -  { fix f
  8.1905 -    have "\<lbrakk>finite f;
  8.1906 -           \<And>s. s\<in>f \<Longrightarrow> P s;
  8.1907 -           \<And>s. s\<in>f \<Longrightarrow> \<exists>a b. s = cbox a b;
  8.1908 -           \<And>s t. s\<in>f \<Longrightarrow> t\<in>f \<Longrightarrow> s \<noteq> t \<Longrightarrow> interior s \<inter> interior t = {}\<rbrakk> \<Longrightarrow> P (\<Union>f)"
  8.1909 -    proof (induct f rule: finite_induct)
  8.1910 -      case empty
  8.1911 -      show ?case
  8.1912 -        using assms(1) by auto
  8.1913 -    next
  8.1914 -      case (insert x f)
  8.1915 -      show ?case
  8.1916 -        unfolding Union_insert
  8.1917 -        apply (rule assms(2)[rule_format])
  8.1918 -        using inter_interior_unions_intervals [of f "interior x"]
  8.1919 -        apply (auto simp: insert)
  8.1920 -        by (metis IntI empty_iff insert.hyps(2) insert.prems(3) insert_iff)
  8.1921 -    qed
  8.1922 -  } note UN_cases = this
  8.1923 -  let ?A = "{cbox c d | c d::'a. \<forall>i\<in>Basis. (c\<bullet>i = a\<bullet>i) \<and> (d\<bullet>i = (a\<bullet>i + b\<bullet>i) / 2) \<or>
  8.1924 -    (c\<bullet>i = (a\<bullet>i + b\<bullet>i) / 2) \<and> (d\<bullet>i = b\<bullet>i)}"
  8.1925 -  let ?PP = "\<lambda>c d. \<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> c\<bullet>i \<le> d\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i \<and> 2 * (d\<bullet>i - c\<bullet>i) \<le> b\<bullet>i - a\<bullet>i"
  8.1926 -  {
  8.1927 -    presume "\<forall>c d. ?PP c d \<longrightarrow> P (cbox c d) \<Longrightarrow> False"
  8.1928 -    then show thesis
  8.1929 -      unfolding atomize_not not_all
  8.1930 -      by (blast intro: that)
  8.1931 -  }
  8.1932 -  assume as: "\<forall>c d. ?PP c d \<longrightarrow> P (cbox c d)"
  8.1933 -  have "P (\<Union>?A)"
  8.1934 -  proof (rule UN_cases)
  8.1935 -    let ?B = "(\<lambda>s. cbox (\<Sum>i\<in>Basis. (if i \<in> s then a\<bullet>i else (a\<bullet>i + b\<bullet>i) / 2) *\<^sub>R i::'a)
  8.1936 -      (\<Sum>i\<in>Basis. (if i \<in> s then (a\<bullet>i + b\<bullet>i) / 2 else b\<bullet>i) *\<^sub>R i)) ` {s. s \<subseteq> Basis}"
  8.1937 -    have "?A \<subseteq> ?B"
  8.1938 -    proof
  8.1939 -      fix x
  8.1940 -      assume "x \<in> ?A"
  8.1941 -      then obtain c d
  8.1942 -        where x:  "x = cbox c d"
  8.1943 -                  "\<And>i. i \<in> Basis \<Longrightarrow>
  8.1944 -                        c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  8.1945 -                        c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i" by blast
  8.1946 -      show "x \<in> ?B"
  8.1947 -        unfolding image_iff x
  8.1948 -        apply (rule_tac x="{i. i\<in>Basis \<and> c\<bullet>i = a\<bullet>i}" in bexI)
  8.1949 -        apply (rule arg_cong2 [where f = cbox])
  8.1950 -        using x(2) ab
  8.1951 -        apply (auto simp add: euclidean_eq_iff[where 'a='a])
  8.1952 -        by fastforce
  8.1953 -    qed
  8.1954 -    then show "finite ?A"
  8.1955 -      by (rule finite_subset) auto
  8.1956 -  next
  8.1957 -    fix s
  8.1958 -    assume "s \<in> ?A"
  8.1959 -    then obtain c d
  8.1960 -      where s: "s = cbox c d"
  8.1961 -               "\<And>i. i \<in> Basis \<Longrightarrow>
  8.1962 -                     c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  8.1963 -                     c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i"
  8.1964 -      by blast
  8.1965 -    show "P s"
  8.1966 -      unfolding s
  8.1967 -      apply (rule as[rule_format])
  8.1968 -      using ab s(2) by force
  8.1969 -    show "\<exists>a b. s = cbox a b"
  8.1970 -      unfolding s by auto
  8.1971 -    fix t
  8.1972 -    assume "t \<in> ?A"
  8.1973 -    then obtain e f where t:
  8.1974 -      "t = cbox e f"
  8.1975 -      "\<And>i. i \<in> Basis \<Longrightarrow>
  8.1976 -        e \<bullet> i = a \<bullet> i \<and> f \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  8.1977 -        e \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> f \<bullet> i = b \<bullet> i"
  8.1978 -      by blast
  8.1979 -    assume "s \<noteq> t"
  8.1980 -    then have "\<not> (c = e \<and> d = f)"
  8.1981 -      unfolding s t by auto
  8.1982 -    then obtain i where "c\<bullet>i \<noteq> e\<bullet>i \<or> d\<bullet>i \<noteq> f\<bullet>i" and i': "i \<in> Basis"
  8.1983 -      unfolding euclidean_eq_iff[where 'a='a] by auto
  8.1984 -    then have i: "c\<bullet>i \<noteq> e\<bullet>i" "d\<bullet>i \<noteq> f\<bullet>i"
  8.1985 -      using s(2) t(2) apply fastforce
  8.1986 -      using t(2)[OF i'] \<open>c \<bullet> i \<noteq> e \<bullet> i \<or> d \<bullet> i \<noteq> f \<bullet> i\<close> i' s(2) t(2) by fastforce
  8.1987 -    have *: "\<And>s t. (\<And>a. a \<in> s \<Longrightarrow> a \<in> t \<Longrightarrow> False) \<Longrightarrow> s \<inter> t = {}"
  8.1988 -      by auto
  8.1989 -    show "interior s \<inter> interior t = {}"
  8.1990 -      unfolding s t interior_cbox
  8.1991 -    proof (rule *)
  8.1992 -      fix x
  8.1993 -      assume "x \<in> box c d" "x \<in> box e f"
  8.1994 -      then have x: "c\<bullet>i < d\<bullet>i" "e\<bullet>i < f\<bullet>i" "c\<bullet>i < f\<bullet>i" "e\<bullet>i < d\<bullet>i"
  8.1995 -        unfolding mem_box using i'
  8.1996 -        by force+
  8.1997 -      show False  using s(2)[OF i']
  8.1998 -      proof safe
  8.1999 -        assume as: "c \<bullet> i = a \<bullet> i" "d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2"
  8.2000 -        show False
  8.2001 -          using t(2)[OF i'] and i x unfolding as by (fastforce simp add:field_simps)
  8.2002 -      next
  8.2003 -        assume as: "c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2" "d \<bullet> i = b \<bullet> i"
  8.2004 -        show False
  8.2005 -          using t(2)[OF i'] and i x unfolding as by(fastforce simp add:field_simps)
  8.2006 -      qed
  8.2007 -    qed
  8.2008 -  qed
  8.2009 -  also have "\<Union>?A = cbox a b"
  8.2010 -  proof (rule set_eqI,rule)
  8.2011 -    fix x
  8.2012 -    assume "x \<in> \<Union>?A"
  8.2013 -    then obtain c d where x:
  8.2014 -      "x \<in> cbox c d"
  8.2015 -      "\<And>i. i \<in> Basis \<Longrightarrow>
  8.2016 -        c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  8.2017 -        c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i"
  8.2018 -      by blast
  8.2019 -    show "x\<in>cbox a b"
  8.2020 -      unfolding mem_box
  8.2021 -    proof safe
  8.2022 -      fix i :: 'a
  8.2023 -      assume i: "i \<in> Basis"
  8.2024 -      then show "a \<bullet> i \<le> x \<bullet> i" "x \<bullet> i \<le> b \<bullet> i"
  8.2025 -        using x(2)[OF i] x(1)[unfolded mem_box,THEN bspec, OF i] by auto
  8.2026 -    qed
  8.2027 -  next
  8.2028 -    fix x
  8.2029 -    assume x: "x \<in> cbox a b"
  8.2030 -    have "\<forall>i\<in>Basis.
  8.2031 -      \<exists>c d. (c = a\<bullet>i \<and> d = (a\<bullet>i + b\<bullet>i) / 2 \<or> c = (a\<bullet>i + b\<bullet>i) / 2 \<and> d = b\<bullet>i) \<and> c\<le>x\<bullet>i \<and> x\<bullet>i \<le> d"
  8.2032 -      (is "\<forall>i\<in>Basis. \<exists>c d. ?P i c d")
  8.2033 -      unfolding mem_box
  8.2034 -    proof
  8.2035 -      fix i :: 'a
  8.2036 -      assume i: "i \<in> Basis"
  8.2037 -      have "?P i (a\<bullet>i) ((a \<bullet> i + b \<bullet> i) / 2) \<or> ?P i ((a \<bullet> i + b \<bullet> i) / 2) (b\<bullet>i)"
  8.2038 -        using x[unfolded mem_box,THEN bspec, OF i] by auto
  8.2039 -      then show "\<exists>c d. ?P i c d"
  8.2040 -        by blast
  8.2041 -    qed
  8.2042 -    then show "x\<in>\<Union>?A"
  8.2043 -      unfolding Union_iff Bex_def mem_Collect_eq choice_Basis_iff
  8.2044 -      apply auto
  8.2045 -      apply (rule_tac x="cbox xa xaa" in exI)
  8.2046 -      unfolding mem_box
  8.2047 -      apply auto
  8.2048 -      done
  8.2049 -  qed
  8.2050 -  finally show False
  8.2051 -    using assms by auto
  8.2052 -qed
  8.2053 -
  8.2054 -lemma interval_bisection:
  8.2055 -  fixes type :: "'a::euclidean_space"
  8.2056 -  assumes "P {}"
  8.2057 -    and "(\<forall>s t. P s \<and> P t \<and> interior(s) \<inter> interior(t) = {} \<longrightarrow> P(s \<union> t))"
  8.2058 -    and "\<not> P (cbox a (b::'a))"
  8.2059 -  obtains x where "x \<in> cbox a b"
  8.2060 -    and "\<forall>e>0. \<exists>c d. x \<in> cbox c d \<and> cbox c d \<subseteq> ball x e \<and> cbox c d \<subseteq> cbox a b \<and> \<not> P (cbox c d)"
  8.2061 -proof -
  8.2062 -  have "\<forall>x. \<exists>y. \<not> P (cbox (fst x) (snd x)) \<longrightarrow> (\<not> P (cbox (fst y) (snd y)) \<and>
  8.2063 -    (\<forall>i\<in>Basis. fst x\<bullet>i \<le> fst y\<bullet>i \<and> fst y\<bullet>i \<le> snd y\<bullet>i \<and> snd y\<bullet>i \<le> snd x\<bullet>i \<and>
  8.2064 -       2 * (snd y\<bullet>i - fst y\<bullet>i) \<le> snd x\<bullet>i - fst x\<bullet>i))" (is "\<forall>x. ?P x")
  8.2065 -  proof
  8.2066 -    show "?P x" for x
  8.2067 -    proof (cases "P (cbox (fst x) (snd x))")
  8.2068 -      case True
  8.2069 -      then show ?thesis by auto
  8.2070 -    next
  8.2071 -      case as: False
  8.2072 -      obtain c d where "\<not> P (cbox c d)"
  8.2073 -        "\<forall>i\<in>Basis.
  8.2074 -           fst x \<bullet> i \<le> c \<bullet> i \<and>
  8.2075 -           c \<bullet> i \<le> d \<bullet> i \<and>
  8.2076 -           d \<bullet> i \<le> snd x \<bullet> i \<and>
  8.2077 -           2 * (d \<bullet> i - c \<bullet> i) \<le> snd x \<bullet> i - fst x \<bullet> i"
  8.2078 -        by (rule interval_bisection_step[of P, OF assms(1-2) as])
  8.2079 -      then show ?thesis
  8.2080 -        apply -
  8.2081 -        apply (rule_tac x="(c,d)" in exI)
  8.2082 -        apply auto
  8.2083 -        done
  8.2084 -    qed
  8.2085 -  qed
  8.2086 -  then obtain f where f:
  8.2087 -    "\<forall>x.
  8.2088 -      \<not> P (cbox (fst x) (snd x)) \<longrightarrow>
  8.2089 -      \<not> P (cbox (fst (f x)) (snd (f x))) \<and>
  8.2090 -        (\<forall>i\<in>Basis.
  8.2091 -            fst x \<bullet> i \<le> fst (f x) \<bullet> i \<and>
  8.2092 -            fst (f x) \<bullet> i \<le> snd (f x) \<bullet> i \<and>
  8.2093 -            snd (f x) \<bullet> i \<le> snd x \<bullet> i \<and>
  8.2094 -            2 * (snd (f x) \<bullet> i - fst (f x) \<bullet> i) \<le> snd x \<bullet> i - fst x \<bullet> i)"
  8.2095 -    apply -
  8.2096 -    apply (drule choice)
  8.2097 -    apply blast
  8.2098 -    done
  8.2099 -  define AB A B where ab_def: "AB n = (f ^^ n) (a,b)" "A n = fst(AB n)" "B n = snd(AB n)" for n
  8.2100 -  have "A 0 = a" "B 0 = b" "\<And>n. \<not> P (cbox (A(Suc n)) (B(Suc n))) \<and>
  8.2101 -    (\<forall>i\<in>Basis. A(n)\<bullet>i \<le> A(Suc n)\<bullet>i \<and> A(Suc n)\<bullet>i \<le> B(Suc n)\<bullet>i \<and> B(Suc n)\<bullet>i \<le> B(n)\<bullet>i \<and>
  8.2102 -    2 * (B(Suc n)\<bullet>i - A(Suc n)\<bullet>i) \<le> B(n)\<bullet>i - A(n)\<bullet>i)" (is "\<And>n. ?P n")
  8.2103 -  proof -
  8.2104 -    show "A 0 = a" "B 0 = b"
  8.2105 -      unfolding ab_def by auto
  8.2106 -    note S = ab_def funpow.simps o_def id_apply
  8.2107 -    show "?P n" for n
  8.2108 -    proof (induct n)
  8.2109 -      case 0
  8.2110 -      then show ?case
  8.2111 -        unfolding S
  8.2112 -        apply (rule f[rule_format]) using assms(3)
  8.2113 -        apply auto
  8.2114 -        done
  8.2115 -    next
  8.2116 -      case (Suc n)
  8.2117 -      show ?case
  8.2118 -        unfolding S
  8.2119 -        apply (rule f[rule_format])
  8.2120 -        using Suc
  8.2121 -        unfolding S
  8.2122 -        apply auto
  8.2123 -        done
  8.2124 -    qed
  8.2125 -  qed
  8.2126 -  note AB = this(1-2) conjunctD2[OF this(3),rule_format]
  8.2127 -
  8.2128 -  have interv: "\<exists>n. \<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e"
  8.2129 -    if e: "0 < e" for e
  8.2130 -  proof -
  8.2131 -    obtain n where n: "(\<Sum>i\<in>Basis. b \<bullet> i - a \<bullet> i) / e < 2 ^ n"
  8.2132 -      using real_arch_pow[of 2 "(setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis) / e"] by auto
  8.2133 -    show ?thesis
  8.2134 -    proof (rule exI [where x=n], clarify)
  8.2135 -      fix x y
  8.2136 -      assume xy: "x\<in>cbox (A n) (B n)" "y\<in>cbox (A n) (B n)"
  8.2137 -      have "dist x y \<le> setsum (\<lambda>i. \<bar>(x - y)\<bullet>i\<bar>) Basis"
  8.2138 -        unfolding dist_norm by(rule norm_le_l1)
  8.2139 -      also have "\<dots> \<le> setsum (\<lambda>i. B n\<bullet>i - A n\<bullet>i) Basis"
  8.2140 -      proof (rule setsum_mono)
  8.2141 -        fix i :: 'a
  8.2142 -        assume i: "i \<in> Basis"
  8.2143 -        show "\<bar>(x - y) \<bullet> i\<bar> \<le> B n \<bullet> i - A n \<bullet> i"
  8.2144 -          using xy[unfolded mem_box,THEN bspec, OF i]
  8.2145 -          by (auto simp: inner_diff_left)
  8.2146 -      qed
  8.2147 -      also have "\<dots> \<le> setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis / 2^n"
  8.2148 -        unfolding setsum_divide_distrib
  8.2149 -      proof (rule setsum_mono)
  8.2150 -        show "B n \<bullet> i - A n \<bullet> i \<le> (b \<bullet> i - a \<bullet> i) / 2 ^ n" if i: "i \<in> Basis" for i
  8.2151 -        proof (induct n)
  8.2152 -          case 0
  8.2153 -          then show ?case
  8.2154 -            unfolding AB by auto
  8.2155 -        next
  8.2156 -          case (Suc n)
  8.2157 -          have "B (Suc n) \<bullet> i - A (Suc n) \<bullet> i \<le> (B n \<bullet> i - A n \<bullet> i) / 2"
  8.2158 -            using AB(4)[of i n] using i by auto
  8.2159 -          also have "\<dots> \<le> (b \<bullet> i - a \<bullet> i) / 2 ^ Suc n"
  8.2160 -            using Suc by (auto simp add: field_simps)
  8.2161 -          finally show ?case .
  8.2162 -        qed
  8.2163 -      qed
  8.2164 -      also have "\<dots> < e"
  8.2165 -        using n using e by (auto simp add: field_simps)
  8.2166 -      finally show "dist x y < e" .
  8.2167 -    qed
  8.2168 -  qed
  8.2169 -  {
  8.2170 -    fix n m :: nat
  8.2171 -    assume "m \<le> n" then have "cbox (A n) (B n) \<subseteq> cbox (A m) (B m)"
  8.2172 -    proof (induction rule: inc_induct)
  8.2173 -      case (step i)
  8.2174 -      show ?case
  8.2175 -        using AB(4) by (intro order_trans[OF step.IH] subset_box_imp) auto
  8.2176 -    qed simp
  8.2177 -  } note ABsubset = this
  8.2178 -  have "\<exists>a. \<forall>n. a\<in> cbox (A n) (B n)"
  8.2179 -    by (rule decreasing_closed_nest[rule_format,OF closed_cbox _ ABsubset interv])
  8.2180 -      (metis nat.exhaust AB(1-3) assms(1,3))
  8.2181 -  then obtain x0 where x0: "\<And>n. x0 \<in> cbox (A n) (B n)"
  8.2182 -    by blast
  8.2183 -  show thesis
  8.2184 -  proof (rule that[rule_format, of x0])
  8.2185 -    show "x0\<in>cbox a b"
  8.2186 -      using x0[of 0] unfolding AB .
  8.2187 -    fix e :: real
  8.2188 -    assume "e > 0"
  8.2189 -    from interv[OF this] obtain n
  8.2190 -      where n: "\<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e" ..
  8.2191 -    have "\<not> P (cbox (A n) (B n))"
  8.2192 -      apply (cases "0 < n")
  8.2193 -      using AB(3)[of "n - 1"] assms(3) AB(1-2)
  8.2194 -      apply auto
  8.2195 -      done
  8.2196 -    moreover have "cbox (A n) (B n) \<subseteq> ball x0 e"
  8.2197 -      using n using x0[of n] by auto
  8.2198 -    moreover have "cbox (A n) (B n) \<subseteq> cbox a b"
  8.2199 -      unfolding AB(1-2)[symmetric] by (rule ABsubset) auto
  8.2200 -    ultimately show "\<exists>c d. x0 \<in> cbox c d \<and> cbox c d \<subseteq> ball x0 e \<and> cbox c d \<subseteq> cbox a b \<and> \<not> P (cbox c d)"
  8.2201 -      apply (rule_tac x="A n" in exI)
  8.2202 -      apply (rule_tac x="B n" in exI)
  8.2203 -      apply (auto simp: x0)
  8.2204 -      done
  8.2205 -  qed
  8.2206 -qed
  8.2207 -
  8.2208 -
  8.2209 -subsection \<open>Cousin's lemma.\<close>
  8.2210 -
  8.2211 -lemma fine_division_exists:
  8.2212 -  fixes a b :: "'a::euclidean_space"
  8.2213 -  assumes "gauge g"
  8.2214 -  obtains p where "p tagged_division_of (cbox a b)" "g fine p"
  8.2215 -proof -
  8.2216 -  presume "\<not> (\<exists>p. p tagged_division_of (cbox a b) \<and> g fine p) \<Longrightarrow> False"
  8.2217 -  then obtain p where "p tagged_division_of (cbox a b)" "g fine p"
  8.2218 -    by blast
  8.2219 -  then show thesis ..
  8.2220 -next
  8.2221 -  assume as: "\<not> (\<exists>p. p tagged_division_of (cbox a b) \<and> g fine p)"
  8.2222 -  obtain x where x:
  8.2223 -      "x \<in> (cbox a b)"
  8.2224 -      "\<And>e. 0 < e \<Longrightarrow>
  8.2225 -        \<exists>c d.
  8.2226 -          x \<in> cbox c d \<and>
  8.2227 -          cbox c d \<subseteq> ball x e \<and>
  8.2228 -          cbox c d \<subseteq> (cbox a b) \<and>
  8.2229 -          \<not> (\<exists>p. p tagged_division_of cbox c d \<and> g fine p)"
  8.2230 -    apply (rule interval_bisection[of "\<lambda>s. \<exists>p. p tagged_division_of s \<and> g fine p", OF _ _ as])
  8.2231 -    apply (simp add: fine_def)
  8.2232 -    apply (metis tagged_division_union fine_union)
  8.2233 -    apply (auto simp: )
  8.2234 -    done
  8.2235 -  obtain e where e: "e > 0" "ball x e \<subseteq> g x"
  8.2236 -    using gaugeD[OF assms, of x] unfolding open_contains_ball by auto
  8.2237 -  from x(2)[OF e(1)]
  8.2238 -  obtain c d where c_d: "x \<in> cbox c d"
  8.2239 -                        "cbox c d \<subseteq> ball x e"
  8.2240 -                        "cbox c d \<subseteq> cbox a b"
  8.2241 -                        "\<not> (\<exists>p. p tagged_division_of cbox c d \<and> g fine p)"
  8.2242 -    by blast
  8.2243 -  have "g fine {(x, cbox c d)}"
  8.2244 -    unfolding fine_def using e using c_d(2) by auto
  8.2245 -  then show False
  8.2246 -    using tagged_division_of_self[OF c_d(1)] using c_d by auto
  8.2247 -qed
  8.2248 -
  8.2249 -lemma fine_division_exists_real:
  8.2250 -  fixes a b :: real
  8.2251 -  assumes "gauge g"
  8.2252 -  obtains p where "p tagged_division_of {a .. b}" "g fine p"
  8.2253 -  by (metis assms box_real(2) fine_division_exists)
  8.2254 -
  8.2255 -subsection \<open>Division filter\<close>
  8.2256 -
  8.2257 -text \<open>Divisions over all gauges towards finer divisions.\<close>
  8.2258 -
  8.2259 -definition division_filter :: "'a::euclidean_space set \<Rightarrow> ('a \<times> 'a set) set filter"
  8.2260 -  where "division_filter s = (INF g:{g. gauge g}. principal {p. p tagged_division_of s \<and> g fine p})"
  8.2261 -
  8.2262 -lemma eventually_division_filter:
  8.2263 -  "(\<forall>\<^sub>F p in division_filter s. P p) \<longleftrightarrow>
  8.2264 -    (\<exists>g. gauge g \<and> (\<forall>p. p tagged_division_of s \<and> g fine p \<longrightarrow> P p))"
  8.2265 -  unfolding division_filter_def
  8.2266 -proof (subst eventually_INF_base; clarsimp)
  8.2267 -  fix g1 g2 :: "'a \<Rightarrow> 'a set" show "gauge g1 \<Longrightarrow> gauge g2 \<Longrightarrow> \<exists>x. gauge x \<and>
  8.2268 -    {p. p tagged_division_of s \<and> x fine p} \<subseteq> {p. p tagged_division_of s \<and> g1 fine p} \<and>
  8.2269 -    {p. p tagged_division_of s \<and> x fine p} \<subseteq> {p. p tagged_division_of s \<and> g2 fine p}"
  8.2270 -    by (intro exI[of _ "\<lambda>x. g1 x \<inter> g2 x"]) (auto simp: fine_inter)
  8.2271 -qed (auto simp: eventually_principal)
  8.2272 -
  8.2273 -lemma division_filter_not_empty: "division_filter (cbox a b) \<noteq> bot"
  8.2274 -  unfolding trivial_limit_def eventually_division_filter
  8.2275 -  by (auto elim: fine_division_exists)
  8.2276 -
  8.2277 -lemma eventually_division_filter_tagged_division:
  8.2278 -  "eventually (\<lambda>p. p tagged_division_of s) (division_filter s)"
  8.2279 -  unfolding eventually_division_filter by (intro exI[of _ "\<lambda>x. ball x 1"]) auto
  8.2280 +lemma property_empty_interval: "\<forall>a b. content (cbox a b) = 0 \<longrightarrow> P (cbox a b) \<Longrightarrow> P {}"
  8.2281 +  using content_empty unfolding empty_as_interval by auto
  8.2282  
  8.2283  subsection \<open>Gauge integral\<close>
  8.2284  
  8.2285 @@ -2421,26 +288,6 @@
  8.2286  lemma has_integral_integral: "f integrable_on s \<longleftrightarrow> (f has_integral (integral s f)) s"
  8.2287    by auto
  8.2288  
  8.2289 -lemma setsum_content_null:
  8.2290 -  assumes "content (cbox a b) = 0"
  8.2291 -    and "p tagged_division_of (cbox a b)"
  8.2292 -  shows "setsum (\<lambda>(x,k). content k *\<^sub>R f x) p = (0::'a::real_normed_vector)"
  8.2293 -proof (rule setsum.neutral, rule)
  8.2294 -  fix y
  8.2295 -  assume y: "y \<in> p"
  8.2296 -  obtain x k where xk: "y = (x, k)"
  8.2297 -    using surj_pair[of y] by blast
  8.2298 -  note assm = tagged_division_ofD(3-4)[OF assms(2) y[unfolded xk]]
  8.2299 -  from this(2) obtain c d where k: "k = cbox c d" by blast
  8.2300 -  have "(\<lambda>(x, k). content k *\<^sub>R f x) y = content k *\<^sub>R f x"
  8.2301 -    unfolding xk by auto
  8.2302 -  also have "\<dots> = 0"
  8.2303 -    using content_subset[OF assm(1)[unfolded k]] content_pos_le[of c d]
  8.2304 -    unfolding assms(1) k
  8.2305 -    by auto
  8.2306 -  finally show "(\<lambda>(x, k). content k *\<^sub>R f x) y = 0" .
  8.2307 -qed
  8.2308 -
  8.2309  subsection \<open>Basic theorems about integrals.\<close>
  8.2310  
  8.2311  lemma has_integral_unique:
  8.2312 @@ -3153,38 +1000,32 @@
  8.2313  
  8.2314  subsection \<open>Additivity of integral on abutting intervals.\<close>
  8.2315  
  8.2316 -lemma tagged_division_split_left_inj:
  8.2317 -  fixes x1 :: "'a::euclidean_space"
  8.2318 +lemma tagged_division_split_left_inj_content:
  8.2319    assumes d: "d tagged_division_of i"
  8.2320 -    and k12: "(x1, k1) \<in> d"
  8.2321 -             "(x2, k2) \<in> d"
  8.2322 -             "k1 \<noteq> k2"
  8.2323 -             "k1 \<inter> {x. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  8.2324 -             "k \<in> Basis"
  8.2325 +    and "(x1, k1) \<in> d" "(x2, k2) \<in> d" "k1 \<noteq> k2" "k1 \<inter> {x. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}" "k \<in> Basis"
  8.2326    shows "content (k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  8.2327  proof -
  8.2328 -  have *: "\<And>a b c. (a,b) \<in> c \<Longrightarrow> b \<in> snd ` c"
  8.2329 -    by force
  8.2330 +  from tagged_division_ofD(4)[OF d \<open>(x1, k1) \<in> d\<close>] obtain a b where k1: "k1 = cbox a b"
  8.2331 +    by auto
  8.2332    show ?thesis
  8.2333 -    using k12
  8.2334 -    by (fastforce intro!:  division_split_left_inj[OF division_of_tagged_division[OF d]] *)
  8.2335 +    unfolding k1 interval_split[OF \<open>k \<in> Basis\<close>]
  8.2336 +    unfolding content_eq_0_interior
  8.2337 +    unfolding interval_split[OF \<open>k \<in> Basis\<close>, symmetric] k1[symmetric]
  8.2338 +    by (rule tagged_division_split_left_inj[OF assms])
  8.2339  qed
  8.2340  
  8.2341 -lemma tagged_division_split_right_inj:
  8.2342 -  fixes x1 :: "'a::euclidean_space"
  8.2343 +lemma tagged_division_split_right_inj_content:
  8.2344    assumes d: "d tagged_division_of i"
  8.2345 -    and k12: "(x1, k1) \<in> d"
  8.2346 -             "(x2, k2) \<in> d"
  8.2347 -             "k1 \<noteq> k2"
  8.2348 -             "k1 \<inter> {x. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}"
  8.2349 -             "k \<in> Basis"
  8.2350 +    and "(x1, k1) \<in> d" "(x2, k2) \<in> d" "k1 \<noteq> k2" "k1 \<inter> {x. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}" "k \<in> Basis"
  8.2351    shows "content (k1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
  8.2352  proof -
  8.2353 -  have *: "\<And>a b c. (a,b) \<in> c \<Longrightarrow> b \<in> snd ` c"
  8.2354 -    by force
  8.2355 +  from tagged_division_ofD(4)[OF d \<open>(x1, k1) \<in> d\<close>] obtain a b where k1: "k1 = cbox a b"
  8.2356 +    by auto
  8.2357    show ?thesis
  8.2358 -    using k12
  8.2359 -    by (fastforce intro!:  division_split_right_inj[OF division_of_tagged_division[OF d]] *)
  8.2360 +    unfolding k1 interval_split[OF \<open>k \<in> Basis\<close>]
  8.2361 +    unfolding content_eq_0_interior
  8.2362 +    unfolding interval_split[OF \<open>k \<in> Basis\<close>, symmetric] k1[symmetric]
  8.2363 +    by (rule tagged_division_split_right_inj[OF assms])
  8.2364  qed
  8.2365  
  8.2366  lemma has_integral_split:
  8.2367 @@ -3262,7 +1103,8 @@
  8.2368      have lem1: "\<And>f P Q. (\<forall>x k. (x, k) \<in> {(x, f k) | x k. P x k} \<longrightarrow> Q x k) \<longleftrightarrow>
  8.2369                           (\<forall>x k. P x k \<longrightarrow> Q x (f k))"
  8.2370        by auto
  8.2371 -    have fin_finite: "finite {(x,f k) | x k. (x,k) \<in> s \<and> P x k}" if "finite s" for f s P
  8.2372 +    have fin_finite: "finite {(x,f k) | x k. (x,k) \<in> s \<and> P x k}"
  8.2373 +      if "finite s" for s and f :: "'a set \<Rightarrow> 'a set" and P :: "'a \<Rightarrow> 'a set \<Rightarrow> bool"
  8.2374      proof -
  8.2375        from that have "finite ((\<lambda>(x, k). (x, f k)) ` s)"
  8.2376          by auto
  8.2377 @@ -3376,8 +1218,9 @@
  8.2378        also have "\<dots> = (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) +
  8.2379          (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) - (i + j)"
  8.2380          unfolding lem3[OF p(3)]
  8.2381 -        by (subst setsum.reindex_nontrivial[OF p(3)], auto intro!: k eq0 tagged_division_split_left_inj[OF p(1)] tagged_division_split_right_inj[OF p(1)]
  8.2382 -              simp: cont_eq)+
  8.2383 +        by (subst (1 2) setsum.reindex_nontrivial[OF p(3)])
  8.2384 +           (auto intro!: k eq0 tagged_division_split_left_inj_content[OF p(1)] tagged_division_split_right_inj_content[OF p(1)]
  8.2385 +                 simp: cont_eq)+
  8.2386        also note setsum.distrib[symmetric]
  8.2387        also have "\<And>x. x \<in> p \<Longrightarrow>
  8.2388                      (\<lambda>(x,ka). content (ka \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) x +
  8.2389 @@ -3407,34 +1250,6 @@
  8.2390  
  8.2391  subsection \<open>A sort of converse, integrability on subintervals.\<close>
  8.2392  
  8.2393 -lemma tagged_division_union_interval:
  8.2394 -  fixes a :: "'a::euclidean_space"
  8.2395 -  assumes "p1 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<le> (c::real)})"
  8.2396 -    and "p2 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  8.2397 -    and k: "k \<in> Basis"
  8.2398 -  shows "(p1 \<union> p2) tagged_division_of (cbox a b)"
  8.2399 -proof -
  8.2400 -  have *: "cbox a b = (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<union> (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  8.2401 -    by auto
  8.2402 -  show ?thesis
  8.2403 -    apply (subst *)
  8.2404 -    apply (rule tagged_division_union[OF assms(1-2)])
  8.2405 -    unfolding interval_split[OF k] interior_cbox
  8.2406 -    using k
  8.2407 -    apply (auto simp add: box_def elim!: ballE[where x=k])
  8.2408 -    done
  8.2409 -qed
  8.2410 -
  8.2411 -lemma tagged_division_union_interval_real:
  8.2412 -  fixes a :: real
  8.2413 -  assumes "p1 tagged_division_of ({a .. b} \<inter> {x. x\<bullet>k \<le> (c::real)})"
  8.2414 -    and "p2 tagged_division_of ({a .. b} \<inter> {x. x\<bullet>k \<ge> c})"
  8.2415 -    and k: "k \<in> Basis"
  8.2416 -  shows "(p1 \<union> p2) tagged_division_of {a .. b}"
  8.2417 -  using assms
  8.2418 -  unfolding box_real[symmetric]
  8.2419 -  by (rule tagged_division_union_interval)
  8.2420 -
  8.2421  lemma has_integral_separate_sides:
  8.2422    fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  8.2423    assumes "(f has_integral i) (cbox a b)"
  8.2424 @@ -3599,10 +1414,10 @@
  8.2425      qed
  8.2426    next
  8.2427      fix a b :: 'a
  8.2428 -    assume "content (cbox a b) = 0"
  8.2429 +    assume "box a b = {}"
  8.2430      then show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) = Some 0"
  8.2431        using has_integral_null_eq
  8.2432 -      by (auto simp: integrable_on_null)
  8.2433 +      by (auto simp: integrable_on_null content_eq_0_interior)
  8.2434    qed
  8.2435  qed
  8.2436  
  8.2437 @@ -4047,47 +1862,6 @@
  8.2438  
  8.2439  subsection \<open>Negligibility of hyperplane.\<close>
  8.2440  
  8.2441 -lemma interval_doublesplit:
  8.2442 -  fixes a :: "'a::euclidean_space"
  8.2443 -  assumes "k \<in> Basis"
  8.2444 -  shows "cbox a b \<inter> {x . \<bar>x\<bullet>k - c\<bar> \<le> (e::real)} =
  8.2445 -    cbox (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) (c - e) else a\<bullet>i) *\<^sub>R i)
  8.2446 -     (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) (c + e) else b\<bullet>i) *\<^sub>R i)"
  8.2447 -proof -
  8.2448 -  have *: "\<And>x c e::real. \<bar>x - c\<bar> \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
  8.2449 -    by auto
  8.2450 -  have **: "\<And>s P Q. s \<inter> {x. P x \<and> Q x} = (s \<inter> {x. Q x}) \<inter> {x. P x}"
  8.2451 -    by blast
  8.2452 -  show ?thesis
  8.2453 -    unfolding * ** interval_split[OF assms] by (rule refl)
  8.2454 -qed
  8.2455 -
  8.2456 -lemma division_doublesplit:
  8.2457 -  fixes a :: "'a::euclidean_space"
  8.2458 -  assumes "p division_of (cbox a b)"
  8.2459 -    and k: "k \<in> Basis"
  8.2460 -  shows "(\<lambda>l. l \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> e}) ` {l\<in>p. l \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> e} \<noteq> {}}
  8.2461 -         division_of  (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> e})"
  8.2462 -proof -
  8.2463 -  have *: "\<And>x c. \<bar>x - c\<bar> \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
  8.2464 -    by auto
  8.2465 -  have **: "\<And>p q p' q'. p division_of q \<Longrightarrow> p = p' \<Longrightarrow> q = q' \<Longrightarrow> p' division_of q'"
  8.2466 -    by auto
  8.2467 -  note division_split(1)[OF assms, where c="c+e",unfolded interval_split[OF k]]
  8.2468 -  note division_split(2)[OF this, where c="c-e" and k=k,OF k]
  8.2469 -  then show ?thesis
  8.2470 -    apply (rule **)
  8.2471 -    subgoal
  8.2472 -      apply (simp add: abs_diff_le_iff field_simps Collect_conj_eq setcompr_eq_image[symmetric])
  8.2473 -      apply (rule equalityI)
  8.2474 -      apply blast
  8.2475 -      apply clarsimp
  8.2476 -      apply (rule_tac x="l \<inter> {x. c + e \<ge> x \<bullet> k}" in exI)
  8.2477 -      apply auto
  8.2478 -      done
  8.2479 -    by (simp add: interval_split k interval_doublesplit)
  8.2480 -qed
  8.2481 -
  8.2482  lemma content_doublesplit:
  8.2483    fixes a :: "'a::euclidean_space"
  8.2484    assumes "0 < e"
  8.2485 @@ -4240,6 +2014,8 @@
  8.2486        also have "\<dots> < e"
  8.2487        proof (subst setsum.over_tagged_division_lemma[OF p[THEN conjunct1]], goal_cases)
  8.2488          case prems: (1 u v)
  8.2489 +        then have *: "content (cbox u v) = 0"
  8.2490 +          unfolding content_eq_0_interior by simp
  8.2491          have "content (cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<le> content (cbox u v)"
  8.2492            unfolding interval_doublesplit[OF k]
  8.2493            apply (rule content_subset)
  8.2494 @@ -4247,7 +2023,7 @@
  8.2495            apply auto
  8.2496            done
  8.2497          then show ?case
  8.2498 -          unfolding prems interval_doublesplit[OF k]
  8.2499 +          unfolding * interval_doublesplit[OF k]
  8.2500            by (blast intro: antisym)
  8.2501        next
  8.2502          have "(\<Sum>l\<in>snd ` p. content (l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) =
  8.2503 @@ -4281,188 +2057,9 @@
  8.2504  qed
  8.2505  
  8.2506  
  8.2507 -subsection \<open>A technical lemma about "refinement" of division.\<close>
  8.2508 -
  8.2509 -lemma tagged_division_finer:
  8.2510 -  fixes p :: "('a::euclidean_space \<times> ('a::euclidean_space set)) set"
  8.2511 -  assumes "p tagged_division_of (cbox a b)"
  8.2512 -    and "gauge d"
  8.2513 -  obtains q where "q tagged_division_of (cbox a b)"
  8.2514 -    and "d fine q"
  8.2515 -    and "\<forall>(x,k) \<in> p. k \<subseteq> d(x) \<longrightarrow> (x,k) \<in> q"
  8.2516 -proof -
  8.2517 -  let ?P = "\<lambda>p. p tagged_partial_division_of (cbox a b) \<longrightarrow> gauge d \<longrightarrow>
  8.2518 -    (\<exists>q. q tagged_division_of (\<Union>{k. \<exists>x. (x,k) \<in> p}) \<and> d fine q \<and>
  8.2519 -      (\<forall>(x,k) \<in> p. k \<subseteq> d(x) \<longrightarrow> (x,k) \<in> q))"
  8.2520 -  {
  8.2521 -    have *: "finite p" "p tagged_partial_division_of (cbox a b)"
  8.2522 -      using assms(1)
  8.2523 -      unfolding tagged_division_of_def
  8.2524 -      by auto
  8.2525 -    presume "\<And>p. finite p \<Longrightarrow> ?P p"
  8.2526 -    from this[rule_format,OF * assms(2)] guess q .. note q=this
  8.2527 -    then show ?thesis
  8.2528 -      apply -
  8.2529 -      apply (rule that[of q])
  8.2530 -      unfolding tagged_division_ofD[OF assms(1)]
  8.2531 -      apply auto
  8.2532 -      done
  8.2533 -  }
  8.2534 -  fix p :: "('a::euclidean_space \<times> ('a::euclidean_space set)) set"
  8.2535 -  assume as: "finite p"
  8.2536 -  show "?P p"
  8.2537 -    apply rule
  8.2538 -    apply rule
  8.2539 -    using as
  8.2540 -  proof (induct p)
  8.2541 -    case empty
  8.2542 -    show ?case
  8.2543 -      apply (rule_tac x="{}" in exI)
  8.2544 -      unfolding fine_def
  8.2545 -      apply auto
  8.2546 -      done
  8.2547 -  next
  8.2548 -    case (insert xk p)
  8.2549 -    guess x k using surj_pair[of xk] by (elim exE) note xk=this
  8.2550 -    note tagged_partial_division_subset[OF insert(4) subset_insertI]
  8.2551 -    from insert(3)[OF this insert(5)] guess q1 .. note q1 = conjunctD3[OF this]
  8.2552 -    have *: "\<Union>{l. \<exists>y. (y,l) \<in> insert xk p} = k \<union> \<Union>{l. \<exists>y. (y,l) \<in> p}"
  8.2553 -      unfolding xk by auto
  8.2554 -    note p = tagged_partial_division_ofD[OF insert(4)]
  8.2555 -    from p(4)[unfolded xk, OF insertI1] guess u v by (elim exE) note uv=this
  8.2556 -
  8.2557 -    have "finite {k. \<exists>x. (x, k) \<in> p}"
  8.2558 -      apply (rule finite_subset[of _ "snd ` p"])
  8.2559 -      using p
  8.2560 -      apply safe
  8.2561 -      apply (metis image_iff snd_conv)
  8.2562 -      apply auto
  8.2563 -      done
  8.2564 -    then have int: "interior (cbox u v) \<inter> interior (\<Union>{k. \<exists>x. (x, k) \<in> p}) = {}"
  8.2565 -      apply (rule inter_interior_unions_intervals)
  8.2566 -      apply (rule open_interior)
  8.2567 -      apply (rule_tac[!] ballI)
  8.2568 -      unfolding mem_Collect_eq
  8.2569 -      apply (erule_tac[!] exE)
  8.2570 -      apply (drule p(4)[OF insertI2])
  8.2571 -      apply assumption
  8.2572 -      apply (rule p(5))
  8.2573 -      unfolding uv xk
  8.2574 -      apply (rule insertI1)
  8.2575 -      apply (rule insertI2)
  8.2576 -      apply assumption
  8.2577 -      using insert(2)
  8.2578 -      unfolding uv xk
  8.2579 -      apply auto
  8.2580 -      done
  8.2581 -    show ?case
  8.2582 -    proof (cases "cbox u v \<subseteq> d x")
  8.2583 -      case True
  8.2584 -      then show ?thesis
  8.2585 -        apply (rule_tac x="{(x,cbox u v)} \<union> q1" in exI)
  8.2586 -        apply rule
  8.2587 -        unfolding * uv
  8.2588 -        apply (rule tagged_division_union)
  8.2589 -        apply (rule tagged_division_of_self)
  8.2590 -        apply (rule p[unfolded xk uv] insertI1)+
  8.2591 -        apply (rule q1)
  8.2592 -        apply (rule int)
  8.2593 -        apply rule
  8.2594 -        apply (rule fine_union)
  8.2595 -        apply (subst fine_def)
  8.2596 -        defer
  8.2597 -        apply (rule q1)
  8.2598 -        unfolding Ball_def split_paired_All split_conv
  8.2599 -        apply rule
  8.2600 -        apply rule
  8.2601 -        apply rule
  8.2602 -        apply rule
  8.2603 -        apply (erule insertE)
  8.2604 -        apply (simp add: uv xk)
  8.2605 -        apply (rule UnI2)
  8.2606 -        apply (drule q1(3)[rule_format])
  8.2607 -        unfolding xk uv
  8.2608 -        apply auto
  8.2609 -        done
  8.2610 -    next
  8.2611 -      case False
  8.2612 -      from fine_division_exists[OF assms(2), of u v] guess q2 . note q2=this
  8.2613 -      show ?thesis
  8.2614 -        apply (rule_tac x="q2 \<union> q1" in exI)
  8.2615 -        apply rule
  8.2616 -        unfolding * uv
  8.2617 -        apply (rule tagged_division_union q2 q1 int fine_union)+
  8.2618 -        unfolding Ball_def split_paired_All split_conv
  8.2619 -        apply rule
  8.2620 -        apply (rule fine_union)
  8.2621 -        apply (rule q1 q2)+
  8.2622 -        apply rule
  8.2623 -        apply rule
  8.2624 -        apply rule
  8.2625 -        apply rule
  8.2626 -        apply (erule insertE)
  8.2627 -        apply (rule UnI2)
  8.2628 -        apply (simp add: False uv xk)
  8.2629 -        apply (drule q1(3)[rule_format])
  8.2630 -        using False
  8.2631 -        unfolding xk uv
  8.2632 -        apply auto
  8.2633 -        done
  8.2634 -    qed
  8.2635 -  qed
  8.2636 -qed
  8.2637 -
  8.2638  
  8.2639  subsection \<open>Hence the main theorem about negligible sets.\<close>
  8.2640  
  8.2641 -lemma finite_product_dependent:
  8.2642 -  assumes "finite s"
  8.2643 -    and "\<And>x. x \<in> s \<Longrightarrow> finite (t x)"
  8.2644 -  shows "finite {(i, j) |i j. i \<in> s \<and> j \<in> t i}"
  8.2645 -  using assms
  8.2646 -proof induct
  8.2647 -  case (insert x s)
  8.2648 -  have *: "{(i, j) |i j. i \<in> insert x s \<and> j \<in> t i} =
  8.2649 -    (\<lambda>y. (x,y)) ` (t x) \<union> {(i, j) |i j. i \<in> s \<and> j \<in> t i}" by auto
  8.2650 -  show ?case
  8.2651 -    unfolding *
  8.2652 -    apply (rule finite_UnI)
  8.2653 -    using insert
  8.2654 -    apply auto
  8.2655 -    done
  8.2656 -qed auto
  8.2657 -
  8.2658 -lemma sum_sum_product:
  8.2659 -  assumes "finite s"
  8.2660 -    and "\<forall>i\<in>s. finite (t i)"
  8.2661 -  shows "setsum (\<lambda>i. setsum (x i) (t i)::real) s =
  8.2662 -    setsum (\<lambda>(i,j). x i j) {(i,j) | i j. i \<in> s \<and> j \<in> t i}"
  8.2663 -  using assms
  8.2664 -proof induct
  8.2665 -  case (insert a s)
  8.2666 -  have *: "{(i, j) |i j. i \<in> insert a s \<and> j \<in> t i} =
  8.2667 -    (\<lambda>y. (a,y)) ` (t a) \<union> {(i, j) |i j. i \<in> s \<and> j \<in> t i}" by auto
  8.2668 -  show ?case
  8.2669 -    unfolding *
  8.2670 -    apply (subst setsum.union_disjoint)
  8.2671 -    unfolding setsum.insert[OF insert(1-2)]
  8.2672 -    prefer 4
  8.2673 -    apply (subst insert(3))
  8.2674 -    unfolding add_right_cancel
  8.2675 -  proof -
  8.2676 -    show "setsum (x a) (t a) = (\<Sum>(xa, y)\<in> Pair a ` t a. x xa y)"
  8.2677 -      apply (subst setsum.reindex)
  8.2678 -      unfolding inj_on_def
  8.2679 -      apply auto
  8.2680 -      done
  8.2681 -    show "finite {(i, j) |i j. i \<in> s \<and> j \<in> t i}"
  8.2682 -      apply (rule finite_product_dependent)
  8.2683 -      using insert
  8.2684 -      apply auto
  8.2685 -      done
  8.2686 -  qed (insert insert, auto)
  8.2687 -qed auto
  8.2688 -
  8.2689  lemma has_integral_negligible:
  8.2690    fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  8.2691    assumes "negligible s"
  8.2692 @@ -4767,7 +2364,7 @@
  8.2693  qed
  8.2694  
  8.2695  lemma negligible_Un_eq[simp]: "negligible (s \<union> t) \<longleftrightarrow> negligible s \<and> negligible t"
  8.2696 -  using negligible_Un negligible_subset by blast 
  8.2697 +  using negligible_Un negligible_subset by blast
  8.2698  
  8.2699  lemma negligible_sing[intro]: "negligible {a::'a::euclidean_space}"
  8.2700    using negligible_standard_hyperplane[OF SOME_Basis, of "a \<bullet> (SOME i. i \<in> Basis)"] negligible_subset by blast
  8.2701 @@ -4915,10 +2512,10 @@
  8.2702  proof safe
  8.2703    fix a b :: 'b
  8.2704    show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
  8.2705 -    if "content (cbox a b) = 0"
  8.2706 +    if "box a b = {}"
  8.2707      apply (rule_tac x=f in exI)
  8.2708      using assms that
  8.2709 -    apply (auto intro!: integrable_on_null)
  8.2710 +    apply (auto simp: content_eq_0_interior)
  8.2711      done
  8.2712    {
  8.2713      fix c g
  8.2714 @@ -5037,33 +2634,6 @@
  8.2715  
  8.2716  subsection \<open>Specialization of additivity to one dimension.\<close>
  8.2717  
  8.2718 -subsection \<open>Special case of additivity we need for the FTC.\<close>
  8.2719 -
  8.2720 -lemma additive_tagged_division_1:
  8.2721 -  fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
  8.2722 -  assumes "a \<le> b"
  8.2723 -    and "p tagged_division_of {a..b}"
  8.2724 -  shows "setsum (\<lambda>(x,k). f(Sup k) - f(Inf k)) p = f b - f a"
  8.2725 -proof -
  8.2726 -  let ?f = "(\<lambda>k::(real) set. if k = {} then 0 else f(interval_upperbound k) - f(interval_lowerbound k))"
  8.2727 -  have ***: "\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i"
  8.2728 -    using assms by auto
  8.2729 -  have *: "add.operative ?f"
  8.2730 -    unfolding add.operative_1_lt box_eq_empty
  8.2731 -    by auto
  8.2732 -  have **: "cbox a b \<noteq> {}"
  8.2733 -    using assms(1) by auto
  8.2734 -  note setsum.operative_tagged_division[OF * assms(2)[simplified box_real[symmetric]]]
  8.2735 -  note * = this[unfolded if_not_P[OF **] interval_bounds[OF ***],symmetric]
  8.2736 -  show ?thesis
  8.2737 -    unfolding *
  8.2738 -    apply (rule setsum.cong)
  8.2739 -    unfolding split_paired_all split_conv
  8.2740 -    using assms(2)
  8.2741 -    apply auto
  8.2742 -    done
  8.2743 -qed
  8.2744 -
  8.2745  
  8.2746  subsection \<open>A useful lemma allowing us to factor out the content size.\<close>
  8.2747  
  8.2748 @@ -5351,20 +2921,6 @@
  8.2749  qed
  8.2750  
  8.2751  
  8.2752 -subsection \<open>Attempt a systematic general set of "offset" results for components.\<close>
  8.2753 -
  8.2754 -lemma gauge_modify:
  8.2755 -  assumes "(\<forall>s. open s \<longrightarrow> open {x. f(x) \<in> s})" "gauge d"
  8.2756 -  shows "gauge (\<lambda>x. {y. f y \<in> d (f x)})"
  8.2757 -  using assms
  8.2758 -  unfolding gauge_def
  8.2759 -  apply safe
  8.2760 -  defer
  8.2761 -  apply (erule_tac x="f x" in allE)
  8.2762 -  apply (erule_tac x="d (f x)" in allE)
  8.2763 -  apply auto
  8.2764 -  done
  8.2765 -
  8.2766  
  8.2767  subsection \<open>Only need trivial subintervals if the interval itself is trivial.\<close>
  8.2768  
  8.2769 @@ -5502,10 +3058,12 @@
  8.2770    shows "comm_monoid.operative op \<and> True (\<lambda>i. f integrable_on i)"
  8.2771    unfolding comm_monoid.operative_def[OF comm_monoid_and]
  8.2772    apply safe
  8.2773 -  apply (subst integrable_on_def)
  8.2774 -  unfolding has_integral_null_eq
  8.2775 -  apply (rule, rule refl)
  8.2776 -  apply (rule, assumption, assumption)+
  8.2777 +     apply (subst integrable_on_def)
  8.2778 +     apply rule
  8.2779 +     apply (rule has_integral_null_eq[where i=0, THEN iffD2])
  8.2780 +      apply (simp add: content_eq_0_interior)
  8.2781 +     apply rule
  8.2782 +    apply (rule, assumption, assumption)+
  8.2783    unfolding integrable_on_def
  8.2784    by (auto intro!: has_integral_split)
  8.2785  
  8.2786 @@ -6099,18 +3657,6 @@
  8.2787  
  8.2788  subsection \<open>Stronger form of FCT; quite a tedious proof.\<close>
  8.2789  
  8.2790 -lemma bgauge_existence_lemma: "(\<forall>x\<in>s. \<exists>d::real. 0 < d \<and> q d x) \<longleftrightarrow> (\<forall>x. \<exists>d>0. x\<in>s \<longrightarrow> q d x)"
  8.2791 -  by (meson zero_less_one)
  8.2792 -
  8.2793 -lemma additive_tagged_division_1':
  8.2794 -  fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
  8.2795 -  assumes "a \<le> b"
  8.2796 -    and "p tagged_division_of {a..b}"
  8.2797 -  shows "setsum (\<lambda>(x,k). f (Sup k) - f(Inf k)) p = f b - f a"
  8.2798 -  using additive_tagged_division_1[OF _ assms(2), of f]
  8.2799 -  using assms(1)
  8.2800 -  by auto
  8.2801 -
  8.2802  lemma split_minus[simp]: "(\<lambda>(x, k). f x k) x - (\<lambda>(x, k). g x k) x = (\<lambda>(x, k). f x k - g x k) x"
  8.2803    by (simp add: split_def)
  8.2804  
  8.2805 @@ -7695,39 +5241,6 @@
  8.2806    shows "f integrable_on s \<longleftrightarrow> f integrable_on t"
  8.2807  by (blast intro: integrable_spike_set assms negligible_subset)
  8.2808  
  8.2809 -(*lemma integral_spike_set:
  8.2810 - "\<forall>f:real^M->real^N g s t.
  8.2811 -        negligible(s DIFF t \<union> t DIFF s)
  8.2812 -        \<longrightarrow> integral s f = integral t f"
  8.2813 -qed  REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN
  8.2814 -  AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN
  8.2815 -  ASM_MESON_TAC[]);;
  8.2816 -
  8.2817 -lemma has_integral_interior:
  8.2818 - "\<forall>f:real^M->real^N y s.
  8.2819 -        negligible(frontier s)
  8.2820 -        \<longrightarrow> ((f has_integral y) (interior s) \<longleftrightarrow> (f has_integral y) s)"
  8.2821 -qed  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN
  8.2822 -  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
  8.2823 -    NEGLIGIBLE_SUBSET)) THEN
  8.2824 -  REWRITE_TAC[frontier] THEN
  8.2825 -  MP_TAC(ISPEC `s:real^M->bool` INTERIOR_SUBSET) THEN
  8.2826 -  MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN
  8.2827 -  SET_TAC[]);;
  8.2828 -
  8.2829 -lemma has_integral_closure:
  8.2830 - "\<forall>f:real^M->real^N y s.
  8.2831 -        negligible(frontier s)
  8.2832 -        \<longrightarrow> ((f has_integral y) (closure s) \<longleftrightarrow> (f has_integral y) s)"
  8.2833 -qed  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN
  8.2834 -  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
  8.2835 -    NEGLIGIBLE_SUBSET)) THEN
  8.2836 -  REWRITE_TAC[frontier] THEN
  8.2837 -  MP_TAC(ISPEC `s:real^M->bool` INTERIOR_SUBSET) THEN
  8.2838 -  MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN
  8.2839 -  SET_TAC[]);;*)
  8.2840 -
  8.2841 -
  8.2842  subsection \<open>More lemmas that are useful later\<close>
  8.2843  
  8.2844  lemma has_integral_subset_component_le:
  8.2845 @@ -8412,34 +5925,26 @@
  8.2846  
  8.2847  subsection \<open>Also tagged divisions\<close>
  8.2848  
  8.2849 +lemma has_integral_iff: "(f has_integral i) s \<longleftrightarrow> (f integrable_on s \<and> integral s f = i)"
  8.2850 +  by blast
  8.2851 +
  8.2852  lemma has_integral_combine_tagged_division:
  8.2853    fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
  8.2854    assumes "p tagged_division_of s"
  8.2855      and "\<forall>(x,k) \<in> p. (f has_integral (i k)) k"
  8.2856 -  shows "(f has_integral (setsum (\<lambda>(x,k). i k) p)) s"
  8.2857 +  shows "(f has_integral (\<Sum>(x,k)\<in>p. i k)) s"
  8.2858  proof -
  8.2859 -  have *: "(f has_integral (setsum (\<lambda>k. integral k f) (snd ` p))) s"
  8.2860 -    apply (rule has_integral_combine_division)
  8.2861 -    apply (rule division_of_tagged_division[OF assms(1)])
  8.2862 +  have *: "(f has_integral (\<Sum>k\<in>snd`p. integral k f)) s"
  8.2863      using assms(2)
  8.2864 -    unfolding has_integral_integral[symmetric]
  8.2865 -    apply safe
  8.2866 +    apply (intro has_integral_combine_division)
  8.2867 +    apply (auto simp: has_integral_integral[symmetric] intro: division_of_tagged_division[OF assms(1)])
  8.2868      apply auto
  8.2869      done
  8.2870 -  then show ?thesis
  8.2871 -    apply -
  8.2872 -    apply (rule subst[where P="\<lambda>i. (f has_integral i) s"])
  8.2873 -    defer
  8.2874 -    apply assumption
  8.2875 -    apply (rule trans[of _ "setsum (\<lambda>(x,k). integral k f) p"])
  8.2876 -    apply (subst eq_commute)
  8.2877 -    apply (rule setsum.over_tagged_division_lemma[OF assms(1)])
  8.2878 -    apply (rule integral_null)
  8.2879 -    apply assumption
  8.2880 -    apply (rule setsum.cong)
  8.2881 -    using assms(2)
  8.2882 -    apply auto
  8.2883 -    done
  8.2884 +  also have "(\<Sum>k\<in>snd`p. integral k f) = (\<Sum>(x, k)\<in>p. integral k f)"
  8.2885 +    by (intro setsum.over_tagged_division_lemma[OF assms(1), symmetric] integral_null)
  8.2886 +       (simp add: content_eq_0_interior)
  8.2887 +  finally show ?thesis
  8.2888 +    using assms by (auto simp add: has_integral_iff intro!: setsum.cong)
  8.2889  qed
  8.2890  
  8.2891  lemma integral_combine_tagged_division_bottomup:
  8.2892 @@ -9594,84 +7099,6 @@
  8.2893  
  8.2894  subsection \<open>differentiation under the integral sign\<close>
  8.2895  
  8.2896 -lemma tube_lemma:
  8.2897 -  assumes "compact K"
  8.2898 -  assumes "open W"
  8.2899 -  assumes "{x0} \<times> K \<subseteq> W"
  8.2900 -  shows "\<exists>X0. x0 \<in> X0 \<and> open X0 \<and> X0 \<times> K \<subseteq> W"
  8.2901 -proof -
  8.2902 -  {
  8.2903 -    fix y assume "y \<in> K"
  8.2904 -    then have "(x0, y) \<in> W" using assms by auto
  8.2905 -    with \<open>open W\<close>
  8.2906 -    have "\<exists>X0 Y. open X0 \<and> open Y \<and> x0 \<in> X0 \<and> y \<in> Y \<and> X0 \<times> Y \<subseteq> W"
  8.2907 -      by (rule open_prod_elim) blast
  8.2908 -  }
  8.2909 -  then obtain X0 Y where
  8.2910 -    *: "\<forall>y \<in> K. open (X0 y) \<and> open (Y y) \<and> x0 \<in> X0 y \<and> y \<in> Y y \<and> X0 y \<times> Y y \<subseteq> W"
  8.2911 -    by metis
  8.2912 -  from * have "\<forall>t\<in>Y ` K. open t" "K \<subseteq> \<Union>(Y ` K)" by auto
  8.2913 -  with \<open>compact K\<close> obtain CC where CC: "CC \<subseteq> Y ` K" "finite CC" "K \<subseteq> \<Union>CC"
  8.2914 -    by (rule compactE)
  8.2915 -  then obtain c where c: "\<And>C. C \<in> CC \<Longrightarrow> c C \<in> K \<and> C = Y (c C)"
  8.2916 -    by (force intro!: choice)
  8.2917 -  with * CC show ?thesis
  8.2918 -    by (force intro!: exI[where x="\<Inter>C\<in>CC. X0 (c C)"]) (* SLOW *)
  8.2919 -qed
  8.2920 -
  8.2921 -lemma continuous_on_prod_compactE:
  8.2922 -  fixes fx::"'a::topological_space \<times> 'b::topological_space \<Rightarrow> 'c::metric_space"
  8.2923 -    and e::real
  8.2924 -  assumes cont_fx: "continuous_on (U \<times> C) fx"
  8.2925 -  assumes "compact C"
  8.2926 -  assumes [intro]: "x0 \<in> U"
  8.2927 -  notes [continuous_intros] = continuous_on_compose2[OF cont_fx]
  8.2928 -  assumes "e > 0"
  8.2929 -  obtains X0 where "x0 \<in> X0" "open X0"
  8.2930 -    "\<forall>x\<in>X0 \<inter> U. \<forall>t \<in> C. dist (fx (x, t)) (fx (x0, t)) \<le> e"
  8.2931 -proof -
  8.2932 -  define psi where "psi = (\<lambda>(x, t). dist (fx (x, t)) (fx (x0, t)))"
  8.2933 -  define W0 where "W0 = {(x, t) \<in> U \<times> C. psi (x, t) < e}"
  8.2934 -  have W0_eq: "W0 = psi -` {..<e} \<inter> U \<times> C"
  8.2935 -    by (auto simp: vimage_def W0_def)
  8.2936 -  have "open {..<e}" by simp
  8.2937 -  have "continuous_on (U \<times> C) psi"
  8.2938 -    by (auto intro!: continuous_intros simp: psi_def split_beta')
  8.2939 -  from this[unfolded continuous_on_open_invariant, rule_format, OF \<open>open {..<e}\<close>]
  8.2940 -  obtain W where W: "open W" "W \<inter> U \<times> C = W0 \<inter> U \<times> C"
  8.2941 -    unfolding W0_eq by blast
  8.2942 -  have "{x0} \<times> C \<subseteq> W \<inter> U \<times> C"
  8.2943 -    unfolding W
  8.2944 -    by (auto simp: W0_def psi_def \<open>0 < e\<close>)
  8.2945 -  then have "{x0} \<times> C \<subseteq> W" by blast
  8.2946 -  from tube_lemma[OF \<open>compact C\<close> \<open>open W\<close> this]
  8.2947 -  obtain X0 where X0: "x0 \<in> X0" "open X0" "X0 \<times> C \<subseteq> W"
  8.2948 -    by blast
  8.2949 -
  8.2950 -  have "\<forall>x\<in>X0 \<inter> U. \<forall>t \<in> C. dist (fx (x, t)) (fx (x0, t)) \<le> e"
  8.2951 -  proof safe
  8.2952 -    fix x assume x: "x \<in> X0" "x \<in> U"
  8.2953 -    fix t assume t: "t \<in> C"
  8.2954 -    have "dist (fx (x, t)) (fx (x0, t)) = psi (x, t)"
  8.2955 -      by (auto simp: psi_def)
  8.2956 -    also
  8.2957 -    {
  8.2958 -      have "(x, t) \<in> X0 \<times> C"
  8.2959 -        using t x
  8.2960 -        by auto
  8.2961 -      also note \<open>\<dots> \<subseteq> W\<close>
  8.2962 -      finally have "(x, t) \<in> W" .
  8.2963 -      with t x have "(x, t) \<in> W \<inter> U \<times> C"
  8.2964 -        by blast
  8.2965 -      also note \<open>W \<inter> U \<times> C = W0 \<inter> U \<times> C\<close>
  8.2966 -      finally  have "psi (x, t) < e"
  8.2967 -        by (auto simp: W0_def)
  8.2968 -    }
  8.2969 -    finally show "dist (fx (x, t)) (fx (x0, t)) \<le> e" by simp
  8.2970 -  qed
  8.2971 -  from X0(1,2) this show ?thesis ..
  8.2972 -qed
  8.2973 -
  8.2974  lemma integral_continuous_on_param:
  8.2975    fixes f::"'a::topological_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
  8.2976    assumes cont_fx: "continuous_on (U \<times> cbox a b) (\<lambda>(x, t). f x t)"
  8.2977 @@ -9721,26 +7148,6 @@
  8.2978    qed
  8.2979  qed (auto intro!: continuous_on_const)
  8.2980  
  8.2981 -lemma eventually_closed_segment:
  8.2982 -  fixes x0::"'a::real_normed_vector"
  8.2983 -  assumes "open X0" "x0 \<in> X0"
  8.2984 -  shows "\<forall>\<^sub>F x in at x0 within U. closed_segment x0 x \<subseteq> X0"
  8.2985 -proof -
  8.2986 -  from openE[OF assms]
  8.2987 -  obtain e where e: "0 < e" "ball x0 e \<subseteq> X0" .
  8.2988 -  then have "\<forall>\<^sub>F x in at x0 within U. x \<in> ball x0 e"
  8.2989 -    by (auto simp: dist_commute eventually_at)
  8.2990 -  then show ?thesis
  8.2991 -  proof eventually_elim
  8.2992 -    case (elim x)
  8.2993 -    have "x0 \<in> ball x0 e" using \<open>e > 0\<close> by simp
  8.2994 -    from convex_ball[unfolded convex_contains_segment, rule_format, OF this elim]
  8.2995 -    have "closed_segment x0 x \<subseteq> ball x0 e" .
  8.2996 -    also note \<open>\<dots> \<subseteq> X0\<close>
  8.2997 -    finally show ?case .
  8.2998 -  qed
  8.2999 -qed
  8.3000 -
  8.3001  lemma leibniz_rule:
  8.3002    fixes f::"'a::banach \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
  8.3003    assumes fx: "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow>
  8.3004 @@ -9834,8 +7241,7 @@
  8.3005    qed (rule blinfun.bounded_linear_right)
  8.3006  qed (auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps)
  8.3007  
  8.3008 -lemma
  8.3009 -  has_vector_derivative_eq_has_derivative_blinfun:
  8.3010 +lemma has_vector_derivative_eq_has_derivative_blinfun:
  8.3011    "(f has_vector_derivative f') (at x within U) \<longleftrightarrow>
  8.3012      (f has_derivative blinfun_scaleR_left f') (at x within U)"
  8.3013    by (simp add: has_vector_derivative_def)
  8.3014 @@ -9867,8 +7273,7 @@
  8.3015      done
  8.3016  qed
  8.3017  
  8.3018 -lemma
  8.3019 -  has_field_derivative_eq_has_derivative_blinfun:
  8.3020 +lemma has_field_derivative_eq_has_derivative_blinfun:
  8.3021    "(f has_field_derivative f') (at x within U) \<longleftrightarrow> (f has_derivative blinfun_mult_right f') (at x within U)"
  8.3022    by (simp add: has_field_derivative_def)
  8.3023  
  8.3024 @@ -9900,8 +7305,7 @@
  8.3025  
  8.3026  subsection \<open>Exchange uniform limit and integral\<close>
  8.3027  
  8.3028 -lemma
  8.3029 -  uniform_limit_integral:
  8.3030 +lemma uniform_limit_integral:
  8.3031    fixes f::"'a \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
  8.3032    assumes u: "uniform_limit (cbox a b) f g F"
  8.3033    assumes c: "\<And>n. continuous_on (cbox a b) (f n)"
  8.3034 @@ -10095,18 +7499,6 @@
  8.3035  
  8.3036  subsection \<open>Compute a double integral using iterated integrals and switching the order of integration\<close>
  8.3037  
  8.3038 -lemma setcomp_dot1: "{z. P (z \<bullet> (i,0))} = {(x,y). P(x \<bullet> i)}"
  8.3039 -  by auto
  8.3040 -
  8.3041 -lemma setcomp_dot2: "{z. P (z \<bullet> (0,i))} = {(x,y). P(y \<bullet> i)}"
  8.3042 -  by auto
  8.3043 -
  8.3044 -lemma Sigma_Int_Paircomp1: "(Sigma A B) \<inter> {(x, y). P x} = Sigma (A \<inter> {x. P x}) B"
  8.3045 -  by blast
  8.3046 -
  8.3047 -lemma Sigma_Int_Paircomp2: "(Sigma A B) \<inter> {(x, y). P y} = Sigma A (\<lambda>z. B z \<inter> {y. P y})"
  8.3048 -  by blast
  8.3049 -
  8.3050  lemma continuous_on_imp_integrable_on_Pair1:
  8.3051    fixes f :: "_ \<Rightarrow> 'b::banach"
  8.3052    assumes con: "continuous_on (cbox (a,c) (b,d)) f" and x: "x \<in> cbox a b"
  8.3053 @@ -10158,11 +7550,6 @@
  8.3054      done
  8.3055  qed
  8.3056  
  8.3057 -lemma norm_diff2: "\<lbrakk>y = y1 + y2; x = x1 + x2; e = e1 + e2; norm(y1 - x1) \<le> e1; norm(y2 - x2) \<le> e2\<rbrakk>
  8.3058 -            \<Longrightarrow> norm(y - x) \<le> e"
  8.3059 -using norm_triangle_mono [of "y1 - x1" "e1" "y2 - x2" "e2"]
  8.3060 -  by (simp add: add_diff_add)
  8.3061 -
  8.3062  lemma integral_split:
  8.3063    fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
  8.3064    assumes f: "f integrable_on (cbox a b)"
  8.3065 @@ -10186,9 +7573,11 @@
  8.3066                      \<le> e * content (cbox (a,c) (b,d)))"
  8.3067  proof (auto simp: comm_monoid.operative_def[OF comm_monoid_and])
  8.3068    fix a::'a and c::'b and b::'a and d::'b and u::'a and v::'a and w::'b and z::'b
  8.3069 -  assume c0: "content (cbox (a, c) (b, d)) = 0"
  8.3070 +  assume *: "box (a, c) (b, d) = {}"
  8.3071       and cb1: "cbox (u, w) (v, z) \<subseteq> cbox (a, c) (b, d)"
  8.3072       and cb2: "cbox (u, w) (v, z) \<subseteq> s"
  8.3073 +  then have c0: "content (cbox (a, c) (b, d)) = 0"
  8.3074 +    using * unfolding content_eq_0_interior by simp
  8.3075    have c0': "content (cbox (u, w) (v, z)) = 0"
  8.3076      by (fact content_0_subset [OF c0 cb1])
  8.3077    show "norm (integral (cbox (u,w) (v,z)) f - integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))))
  8.3078 @@ -10274,9 +7663,6 @@
  8.3079       integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. k))"
  8.3080    by (simp add: content_Pair)
  8.3081  
  8.3082 -lemma norm_minus2: "norm (x1-x2, y1-y2) = norm (x2-x1, y2-y1)"
  8.3083 -  by (simp add: norm_minus_eqI)
  8.3084 -
  8.3085  lemma integral_prod_continuous:
  8.3086    fixes f :: "('a::euclidean_space * 'b::euclidean_space) \<Rightarrow> 'c::banach"
  8.3087    assumes "continuous_on (cbox (a,c) (b,d)) f" (is "continuous_on ?CBOX f")
  8.3088 @@ -10392,20 +7778,6 @@
  8.3089      by simp
  8.3090  qed
  8.3091  
  8.3092 -lemma swap_continuous:
  8.3093 -  assumes "continuous_on (cbox (a,c) (b,d)) (\<lambda>(x,y). f x y)"
  8.3094 -    shows "continuous_on (cbox (c,a) (d,b)) (\<lambda>(x, y). f y x)"
  8.3095 -proof -
  8.3096 -  have "(\<lambda>(x, y). f y x) = (\<lambda>(x, y). f x y) \<circ> prod.swap"
  8.3097 -    by auto
  8.3098 -  then show ?thesis
  8.3099 -    apply (rule ssubst)
  8.3100 -    apply (rule continuous_on_compose)
  8.3101 -    apply (simp add: split_def)
  8.3102 -    apply (rule continuous_intros | simp add: assms)+
  8.3103 -    done
  8.3104 -qed
  8.3105 -
  8.3106  lemma integral_swap_2dim:
  8.3107    fixes f :: "['a::euclidean_space, 'b::euclidean_space] \<Rightarrow> 'c::banach"
  8.3108    assumes "continuous_on (cbox (a,c) (b,d)) (\<lambda>(x,y). f x y)"
     9.1 --- a/src/HOL/Analysis/Lebesgue_Measure.thy	Thu Sep 29 16:49:42 2016 +0200
     9.2 +++ b/src/HOL/Analysis/Lebesgue_Measure.thy	Fri Sep 30 10:00:49 2016 +0200
     9.3 @@ -8,7 +8,7 @@
     9.4  section \<open>Lebesgue measure\<close>
     9.5  
     9.6  theory Lebesgue_Measure
     9.7 -  imports Finite_Product_Measure Bochner_Integration Caratheodory
     9.8 +  imports Finite_Product_Measure Bochner_Integration Caratheodory Complete_Measure Summation_Tests
     9.9  begin
    9.10  
    9.11  subsection \<open>Every right continuous and nondecreasing function gives rise to a measure\<close>
    9.12 @@ -356,6 +356,12 @@
    9.13  definition lborel :: "('a :: euclidean_space) measure" where
    9.14    "lborel = distr (\<Pi>\<^sub>M b\<in>Basis. interval_measure (\<lambda>x. x)) borel (\<lambda>f. \<Sum>b\<in>Basis. f b *\<^sub>R b)"
    9.15  
    9.16 +abbreviation lebesgue :: "'a::euclidean_space measure"
    9.17 +  where "lebesgue \<equiv> completion lborel"
    9.18 +
    9.19 +abbreviation lebesgue_on :: "'a set \<Rightarrow> 'a::euclidean_space measure"
    9.20 +  where "lebesgue_on \<Omega> \<equiv> restrict_space (completion lborel) \<Omega>"
    9.21 +
    9.22  lemma
    9.23    shows sets_lborel[simp, measurable_cong]: "sets lborel = sets borel"
    9.24      and space_lborel[simp]: "space lborel = space borel"
    9.25 @@ -659,6 +665,105 @@
    9.26      by (simp add: lborel_integrable_real_affine_iff not_integrable_integral_eq)
    9.27  qed
    9.28  
    9.29 +lemma
    9.30 +  fixes c :: "'a::euclidean_space \<Rightarrow> real" and t
    9.31 +  assumes c: "\<And>j. j \<in> Basis \<Longrightarrow> c j \<noteq> 0"
    9.32 +  defines "T == (\<lambda>x. t + (\<Sum>j\<in>Basis. (c j * (x \<bullet> j)) *\<^sub>R j))"
    9.33 +  shows lebesgue_affine_euclidean: "lebesgue = density (distr lebesgue lebesgue T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))" (is "_ = ?D")
    9.34 +    and lebesgue_affine_measurable: "T \<in> lebesgue \<rightarrow>\<^sub>M lebesgue"
    9.35 +proof -
    9.36 +  have T_borel[measurable]: "T \<in> borel \<rightarrow>\<^sub>M borel"
    9.37 +    by (auto simp: T_def[abs_def])
    9.38 +  { fix A :: "'a set" assume A: "A \<in> sets borel"
    9.39 +    then have "emeasure lborel A = 0 \<longleftrightarrow> emeasure (density (distr lborel borel T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))) A = 0"
    9.40 +      unfolding T_def using c by (subst lborel_affine_euclidean[symmetric]) auto
    9.41 +    also have "\<dots> \<longleftrightarrow> emeasure (distr lebesgue lborel T) A = 0"
    9.42 +      using A c by (simp add: distr_completion emeasure_density nn_integral_cmult setprod_nonneg cong: distr_cong)
    9.43 +    finally have "emeasure lborel A = 0 \<longleftrightarrow> emeasure (distr lebesgue lborel T) A = 0" . }
    9.44 +  then have eq: "null_sets lborel = null_sets (distr lebesgue lborel T)"
    9.45 +    by (auto simp: null_sets_def)
    9.46 +
    9.47 +  show "T \<in> lebesgue \<rightarrow>\<^sub>M lebesgue"
    9.48 +    by (rule completion.measurable_completion2) (auto simp: eq measurable_completion)
    9.49 +
    9.50 +  have "lebesgue = completion (density (distr lborel borel T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>)))"
    9.51 +    using c by (subst lborel_affine_euclidean[of c t]) (simp_all add: T_def[abs_def])
    9.52 +  also have "\<dots> = density (completion (distr lebesgue lborel T)) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))"
    9.53 +    using c by (auto intro!: always_eventually setprod_pos completion_density_eq simp: distr_completion cong: distr_cong)
    9.54 +  also have "\<dots> = density (distr lebesgue lebesgue T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))"
    9.55 +    by (subst completion.completion_distr_eq) (auto simp: eq measurable_completion)
    9.56 +  finally show "lebesgue = density (distr lebesgue lebesgue T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))" .
    9.57 +qed
    9.58 +
    9.59 +lemma lebesgue_measurable_scaling[measurable]: "op *\<^sub>R x \<in> lebesgue \<rightarrow>\<^sub>M lebesgue"
    9.60 +proof cases
    9.61 +  assume "x = 0"
    9.62 +  then have "op *\<^sub>R x = (\<lambda>x. 0::'a)"
    9.63 +    by (auto simp: fun_eq_iff)
    9.64 +  then show ?thesis by auto
    9.65 +next
    9.66 +  assume "x \<noteq> 0" then show ?thesis
    9.67 +    using lebesgue_affine_measurable[of "\<lambda>_. x" 0]
    9.68 +    unfolding scaleR_scaleR[symmetric] scaleR_setsum_right[symmetric] euclidean_representation
    9.69 +    by (auto simp add: ac_simps)
    9.70 +qed
    9.71 +
    9.72 +lemma
    9.73 +  fixes m :: real and \<delta> :: "'a::euclidean_space"
    9.74 +  defines "T r d x \<equiv> r *\<^sub>R x + d"
    9.75 +  shows emeasure_lebesgue_affine: "emeasure lebesgue (T m \<delta> ` S) = \<bar>m\<bar> ^ DIM('a) * emeasure lebesgue S" (is ?e)
    9.76 +    and measure_lebesgue_affine: "measure lebesgue (T m \<delta> ` S) = \<bar>m\<bar> ^ DIM('a) * measure lebesgue S" (is ?m)
    9.77 +proof -
    9.78 +  show ?e
    9.79 +  proof cases
    9.80 +    assume "m = 0" then show ?thesis
    9.81 +      by (simp add: image_constant_conv T_def[abs_def])
    9.82 +  next
    9.83 +    let ?T = "T m \<delta>" and ?T' = "T (1 / m) (- ((1/m) *\<^sub>R \<delta>))"
    9.84 +    assume "m \<noteq> 0"
    9.85 +    then have s_comp_s: "?T' \<circ> ?T = id" "?T \<circ> ?T' = id"
    9.86 +      by (auto simp: T_def[abs_def] fun_eq_iff scaleR_add_right scaleR_diff_right)
    9.87 +    then have "inv ?T' = ?T" "bij ?T'"
    9.88 +      by (auto intro: inv_unique_comp o_bij)
    9.89 +    then have eq: "T m \<delta> ` S = T (1 / m) ((-1/m) *\<^sub>R \<delta>) -` S \<inter> space lebesgue"
    9.90 +      using bij_vimage_eq_inv_image[OF \<open>bij ?T'\<close>, of S] by auto
    9.91 +
    9.92 +    have trans_eq_T: "(\<lambda>x. \<delta> + (\<Sum>j\<in>Basis. (m * (x \<bullet> j)) *\<^sub>R j)) = T m \<delta>" for m \<delta>
    9.93 +      unfolding T_def[abs_def] scaleR_scaleR[symmetric] scaleR_setsum_right[symmetric]
    9.94 +      by (auto simp add: euclidean_representation ac_simps)
    9.95 +
    9.96 +    have T[measurable]: "T r d \<in> lebesgue \<rightarrow>\<^sub>M lebesgue" for r d
    9.97 +      using lebesgue_affine_measurable[of "\<lambda>_. r" d]
    9.98 +      by (cases "r = 0") (auto simp: trans_eq_T T_def[abs_def])
    9.99 +
   9.100 +    show ?thesis
   9.101 +    proof cases
   9.102 +      assume "S \<in> sets lebesgue" with \<open>m \<noteq> 0\<close> show ?thesis
   9.103 +        unfolding eq
   9.104 +        apply (subst lebesgue_affine_euclidean[of "\<lambda>_. m" \<delta>])
   9.105 +        apply (simp_all add: emeasure_density trans_eq_T nn_integral_cmult emeasure_distr
   9.106 +                        del: space_completion emeasure_completion)
   9.107 +        apply (simp add: vimage_comp s_comp_s setprod_constant)
   9.108 +        done
   9.109 +    next
   9.110 +      assume "S \<notin> sets lebesgue"
   9.111 +      moreover have "?T ` S \<notin> sets lebesgue"
   9.112 +      proof
   9.113 +        assume "?T ` S \<in> sets lebesgue"
   9.114 +        then have "?T -` (?T ` S) \<inter> space lebesgue \<in> sets lebesgue"
   9.115 +          by (rule measurable_sets[OF T])
   9.116 +        also have "?T -` (?T ` S) \<inter> space lebesgue = S"
   9.117 +          by (simp add: vimage_comp s_comp_s eq)
   9.118 +        finally show False using \<open>S \<notin> sets lebesgue\<close> by auto
   9.119 +      qed
   9.120 +      ultimately show ?thesis
   9.121 +        by (simp add: emeasure_notin_sets)
   9.122 +    qed
   9.123 +  qed
   9.124 +  show ?m
   9.125 +    unfolding measure_def \<open>?e\<close> by (simp add: enn2real_mult setprod_nonneg)
   9.126 +qed
   9.127 +
   9.128  lemma divideR_right:
   9.129    fixes x y :: "'a::real_normed_vector"
   9.130    shows "r \<noteq> 0 \<Longrightarrow> y = x /\<^sub>R r \<longleftrightarrow> r *\<^sub>R y = x"
   9.131 @@ -780,4 +885,105 @@
   9.132      by (auto simp: mult.commute)
   9.133  qed
   9.134  
   9.135 +abbreviation lmeasurable :: "'a::euclidean_space set set"
   9.136 +where
   9.137 +  "lmeasurable \<equiv> fmeasurable lebesgue"
   9.138 +
   9.139 +lemma lmeasurable_iff_integrable:
   9.140 +  "S \<in> lmeasurable \<longleftrightarrow> integrable lebesgue (indicator S :: 'a::euclidean_space \<Rightarrow> real)"
   9.141 +  by (auto simp: fmeasurable_def integrable_iff_bounded borel_measurable_indicator_iff ennreal_indicator)
   9.142 +
   9.143 +lemma lmeasurable_cbox [iff]: "cbox a b \<in> lmeasurable"
   9.144 +  and lmeasurable_box [iff]: "box a b \<in> lmeasurable"
   9.145 +  by (auto simp: fmeasurable_def emeasure_lborel_box_eq emeasure_lborel_cbox_eq)
   9.146 +
   9.147 +lemma lmeasurable_compact: "compact S \<Longrightarrow> S \<in> lmeasurable"
   9.148 +  using emeasure_compact_finite[of S] by (intro fmeasurableI) (auto simp: borel_compact)
   9.149 +
   9.150 +lemma lmeasurable_open: "bounded S \<Longrightarrow> open S \<Longrightarrow> S \<in> lmeasurable"
   9.151 +  using emeasure_bounded_finite[of S] by (intro fmeasurableI) (auto simp: borel_open)
   9.152 +
   9.153 +lemma lmeasurable_ball: "ball a r \<in> lmeasurable"
   9.154 +  by (simp add: lmeasurable_open)
   9.155 +
   9.156 +lemma lmeasurable_interior: "bounded S \<Longrightarrow> interior S \<in> lmeasurable"
   9.157 +  by (simp add: bounded_interior lmeasurable_open)
   9.158 +
   9.159 +lemma null_sets_cbox_Diff_box: "cbox a b - box a b \<in> null_sets lborel"
   9.160 +proof -
   9.161 +  have "emeasure lborel (cbox a b - box a b) = 0"
   9.162 +    by (subst emeasure_Diff) (auto simp: emeasure_lborel_cbox_eq emeasure_lborel_box_eq box_subset_cbox)
   9.163 +  then have "cbox a b - box a b \<in> null_sets lborel"
   9.164 +    by (auto simp: null_sets_def)
   9.165 +  then show ?thesis
   9.166 +    by (auto dest!: AE_not_in)
   9.167 +qed
   9.168 +subsection\<open> A nice lemma for negligibility proofs.\<close>
   9.169 +
   9.170 +lemma summable_iff_suminf_neq_top: "(\<And>n. f n \<ge> 0) \<Longrightarrow> \<not> summable f \<Longrightarrow> (\<Sum>i. ennreal (f i)) = top"
   9.171 +  by (metis summable_suminf_not_top)
   9.172 +
   9.173 +proposition starlike_negligible_bounded_gmeasurable:
   9.174 +  fixes S :: "'a :: euclidean_space set"
   9.175 +  assumes S: "S \<in> sets lebesgue" and "bounded S"
   9.176 +      and eq1: "\<And>c x. \<lbrakk>(c *\<^sub>R x) \<in> S; 0 \<le> c; x \<in> S\<rbrakk> \<Longrightarrow> c = 1"
   9.177 +    shows "S \<in> null_sets lebesgue"
   9.178 +proof -
   9.179 +  obtain M where "0 < M" "S \<subseteq> ball 0 M"
   9.180 +    using \<open>bounded S\<close> by (auto dest: bounded_subset_ballD)
   9.181 +
   9.182 +  let ?f = "\<lambda>n. root DIM('a) (Suc n)"
   9.183 +
   9.184 +  have vimage_eq_image: "op *\<^sub>R (?f n) -` S = op *\<^sub>R (1 / ?f n) ` S" for n
   9.185 +    apply safe
   9.186 +    subgoal for x by (rule image_eqI[of _ _ "?f n *\<^sub>R x"]) auto
   9.187 +    subgoal by auto
   9.188 +    done
   9.189 +
   9.190 +  have eq: "(1 / ?f n) ^ DIM('a) = 1 / Suc n" for n
   9.191 +    by (simp add: field_simps)
   9.192 +
   9.193 +  { fix n x assume x: "root DIM('a) (1 + real n) *\<^sub>R x \<in> S"
   9.194 +    have "1 * norm x \<le> root DIM('a) (1 + real n) * norm x"
   9.195 +      by (rule mult_mono) auto
   9.196 +    also have "\<dots> < M"
   9.197 +      using x \<open>S \<subseteq> ball 0 M\<close> by auto
   9.198 +    finally have "norm x < M" by simp }
   9.199 +  note less_M = this
   9.200 +
   9.201 +  have "(\<Sum>n. ennreal (1 / Suc n)) = top"
   9.202 +    using not_summable_harmonic[where 'a=real] summable_Suc_iff[where f="\<lambda>n. 1 / (real n)"]
   9.203 +    by (intro summable_iff_suminf_neq_top) (auto simp add: inverse_eq_divide)
   9.204 +  then have "top * emeasure lebesgue S = (\<Sum>n. (1 / ?f n)^DIM('a) * emeasure lebesgue S)"
   9.205 +    unfolding ennreal_suminf_multc eq by simp
   9.206 +  also have "\<dots> = (\<Sum>n. emeasure lebesgue (op *\<^sub>R (?f n) -` S))"
   9.207 +    unfolding vimage_eq_image using emeasure_lebesgue_affine[of "1 / ?f n" 0 S for n] by simp
   9.208 +  also have "\<dots> = emeasure lebesgue (\<Union>n. op *\<^sub>R (?f n) -` S)"
   9.209 +  proof (intro suminf_emeasure)
   9.210 +    show "disjoint_family (\<lambda>n. op *\<^sub>R (?f n) -` S)"
   9.211 +      unfolding disjoint_family_on_def
   9.212 +    proof safe
   9.213 +      fix m n :: nat and x assume "m \<noteq> n" "?f m *\<^sub>R x \<in> S" "?f n *\<^sub>R x \<in> S"
   9.214 +      with eq1[of "?f m / ?f n" "?f n *\<^sub>R x"] show "x \<in> {}"
   9.215 +        by auto
   9.216 +    qed
   9.217 +    have "op *\<^sub>R (?f i) -` S \<in> sets lebesgue" for i
   9.218 +      using measurable_sets[OF lebesgue_measurable_scaling[of "?f i"] S] by auto
   9.219 +    then show "range (\<lambda>i. op *\<^sub>R (?f i) -` S) \<subseteq> sets lebesgue"
   9.220 +      by auto
   9.221 +  qed
   9.222 +  also have "\<dots> \<le> emeasure lebesgue (ball 0 M :: 'a set)"
   9.223 +    using less_M by (intro emeasure_mono) auto
   9.224 +  also have "\<dots> < top"
   9.225 +    using lmeasurable_ball by (auto simp: fmeasurable_def)
   9.226 +  finally have "emeasure lebesgue S = 0"
   9.227 +    by (simp add: ennreal_top_mult split: if_split_asm)
   9.228 +  then show "S \<in> null_sets lebesgue"
   9.229 +    unfolding null_sets_def using \<open>S \<in> sets lebesgue\<close> by auto
   9.230 +qed
   9.231 +
   9.232 +corollary starlike_negligible_compact:
   9.233 +  "compact S \<Longrightarrow> (\<And>c x. \<lbrakk>(c *\<^sub>R x) \<in> S; 0 \<le> c; x \<in> S\<rbrakk> \<Longrightarrow> c = 1) \<Longrightarrow> S \<in> null_sets lebesgue"
   9.234 +  using starlike_negligible_bounded_gmeasurable[of S] by (auto simp: compact_eq_bounded_closed)
   9.235 +
   9.236  end
    10.1 --- a/src/HOL/Analysis/Measure_Space.thy	Thu Sep 29 16:49:42 2016 +0200
    10.2 +++ b/src/HOL/Analysis/Measure_Space.thy	Fri Sep 30 10:00:49 2016 +0200
    10.3 @@ -965,6 +965,16 @@
    10.4  translations
    10.5    "AE x in M. P" \<rightleftharpoons> "CONST almost_everywhere M (\<lambda>x. P)"
    10.6  
    10.7 +abbreviation
    10.8 +  "set_almost_everywhere A M P \<equiv> AE x in M. x \<in> A \<longrightarrow> P x"
    10.9 +
   10.10 +syntax
   10.11 +  "_set_almost_everywhere" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> bool"
   10.12 +  ("AE _\<in>_ in _./ _" [0,0,0,10] 10)
   10.13 +
   10.14 +translations
   10.15 +  "AE x\<in>A in M. P" \<rightleftharpoons> "CONST set_almost_everywhere A M (\<lambda>x. P)"
   10.16 +
   10.17  lemma eventually_ae_filter: "eventually P (ae_filter M) \<longleftrightarrow> (\<exists>N\<in>null_sets M. {x \<in> space M. \<not> P x} \<subseteq> N)"
   10.18    unfolding ae_filter_def by (subst eventually_INF_base) (auto simp: eventually_principal subset_eq)
   10.19  
   10.20 @@ -1117,6 +1127,12 @@
   10.21      unfolding eventually_ae_filter by auto
   10.22  qed auto
   10.23  
   10.24 +lemma pairwise_alt: "pairwise R S \<longleftrightarrow> (\<forall>x\<in>S. \<forall>y\<in>S-{x}. R x y)"
   10.25 +  by (auto simp add: pairwise_def)
   10.26 +
   10.27 +lemma AE_pairwise: "countable F \<Longrightarrow> pairwise (\<lambda>A B. AE x in M. R x A B) F \<longleftrightarrow> (AE x in M. pairwise (R x) F)"
   10.28 +  unfolding pairwise_alt by (simp add: AE_ball_countable)
   10.29 +
   10.30  lemma AE_discrete_difference:
   10.31    assumes X: "countable X"
   10.32    assumes null: "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0"
   10.33 @@ -1443,6 +1459,12 @@
   10.34    by (simp add: enn2real_def plus_ennreal.rep_eq real_of_ereal_add less_top
   10.35             del: real_of_ereal_enn2ereal)
   10.36  
   10.37 +lemma measure_eq_AE:
   10.38 +  assumes iff: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B"
   10.39 +  assumes A: "A \<in> sets M" and B: "B \<in> sets M"
   10.40 +  shows "measure M A = measure M B"
   10.41 +  using assms emeasure_eq_AE[OF assms] by (simp add: measure_def)
   10.42 +
   10.43  lemma measure_Union:
   10.44    "emeasure M A \<noteq> \<infinity> \<Longrightarrow> emeasure M B \<noteq> \<infinity> \<Longrightarrow> A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> A \<inter> B = {} \<Longrightarrow>
   10.45      measure M (A \<union> B) = measure M A + measure M B"
   10.46 @@ -1544,6 +1566,12 @@
   10.47      done
   10.48  qed
   10.49  
   10.50 +lemma measure_Un_null_set: "A \<in> sets M \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> measure M (A \<union> B) = measure M A"
   10.51 +  by (simp add: measure_def emeasure_Un_null_set)
   10.52 +
   10.53 +lemma measure_Diff_null_set: "A \<in> sets M \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> measure M (A - B) = measure M A"
   10.54 +  by (simp add: measure_def emeasure_Diff_null_set)
   10.55 +
   10.56  lemma measure_eq_setsum_singleton:
   10.57    "finite S \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> {x} \<in> sets M) \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> emeasure M {x} \<noteq> \<infinity>) \<Longrightarrow>
   10.58      measure M S = (\<Sum>x\<in>S. measure M {x})"
   10.59 @@ -1576,6 +1604,151 @@
   10.60      using fin A by (auto intro!: Lim_emeasure_decseq)
   10.61  qed auto
   10.62  
   10.63 +subsection \<open>Set of measurable sets with finite measure\<close>
   10.64 +
   10.65 +definition fmeasurable :: "'a measure \<Rightarrow> 'a set set"
   10.66 +where
   10.67 +  "fmeasurable M = {A\<in>sets M. emeasure M A < \<infinity>}"
   10.68 +
   10.69 +lemma fmeasurableD[dest, measurable_dest]: "A \<in> fmeasurable M \<Longrightarrow> A \<in> sets M"
   10.70 +  by (auto simp: fmeasurable_def)
   10.71 +
   10.72 +lemma fmeasurableD2: "A \<in> fmeasurable M \<Longrightarrow> emeasure M A \<noteq> top"
   10.73 +  by (auto simp: fmeasurable_def)
   10.74 +
   10.75 +lemma fmeasurableI: "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow> A \<in> fmeasurable M"
   10.76 +  by (auto simp: fmeasurable_def)
   10.77 +
   10.78 +lemma fmeasurableI_null_sets: "A \<in> null_sets M \<Longrightarrow> A \<in> fmeasurable M"
   10.79 +  by (auto simp: fmeasurable_def)
   10.80 +
   10.81 +lemma fmeasurableI2: "A \<in> fmeasurable M \<Longrightarrow> B \<subseteq> A \<Longrightarrow> B \<in> sets M \<Longrightarrow> B \<in> fmeasurable M"
   10.82 +  using emeasure_mono[of B A M] by (auto simp: fmeasurable_def)
   10.83 +
   10.84 +lemma measure_mono_fmeasurable:
   10.85 +  "A \<subseteq> B \<Longrightarrow> A \<in> sets M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow> measure M A \<le> measure M B"
   10.86 +  by (auto simp: measure_def fmeasurable_def intro!: emeasure_mono enn2real_mono)
   10.87 +
   10.88 +lemma emeasure_eq_measure2: "A \<in> fmeasurable M \<Longrightarrow> emeasure M A = measure M A"
   10.89 +  by (simp add: emeasure_eq_ennreal_measure fmeasurable_def less_top)
   10.90 +
   10.91 +interpretation fmeasurable: ring_of_sets "space M" "fmeasurable M"
   10.92 +proof (rule ring_of_setsI)
   10.93 +  show "fmeasurable M \<subseteq> Pow (space M)" "{} \<in> fmeasurable M"
   10.94 +    by (auto simp: fmeasurable_def dest: sets.sets_into_space)
   10.95 +  fix a b assume *: "a \<in> fmeasurable M" "b \<in> fmeasurable M"
   10.96 +  then have "emeasure M (a \<union> b) \<le> emeasure M a + emeasure M b"
   10.97 +    by (intro emeasure_subadditive) auto
   10.98 +  also have "\<dots> < top"
   10.99 +    using * by (auto simp: fmeasurable_def)
  10.100 +  finally show  "a \<union> b \<in> fmeasurable M"
  10.101 +    using * by (auto intro: fmeasurableI)
  10.102 +  show "a - b \<in> fmeasurable M"
  10.103 +    using emeasure_mono[of "a - b" a M] * by (auto simp: fmeasurable_def Diff_subset)
  10.104 +qed
  10.105 +
  10.106 +lemma fmeasurable_Diff: "A \<in> fmeasurable M \<Longrightarrow> B \<in> sets M \<Longrightarrow> A - B \<in> fmeasurable M"
  10.107 +  using fmeasurableI2[of A M "A - B"] by auto
  10.108 +
  10.109 +lemma fmeasurable_UN:
  10.110 +  assumes "countable I" "\<And>i. i \<in> I \<Longrightarrow> F i \<subseteq> A" "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M" "A \<in> fmeasurable M"
  10.111 +  shows "(\<Union>i\<in>I. F i) \<in> fmeasurable M"
  10.112 +proof (rule fmeasurableI2)
  10.113 +  show "A \<in> fmeasurable M" "(\<Union>i\<in>I. F i) \<subseteq> A" using assms by auto
  10.114 +  show "(\<Union>i\<in>I. F i) \<in> sets M"
  10.115 +    using assms by (intro sets.countable_UN') auto
  10.116 +qed
  10.117 +
  10.118 +lemma fmeasurable_INT:
  10.119 +  assumes "countable I" "i \<in> I" "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M" "F i \<in> fmeasurable M"
  10.120 +  shows "(\<Inter>i\<in>I. F i) \<in> fmeasurable M"
  10.121 +proof (rule fmeasurableI2)
  10.122 +  show "F i \<in> fmeasurable M" "(\<Inter>i\<in>I. F i) \<subseteq> F i"
  10.123 +    using assms by auto
  10.124 +  show "(\<Inter>i\<in>I. F i) \<in> sets M"
  10.125 +    using assms by (intro sets.countable_INT') auto
  10.126 +qed
  10.127 +
  10.128 +lemma measure_Un2:
  10.129 +  "A \<in> fmeasurable M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow> measure M (A \<union> B) = measure M A + measure M (B - A)"
  10.130 +  using measure_Union[of M A "B - A"] by (auto simp: fmeasurableD2 fmeasurable.Diff)
  10.131 +
  10.132 +lemma measure_Un3:
  10.133 +  assumes "A \<in> fmeasurable M" "B \<in> fmeasurable M"
  10.134 +  shows "measure M (A \<union> B) = measure M A + measure M B - measure M (A \<inter> B)"
  10.135 +proof -
  10.136 +  have "measure M (A \<union> B) = measure M A + measure M (B - A)"
  10.137 +    using assms by (rule measure_Un2)
  10.138 +  also have "B - A = B - (A \<inter> B)"
  10.139 +    by auto
  10.140 +  also have "measure M (B - (A \<inter> B)) = measure M B - measure M (A \<inter> B)"
  10.141 +    using assms by (intro measure_Diff) (auto simp: fmeasurable_def)
  10.142 +  finally show ?thesis
  10.143 +    by simp
  10.144 +qed
  10.145 +
  10.146 +lemma measure_Un_AE:
  10.147 +  "AE x in M. x \<notin> A \<or> x \<notin> B \<Longrightarrow> A \<in> fmeasurable M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow>
  10.148 +  measure M (A \<union> B) = measure M A + measure M B"
  10.149 +  by (subst measure_Un2) (auto intro!: measure_eq_AE)
  10.150 +
  10.151 +lemma measure_UNION_AE:
  10.152 +  assumes I: "finite I"
  10.153 +  shows "(\<And>i. i \<in> I \<Longrightarrow> F i \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>i j. AE x in M. x \<notin> F i \<or> x \<notin> F j) I \<Longrightarrow>
  10.154 +    measure M (\<Union>i\<in>I. F i) = (\<Sum>i\<in>I. measure M (F i))"
  10.155 +  unfolding AE_pairwise[OF countable_finite, OF I]
  10.156 +  using I
  10.157 +  apply (induction I rule: finite_induct)
  10.158 +   apply simp
  10.159 +  apply (simp add: pairwise_insert)
  10.160 +  apply (subst measure_Un_AE)
  10.161 +  apply auto
  10.162 +  done
  10.163 +
  10.164 +lemma measure_UNION':
  10.165 +  "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>i j. disjnt (F i) (F j)) I \<Longrightarrow>
  10.166 +    measure M (\<Union>i\<in>I. F i) = (\<Sum>i\<in>I. measure M (F i))"
  10.167 +  by (intro measure_UNION_AE) (auto simp: disjnt_def elim!: pairwise_mono intro!: always_eventually)
  10.168 +
  10.169 +lemma measure_Union_AE:
  10.170 +  "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>S T. AE x in M. x \<notin> S \<or> x \<notin> T) F \<Longrightarrow>
  10.171 +    measure M (\<Union>F) = (\<Sum>S\<in>F. measure M S)"
  10.172 +  using measure_UNION_AE[of F "\<lambda>x. x" M] by simp
  10.173 +
  10.174 +lemma measure_Union':
  10.175 +  "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> fmeasurable M) \<Longrightarrow> pairwise disjnt F \<Longrightarrow> measure M (\<Union>F) = (\<Sum>S\<in>F. measure M S)"
  10.176 +  using measure_UNION'[of F "\<lambda>x. x" M] by simp
  10.177 +
  10.178 +lemma measure_Un_le:
  10.179 +  assumes "A \<in> sets M" "B \<in> sets M" shows "measure M (A \<union> B) \<le> measure M A + measure M B"
  10.180 +proof cases
  10.181 +  assume "A \<in> fmeasurable M \<and> B \<in> fmeasurable M"
  10.182 +  with measure_subadditive[of A M B] assms show ?thesis
  10.183 +    by (auto simp: fmeasurableD2)
  10.184 +next
  10.185 +  assume "\<not> (A \<in> fmeasurable M \<and> B \<in> fmeasurable M)"
  10.186 +  then have "A \<union> B \<notin> fmeasurable M"
  10.187 +    using fmeasurableI2[of "A \<union> B" M A] fmeasurableI2[of "A \<union> B" M B] assms by auto
  10.188 +  with assms show ?thesis
  10.189 +    by (auto simp: fmeasurable_def measure_def less_top[symmetric])
  10.190 +qed
  10.191 +
  10.192 +lemma measure_UNION_le:
  10.193 +  "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M) \<Longrightarrow> measure M (\<Union>i\<in>I. F i) \<le> (\<Sum>i\<in>I. measure M (F i))"
  10.194 +proof (induction I rule: finite_induct)
  10.195 +  case (insert i I)
  10.196 +  then have "measure M (\<Union>i\<in>insert i I. F i) \<le> measure M (F i) + measure M (\<Union>i\<in>I. F i)"
  10.197 +    by (auto intro!: measure_Un_le)
  10.198 +  also have "measure M (\<Union>i\<in>I. F i) \<le> (\<Sum>i\<in>I. measure M (F i))"
  10.199 +    using insert by auto
  10.200 +  finally show ?case
  10.201 +    using insert by simp
  10.202 +qed simp
  10.203 +
  10.204 +lemma measure_Union_le:
  10.205 +  "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> sets M) \<Longrightarrow> measure M (\<Union>F) \<le> (\<Sum>S\<in>F. measure M S)"
  10.206 +  using measure_UNION_le[of F "\<lambda>x. x" M] by simp
  10.207 +
  10.208  subsection \<open>Measure spaces with @{term "emeasure M (space M) < \<infinity>"}\<close>
  10.209  
  10.210  locale finite_measure = sigma_finite_measure M for M +
  10.211 @@ -1588,6 +1761,9 @@
  10.212  lemma (in finite_measure) emeasure_finite[simp, intro]: "emeasure M A \<noteq> top"
  10.213    using finite_emeasure_space emeasure_space[of M A] by (auto simp: top_unique)
  10.214  
  10.215 +lemma (in finite_measure) fmeasurable_eq_sets: "fmeasurable M = sets M"
  10.216 +  by (auto simp: fmeasurable_def less_top[symmetric])
  10.217 +
  10.218  lemma (in finite_measure) emeasure_eq_measure: "emeasure M A = ennreal (measure M A)"
  10.219    by (intro emeasure_eq_ennreal_measure) simp
  10.220  
  10.221 @@ -3135,7 +3311,7 @@
  10.222  proof -
  10.223    { fix a m assume "a \<in> sigma_sets \<Omega> m" "m \<in> M"
  10.224      then have "a \<in> sigma_sets \<Omega> (\<Union>M)"
  10.225 -     by induction (auto intro: sigma_sets.intros) }
  10.226 +     by induction (auto intro: sigma_sets.intros(2-)) }
  10.227    then show "sets (SUP m:M. sigma \<Omega> m) = sets (sigma \<Omega> (\<Union>M))"
  10.228      apply (subst sets_Sup_eq[where X="\<Omega>"])
  10.229      apply (auto simp add: M) []
  10.230 @@ -3317,7 +3493,7 @@
  10.231    assume "?M \<noteq> 0"
  10.232    then have *: "{x. ?m x \<noteq> 0} = (\<Union>n. {x. ?M / Suc n < ?m x})"
  10.233      using reals_Archimedean[of "?m x / ?M" for x]
  10.234 -    by (auto simp: field_simps not_le[symmetric] measure_nonneg divide_le_0_iff measure_le_0_iff)
  10.235 +    by (auto simp: field_simps not_le[symmetric] divide_le_0_iff measure_le_0_iff)
  10.236    have **: "\<And>n. finite {x. ?M / Suc n < ?m x}"
  10.237    proof (rule ccontr)
  10.238      fix n assume "infinite {x. ?M / Suc n < ?m x}" (is "infinite ?X")
    11.1 --- a/src/HOL/Analysis/Path_Connected.thy	Thu Sep 29 16:49:42 2016 +0200
    11.2 +++ b/src/HOL/Analysis/Path_Connected.thy	Fri Sep 30 10:00:49 2016 +0200
    11.3 @@ -2315,10 +2315,10 @@
    11.4     "outside s \<inter> s = {}"
    11.5    by (auto simp: outside_def)
    11.6  
    11.7 -lemma inside_inter_outside [simp]: "inside s \<inter> outside s = {}"
    11.8 +lemma inside_Int_outside [simp]: "inside s \<inter> outside s = {}"
    11.9    by (auto simp: inside_def outside_def)
   11.10  
   11.11 -lemma inside_union_outside [simp]: "inside s \<union> outside s = (- s)"
   11.12 +lemma inside_Un_outside [simp]: "inside s \<union> outside s = (- s)"
   11.13    by (auto simp: inside_def outside_def)
   11.14  
   11.15  lemma inside_eq_outside:
   11.16 @@ -2606,7 +2606,7 @@
   11.17    by (simp add: inside_def connected_component_UNIV)
   11.18  
   11.19  lemma outside_empty [simp]: "outside {} = (UNIV :: 'a :: {real_normed_vector, perfect_space} set)"
   11.20 -using inside_empty inside_union_outside by blast
   11.21 +using inside_empty inside_Un_outside by blast
   11.22  
   11.23  lemma inside_same_component:
   11.24     "\<lbrakk>connected_component (- s) x y; x \<in> inside s\<rbrakk> \<Longrightarrow> y \<in> inside s"
   11.25 @@ -2666,7 +2666,7 @@
   11.26    fixes s :: "'a :: {real_normed_vector, perfect_space} set"
   11.27    assumes "convex s"
   11.28      shows "outside s = - s"
   11.29 -  by (metis ComplD assms convex_in_outside equalityI inside_union_outside subsetI sup.cobounded2)
   11.30 +  by (metis ComplD assms convex_in_outside equalityI inside_Un_outside subsetI sup.cobounded2)
   11.31  
   11.32  lemma inside_convex:
   11.33    fixes s :: "'a :: {real_normed_vector, perfect_space} set"
   11.34 @@ -2761,7 +2761,7 @@
   11.35    have "closure (inside s) \<inter> - inside s = closure (inside s) - interior (inside s)"
   11.36      by (metis (no_types) Diff_Compl assms closure_closed interior_closure open_closed open_inside)
   11.37    moreover have "- inside s \<inter> - outside s = s"
   11.38 -    by (metis (no_types) compl_sup double_compl inside_union_outside)
   11.39 +    by (metis (no_types) compl_sup double_compl inside_Un_outside)
   11.40    moreover have "closure (inside s) \<subseteq> - outside s"
   11.41      by (metis (no_types) assms closure_inside_subset union_with_inside)
   11.42    ultimately have "closure (inside s) - interior (inside s) \<subseteq> s"
   11.43 @@ -5460,21 +5460,6 @@
   11.44  
   11.45  subsection\<open>Components, continuity, openin, closedin\<close>
   11.46  
   11.47 -lemma continuous_openin_preimage_eq:
   11.48 -   "continuous_on S f \<longleftrightarrow>
   11.49 -    (\<forall>t. open t \<longrightarrow> openin (subtopology euclidean S) {x. x \<in> S \<and> f x \<in> t})"
   11.50 -apply (auto simp: continuous_openin_preimage_gen)
   11.51 -apply (fastforce simp add: continuous_on_open openin_open)
   11.52 -done
   11.53 -
   11.54 -lemma continuous_closedin_preimage_eq:
   11.55 -   "continuous_on S f \<longleftrightarrow>
   11.56 -    (\<forall>t. closed t \<longrightarrow> closedin (subtopology euclidean S) {x. x \<in> S \<and> f x \<in> t})"
   11.57 -apply safe
   11.58 -apply (simp add: continuous_closedin_preimage)
   11.59 -apply (fastforce simp add: continuous_on_closed closedin_closed)
   11.60 -done
   11.61 -
   11.62  lemma continuous_on_components_gen:
   11.63   fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   11.64    assumes "\<And>c. c \<in> components S \<Longrightarrow>
   11.65 @@ -6108,7 +6093,6 @@
   11.66  apply (metis assms homotopy_eqv_homotopic_triviality_imp)
   11.67  by (metis (no_types) assms homotopy_eqv_homotopic_triviality_imp homotopy_eqv_sym)
   11.68  
   11.69 -
   11.70  lemma homotopy_eqv_cohomotopic_triviality_null_imp:
   11.71    fixes S :: "'a::real_normed_vector set"
   11.72      and T :: "'b::real_normed_vector set"
   11.73 @@ -6156,7 +6140,6 @@
   11.74  apply (metis assms homotopy_eqv_cohomotopic_triviality_null_imp)
   11.75  by (metis assms homotopy_eqv_cohomotopic_triviality_null_imp homotopy_eqv_sym)
   11.76  
   11.77 -
   11.78  lemma homotopy_eqv_contractible_sets:
   11.79    fixes S :: "'a::real_normed_vector set"
   11.80      and T :: "'b::real_normed_vector set"
   11.81 @@ -6215,6 +6198,50 @@
   11.82  lemma homeomorphic_contractible:
   11.83    fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   11.84    shows "\<lbrakk>contractible S; S homeomorphic T\<rbrakk> \<Longrightarrow> contractible T"
   11.85 -by (metis homeomorphic_contractible_eq)
   11.86 +  by (metis homeomorphic_contractible_eq)
   11.87 +
   11.88 +subsection\<open>Misc other results\<close>
   11.89 +
   11.90 +lemma bounded_connected_Compl_real:
   11.91 +  fixes S :: "real set"
   11.92 +  assumes "bounded S" and conn: "connected(- S)"
   11.93 +    shows "S = {}"
   11.94 +proof -
   11.95 +  obtain a b where "S \<subseteq> box a b"
   11.96 +    by (meson assms bounded_subset_open_interval)
   11.97 +  then have "a \<notin> S" "b \<notin> S"
   11.98 +    by auto
   11.99 +  then have "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> x \<in> - S"
  11.100 +    by (meson Compl_iff conn connected_iff_interval)
  11.101 +  then show ?thesis
  11.102 +    using \<open>S \<subseteq> box a b\<close> by auto
  11.103 +qed
  11.104 +
  11.105 +lemma bounded_connected_Compl_1:
  11.106 +  fixes S :: "'a::{euclidean_space} set"
  11.107 +  assumes "bounded S" and conn: "connected(- S)" and 1: "DIM('a) = 1"
  11.108 +    shows "S = {}"
  11.109 +proof -
  11.110 +  have "DIM('a) = DIM(real)"
  11.111 +    by (simp add: "1")
  11.112 +  then obtain f::"'a \<Rightarrow> real" and g
  11.113 +  where "linear f" "\<And>x. norm(f x) = norm x" "\<And>x. g(f x) = x" "\<And>y. f(g y) = y"
  11.114 +    by (rule isomorphisms_UNIV_UNIV) blast
  11.115 +  with \<open>bounded S\<close> have "bounded (f ` S)"
  11.116 +    using bounded_linear_image linear_linear by blast
  11.117 +  have "connected (f ` (-S))"
  11.118 +    using connected_linear_image assms \<open>linear f\<close> by blast
  11.119 +  moreover have "f ` (-S) = - (f ` S)"
  11.120 +    apply (rule bij_image_Compl_eq)
  11.121 +    apply (auto simp: bij_def)
  11.122 +     apply (metis \<open>\<And>x. g (f x) = x\<close> injI)
  11.123 +    by (metis UNIV_I \<open>\<And>y. f (g y) = y\<close> image_iff)
  11.124 +  finally have "connected (- (f ` S))"
  11.125 +    by simp
  11.126 +  then have "f ` S = {}"
  11.127 +    using \<open>bounded (f ` S)\<close> bounded_connected_Compl_real by blast
  11.128 +  then show ?thesis
  11.129 +    by blast
  11.130 +qed
  11.131  
  11.132  end
    12.1 --- a/src/HOL/Analysis/Set_Integral.thy	Thu Sep 29 16:49:42 2016 +0200
    12.2 +++ b/src/HOL/Analysis/Set_Integral.thy	Fri Sep 30 10:00:49 2016 +0200
    12.3 @@ -27,16 +27,6 @@
    12.4  translations
    12.5  "LINT x:A|M. f" == "CONST set_lebesgue_integral M A (\<lambda>x. f)"
    12.6  
    12.7 -abbreviation
    12.8 -  "set_almost_everywhere A M P \<equiv> AE x in M. x \<in> A \<longrightarrow> P x"
    12.9 -
   12.10 -syntax
   12.11 -  "_set_almost_everywhere" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> bool"
   12.12 -("AE _\<in>_ in _./ _" [0,0,0,10] 10)
   12.13 -
   12.14 -translations
   12.15 -  "AE x\<in>A in M. P" == "CONST set_almost_everywhere A M (\<lambda>x. P)"
   12.16 -
   12.17  (*
   12.18      Notation for integration wrt lebesgue measure on the reals:
   12.19  
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/HOL/Analysis/Tagged_Division.thy	Fri Sep 30 10:00:49 2016 +0200
    13.3 @@ -0,0 +1,2817 @@
    13.4 +(*  Title:      HOL/Analysis/Tagged_Division.thy
    13.5 +    Author:     John Harrison
    13.6 +    Author:     Robert Himmelmann, TU Muenchen (Translation from HOL light); proofs reworked by LCP
    13.7 +*)
    13.8 +
    13.9 +section \<open>Tagged divisions used for the Henstock-Kurzweil gauge integration\<close>
   13.10 +
   13.11 +theory Tagged_Division
   13.12 +imports
   13.13 +  Topology_Euclidean_Space
   13.14 +begin
   13.15 +
   13.16 +lemma finite_product_dependent:
   13.17 +  assumes "finite s"
   13.18 +    and "\<And>x. x \<in> s \<Longrightarrow> finite (t x)"
   13.19 +  shows "finite {(i, j) |i j. i \<in> s \<and> j \<in> t i}"
   13.20 +  using assms
   13.21 +proof induct
   13.22 +  case (insert x s)
   13.23 +  have *: "{(i, j) |i j. i \<in> insert x s \<and> j \<in> t i} =
   13.24 +    (\<lambda>y. (x,y)) ` (t x) \<union> {(i, j) |i j. i \<in> s \<and> j \<in> t i}" by auto
   13.25 +  show ?case
   13.26 +    unfolding *
   13.27 +    apply (rule finite_UnI)
   13.28 +    using insert
   13.29 +    apply auto
   13.30 +    done
   13.31 +qed auto
   13.32 +
   13.33 +lemma sum_sum_product:
   13.34 +  assumes "finite s"
   13.35 +    and "\<forall>i\<in>s. finite (t i)"
   13.36 +  shows "setsum (\<lambda>i. setsum (x i) (t i)::real) s =
   13.37 +    setsum (\<lambda>(i,j). x i j) {(i,j) | i j. i \<in> s \<and> j \<in> t i}"
   13.38 +  using assms
   13.39 +proof induct
   13.40 +  case (insert a s)
   13.41 +  have *: "{(i, j) |i j. i \<in> insert a s \<and> j \<in> t i} =
   13.42 +    (\<lambda>y. (a,y)) ` (t a) \<union> {(i, j) |i j. i \<in> s \<and> j \<in> t i}" by auto
   13.43 +  show ?case
   13.44 +    unfolding *
   13.45 +    apply (subst setsum.union_disjoint)
   13.46 +    unfolding setsum.insert[OF insert(1-2)]
   13.47 +    prefer 4
   13.48 +    apply (subst insert(3))
   13.49 +    unfolding add_right_cancel
   13.50 +  proof -
   13.51 +    show "setsum (x a) (t a) = (\<Sum>(xa, y)\<in> Pair a ` t a. x xa y)"
   13.52 +      apply (subst setsum.reindex)
   13.53 +      unfolding inj_on_def
   13.54 +      apply auto
   13.55 +      done
   13.56 +    show "finite {(i, j) |i j. i \<in> s \<and> j \<in> t i}"
   13.57 +      apply (rule finite_product_dependent)
   13.58 +      using insert
   13.59 +      apply auto
   13.60 +      done
   13.61 +  qed (insert insert, auto)
   13.62 +qed auto
   13.63 +
   13.64 +lemmas scaleR_simps = scaleR_zero_left scaleR_minus_left scaleR_left_diff_distrib
   13.65 +  scaleR_zero_right scaleR_minus_right scaleR_right_diff_distrib scaleR_eq_0_iff
   13.66 +  scaleR_cancel_left scaleR_cancel_right scaleR_add_right scaleR_add_left real_vector_class.scaleR_one
   13.67 +
   13.68 +
   13.69 +subsection \<open>Sundries\<close>
   13.70 +
   13.71 +
   13.72 +text\<open>A transitive relation is well-founded if all initial segments are finite.\<close>
   13.73 +lemma wf_finite_segments:
   13.74 +  assumes "irrefl r" and "trans r" and "\<And>x. finite {y. (y, x) \<in> r}"
   13.75 +  shows "wf (r)"
   13.76 +  apply (simp add: trans_wf_iff wf_iff_acyclic_if_finite converse_def assms)
   13.77 +  using acyclic_def assms irrefl_def trans_Restr by fastforce
   13.78 +
   13.79 +text\<open>For creating values between @{term u} and @{term v}.\<close>
   13.80 +lemma scaling_mono:
   13.81 +  fixes u::"'a::linordered_field"
   13.82 +  assumes "u \<le> v" "0 \<le> r" "r \<le> s"
   13.83 +    shows "u + r * (v - u) / s \<le> v"
   13.84 +proof -
   13.85 +  have "r/s \<le> 1" using assms
   13.86 +    using divide_le_eq_1 by fastforce
   13.87 +  then have "(r/s) * (v - u) \<le> 1 * (v - u)"
   13.88 +    by (meson diff_ge_0_iff_ge mult_right_mono \<open>u \<le> v\<close>)
   13.89 +  then show ?thesis
   13.90 +    by (simp add: field_simps)
   13.91 +qed
   13.92 +
   13.93 +lemma conjunctD2: assumes "a \<and> b" shows a b using assms by auto
   13.94 +lemma conjunctD3: assumes "a \<and> b \<and> c" shows a b c using assms by auto
   13.95 +lemma conjunctD4: assumes "a \<and> b \<and> c \<and> d" shows a b c d using assms by auto
   13.96 +
   13.97 +lemma cond_cases: "(P \<Longrightarrow> Q x) \<Longrightarrow> (\<not> P \<Longrightarrow> Q y) \<Longrightarrow> Q (if P then x else y)"
   13.98 +  by auto
   13.99 +
  13.100 +declare norm_triangle_ineq4[intro]
  13.101 +
  13.102 +lemma transitive_stepwise_le:
  13.103 +  assumes "\<And>x. R x x" "\<And>x y z. R x y \<Longrightarrow> R y z \<Longrightarrow> R x z" and "\<And>n. R n (Suc n)"
  13.104 +  shows "\<forall>n\<ge>m. R m n"
  13.105 +proof (intro allI impI)
  13.106 +  show "m \<le> n \<Longrightarrow> R m n" for n
  13.107 +    by (induction rule: dec_induct)
  13.108 +       (use assms in blast)+
  13.109 +qed
  13.110 +
  13.111 +subsection \<open>Some useful lemmas about intervals.\<close>
  13.112 +
  13.113 +lemma interior_subset_union_intervals:
  13.114 +  assumes "i = cbox a b"
  13.115 +    and "j = cbox c d"
  13.116 +    and "interior j \<noteq> {}"
  13.117 +    and "i \<subseteq> j \<union> s"
  13.118 +    and "interior i \<inter> interior j = {}"
  13.119 +  shows "interior i \<subseteq> interior s"
  13.120 +proof -
  13.121 +  have "box a b \<inter> cbox c d = {}"
  13.122 +     using inter_interval_mixed_eq_empty[of c d a b] and assms(3,5)
  13.123 +     unfolding assms(1,2) interior_cbox by auto
  13.124 +  moreover
  13.125 +  have "box a b \<subseteq> cbox c d \<union> s"
  13.126 +    apply (rule order_trans,rule box_subset_cbox)
  13.127 +    using assms(4) unfolding assms(1,2)
  13.128 +    apply auto
  13.129 +    done
  13.130 +  ultimately
  13.131 +  show ?thesis
  13.132 +    unfolding assms interior_cbox
  13.133 +      by auto (metis IntI UnE empty_iff interior_maximal open_box subsetCE subsetI)
  13.134 +qed
  13.135 +
  13.136 +lemma interior_Union_subset_cbox:
  13.137 +  assumes "finite f"
  13.138 +  assumes f: "\<And>s. s \<in> f \<Longrightarrow> \<exists>a b. s = cbox a b" "\<And>s. s \<in> f \<Longrightarrow> interior s \<subseteq> t"
  13.139 +    and t: "closed t"
  13.140 +  shows "interior (\<Union>f) \<subseteq> t"
  13.141 +proof -
  13.142 +  have [simp]: "s \<in> f \<Longrightarrow> closed s" for s
  13.143 +    using f by auto
  13.144 +  define E where "E = {s\<in>f. interior s = {}}"
  13.145 +  then have "finite E" "E \<subseteq> {s\<in>f. interior s = {}}"
  13.146 +    using \<open>finite f\<close> by auto
  13.147 +  then have "interior (\<Union>f) = interior (\<Union>(f - E))"
  13.148 +  proof (induction E rule: finite_subset_induct')
  13.149 +    case (insert s f')
  13.150 +    have "interior (\<Union>(f - insert s f') \<union> s) = interior (\<Union>(f - insert s f'))"
  13.151 +      using insert.hyps \<open>finite f\<close> by (intro interior_closed_Un_empty_interior) auto
  13.152 +    also have "\<Union>(f - insert s f') \<union> s = \<Union>(f - f')"
  13.153 +      using insert.hyps by auto
  13.154 +    finally show ?case
  13.155 +      by (simp add: insert.IH)
  13.156 +  qed simp
  13.157 +  also have "\<dots> \<subseteq> \<Union>(f - E)"
  13.158 +    by (rule interior_subset)
  13.159 +  also have "\<dots> \<subseteq> t"
  13.160 +  proof (rule Union_least)
  13.161 +    fix s assume "s \<in> f - E"
  13.162 +    with f[of s] obtain a b where s: "s \<in> f" "s = cbox a b" "box a b \<noteq> {}"
  13.163 +      by (fastforce simp: E_def)
  13.164 +    have "closure (interior s) \<subseteq> closure t"
  13.165 +      by (intro closure_mono f \<open>s \<in> f\<close>)
  13.166 +    with s \<open>closed t\<close> show "s \<subseteq> t"
  13.167 +      by simp
  13.168 +  qed
  13.169 +  finally show ?thesis .
  13.170 +qed
  13.171 +
  13.172 +lemma inter_interior_unions_intervals:
  13.173 +    "finite f \<Longrightarrow> open s \<Longrightarrow> \<forall>t\<in>f. \<exists>a b. t = cbox a b \<Longrightarrow> \<forall>t\<in>f. s \<inter> (interior t) = {} \<Longrightarrow> s \<inter> interior (\<Union>f) = {}"
  13.174 +  using interior_Union_subset_cbox[of f "UNIV - s"] by auto
  13.175 +
  13.176 +lemma interval_split:
  13.177 +  fixes a :: "'a::euclidean_space"
  13.178 +  assumes "k \<in> Basis"
  13.179 +  shows
  13.180 +    "cbox a b \<inter> {x. x\<bullet>k \<le> c} = cbox a (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) c else b\<bullet>i) *\<^sub>R i)"
  13.181 +    "cbox a b \<inter> {x. x\<bullet>k \<ge> c} = cbox (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) c else a\<bullet>i) *\<^sub>R i) b"
  13.182 +  apply (rule_tac[!] set_eqI)
  13.183 +  unfolding Int_iff mem_box mem_Collect_eq
  13.184 +  using assms
  13.185 +  apply auto
  13.186 +  done
  13.187 +
  13.188 +lemma interval_not_empty: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow> cbox a b \<noteq> {}"
  13.189 +  by (simp add: box_ne_empty)
  13.190 +
  13.191 +subsection \<open>Bounds on intervals where they exist.\<close>
  13.192 +
  13.193 +definition interval_upperbound :: "('a::euclidean_space) set \<Rightarrow> 'a"
  13.194 +  where "interval_upperbound s = (\<Sum>i\<in>Basis. (SUP x:s. x\<bullet>i) *\<^sub>R i)"
  13.195 +
  13.196 +definition interval_lowerbound :: "('a::euclidean_space) set \<Rightarrow> 'a"
  13.197 +  where "interval_lowerbound s = (\<Sum>i\<in>Basis. (INF x:s. x\<bullet>i) *\<^sub>R i)"
  13.198 +
  13.199 +lemma interval_upperbound[simp]:
  13.200 +  "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow>
  13.201 +    interval_upperbound (cbox a b) = (b::'a::euclidean_space)"
  13.202 +  unfolding interval_upperbound_def euclidean_representation_setsum cbox_def
  13.203 +  by (safe intro!: cSup_eq) auto
  13.204 +
  13.205 +lemma interval_lowerbound[simp]:
  13.206 +  "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow>
  13.207 +    interval_lowerbound (cbox a b) = (a::'a::euclidean_space)"
  13.208 +  unfolding interval_lowerbound_def euclidean_representation_setsum cbox_def
  13.209 +  by (safe intro!: cInf_eq) auto
  13.210 +
  13.211 +lemmas interval_bounds = interval_upperbound interval_lowerbound
  13.212 +
  13.213 +lemma
  13.214 +  fixes X::"real set"
  13.215 +  shows interval_upperbound_real[simp]: "interval_upperbound X = Sup X"
  13.216 +    and interval_lowerbound_real[simp]: "interval_lowerbound X = Inf X"
  13.217 +  by (auto simp: interval_upperbound_def interval_lowerbound_def)
  13.218 +
  13.219 +lemma interval_bounds'[simp]:
  13.220 +  assumes "cbox a b \<noteq> {}"
  13.221 +  shows "interval_upperbound (cbox a b) = b"
  13.222 +    and "interval_lowerbound (cbox a b) = a"
  13.223 +  using assms unfolding box_ne_empty by auto
  13.224 +
  13.225 +lemma interval_upperbound_Times:
  13.226 +  assumes "A \<noteq> {}" and "B \<noteq> {}"
  13.227 +  shows "interval_upperbound (A \<times> B) = (interval_upperbound A, interval_upperbound B)"
  13.228 +proof-
  13.229 +  from assms have fst_image_times': "A = fst ` (A \<times> B)" by simp
  13.230 +  have "(\<Sum>i\<in>Basis. (SUP x:A \<times> B. x \<bullet> (i, 0)) *\<^sub>R i) = (\<Sum>i\<in>Basis. (SUP x:A. x \<bullet> i) *\<^sub>R i)"
  13.231 +      by (subst (2) fst_image_times') (simp del: fst_image_times add: o_def inner_Pair_0)
  13.232 +  moreover from assms have snd_image_times': "B = snd ` (A \<times> B)" by simp
  13.233 +  have "(\<Sum>i\<in>Basis. (SUP x:A \<times> B. x \<bullet> (0, i)) *\<^sub>R i) = (\<Sum>i\<in>Basis. (SUP x:B. x \<bullet> i) *\<^sub>R i)"
  13.234 +      by (subst (2) snd_image_times') (simp del: snd_image_times add: o_def inner_Pair_0)
  13.235 +  ultimately show ?thesis unfolding interval_upperbound_def
  13.236 +      by (subst setsum_Basis_prod_eq) (auto simp add: setsum_prod)
  13.237 +qed
  13.238 +
  13.239 +lemma interval_lowerbound_Times:
  13.240 +  assumes "A \<noteq> {}" and "B \<noteq> {}"
  13.241 +  shows "interval_lowerbound (A \<times> B) = (interval_lowerbound A, interval_lowerbound B)"
  13.242 +proof-
  13.243 +  from assms have fst_image_times': "A = fst ` (A \<times> B)" by simp
  13.244 +  have "(\<Sum>i\<in>Basis. (INF x:A \<times> B. x \<bullet> (i, 0)) *\<^sub>R i) = (\<Sum>i\<in>Basis. (INF x:A. x \<bullet> i) *\<^sub>R i)"
  13.245 +      by (subst (2) fst_image_times') (simp del: fst_image_times add: o_def inner_Pair_0)
  13.246 +  moreover from assms have snd_image_times': "B = snd ` (A \<times> B)" by simp
  13.247 +  have "(\<Sum>i\<in>Basis. (INF x:A \<times> B. x \<bullet> (0, i)) *\<^sub>R i) = (\<Sum>i\<in>Basis. (INF x:B. x \<bullet> i) *\<^sub>R i)"
  13.248 +      by (subst (2) snd_image_times') (simp del: snd_image_times add: o_def inner_Pair_0)
  13.249 +  ultimately show ?thesis unfolding interval_lowerbound_def
  13.250 +      by (subst setsum_Basis_prod_eq) (auto simp add: setsum_prod)
  13.251 +qed
  13.252 +
  13.253 +subsection \<open>The notion of a gauge --- simply an open set containing the point.\<close>
  13.254 +
  13.255 +definition "gauge d \<longleftrightarrow> (\<forall>x. x \<in> d x \<and> open (d x))"
  13.256 +
  13.257 +lemma gaugeI:
  13.258 +  assumes "\<And>x. x \<in> g x"
  13.259 +    and "\<And>x. open (g x)"
  13.260 +  shows "gauge g"
  13.261 +  using assms unfolding gauge_def by auto
  13.262 +
  13.263 +lemma gaugeD[dest]:
  13.264 +  assumes "gauge d"
  13.265 +  shows "x \<in> d x"
  13.266 +    and "open (d x)"
  13.267 +  using assms unfolding gauge_def by auto
  13.268 +
  13.269 +lemma gauge_ball_dependent: "\<forall>x. 0 < e x \<Longrightarrow> gauge (\<lambda>x. ball x (e x))"
  13.270 +  unfolding gauge_def by auto
  13.271 +
  13.272 +lemma gauge_ball[intro]: "0 < e \<Longrightarrow> gauge (\<lambda>x. ball x e)"
  13.273 +  unfolding gauge_def by auto
  13.274 +
  13.275 +lemma gauge_trivial[intro!]: "gauge (\<lambda>x. ball x 1)"
  13.276 +  by (rule gauge_ball) auto
  13.277 +
  13.278 +lemma gauge_inter[intro]: "gauge d1 \<Longrightarrow> gauge d2 \<Longrightarrow> gauge (\<lambda>x. d1 x \<inter> d2 x)"
  13.279 +  unfolding gauge_def by auto
  13.280 +
  13.281 +lemma gauge_inters:
  13.282 +  assumes "finite s"
  13.283 +    and "\<forall>d\<in>s. gauge (f d)"
  13.284 +  shows "gauge (\<lambda>x. \<Inter>{f d x | d. d \<in> s})"
  13.285 +proof -
  13.286 +  have *: "\<And>x. {f d x |d. d \<in> s} = (\<lambda>d. f d x) ` s"
  13.287 +    by auto
  13.288 +  show ?thesis
  13.289 +    unfolding gauge_def unfolding *
  13.290 +    using assms unfolding Ball_def Inter_iff mem_Collect_eq gauge_def by auto
  13.291 +qed
  13.292 +
  13.293 +lemma gauge_existence_lemma:
  13.294 +  "(\<forall>x. \<exists>d :: real. p x \<longrightarrow> 0 < d \<and> q d x) \<longleftrightarrow> (\<forall>x. \<exists>d>0. p x \<longrightarrow> q d x)"
  13.295 +  by (metis zero_less_one)
  13.296 +
  13.297 +subsection \<open>Attempt a systematic general set of "offset" results for components.\<close>
  13.298 +
  13.299 +lemma gauge_modify:
  13.300 +  assumes "(\<forall>s. open s \<longrightarrow> open {x. f(x) \<in> s})" "gauge d"
  13.301 +  shows "gauge (\<lambda>x. {y. f y \<in> d (f x)})"
  13.302 +  using assms
  13.303 +  unfolding gauge_def
  13.304 +  apply safe
  13.305 +  defer
  13.306 +  apply (erule_tac x="f x" in allE)
  13.307 +  apply (erule_tac x="d (f x)" in allE)
  13.308 +  apply auto
  13.309 +  done
  13.310 +
  13.311 +subsection \<open>Divisions.\<close>
  13.312 +
  13.313 +definition division_of (infixl "division'_of" 40)
  13.314 +where
  13.315 +  "s division_of i \<longleftrightarrow>
  13.316 +    finite s \<and>
  13.317 +    (\<forall>k\<in>s. k \<subseteq> i \<and> k \<noteq> {} \<and> (\<exists>a b. k = cbox a b)) \<and>
  13.318 +    (\<forall>k1\<in>s. \<forall>k2\<in>s. k1 \<noteq> k2 \<longrightarrow> interior(k1) \<inter> interior(k2) = {}) \<and>
  13.319 +    (\<Union>s = i)"
  13.320 +
  13.321 +lemma division_ofD[dest]:
  13.322 +  assumes "s division_of i"
  13.323 +  shows "finite s"
  13.324 +    and "\<And>k. k \<in> s \<Longrightarrow> k \<subseteq> i"
  13.325 +    and "\<And>k. k \<in> s \<Longrightarrow> k \<noteq> {}"
  13.326 +    and "\<And>k. k \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
  13.327 +    and "\<And>k1 k2. k1 \<in> s \<Longrightarrow> k2 \<in> s \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior(k1) \<inter> interior(k2) = {}"
  13.328 +    and "\<Union>s = i"
  13.329 +  using assms unfolding division_of_def by auto
  13.330 +
  13.331 +lemma division_ofI:
  13.332 +  assumes "finite s"
  13.333 +    and "\<And>k. k \<in> s \<Longrightarrow> k \<subseteq> i"
  13.334 +    and "\<And>k. k \<in> s \<Longrightarrow> k \<noteq> {}"
  13.335 +    and "\<And>k. k \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
  13.336 +    and "\<And>k1 k2. k1 \<in> s \<Longrightarrow> k2 \<in> s \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
  13.337 +    and "\<Union>s = i"
  13.338 +  shows "s division_of i"
  13.339 +  using assms unfolding division_of_def by auto
  13.340 +
  13.341 +lemma division_of_finite: "s division_of i \<Longrightarrow> finite s"
  13.342 +  unfolding division_of_def by auto
  13.343 +
  13.344 +lemma division_of_self[intro]: "cbox a b \<noteq> {} \<Longrightarrow> {cbox a b} division_of (cbox a b)"
  13.345 +  unfolding division_of_def by auto
  13.346 +
  13.347 +lemma division_of_trivial[simp]: "s division_of {} \<longleftrightarrow> s = {}"
  13.348 +  unfolding division_of_def by auto
  13.349 +
  13.350 +lemma division_of_sing[simp]:
  13.351 +  "s division_of cbox a (a::'a::euclidean_space) \<longleftrightarrow> s = {cbox a a}"
  13.352 +  (is "?l = ?r")
  13.353 +proof
  13.354 +  assume ?r
  13.355 +  moreover
  13.356 +  { fix k
  13.357 +    assume "s = {{a}}" "k\<in>s"
  13.358 +    then have "\<exists>x y. k = cbox x y"
  13.359 +      apply (rule_tac x=a in exI)+
  13.360 +      apply (force simp: cbox_sing)
  13.361 +      done
  13.362 +  }
  13.363 +  ultimately show ?l
  13.364 +    unfolding division_of_def cbox_sing by auto
  13.365 +next
  13.366 +  assume ?l
  13.367 +  note * = conjunctD4[OF this[unfolded division_of_def cbox_sing]]
  13.368 +  {
  13.369 +    fix x
  13.370 +    assume x: "x \<in> s" have "x = {a}"
  13.371 +      using *(2)[rule_format,OF x] by auto
  13.372 +  }
  13.373 +  moreover have "s \<noteq> {}"
  13.374 +    using *(4) by auto
  13.375 +  ultimately show ?r
  13.376 +    unfolding cbox_sing by auto
  13.377 +qed
  13.378 +
  13.379 +lemma elementary_empty: obtains p where "p division_of {}"
  13.380 +  unfolding division_of_trivial by auto
  13.381 +
  13.382 +lemma elementary_interval: obtains p where "p division_of (cbox a b)"
  13.383 +  by (metis division_of_trivial division_of_self)
  13.384 +
  13.385 +lemma division_contains: "s division_of i \<Longrightarrow> \<forall>x\<in>i. \<exists>k\<in>s. x \<in> k"
  13.386 +  unfolding division_of_def by auto
  13.387 +
  13.388 +lemma forall_in_division:
  13.389 +  "d division_of i \<Longrightarrow> (\<forall>x\<in>d. P x) \<longleftrightarrow> (\<forall>a b. cbox a b \<in> d \<longrightarrow> P (cbox a b))"
  13.390 +  unfolding division_of_def by fastforce
  13.391 +
  13.392 +lemma division_of_subset:
  13.393 +  assumes "p division_of (\<Union>p)"
  13.394 +    and "q \<subseteq> p"
  13.395 +  shows "q division_of (\<Union>q)"
  13.396 +proof (rule division_ofI)
  13.397 +  note * = division_ofD[OF assms(1)]
  13.398 +  show "finite q"
  13.399 +    using "*"(1) assms(2) infinite_super by auto
  13.400 +  {
  13.401 +    fix k
  13.402 +    assume "k \<in> q"
  13.403 +    then have kp: "k \<in> p"
  13.404 +      using assms(2) by auto
  13.405 +    show "k \<subseteq> \<Union>q"
  13.406 +      using \<open>k \<in> q\<close> by auto
  13.407 +    show "\<exists>a b. k = cbox a b"
  13.408 +      using *(4)[OF kp] by auto
  13.409 +    show "k \<noteq> {}"
  13.410 +      using *(3)[OF kp] by auto
  13.411 +  }
  13.412 +  fix k1 k2
  13.413 +  assume "k1 \<in> q" "k2 \<in> q" "k1 \<noteq> k2"
  13.414 +  then have **: "k1 \<in> p" "k2 \<in> p" "k1 \<noteq> k2"
  13.415 +    using assms(2) by auto
  13.416 +  show "interior k1 \<inter> interior k2 = {}"
  13.417 +    using *(5)[OF **] by auto
  13.418 +qed auto
  13.419 +
  13.420 +lemma division_of_union_self[intro]: "p division_of s \<Longrightarrow> p division_of (\<Union>p)"
  13.421 +  unfolding division_of_def by auto
  13.422 +
  13.423 +lemma division_inter:
  13.424 +  fixes s1 s2 :: "'a::euclidean_space set"
  13.425 +  assumes "p1 division_of s1"
  13.426 +    and "p2 division_of s2"
  13.427 +  shows "{k1 \<inter> k2 | k1 k2. k1 \<in> p1 \<and> k2 \<in> p2 \<and> k1 \<inter> k2 \<noteq> {}} division_of (s1 \<inter> s2)"
  13.428 +  (is "?A' division_of _")
  13.429 +proof -
  13.430 +  let ?A = "{s. s \<in>  (\<lambda>(k1,k2). k1 \<inter> k2) ` (p1 \<times> p2) \<and> s \<noteq> {}}"
  13.431 +  have *: "?A' = ?A" by auto
  13.432 +  show ?thesis
  13.433 +    unfolding *
  13.434 +  proof (rule division_ofI)
  13.435 +    have "?A \<subseteq> (\<lambda>(x, y). x \<inter> y) ` (p1 \<times> p2)"
  13.436 +      by auto
  13.437 +    moreover have "finite (p1 \<times> p2)"
  13.438 +      using assms unfolding division_of_def by auto
  13.439 +    ultimately show "finite ?A" by auto
  13.440 +    have *: "\<And>s. \<Union>{x\<in>s. x \<noteq> {}} = \<Union>s"
  13.441 +      by auto
  13.442 +    show "\<Union>?A = s1 \<inter> s2"
  13.443 +      apply (rule set_eqI)
  13.444 +      unfolding * and UN_iff
  13.445 +      using division_ofD(6)[OF assms(1)] and division_ofD(6)[OF assms(2)]
  13.446 +      apply auto
  13.447 +      done
  13.448 +    {
  13.449 +      fix k
  13.450 +      assume "k \<in> ?A"
  13.451 +      then obtain k1 k2 where k: "k = k1 \<inter> k2" "k1 \<in> p1" "k2 \<in> p2" "k \<noteq> {}"
  13.452 +        by auto
  13.453 +      then show "k \<noteq> {}"
  13.454 +        by auto
  13.455 +      show "k \<subseteq> s1 \<inter> s2"
  13.456 +        using division_ofD(2)[OF assms(1) k(2)] and division_ofD(2)[OF assms(2) k(3)]
  13.457 +        unfolding k by auto
  13.458 +      obtain a1 b1 where k1: "k1 = cbox a1 b1"
  13.459 +        using division_ofD(4)[OF assms(1) k(2)] by blast
  13.460 +      obtain a2 b2 where k2: "k2 = cbox a2 b2"
  13.461 +        using division_ofD(4)[OF assms(2) k(3)] by blast
  13.462 +      show "\<exists>a b. k = cbox a b"
  13.463 +        unfolding k k1 k2 unfolding Int_interval by auto
  13.464 +    }
  13.465 +    fix k1 k2
  13.466 +    assume "k1 \<in> ?A"
  13.467 +    then obtain x1 y1 where k1: "k1 = x1 \<inter> y1" "x1 \<in> p1" "y1 \<in> p2" "k1 \<noteq> {}"
  13.468 +      by auto
  13.469 +    assume "k2 \<in> ?A"
  13.470 +    then obtain x2 y2 where k2: "k2 = x2 \<inter> y2" "x2 \<in> p1" "y2 \<in> p2" "k2 \<noteq> {}"
  13.471 +      by auto
  13.472 +    assume "k1 \<noteq> k2"
  13.473 +    then have th: "x1 \<noteq> x2 \<or> y1 \<noteq> y2"
  13.474 +      unfolding k1 k2 by auto
  13.475 +    have *: "interior x1 \<inter> interior x2 = {} \<or> interior y1 \<inter> interior y2 = {} \<Longrightarrow>
  13.476 +      interior (x1 \<inter> y1) \<subseteq> interior x1 \<Longrightarrow> interior (x1 \<inter> y1) \<subseteq> interior y1 \<Longrightarrow>
  13.477 +      interior (x2 \<inter> y2) \<subseteq> interior x2 \<Longrightarrow> interior (x2 \<inter> y2) \<subseteq> interior y2 \<Longrightarrow>
  13.478 +      interior (x1 \<inter> y1) \<inter> interior (x2 \<inter> y2) = {}" by auto
  13.479 +    show "interior k1 \<inter> interior k2 = {}"
  13.480 +      unfolding k1 k2
  13.481 +      apply (rule *)
  13.482 +      using assms division_ofD(5) k1 k2(2) k2(3) th apply auto
  13.483 +      done
  13.484 +  qed
  13.485 +qed
  13.486 +
  13.487 +lemma division_inter_1:
  13.488 +  assumes "d division_of i"
  13.489 +    and "cbox a (b::'a::euclidean_space) \<subseteq> i"
  13.490 +  shows "{cbox a b \<inter> k | k. k \<in> d \<and> cbox a b \<inter> k \<noteq> {}} division_of (cbox a b)"
  13.491 +proof (cases "cbox a b = {}")
  13.492 +  case True
  13.493 +  show ?thesis
  13.494 +    unfolding True and division_of_trivial by auto
  13.495 +next
  13.496 +  case False
  13.497 +  have *: "cbox a b \<inter> i = cbox a b" using assms(2) by auto
  13.498 +  show ?thesis
  13.499 +    using division_inter[OF division_of_self[OF False] assms(1)]
  13.500 +    unfolding * by auto
  13.501 +qed
  13.502 +
  13.503 +lemma elementary_inter:
  13.504 +  fixes s t :: "'a::euclidean_space set"
  13.505 +  assumes "p1 division_of s"
  13.506 +    and "p2 division_of t"
  13.507 +  shows "\<exists>p. p division_of (s \<inter> t)"
  13.508 +using assms division_inter by blast
  13.509 +
  13.510 +lemma elementary_inters:
  13.511 +  assumes "finite f"
  13.512 +    and "f \<noteq> {}"
  13.513 +    and "\<forall>s\<in>f. \<exists>p. p division_of (s::('a::euclidean_space) set)"
  13.514 +  shows "\<exists>p. p division_of (\<Inter>f)"
  13.515 +  using assms
  13.516 +proof (induct f rule: finite_induct)
  13.517 +  case (insert x f)
  13.518 +  show ?case
  13.519 +  proof (cases "f = {}")
  13.520 +    case True
  13.521 +    then show ?thesis
  13.522 +      unfolding True using insert by auto
  13.523 +  next
  13.524 +    case False
  13.525 +    obtain p where "p division_of \<Inter>f"
  13.526 +      using insert(3)[OF False insert(5)[unfolded ball_simps,THEN conjunct2]] ..
  13.527 +    moreover obtain px where "px division_of x"
  13.528 +      using insert(5)[rule_format,OF insertI1] ..
  13.529 +    ultimately show ?thesis
  13.530 +      by (simp add: elementary_inter Inter_insert)
  13.531 +  qed
  13.532 +qed auto
  13.533 +
  13.534 +lemma division_disjoint_union:
  13.535 +  assumes "p1 division_of s1"
  13.536 +    and "p2 division_of s2"
  13.537 +    and "interior s1 \<inter> interior s2 = {}"
  13.538 +  shows "(p1 \<union> p2) division_of (s1 \<union> s2)"
  13.539 +proof (rule division_ofI)
  13.540 +  note d1 = division_ofD[OF assms(1)]
  13.541 +  note d2 = division_ofD[OF assms(2)]
  13.542 +  show "finite (p1 \<union> p2)"
  13.543 +    using d1(1) d2(1) by auto
  13.544 +  show "\<Union>(p1 \<union> p2) = s1 \<union> s2"
  13.545 +    using d1(6) d2(6) by auto
  13.546 +  {
  13.547 +    fix k1 k2
  13.548 +    assume as: "k1 \<in> p1 \<union> p2" "k2 \<in> p1 \<union> p2" "k1 \<noteq> k2"
  13.549 +    moreover
  13.550 +    let ?g="interior k1 \<inter> interior k2 = {}"
  13.551 +    {
  13.552 +      assume as: "k1\<in>p1" "k2\<in>p2"
  13.553 +      have ?g
  13.554 +        using interior_mono[OF d1(2)[OF as(1)]] interior_mono[OF d2(2)[OF as(2)]]
  13.555 +        using assms(3) by blast
  13.556 +    }
  13.557 +    moreover
  13.558 +    {
  13.559 +      assume as: "k1\<in>p2" "k2\<in>p1"
  13.560 +      have ?g
  13.561 +        using interior_mono[OF d1(2)[OF as(2)]] interior_mono[OF d2(2)[OF as(1)]]
  13.562 +        using assms(3) by blast
  13.563 +    }
  13.564 +    ultimately show ?g
  13.565 +      using d1(5)[OF _ _ as(3)] and d2(5)[OF _ _ as(3)] by auto
  13.566 +  }
  13.567 +  fix k
  13.568 +  assume k: "k \<in> p1 \<union> p2"
  13.569 +  show "k \<subseteq> s1 \<union> s2"
  13.570 +    using k d1(2) d2(2) by auto
  13.571 +  show "k \<noteq> {}"
  13.572 +    using k d1(3) d2(3) by auto
  13.573 +  show "\<exists>a b. k = cbox a b"
  13.574 +    using k d1(4) d2(4) by auto
  13.575 +qed
  13.576 +
  13.577 +lemma partial_division_extend_1:
  13.578 +  fixes a b c d :: "'a::euclidean_space"
  13.579 +  assumes incl: "cbox c d \<subseteq> cbox a b"
  13.580 +    and nonempty: "cbox c d \<noteq> {}"
  13.581 +  obtains p where "p division_of (cbox a b)" "cbox c d \<in> p"
  13.582 +proof
  13.583 +  let ?B = "\<lambda>f::'a\<Rightarrow>'a \<times> 'a.
  13.584 +    cbox (\<Sum>i\<in>Basis. (fst (f i) \<bullet> i) *\<^sub>R i) (\<Sum>i\<in>Basis. (snd (f i) \<bullet> i) *\<^sub>R i)"
  13.585 +  define p where "p = ?B ` (Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)})"
  13.586 +
  13.587 +  show "cbox c d \<in> p"
  13.588 +    unfolding p_def
  13.589 +    by (auto simp add: box_eq_empty cbox_def intro!: image_eqI[where x="\<lambda>(i::'a)\<in>Basis. (c, d)"])
  13.590 +  {
  13.591 +    fix i :: 'a
  13.592 +    assume "i \<in> Basis"
  13.593 +    with incl nonempty have "a \<bullet> i \<le> c \<bullet> i" "c \<bullet> i \<le> d \<bullet> i" "d \<bullet> i \<le> b \<bullet> i"
  13.594 +      unfolding box_eq_empty subset_box by (auto simp: not_le)
  13.595 +  }
  13.596 +  note ord = this
  13.597 +
  13.598 +  show "p division_of (cbox a b)"
  13.599 +  proof (rule division_ofI)
  13.600 +    show "finite p"
  13.601 +      unfolding p_def by (auto intro!: finite_PiE)
  13.602 +    {
  13.603 +      fix k
  13.604 +      assume "k \<in> p"
  13.605 +      then obtain f where f: "f \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}" and k: "k = ?B f"
  13.606 +        by (auto simp: p_def)
  13.607 +      then show "\<exists>a b. k = cbox a b"
  13.608 +        by auto
  13.609 +      have "k \<subseteq> cbox a b \<and> k \<noteq> {}"
  13.610 +      proof (simp add: k box_eq_empty subset_box not_less, safe)
  13.611 +        fix i :: 'a
  13.612 +        assume i: "i \<in> Basis"
  13.613 +        with f have "f i = (a, c) \<or> f i = (c, d) \<or> f i = (d, b)"
  13.614 +          by (auto simp: PiE_iff)
  13.615 +        with i ord[of i]
  13.616 +        show "a \<bullet> i \<le> fst (f i) \<bullet> i" "snd (f i) \<bullet> i \<le> b \<bullet> i" "fst (f i) \<bullet> i \<le> snd (f i) \<bullet> i"
  13.617 +          by auto
  13.618 +      qed
  13.619 +      then show "k \<noteq> {}" "k \<subseteq> cbox a b"
  13.620 +        by auto
  13.621 +      {
  13.622 +        fix l
  13.623 +        assume "l \<in> p"
  13.624 +        then obtain g where g: "g \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}" and l: "l = ?B g"
  13.625 +          by (auto simp: p_def)
  13.626 +        assume "l \<noteq> k"
  13.627 +        have "\<exists>i\<in>Basis. f i \<noteq> g i"
  13.628 +        proof (rule ccontr)
  13.629 +          assume "\<not> ?thesis"
  13.630 +          with f g have "f = g"
  13.631 +            by (auto simp: PiE_iff extensional_def fun_eq_iff)
  13.632 +          with \<open>l \<noteq> k\<close> show False
  13.633 +            by (simp add: l k)
  13.634 +        qed
  13.635 +        then obtain i where *: "i \<in> Basis" "f i \<noteq> g i" ..
  13.636 +        then have "f i = (a, c) \<or> f i = (c, d) \<or> f i = (d, b)"
  13.637 +                  "g i = (a, c) \<or> g i = (c, d) \<or> g i = (d, b)"
  13.638 +          using f g by (auto simp: PiE_iff)
  13.639 +        with * ord[of i] show "interior l \<inter> interior k = {}"
  13.640 +          by (auto simp add: l k interior_cbox disjoint_interval intro!: bexI[of _ i])
  13.641 +      }
  13.642 +      note \<open>k \<subseteq> cbox a b\<close>
  13.643 +    }
  13.644 +    moreover
  13.645 +    {
  13.646 +      fix x assume x: "x \<in> cbox a b"
  13.647 +      have "\<forall>i\<in>Basis. \<exists>l. x \<bullet> i \<in> {fst l \<bullet> i .. snd l \<bullet> i} \<and> l \<in> {(a, c), (c, d), (d, b)}"
  13.648 +      proof
  13.649 +        fix i :: 'a
  13.650 +        assume "i \<in> Basis"
  13.651 +        with x ord[of i]
  13.652 +        have "(a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> c \<bullet> i) \<or> (c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i) \<or>
  13.653 +            (d \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> b \<bullet> i)"
  13.654 +          by (auto simp: cbox_def)
  13.655 +        then show "\<exists>l. x \<bullet> i \<in> {fst l \<bullet> i .. snd l \<bullet> i} \<and> l \<in> {(a, c), (c, d), (d, b)}"
  13.656 +          by auto
  13.657 +      qed
  13.658 +      then obtain f where
  13.659 +        f: "\<forall>i\<in>Basis. x \<bullet> i \<in> {fst (f i) \<bullet> i..snd (f i) \<bullet> i} \<and> f i \<in> {(a, c), (c, d), (d, b)}"
  13.660 +        unfolding bchoice_iff ..
  13.661 +      moreover from f have "restrict f Basis \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}"
  13.662 +        by auto
  13.663 +      moreover from f have "x \<in> ?B (restrict f Basis)"
  13.664 +        by (auto simp: mem_box)
  13.665 +      ultimately have "\<exists>k\<in>p. x \<in> k"
  13.666 +        unfolding p_def by blast
  13.667 +    }
  13.668 +    ultimately show "\<Union>p = cbox a b"
  13.669 +      by auto
  13.670 +  qed
  13.671 +qed
  13.672 +
  13.673 +lemma partial_division_extend_interval:
  13.674 +  assumes "p division_of (\<Union>p)" "(\<Union>p) \<subseteq> cbox a b"
  13.675 +  obtains q where "p \<subseteq> q" "q division_of cbox a (b::'a::euclidean_space)"
  13.676 +proof (cases "p = {}")
  13.677 +  case True
  13.678 +  obtain q where "q division_of (cbox a b)"
  13.679 +    by (rule elementary_interval)
  13.680 +  then show ?thesis
  13.681 +    using True that by blast
  13.682 +next
  13.683 +  case False
  13.684 +  note p = division_ofD[OF assms(1)]
  13.685 +  have div_cbox: "\<forall>k\<in>p. \<exists>q. q division_of cbox a b \<and> k \<in> q"
  13.686 +  proof
  13.687 +    fix k
  13.688 +    assume kp: "k \<in> p"
  13.689 +    obtain c d where k: "k = cbox c d"
  13.690 +      using p(4)[OF kp] by blast
  13.691 +    have *: "cbox c d \<subseteq> cbox a b" "cbox c d \<noteq> {}"
  13.692 +      using p(2,3)[OF kp, unfolded k] using assms(2)
  13.693 +      by (blast intro: order.trans)+
  13.694 +    obtain q where "q division_of cbox a b" "cbox c d \<in> q"
  13.695 +      by (rule partial_division_extend_1[OF *])
  13.696 +    then show "\<exists>q. q division_of cbox a b \<and> k \<in> q"
  13.697 +      unfolding k by auto
  13.698 +  qed
  13.699 +  obtain q where q: "\<And>x. x \<in> p \<Longrightarrow> q x division_of cbox a b" "\<And>x. x \<in> p \<Longrightarrow> x \<in> q x"
  13.700 +    using bchoice[OF div_cbox] by blast
  13.701 +  { fix x
  13.702 +    assume x: "x \<in> p"
  13.703 +    have "q x division_of \<Union>q x"
  13.704 +      apply (rule division_ofI)
  13.705 +      using division_ofD[OF q(1)[OF x]]
  13.706 +      apply auto
  13.707 +      done }
  13.708 +  then have "\<And>x. x \<in> p \<Longrightarrow> \<exists>d. d division_of \<Union>(q x - {x})"
  13.709 +    by (meson Diff_subset division_of_subset)
  13.710 +  then have "\<exists>d. d division_of \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p)"
  13.711 +    apply -
  13.712 +    apply (rule elementary_inters [OF finite_imageI[OF p(1)]])
  13.713 +    apply (auto simp: False elementary_inters [OF finite_imageI[OF p(1)]])
  13.714 +    done
  13.715 +  then obtain d where d: "d division_of \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p)" ..
  13.716 +  have "d \<union> p division_of cbox a b"
  13.717 +  proof -
  13.718 +    have te: "\<And>s f t. s \<noteq> {} \<Longrightarrow> \<forall>i\<in>s. f i \<union> i = t \<Longrightarrow> t = \<Inter>(f ` s) \<union> \<Union>s" by auto
  13.719 +    have cbox_eq: "cbox a b = \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p) \<union> \<Union>p"
  13.720 +    proof (rule te[OF False], clarify)
  13.721 +      fix i
  13.722 +      assume i: "i \<in> p"
  13.723 +      show "\<Union>(q i - {i}) \<union> i = cbox a b"
  13.724 +        using division_ofD(6)[OF q(1)[OF i]] using q(2)[OF i] by auto
  13.725 +    qed
  13.726 +    { fix k
  13.727 +      assume k: "k \<in> p"
  13.728 +      have *: "\<And>u t s. t \<inter> s = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<inter> t = {}"
  13.729 +        by auto
  13.730 +      have "interior (\<Inter>i\<in>p. \<Union>(q i - {i})) \<inter> interior k = {}"
  13.731 +      proof (rule *[OF inter_interior_unions_intervals])
  13.732 +        note qk=division_ofD[OF q(1)[OF k]]
  13.733 +        show "finite (q k - {k})" "open (interior k)" "\<forall>t\<in>q k - {k}. \<exists>a b. t = cbox a b"
  13.734 +          using qk by auto
  13.735 +        show "\<forall>t\<in>q k - {k}. interior k \<inter> interior t = {}"
  13.736 +          using qk(5) using q(2)[OF k] by auto
  13.737 +        show "interior (\<Inter>i\<in>p. \<Union>(q i - {i})) \<subseteq> interior (\<Union>(q k - {k}))"
  13.738 +          apply (rule interior_mono)+
  13.739 +          using k
  13.740 +          apply auto
  13.741 +          done
  13.742 +      qed } note [simp] = this
  13.743 +    show "d \<union> p division_of (cbox a b)"
  13.744 +      unfolding cbox_eq
  13.745 +      apply (rule division_disjoint_union[OF d assms(1)])
  13.746 +      apply (rule inter_interior_unions_intervals)
  13.747 +      apply (rule p open_interior ballI)+
  13.748 +      apply simp_all
  13.749 +      done
  13.750 +  qed
  13.751 +  then show ?thesis
  13.752 +    by (meson Un_upper2 that)
  13.753 +qed
  13.754 +
  13.755 +lemma elementary_bounded[dest]:
  13.756 +  fixes s :: "'a::euclidean_space set"
  13.757 +  shows "p division_of s \<Longrightarrow> bounded s"
  13.758 +  unfolding division_of_def by (metis bounded_Union bounded_cbox)
  13.759 +
  13.760 +lemma elementary_subset_cbox:
  13.761 +  "p division_of s \<Longrightarrow> \<exists>a b. s \<subseteq> cbox a (b::'a::euclidean_space)"
  13.762 +  by (meson elementary_bounded bounded_subset_cbox)
  13.763 +
  13.764 +lemma division_union_intervals_exists:
  13.765 +  fixes a b :: "'a::euclidean_space"
  13.766 +  assumes "cbox a b \<noteq> {}"
  13.767 +  obtains p where "(insert (cbox a b) p) division_of (cbox a b \<union> cbox c d)"
  13.768 +proof (cases "cbox c d = {}")
  13.769 +  case True
  13.770 +  show ?thesis
  13.771 +    apply (rule that[of "{}"])
  13.772 +    unfolding True
  13.773 +    using assms
  13.774 +    apply auto
  13.775 +    done
  13.776 +next
  13.777 +  case False
  13.778 +  show ?thesis
  13.779 +  proof (cases "cbox a b \<inter> cbox c d = {}")
  13.780 +    case True
  13.781 +    then show ?thesis
  13.782 +      by (metis that False assms division_disjoint_union division_of_self insert_is_Un interior_Int interior_empty)
  13.783 +  next
  13.784 +    case False
  13.785 +    obtain u v where uv: "cbox a b \<inter> cbox c d = cbox u v"
  13.786 +      unfolding Int_interval by auto
  13.787 +    have uv_sub: "cbox u v \<subseteq> cbox c d" using uv by auto
  13.788 +    obtain p where "p division_of cbox c d" "cbox u v \<in> p"
  13.789 +      by (rule partial_division_extend_1[OF uv_sub False[unfolded uv]])
  13.790 +    note p = this division_ofD[OF this(1)]
  13.791 +    have "interior (cbox a b \<inter> \<Union>(p - {cbox u v})) = interior(cbox u v \<inter> \<Union>(p - {cbox u v}))"
  13.792 +      apply (rule arg_cong[of _ _ interior])
  13.793 +      using p(8) uv by auto
  13.794 +    also have "\<dots> = {}"
  13.795 +      unfolding interior_Int
  13.796 +      apply (rule inter_interior_unions_intervals)
  13.797 +      using p(6) p(7)[OF p(2)] p(3)
  13.798 +      apply auto
  13.799 +      done
  13.800 +    finally have [simp]: "interior (cbox a b) \<inter> interior (\<Union>(p - {cbox u v})) = {}" by simp
  13.801 +    have cbe: "cbox a b \<union> cbox c d = cbox a b \<union> \<Union>(p - {cbox u v})"
  13.802 +      using p(8) unfolding uv[symmetric] by auto
  13.803 +    have "insert (cbox a b) (p - {cbox u v}) division_of cbox a b \<union> \<Union>(p - {cbox u v})"
  13.804 +    proof -
  13.805 +      have "{cbox a b} division_of cbox a b"
  13.806 +        by (simp add: assms division_of_self)
  13.807 +      then show "insert (cbox a b) (p - {cbox u v}) division_of cbox a b \<union> \<Union>(p - {cbox u v})"
  13.808 +        by (metis (no_types) Diff_subset \<open>interior (cbox a b) \<inter> interior (\<Union>(p - {cbox u v})) = {}\<close> division_disjoint_union division_of_subset insert_is_Un p(1) p(8))
  13.809 +    qed
  13.810 +    with that[of "p - {cbox u v}"] show ?thesis by (simp add: cbe)
  13.811 +  qed
  13.812 +qed
  13.813 +
  13.814 +lemma division_of_unions:
  13.815 +  assumes "finite f"
  13.816 +    and "\<And>p. p \<in> f \<Longrightarrow> p division_of (\<Union>p)"
  13.817 +    and "\<And>k1 k2. k1 \<in> \<Union>f \<Longrightarrow> k2 \<in> \<Union>f \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
  13.818 +  shows "\<Union>f division_of \<Union>\<Union>f"
  13.819 +  using assms
  13.820 +  by (auto intro!: division_ofI)
  13.821 +
  13.822 +lemma elementary_union_interval:
  13.823 +  fixes a b :: "'a::euclidean_space"
  13.824 +  assumes "p division_of \<Union>p"
  13.825 +  obtains q where "q division_of (cbox a b \<union> \<Union>p)"
  13.826 +proof -
  13.827 +  note assm = division_ofD[OF assms]
  13.828 +  have lem1: "\<And>f s. \<Union>\<Union>(f ` s) = \<Union>((\<lambda>x. \<Union>(f x)) ` s)"
  13.829 +    by auto
  13.830 +  have lem2: "\<And>f s. f \<noteq> {} \<Longrightarrow> \<Union>{s \<union> t |t. t \<in> f} = s \<union> \<Union>f"
  13.831 +    by auto
  13.832 +  {
  13.833 +    presume "p = {} \<Longrightarrow> thesis"
  13.834 +      "cbox a b = {} \<Longrightarrow> thesis"
  13.835 +      "cbox a b \<noteq> {} \<Longrightarrow> interior (cbox a b) = {} \<Longrightarrow> thesis"
  13.836 +      "p \<noteq> {} \<Longrightarrow> interior (cbox a b)\<noteq>{} \<Longrightarrow> cbox a b \<noteq> {} \<Longrightarrow> thesis"
  13.837 +    then show thesis by auto
  13.838 +  next
  13.839 +    assume as: "p = {}"
  13.840 +    obtain p where "p division_of (cbox a b)"
  13.841 +      by (rule elementary_interval)
  13.842 +    then show thesis
  13.843 +      using as that by auto
  13.844 +  next
  13.845 +    assume as: "cbox a b = {}"
  13.846 +    show thesis
  13.847 +      using as assms that by auto
  13.848 +  next
  13.849 +    assume as: "interior (cbox a b) = {}" "cbox a b \<noteq> {}"
  13.850 +    show thesis
  13.851 +      apply (rule that[of "insert (cbox a b) p"],rule division_ofI)
  13.852 +      unfolding finite_insert
  13.853 +      apply (rule assm(1)) unfolding Union_insert
  13.854 +      using assm(2-4) as
  13.855 +      apply -
  13.856 +      apply (fast dest: assm(5))+
  13.857 +      done
  13.858 +  next
  13.859 +    assume as: "p \<noteq> {}" "interior (cbox a b) \<noteq> {}" "cbox a b \<noteq> {}"
  13.860 +    have "\<forall>k\<in>p. \<exists>q. (insert (cbox a b) q) division_of (cbox a b \<union> k)"
  13.861 +    proof
  13.862 +      fix k
  13.863 +      assume kp: "k \<in> p"
  13.864 +      from assm(4)[OF kp] obtain c d where "k = cbox c d" by blast
  13.865 +      then show "\<exists>q. (insert (cbox a b) q) division_of (cbox a b \<union> k)"
  13.866 +        by (meson as(3) division_union_intervals_exists)
  13.867 +    qed
  13.868 +    from bchoice[OF this] obtain q where "\<forall>x\<in>p. insert (cbox a b) (q x) division_of (cbox a b) \<union> x" ..
  13.869 +    note q = division_ofD[OF this[rule_format]]
  13.870 +    let ?D = "\<Union>{insert (cbox a b) (q k) | k. k \<in> p}"
  13.871 +    show thesis
  13.872 +    proof (rule that[OF division_ofI])
  13.873 +      have *: "{insert (cbox a b) (q k) |k. k \<in> p} = (\<lambda>k. insert (cbox a b) (q k)) ` p"
  13.874 +        by auto
  13.875 +      show "finite ?D"
  13.876 +        using "*" assm(1) q(1) by auto
  13.877 +      show "\<Union>?D = cbox a b \<union> \<Union>p"
  13.878 +        unfolding * lem1
  13.879 +        unfolding lem2[OF as(1), of "cbox a b", symmetric]
  13.880 +        using q(6)
  13.881 +        by auto
  13.882 +      fix k
  13.883 +      assume k: "k \<in> ?D"
  13.884 +      then show "k \<subseteq> cbox a b \<union> \<Union>p"
  13.885 +        using q(2) by auto
  13.886 +      show "k \<noteq> {}"
  13.887 +        using q(3) k by auto
  13.888 +      show "\<exists>a b. k = cbox a b"
  13.889 +        using q(4) k by auto
  13.890 +      fix k'
  13.891 +      assume k': "k' \<in> ?D" "k \<noteq> k'"
  13.892 +      obtain x where x: "k \<in> insert (cbox a b) (q x)" "x\<in>p"
  13.893 +        using k by auto
  13.894 +      obtain x' where x': "k'\<in>insert (cbox a b) (q x')" "x'\<in>p"
  13.895 +        using k' by auto
  13.896 +      show "interior k \<inter> interior k' = {}"
  13.897 +      proof (cases "x = x'")
  13.898 +        case True
  13.899 +        show ?thesis
  13.900 +          using True k' q(5) x' x by auto
  13.901 +      next
  13.902 +        case False
  13.903 +        {
  13.904 +          presume "k = cbox a b \<Longrightarrow> ?thesis"
  13.905 +            and "k' = cbox a b \<Longrightarrow> ?thesis"
  13.906 +            and "k \<noteq> cbox a b \<Longrightarrow> k' \<noteq> cbox a b \<Longrightarrow> ?thesis"
  13.907 +          then show ?thesis by linarith
  13.908 +        next
  13.909 +          assume as': "k  = cbox a b"
  13.910 +          show ?thesis
  13.911 +            using as' k' q(5) x' by blast
  13.912 +        next
  13.913 +          assume as': "k' = cbox a b"
  13.914 +          show ?thesis
  13.915 +            using as' k'(2) q(5) x by blast
  13.916 +        }
  13.917 +        assume as': "k \<noteq> cbox a b" "k' \<noteq> cbox a b"
  13.918 +        obtain c d where k: "k = cbox c d"
  13.919 +          using q(4)[OF x(2,1)] by blast
  13.920 +        have "interior k \<inter> interior (cbox a b) = {}"
  13.921 +          using as' k'(2) q(5) x by blast
  13.922 +        then have "interior k \<subseteq> interior x"
  13.923 +        using interior_subset_union_intervals
  13.924 +          by (metis as(2) k q(2) x interior_subset_union_intervals)
  13.925 +        moreover
  13.926 +        obtain c d where c_d: "k' = cbox c d"
  13.927 +          using q(4)[OF x'(2,1)] by blast
  13.928 +        have "interior k' \<inter> interior (cbox a b) = {}"
  13.929 +          using as'(2) q(5) x' by blast
  13.930 +        then have "interior k' \<subseteq> interior x'"
  13.931 +          by (metis as(2) c_d interior_subset_union_intervals q(2) x'(1) x'(2))
  13.932 +        ultimately show ?thesis
  13.933 +          using assm(5)[OF x(2) x'(2) False] by auto
  13.934 +      qed
  13.935 +    qed
  13.936 +  }
  13.937 +qed
  13.938 +
  13.939 +lemma elementary_unions_intervals:
  13.940 +  assumes fin: "finite f"
  13.941 +    and "\<And>s. s \<in> f \<Longrightarrow> \<exists>a b. s = cbox a (b::'a::euclidean_space)"
  13.942 +  obtains p where "p division_of (\<Union>f)"
  13.943 +proof -
  13.944 +  have "\<exists>p. p division_of (\<Union>f)"
  13.945 +  proof (induct_tac f rule:finite_subset_induct)
  13.946 +    show "\<exists>p. p division_of \<Union>{}" using elementary_empty by auto
  13.947 +  next
  13.948 +    fix x F
  13.949 +    assume as: "finite F" "x \<notin> F" "\<exists>p. p division_of \<Union>F" "x\<in>f"
  13.950 +    from this(3) obtain p where p: "p division_of \<Union>F" ..
  13.951 +    from assms(2)[OF as(4)] obtain a b where x: "x = cbox a b" by blast
  13.952 +    have *: "\<Union>F = \<Union>p"
  13.953 +      using division_ofD[OF p] by auto
  13.954 +    show "\<exists>p. p division_of \<Union>insert x F"
  13.955 +      using elementary_union_interval[OF p[unfolded *], of a b]
  13.956 +      unfolding Union_insert x * by metis
  13.957 +  qed (insert assms, auto)
  13.958 +  then show ?thesis
  13.959 +    using that by auto
  13.960 +qed
  13.961 +
  13.962 +lemma elementary_union:
  13.963 +  fixes s t :: "'a::euclidean_space set"
  13.964 +  assumes "ps division_of s" "pt division_of t"
  13.965 +  obtains p where "p division_of (s \<union> t)"
  13.966 +proof -
  13.967 +  have *: "s \<union> t = \<Union>ps \<union> \<Union>pt"
  13.968 +    using assms unfolding division_of_def by auto
  13.969 +  show ?thesis
  13.970 +    apply (rule elementary_unions_intervals[of "ps \<union> pt"])
  13.971 +    using assms apply auto
  13.972 +    by (simp add: * that)
  13.973 +qed
  13.974 +
  13.975 +lemma partial_division_extend:
  13.976 +  fixes t :: "'a::euclidean_space set"
  13.977 +  assumes "p division_of s"
  13.978 +    and "q division_of t"
  13.979 +    and "s \<subseteq> t"
  13.980 +  obtains r where "p \<subseteq> r" and "r division_of t"
  13.981 +proof -
  13.982 +  note divp = division_ofD[OF assms(1)] and divq = division_ofD[OF assms(2)]
  13.983 +  obtain a b where ab: "t \<subseteq> cbox a b"
  13.984 +    using elementary_subset_cbox[OF assms(2)] by auto
  13.985 +  obtain r1 where "p \<subseteq> r1" "r1 division_of (cbox a b)"
  13.986 +    using assms
  13.987 +    by (metis ab dual_order.trans partial_division_extend_interval divp(6))
  13.988 +  note r1 = this division_ofD[OF this(2)]
  13.989 +  obtain p' where "p' division_of \<Union>(r1 - p)"
  13.990 +    apply (rule elementary_unions_intervals[of "r1 - p"])
  13.991 +    using r1(3,6)
  13.992 +    apply auto
  13.993 +    done
  13.994 +  then obtain r2 where r2: "r2 division_of (\<Union>(r1 - p)) \<inter> (\<Union>q)"
  13.995 +    by (metis assms(2) divq(6) elementary_inter)
  13.996 +  {
  13.997 +    fix x
  13.998 +    assume x: "x \<in> t" "x \<notin> s"
  13.999 +    then have "x\<in>\<Union>r1"
 13.1000 +      unfolding r1 using ab by auto
 13.1001 +    then obtain r where r: "r \<in> r1" "x \<in> r"
 13.1002 +      unfolding Union_iff ..
 13.1003 +    moreover
 13.1004 +    have "r \<notin> p"
 13.1005 +    proof
 13.1006 +      assume "r \<in> p"
 13.1007 +      then have "x \<in> s" using divp(2) r by auto
 13.1008 +      then show False using x by auto
 13.1009 +    qed
 13.1010 +    ultimately have "x\<in>\<Union>(r1 - p)" by auto
 13.1011 +  }
 13.1012 +  then have *: "t = \<Union>p \<union> (\<Union>(r1 - p) \<inter> \<Union>q)"
 13.1013 +    unfolding divp divq using assms(3) by auto
 13.1014 +  show ?thesis
 13.1015 +    apply (rule that[of "p \<union> r2"])
 13.1016 +    unfolding *
 13.1017 +    defer
 13.1018 +    apply (rule division_disjoint_union)
 13.1019 +    unfolding divp(6)
 13.1020 +    apply(rule assms r2)+
 13.1021 +  proof -
 13.1022 +    have "interior s \<inter> interior (\<Union>(r1-p)) = {}"
 13.1023 +    proof (rule inter_interior_unions_intervals)
 13.1024 +      show "finite (r1 - p)" and "open (interior s)" and "\<forall>t\<in>r1-p. \<exists>a b. t = cbox a b"
 13.1025 +        using r1 by auto
 13.1026 +      have *: "\<And>s. (\<And>x. x \<in> s \<Longrightarrow> False) \<Longrightarrow> s = {}"
 13.1027 +        by auto
 13.1028 +      show "\<forall>t\<in>r1-p. interior s \<inter> interior t = {}"
 13.1029 +      proof
 13.1030 +        fix m x
 13.1031 +        assume as: "m \<in> r1 - p"
 13.1032 +        have "interior m \<inter> interior (\<Union>p) = {}"
 13.1033 +        proof (rule inter_interior_unions_intervals)
 13.1034 +          show "finite p" and "open (interior m)" and "\<forall>t\<in>p. \<exists>a b. t = cbox a b"
 13.1035 +            using divp by auto
 13.1036 +          show "\<forall>t\<in>p. interior m \<inter> interior t = {}"
 13.1037 +            by (metis DiffD1 DiffD2 as r1(1) r1(7) set_rev_mp)
 13.1038 +        qed
 13.1039 +        then show "interior s \<inter> interior m = {}"
 13.1040 +          unfolding divp by auto
 13.1041 +      qed
 13.1042 +    qed
 13.1043 +    then show "interior s \<inter> interior (\<Union>(r1-p) \<inter> (\<Union>q)) = {}"
 13.1044 +      using interior_subset by auto
 13.1045 +  qed auto
 13.1046 +qed
 13.1047 +
 13.1048 +
 13.1049 +lemma division_split:
 13.1050 +  fixes a :: "'a::euclidean_space"
 13.1051 +  assumes "p division_of (cbox a b)"
 13.1052 +    and k: "k\<in>Basis"
 13.1053 +  shows "{l \<inter> {x. x\<bullet>k \<le> c} | l. l \<in> p \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}} division_of(cbox a b \<inter> {x. x\<bullet>k \<le> c})"
 13.1054 +      (is "?p1 division_of ?I1")
 13.1055 +    and "{l \<inter> {x. x\<bullet>k \<ge> c} | l. l \<in> p \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}} division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
 13.1056 +      (is "?p2 division_of ?I2")
 13.1057 +proof (rule_tac[!] division_ofI)
 13.1058 +  note p = division_ofD[OF assms(1)]
 13.1059 +  show "finite ?p1" "finite ?p2"
 13.1060 +    using p(1) by auto
 13.1061 +  show "\<Union>?p1 = ?I1" "\<Union>?p2 = ?I2"
 13.1062 +    unfolding p(6)[symmetric] by auto
 13.1063 +  {
 13.1064 +    fix k
 13.1065 +    assume "k \<in> ?p1"
 13.1066 +    then guess l unfolding mem_Collect_eq by (elim exE conjE) note l=this
 13.1067 +    guess u v using p(4)[OF l(2)] by (elim exE) note uv=this
 13.1068 +    show "k \<subseteq> ?I1"
 13.1069 +      using l p(2) uv by force
 13.1070 +    show  "k \<noteq> {}"
 13.1071 +      by (simp add: l)
 13.1072 +    show  "\<exists>a b. k = cbox a b"
 13.1073 +      apply (simp add: l uv p(2-3)[OF l(2)])
 13.1074 +      apply (subst interval_split[OF k])
 13.1075 +      apply (auto intro: order.trans)
 13.1076 +      done
 13.1077 +    fix k'
 13.1078 +    assume "k' \<in> ?p1"
 13.1079 +    then guess l' unfolding mem_Collect_eq by (elim exE conjE) note l'=this
 13.1080 +    assume "k \<noteq> k'"
 13.1081 +    then show "interior k \<inter> interior k' = {}"
 13.1082 +      unfolding l l' using p(5)[OF l(2) l'(2)] by auto
 13.1083 +  }
 13.1084 +  {
 13.1085 +    fix k
 13.1086 +    assume "k \<in> ?p2"
 13.1087 +    then guess l unfolding mem_Collect_eq by (elim exE conjE) note l=this
 13.1088 +    guess u v using p(4)[OF l(2)] by (elim exE) note uv=this
 13.1089 +    show "k \<subseteq> ?I2"
 13.1090 +      using l p(2) uv by force
 13.1091 +    show  "k \<noteq> {}"
 13.1092 +      by (simp add: l)
 13.1093 +    show  "\<exists>a b. k = cbox a b"
 13.1094 +      apply (simp add: l uv p(2-3)[OF l(2)])
 13.1095 +      apply (subst interval_split[OF k])
 13.1096 +      apply (auto intro: order.trans)
 13.1097 +      done
 13.1098 +    fix k'
 13.1099 +    assume "k' \<in> ?p2"
 13.1100 +    then guess l' unfolding mem_Collect_eq by (elim exE conjE) note l'=this
 13.1101 +    assume "k \<noteq> k'"
 13.1102 +    then show "interior k \<inter> interior k' = {}"
 13.1103 +      unfolding l l' using p(5)[OF l(2) l'(2)] by auto
 13.1104 +  }
 13.1105 +qed
 13.1106 +
 13.1107 +subsection \<open>Tagged (partial) divisions.\<close>
 13.1108 +
 13.1109 +definition tagged_partial_division_of (infixr "tagged'_partial'_division'_of" 40)
 13.1110 +  where "s tagged_partial_division_of i \<longleftrightarrow>
 13.1111 +    finite s \<and>
 13.1112 +    (\<forall>x k. (x, k) \<in> s \<longrightarrow> x \<in> k \<and> k \<subseteq> i \<and> (\<exists>a b. k = cbox a b)) \<and>
 13.1113 +    (\<forall>x1 k1 x2 k2. (x1, k1) \<in> s \<and> (x2, k2) \<in> s \<and> (x1, k1) \<noteq> (x2, k2) \<longrightarrow>
 13.1114 +      interior k1 \<inter> interior k2 = {})"
 13.1115 +
 13.1116 +lemma tagged_partial_division_ofD[dest]:
 13.1117 +  assumes "s tagged_partial_division_of i"
 13.1118 +  shows "finite s"
 13.1119 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
 13.1120 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
 13.1121 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
 13.1122 +    and "\<And>x1 k1 x2 k2. (x1,k1) \<in> s \<Longrightarrow>
 13.1123 +      (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
 13.1124 +  using assms unfolding tagged_partial_division_of_def by blast+
 13.1125 +
 13.1126 +definition tagged_division_of (infixr "tagged'_division'_of" 40)
 13.1127 +  where "s tagged_division_of i \<longleftrightarrow> s tagged_partial_division_of i \<and> (\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
 13.1128 +
 13.1129 +lemma tagged_division_of_finite: "s tagged_division_of i \<Longrightarrow> finite s"
 13.1130 +  unfolding tagged_division_of_def tagged_partial_division_of_def by auto
 13.1131 +
 13.1132 +lemma tagged_division_of:
 13.1133 +  "s tagged_division_of i \<longleftrightarrow>
 13.1134 +    finite s \<and>
 13.1135 +    (\<forall>x k. (x, k) \<in> s \<longrightarrow> x \<in> k \<and> k \<subseteq> i \<and> (\<exists>a b. k = cbox a b)) \<and>
 13.1136 +    (\<forall>x1 k1 x2 k2. (x1, k1) \<in> s \<and> (x2, k2) \<in> s \<and> (x1, k1) \<noteq> (x2, k2) \<longrightarrow>
 13.1137 +      interior k1 \<inter> interior k2 = {}) \<and>
 13.1138 +    (\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
 13.1139 +  unfolding tagged_division_of_def tagged_partial_division_of_def by auto
 13.1140 +
 13.1141 +lemma tagged_division_ofI:
 13.1142 +  assumes "finite s"
 13.1143 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
 13.1144 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
 13.1145 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
 13.1146 +    and "\<And>x1 k1 x2 k2. (x1,k1) \<in> s \<Longrightarrow> (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow>
 13.1147 +      interior k1 \<inter> interior k2 = {}"
 13.1148 +    and "(\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
 13.1149 +  shows "s tagged_division_of i"
 13.1150 +  unfolding tagged_division_of
 13.1151 +  using assms
 13.1152 +  apply auto
 13.1153 +  apply fastforce+
 13.1154 +  done
 13.1155 +
 13.1156 +lemma tagged_division_ofD[dest]:  (*FIXME USE A LOCALE*)
 13.1157 +  assumes "s tagged_division_of i"
 13.1158 +  shows "finite s"
 13.1159 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
 13.1160 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
 13.1161 +    and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
 13.1162 +    and "\<And>x1 k1 x2 k2. (x1, k1) \<in> s \<Longrightarrow> (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow>
 13.1163 +      interior k1 \<inter> interior k2 = {}"
 13.1164 +    and "(\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
 13.1165 +  using assms unfolding tagged_division_of by blast+
 13.1166 +
 13.1167 +lemma division_of_tagged_division:
 13.1168 +  assumes "s tagged_division_of i"
 13.1169 +  shows "(snd ` s) division_of i"
 13.1170 +proof (rule division_ofI)
 13.1171 +  note assm = tagged_division_ofD[OF assms]
 13.1172 +  show "\<Union>(snd ` s) = i" "finite (snd ` s)"
 13.1173 +    using assm by auto
 13.1174 +  fix k
 13.1175 +  assume k: "k \<in> snd ` s"
 13.1176 +  then obtain xk where xk: "(xk, k) \<in> s"
 13.1177 +    by auto
 13.1178 +  then show "k \<subseteq> i" "k \<noteq> {}" "\<exists>a b. k = cbox a b"
 13.1179 +    using assm by fastforce+
 13.1180 +  fix k'
 13.1181 +  assume k': "k' \<in> snd ` s" "k \<noteq> k'"
 13.1182 +  from this(1) obtain xk' where xk': "(xk', k') \<in> s"
 13.1183 +    by auto
 13.1184 +  then show "interior k \<inter> interior k' = {}"
 13.1185 +    using assm(5) k'(2) xk by blast
 13.1186 +qed
 13.1187 +
 13.1188 +lemma partial_division_of_tagged_division:
 13.1189 +  assumes "s tagged_partial_division_of i"
 13.1190 +  shows "(snd ` s) division_of \<Union>(snd ` s)"
 13.1191 +proof (rule division_ofI)
 13.1192 +  note assm = tagged_partial_division_ofD[OF assms]
 13.1193 +  show "finite (snd ` s)" "\<Union>(snd ` s) = \<Union>(snd ` s)"
 13.1194 +    using assm by auto
 13.1195 +  fix k
 13.1196 +  assume k: "k \<in> snd ` s"
 13.1197 +  then obtain xk where xk: "(xk, k) \<in> s"
 13.1198 +    by auto
 13.1199 +  then show "k \<noteq> {}" "\<exists>a b. k = cbox a b" "k \<subseteq> \<Union>(snd ` s)"
 13.1200 +    using assm by auto
 13.1201 +  fix k'
 13.1202 +  assume k': "k' \<in> snd ` s" "k \<noteq> k'"
 13.1203 +  from this(1) obtain xk' where xk': "(xk', k') \<in> s"
 13.1204 +    by auto
 13.1205 +  then show "interior k \<inter> interior k' = {}"
 13.1206 +    using assm(5) k'(2) xk by auto
 13.1207 +qed
 13.1208 +
 13.1209 +lemma tagged_partial_division_subset:
 13.1210 +  assumes "s tagged_partial_division_of i"
 13.1211 +    and "t \<subseteq> s"
 13.1212 +  shows "t tagged_partial_division_of i"
 13.1213 +  using assms
 13.1214 +  unfolding tagged_partial_division_of_def
 13.1215 +  using finite_subset[OF assms(2)]
 13.1216 +  by blast
 13.1217 +
 13.1218 +lemma tag_in_interval: "p tagged_division_of i \<Longrightarrow> (x, k) \<in> p \<Longrightarrow> x \<in> i"
 13.1219 +  by auto
 13.1220 +
 13.1221 +lemma tagged_division_of_empty: "{} tagged_division_of {}"
 13.1222 +  unfolding tagged_division_of by auto
 13.1223 +
 13.1224 +lemma tagged_partial_division_of_trivial[simp]: "p tagged_partial_division_of {} \<longleftrightarrow> p = {}"
 13.1225 +  unfolding tagged_partial_division_of_def by auto
 13.1226 +
 13.1227 +lemma tagged_division_of_trivial[simp]: "p tagged_division_of {} \<longleftrightarrow> p = {}"
 13.1228 +  unfolding tagged_division_of by auto
 13.1229 +
 13.1230 +lemma tagged_division_of_self: "x \<in> cbox a b \<Longrightarrow> {(x,cbox a b)} tagged_division_of (cbox a b)"
 13.1231 +  by (rule tagged_division_ofI) auto
 13.1232 +
 13.1233 +lemma tagged_division_of_self_real: "x \<in> {a .. b::real} \<Longrightarrow> {(x,{a .. b})} tagged_division_of {a .. b}"
 13.1234 +  unfolding box_real[symmetric]
 13.1235 +  by (rule tagged_division_of_self)
 13.1236 +
 13.1237 +lemma tagged_division_union:
 13.1238 +  assumes "p1 tagged_division_of s1"
 13.1239 +    and "p2 tagged_division_of s2"
 13.1240 +    and "interior s1 \<inter> interior s2 = {}"
 13.1241 +  shows "(p1 \<union> p2) tagged_division_of (s1 \<union> s2)"
 13.1242 +proof (rule tagged_division_ofI)
 13.1243 +  note p1 = tagged_division_ofD[OF assms(1)]
 13.1244 +  note p2 = tagged_division_ofD[OF assms(2)]
 13.1245 +  show "finite (p1 \<union> p2)"
 13.1246 +    using p1(1) p2(1) by auto
 13.1247 +  show "\<Union>{k. \<exists>x. (x, k) \<in> p1 \<union> p2} = s1 \<union> s2"
 13.1248 +    using p1(6) p2(6) by blast
 13.1249 +  fix x k
 13.1250 +  assume xk: "(x, k) \<in> p1 \<union> p2"
 13.1251 +  show "x \<in> k" "\<exists>a b. k = cbox a b"
 13.1252 +    using xk p1(2,4) p2(2,4) by auto
 13.1253 +  show "k \<subseteq> s1 \<union> s2"
 13.1254 +    using xk p1(3) p2(3) by blast
 13.1255 +  fix x' k'
 13.1256 +  assume xk': "(x', k') \<in> p1 \<union> p2" "(x, k) \<noteq> (x', k')"
 13.1257 +  have *: "\<And>a b. a \<subseteq> s1 \<Longrightarrow> b \<subseteq> s2 \<Longrightarrow> interior a \<inter> interior b = {}"
 13.1258 +    using assms(3) interior_mono by blast
 13.1259 +  show "interior k \<inter> interior k' = {}"
 13.1260 +    apply (cases "(x, k) \<in> p1")
 13.1261 +    apply (meson "*" UnE assms(1) assms(2) p1(5) tagged_division_ofD(3) xk'(1) xk'(2))
 13.1262 +    by (metis "*" UnE assms(1) assms(2) inf_sup_aci(1) p2(5) tagged_division_ofD(3) xk xk'(1) xk'(2))
 13.1263 +qed
 13.1264 +
 13.1265 +lemma tagged_division_unions:
 13.1266 +  assumes "finite iset"
 13.1267 +    and "\<forall>i\<in>iset. pfn i tagged_division_of i"
 13.1268 +    and "\<forall>i1\<in>iset. \<forall>i2\<in>iset. i1 \<noteq> i2 \<longrightarrow> interior(i1) \<inter> interior(i2) = {}"
 13.1269 +  shows "\<Union>(pfn ` iset) tagged_division_of (\<Union>iset)"
 13.1270 +proof (rule tagged_division_ofI)
 13.1271 +  note assm = tagged_division_ofD[OF assms(2)[rule_format]]
 13.1272 +  show "finite (\<Union>(pfn ` iset))"
 13.1273 +    using assms by auto
 13.1274 +  have "\<Union>{k. \<exists>x. (x, k) \<in> \<Union>(pfn ` iset)} = \<Union>((\<lambda>i. \<Union>{k. \<exists>x. (x, k) \<in> pfn i}) ` iset)"
 13.1275 +    by blast
 13.1276 +  also have "\<dots> = \<Union>iset"
 13.1277 +    using assm(6) by auto
 13.1278 +  finally show "\<Union>{k. \<exists>x. (x, k) \<in> \<Union>(pfn ` iset)} = \<Union>iset" .
 13.1279 +  fix x k
 13.1280 +  assume xk: "(x, k) \<in> \<Union>(pfn ` iset)"
 13.1281 +  then obtain i where i: "i \<in> iset" "(x, k) \<in> pfn i"
 13.1282 +    by auto
 13.1283 +  show "x \<in> k" "\<exists>a b. k = cbox a b" "k \<subseteq> \<Union>iset"
 13.1284 +    using assm(2-4)[OF i] using i(1) by auto
 13.1285 +  fix x' k'
 13.1286 +  assume xk': "(x', k') \<in> \<Union>(pfn ` iset)" "(x, k) \<noteq> (x', k')"
 13.1287 +  then obtain i' where i': "i' \<in> iset" "(x', k') \<in> pfn i'"
 13.1288 +    by auto
 13.1289 +  have *: "\<And>a b. i \<noteq> i' \<Longrightarrow> a \<subseteq> i \<Longrightarrow> b \<subseteq> i' \<Longrightarrow> interior a \<inter> interior b = {}"
 13.1290 +    using i(1) i'(1)
 13.1291 +    using assms(3)[rule_format] interior_mono
 13.1292 +    by blast
 13.1293 +  show "interior k \<inter> interior k' = {}"
 13.1294 +    apply (cases "i = i'")
 13.1295 +    using assm(5) i' i(2) xk'(2) apply blast
 13.1296 +    using "*" assm(3) i' i by auto
 13.1297 +qed
 13.1298 +
 13.1299 +lemma tagged_partial_division_of_union_self:
 13.1300 +  assumes "p tagged_partial_division_of s"
 13.1301 +  shows "p tagged_division_of (\<Union>(snd ` p))"
 13.1302 +  apply (rule tagged_division_ofI)
 13.1303 +  using tagged_partial_division_ofD[OF assms]
 13.1304 +  apply auto
 13.1305 +  done
 13.1306 +
 13.1307 +lemma tagged_division_of_union_self:
 13.1308 +  assumes "p tagged_division_of s"
 13.1309 +  shows "p tagged_division_of (\<Union>(snd ` p))"
 13.1310 +  apply (rule tagged_division_ofI)
 13.1311 +  using tagged_division_ofD[OF assms]
 13.1312 +  apply auto
 13.1313 +  done
 13.1314 +
 13.1315 +subsection \<open>Functions closed on boxes: morphisms from boxes to monoids\<close>
 13.1316 +
 13.1317 +text \<open>This auxiliary structure is used to sum up over the elements of a division. Main theorem is
 13.1318 +  @{text operative_division}. Instances for the monoid are @{typ "'a option"}, @{typ real}, and
 13.1319 +  @{typ bool}.\<close>
 13.1320 +
 13.1321 +paragraph \<open>Using additivity of lifted function to encode definedness.\<close>
 13.1322 +
 13.1323 +definition lift_option :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a option \<Rightarrow> 'b option \<Rightarrow> 'c option"
 13.1324 +where
 13.1325 +  "lift_option f a' b' = Option.bind a' (\<lambda>a. Option.bind b' (\<lambda>b. Some (f a b)))"
 13.1326 +
 13.1327 +lemma lift_option_simps[simp]:
 13.1328 +  "lift_option f (Some a) (Some b) = Some (f a b)"
 13.1329 +  "lift_option f None b' = None"
 13.1330 +  "lift_option f a' None = None"
 13.1331 +  by (auto simp: lift_option_def)
 13.1332 +
 13.1333 +lemma comm_monoid_lift_option:
 13.1334 +  assumes "comm_monoid f z"
 13.1335 +  shows "comm_monoid (lift_option f) (Some z)"
 13.1336 +proof -
 13.1337 +  from assms interpret comm_monoid f z .
 13.1338 +  show ?thesis
 13.1339 +    by standard (auto simp: lift_option_def ac_simps split: bind_split)
 13.1340 +qed
 13.1341 +
 13.1342 +lemma comm_monoid_and: "comm_monoid HOL.conj True"
 13.1343 +  by standard auto
 13.1344 +
 13.1345 +lemma comm_monoid_set_and: "comm_monoid_set HOL.conj True"
 13.1346 +  by (rule comm_monoid_set.intro) (fact comm_monoid_and)
 13.1347 +
 13.1348 +paragraph \<open>Operative\<close>
 13.1349 +
 13.1350 +definition (in comm_monoid) operative :: "('b::euclidean_space set \<Rightarrow> 'a) \<Rightarrow> bool"
 13.1351 +  where "operative g \<longleftrightarrow>
 13.1352 +    (\<forall>a b. box a b = {} \<longrightarrow> g (cbox a b) = \<^bold>1) \<and>
 13.1353 +    (\<forall>a b c. \<forall>k\<in>Basis. g (cbox a b) = g (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<^bold>* g (cbox a b \<inter> {x. x\<bullet>k \<ge> c}))"
 13.1354 +
 13.1355 +lemma (in comm_monoid) operativeD[dest]:
 13.1356 +  assumes "operative g"
 13.1357 +  shows "\<And>a b. box a b = {} \<Longrightarrow> g (cbox a b) = \<^bold>1"
 13.1358 +    and "\<And>a b c k. k \<in> Basis \<Longrightarrow> g (cbox a b) = g (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<^bold>* g (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
 13.1359 +  using assms unfolding operative_def by auto
 13.1360 +
 13.1361 +lemma (in comm_monoid) operative_empty:
 13.1362 +  assumes g: "operative g" shows "g {} = \<^bold>1"
 13.1363 +proof -
 13.1364 +  have *: "cbox One (-One) = ({}::'b set)"
 13.1365 +    by (auto simp: box_eq_empty inner_setsum_left inner_Basis setsum.If_cases ex_in_conv)
 13.1366 +  moreover have "box One (-One) = ({}::'b set)"
 13.1367 +    using box_subset_cbox[of One "-One"] by (auto simp: *)
 13.1368 +  ultimately show ?thesis
 13.1369 +    using operativeD(1)[OF g, of One "-One"] by simp
 13.1370 +qed
 13.1371 +
 13.1372 +definition "division_points (k::('a::euclidean_space) set) d =
 13.1373 +   {(j,x). j \<in> Basis \<and> (interval_lowerbound k)\<bullet>j < x \<and> x < (interval_upperbound k)\<bullet>j \<and>
 13.1374 +     (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
 13.1375 +
 13.1376 +lemma division_points_finite:
 13.1377 +  fixes i :: "'a::euclidean_space set"
 13.1378 +  assumes "d division_of i"
 13.1379 +  shows "finite (division_points i d)"
 13.1380 +proof -
 13.1381 +  note assm = division_ofD[OF assms]
 13.1382 +  let ?M = "\<lambda>j. {(j,x)|x. (interval_lowerbound i)\<bullet>j < x \<and> x < (interval_upperbound i)\<bullet>j \<and>
 13.1383 +    (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
 13.1384 +  have *: "division_points i d = \<Union>(?M ` Basis)"
 13.1385 +    unfolding division_points_def by auto
 13.1386 +  show ?thesis
 13.1387 +    unfolding * using assm by auto
 13.1388 +qed
 13.1389 +
 13.1390 +lemma division_points_subset:
 13.1391 +  fixes a :: "'a::euclidean_space"
 13.1392 +  assumes "d division_of (cbox a b)"
 13.1393 +    and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
 13.1394 +    and k: "k \<in> Basis"
 13.1395 +  shows "division_points (cbox a b \<inter> {x. x\<bullet>k \<le> c}) {l \<inter> {x. x\<bullet>k \<le> c} | l . l \<in> d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}} \<subseteq>
 13.1396 +      division_points (cbox a b) d" (is ?t1)
 13.1397 +    and "division_points (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) {l \<inter> {x. x\<bullet>k \<ge> c} | l . l \<in> d \<and> ~(l \<inter> {x. x\<bullet>k \<ge> c} = {})} \<subseteq>
 13.1398 +      division_points (cbox a b) d" (is ?t2)
 13.1399 +proof -
 13.1400 +  note assm = division_ofD[OF assms(1)]
 13.1401 +  have *: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
 13.1402 +    "\<forall>i\<in>Basis. a\<bullet>i \<le> (\<Sum>i\<in>Basis. (if i = k then min (b \<bullet> k) c else  b \<bullet> i) *\<^sub>R i) \<bullet> i"
 13.1403 +    "\<forall>i\<in>Basis. (\<Sum>i\<in>Basis. (if i = k then max (a \<bullet> k) c else a \<bullet> i) *\<^sub>R i) \<bullet> i \<le> b\<bullet>i"
 13.1404 +    "min (b \<bullet> k) c = c" "max (a \<bullet> k) c = c"
 13.1405 +    using assms using less_imp_le by auto
 13.1406 +  show ?t1 (*FIXME a horrible mess*)
 13.1407 +    unfolding division_points_def interval_split[OF k, of a b]
 13.1408 +    unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
 13.1409 +    unfolding *
 13.1410 +    apply (rule subsetI)
 13.1411 +    unfolding mem_Collect_eq split_beta
 13.1412 +    apply (erule bexE conjE)+
 13.1413 +    apply (simp add: )
 13.1414 +    apply (erule exE conjE)+
 13.1415 +  proof
 13.1416 +    fix i l x
 13.1417 +    assume as:
 13.1418 +      "a \<bullet> fst x < snd x" "snd x < (if fst x = k then c else b \<bullet> fst x)"
 13.1419 +      "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
 13.1420 +      "i = l \<inter> {x. x \<bullet> k \<le> c}" "l \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
 13.1421 +      and fstx: "fst x \<in> Basis"
 13.1422 +    from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this
 13.1423 +    have *: "\<forall>i\<in>Basis. u \<bullet> i \<le> (\<Sum>i\<in>Basis. (if i = k then min (v \<bullet> k) c else v \<bullet> i) *\<^sub>R i) \<bullet> i"
 13.1424 +      using as(6) unfolding l interval_split[OF k] box_ne_empty as .
 13.1425 +    have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
 13.1426 +      using l using as(6) unfolding box_ne_empty[symmetric] by auto
 13.1427 +    show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
 13.1428 +      apply (rule bexI[OF _ \<open>l \<in> d\<close>])
 13.1429 +      using as(1-3,5) fstx
 13.1430 +      unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
 13.1431 +      apply (auto split: if_split_asm)
 13.1432 +      done
 13.1433 +    show "snd x < b \<bullet> fst x"
 13.1434 +      using as(2) \<open>c < b\<bullet>k\<close> by (auto split: if_split_asm)
 13.1435 +  qed
 13.1436 +  show ?t2
 13.1437 +    unfolding division_points_def interval_split[OF k, of a b]
 13.1438 +    unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
 13.1439 +    unfolding *
 13.1440 +    unfolding subset_eq
 13.1441 +    apply rule
 13.1442 +    unfolding mem_Collect_eq split_beta
 13.1443 +    apply (erule bexE conjE)+
 13.1444 +    apply (simp only: mem_Collect_eq inner_setsum_left_Basis simp_thms)
 13.1445 +    apply (erule exE conjE)+
 13.1446 +  proof
 13.1447 +    fix i l x
 13.1448 +    assume as:
 13.1449 +      "(if fst x = k then c else a \<bullet> fst x) < snd x" "snd x < b \<bullet> fst x"
 13.1450 +      "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
 13.1451 +      "i = l \<inter> {x. c \<le> x \<bullet> k}" "l \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} \<noteq> {}"
 13.1452 +      and fstx: "fst x \<in> Basis"
 13.1453 +    from assm(4)[OF this(5)] guess u v by (elim exE) note l=this
 13.1454 +    have *: "\<forall>i\<in>Basis. (\<Sum>i\<in>Basis. (if i = k then max (u \<bullet> k) c else u \<bullet> i) *\<^sub>R i) \<bullet> i \<le> v \<bullet> i"
 13.1455 +      using as(6) unfolding l interval_split[OF k] box_ne_empty as .
 13.1456 +    have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
 13.1457 +      using l using as(6) unfolding box_ne_empty[symmetric] by auto
 13.1458 +    show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
 13.1459 +      apply (rule bexI[OF _ \<open>l \<in> d\<close>])
 13.1460 +      using as(1-3,5) fstx
 13.1461 +      unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
 13.1462 +      apply (auto split: if_split_asm)
 13.1463 +      done
 13.1464 +    show "a \<bullet> fst x < snd x"
 13.1465 +      using as(1) \<open>a\<bullet>k < c\<close> by (auto split: if_split_asm)
 13.1466 +   qed
 13.1467 +qed
 13.1468 +
 13.1469 +lemma division_points_psubset:
 13.1470 +  fixes a :: "'a::euclidean_space"
 13.1471 +  assumes "d division_of (cbox a b)"
 13.1472 +      and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
 13.1473 +      and "l \<in> d"
 13.1474 +      and "interval_lowerbound l\<bullet>k = c \<or> interval_upperbound l\<bullet>k = c"
 13.1475 +      and k: "k \<in> Basis"
 13.1476 +  shows "division_points (cbox a b \<inter> {x. x\<bullet>k \<le> c}) {l \<inter> {x. x\<bullet>k \<le> c} | l. l\<in>d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}} \<subset>
 13.1477 +         division_points (cbox a b) d" (is "?D1 \<subset> ?D")
 13.1478 +    and "division_points (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) {l \<inter> {x. x\<bullet>k \<ge> c} | l. l\<in>d \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}} \<subset>
 13.1479 +         division_points (cbox a b) d" (is "?D2 \<subset> ?D")
 13.1480 +proof -
 13.1481 +  have ab: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
 13.1482 +    using assms(2) by (auto intro!:less_imp_le)
 13.1483 +  guess u v using division_ofD(4)[OF assms(1,5)] by (elim exE) note l=this
 13.1484 +  have uv: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "\<forall>i\<in>Basis. a\<bullet>i \<le> u\<bullet>i \<and> v\<bullet>i \<le> b\<bullet>i"
 13.1485 +    using division_ofD(2,2,3)[OF assms(1,5)] unfolding l box_ne_empty
 13.1486 +    using subset_box(1)
 13.1487 +    apply auto
 13.1488 +    apply blast+
 13.1489 +    done
 13.1490 +  have *: "interval_upperbound (cbox a b \<inter> {x. x \<bullet> k \<le> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
 13.1491 +          "interval_upperbound (cbox a b \<inter> {x. x \<bullet> k \<le> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
 13.1492 +    unfolding l interval_split[OF k] interval_bounds[OF uv(1)]
 13.1493 +    using uv[rule_format, of k] ab k
 13.1494 +    by auto
 13.1495 +  have "\<exists>x. x \<in> ?D - ?D1"
 13.1496 +    using assms(3-)
 13.1497 +    unfolding division_points_def interval_bounds[OF ab]
 13.1498 +    apply -
 13.1499 +    apply (erule disjE)
 13.1500 +    apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI, force simp add: *)
 13.1501 +    apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI, force simp add: *)
 13.1502 +    done
 13.1503 +  moreover have "?D1 \<subseteq> ?D"
 13.1504 +    by (auto simp add: assms division_points_subset)
 13.1505 +  ultimately show "?D1 \<subset> ?D"
 13.1506 +    by blast
 13.1507 +  have *: "interval_lowerbound (cbox a b \<inter> {x. x \<bullet> k \<ge> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
 13.1508 +    "interval_lowerbound (cbox a b \<inter> {x. x \<bullet> k \<ge> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
 13.1509 +    unfolding l interval_split[OF k] interval_bounds[OF uv(1)]
 13.1510 +    using uv[rule_format, of k] ab k
 13.1511 +    by auto
 13.1512 +  have "\<exists>x. x \<in> ?D - ?D2"
 13.1513 +    using assms(3-)
 13.1514 +    unfolding division_points_def interval_bounds[OF ab]
 13.1515 +    apply -
 13.1516 +    apply (erule disjE)
 13.1517 +    apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI, force simp add: *)
 13.1518 +    apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI, force simp add: *)
 13.1519 +    done
 13.1520 +  moreover have "?D2 \<subseteq> ?D"
 13.1521 +    by (auto simp add: assms division_points_subset)
 13.1522 +  ultimately show "?D2 \<subset> ?D"
 13.1523 +    by blast
 13.1524 +qed
 13.1525 +
 13.1526 +lemma division_split_left_inj:
 13.1527 +  fixes type :: "'a::euclidean_space"
 13.1528 +  assumes "d division_of i"
 13.1529 +    and "k1 \<in> d"
 13.1530 +    and "k2 \<in> d"
 13.1531 +    and "k1 \<noteq> k2"
 13.1532 +    and "k1 \<inter> {x::'a. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
 13.1533 +    and k: "k\<in>Basis"
 13.1534 +  shows "interior (k1 \<inter> {x. x\<bullet>k \<le> c}) = {}"
 13.1535 +proof -
 13.1536 +  note d=division_ofD[OF assms(1)]
 13.1537 +  guess u1 v1 using d(4)[OF assms(2)] by (elim exE) note uv1=this
 13.1538 +  guess u2 v2 using d(4)[OF assms(3)] by (elim exE) note uv2=this
 13.1539 +  have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
 13.1540 +    by auto
 13.1541 +  show ?thesis
 13.1542 +    unfolding uv1 uv2
 13.1543 +    apply (rule **[OF d(5)[OF assms(2-4)]])
 13.1544 +    apply (simp add: uv1)
 13.1545 +    using assms(5) uv1 by auto
 13.1546 +qed
 13.1547 +
 13.1548 +lemma division_split_right_inj:
 13.1549 +  fixes type :: "'a::euclidean_space"
 13.1550 +  assumes "d division_of i"
 13.1551 +    and "k1 \<in> d"
 13.1552 +    and "k2 \<in> d"
 13.1553 +    and "k1 \<noteq> k2"
 13.1554 +    and "k1 \<inter> {x::'a. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}"
 13.1555 +    and k: "k \<in> Basis"
 13.1556 +  shows "interior (k1 \<inter> {x. x\<bullet>k \<ge> c}) = {}"
 13.1557 +proof -
 13.1558 +  note d=division_ofD[OF assms(1)]
 13.1559 +  guess u1 v1 using d(4)[OF assms(2)] by (elim exE) note uv1=this
 13.1560 +  guess u2 v2 using d(4)[OF assms(3)] by (elim exE) note uv2=this
 13.1561 +  have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
 13.1562 +    by auto
 13.1563 +  show ?thesis
 13.1564 +    unfolding uv1 uv2
 13.1565 +    apply (rule **[OF d(5)[OF assms(2-4)]])
 13.1566 +    apply (simp add: uv1)
 13.1567 +    using assms(5) uv1 by auto
 13.1568 +qed
 13.1569 +
 13.1570 +lemma interval_doublesplit:
 13.1571 +  fixes a :: "'a::euclidean_space"
 13.1572 +  assumes "k \<in> Basis"
 13.1573 +  shows "cbox a b \<inter> {x . \<bar>x\<bullet>k - c\<bar> \<le> (e::real)} =
 13.1574 +    cbox (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) (c - e) else a\<bullet>i) *\<^sub>R i)
 13.1575 +     (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) (c + e) else b\<bullet>i) *\<^sub>R i)"
 13.1576 +proof -
 13.1577 +  have *: "\<And>x c e::real. \<bar>x - c\<bar> \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
 13.1578 +    by auto
 13.1579 +  have **: "\<And>s P Q. s \<inter> {x. P x \<and> Q x} = (s \<inter> {x. Q x}) \<inter> {x. P x}"
 13.1580 +    by blast
 13.1581 +  show ?thesis
 13.1582 +    unfolding * ** interval_split[OF assms] by (rule refl)
 13.1583 +qed
 13.1584 +
 13.1585 +lemma division_doublesplit:
 13.1586 +  fixes a :: "'a::euclidean_space"
 13.1587 +  assumes "p division_of (cbox a b)"
 13.1588 +    and k: "k \<in> Basis"
 13.1589 +  shows "(\<lambda>l. l \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> e}) ` {l\<in>p. l \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> e} \<noteq> {}}
 13.1590 +         division_of  (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> e})"
 13.1591 +proof -
 13.1592 +  have *: "\<And>x c. \<bar>x - c\<bar> \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
 13.1593 +    by auto
 13.1594 +  have **: "\<And>p q p' q'. p division_of q \<Longrightarrow> p = p' \<Longrightarrow> q = q' \<Longrightarrow> p' division_of q'"
 13.1595 +    by auto
 13.1596 +  note division_split(1)[OF assms, where c="c+e",unfolded interval_split[OF k]]
 13.1597 +  note division_split(2)[OF this, where c="c-e" and k=k,OF k]
 13.1598 +  then show ?thesis
 13.1599 +    apply (rule **)
 13.1600 +    subgoal
 13.1601 +      apply (simp add: abs_diff_le_iff field_simps Collect_conj_eq setcompr_eq_image[symmetric])
 13.1602 +      apply (rule equalityI)
 13.1603 +      apply blast
 13.1604 +      apply clarsimp
 13.1605 +      apply (rule_tac x="l \<inter> {x. c + e \<ge> x \<bullet> k}" in exI)
 13.1606 +      apply auto
 13.1607 +      done
 13.1608 +    by (simp add: interval_split k interval_doublesplit)
 13.1609 +qed
 13.1610 +
 13.1611 +lemma (in comm_monoid_set) operative_division:
 13.1612 +  fixes g :: "'b::euclidean_space set \<Rightarrow> 'a"
 13.1613 +  assumes g: "operative g" and d: "d division_of (cbox a b)" shows "F g d = g (cbox a b)"
 13.1614 +proof -
 13.1615 +  define C where [abs_def]: "C = card (division_points (cbox a b) d)"
 13.1616 +  then show ?thesis
 13.1617 +    using d
 13.1618 +  proof (induction C arbitrary: a b d rule: less_induct)
 13.1619 +    case (less a b d)
 13.1620 +    show ?case
 13.1621 +    proof cases
 13.1622 +      assume "box a b = {}"
 13.1623 +      { fix k assume "k\<in>d"
 13.1624 +        then obtain a' b' where k: "k = cbox a' b'"
 13.1625 +          using division_ofD(4)[OF less.prems] by blast
 13.1626 +        with \<open>k\<in>d\<close> division_ofD(2)[OF less.prems] have "cbox a' b' \<subseteq> cbox a b"
 13.1627 +          by auto
 13.1628 +        then have "box a' b' \<subseteq> box a b"
 13.1629 +          unfolding subset_box by auto
 13.1630 +        then have "g k = \<^bold>1"
 13.1631 +          using operativeD(1)[OF g, of a' b'] k by (simp add: \<open>box a b = {}\<close>) }
 13.1632 +      then show "box a b = {} \<Longrightarrow> F g d = g (cbox a b)"
 13.1633 +        by (auto intro!: neutral simp: operativeD(1)[OF g])
 13.1634 +    next
 13.1635 +      assume "box a b \<noteq> {}"
 13.1636 +      then have ab: "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i" and ab': "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
 13.1637 +        by (auto simp: box_ne_empty)
 13.1638 +      show "F g d = g (cbox a b)"
 13.1639 +      proof (cases "division_points (cbox a b) d = {}")
 13.1640 +        case True
 13.1641 +        { fix u v and j :: 'b
 13.1642 +          assume j: "j \<in> Basis" and as: "cbox u v \<in> d"
 13.1643 +          then have "cbox u v \<noteq> {}"
 13.1644 +            using less.prems by blast
 13.1645 +          then have uv: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "u\<bullet>j \<le> v\<bullet>j"
 13.1646 +            using j unfolding box_ne_empty by auto
 13.1647 +          have *: "\<And>p r Q. \<not> j\<in>Basis \<or> p \<or> r \<or> (\<forall>x\<in>d. Q x) \<Longrightarrow> p \<or> r \<or> Q (cbox u v)"
 13.1648 +            using as j by auto
 13.1649 +          have "(j, u\<bullet>j) \<notin> division_points (cbox a b) d"
 13.1650 +               "(j, v\<bullet>j) \<notin> division_points (cbox a b) d" using True by auto
 13.1651 +          note this[unfolded de_Morgan_conj division_points_def mem_Collect_eq split_conv interval_bounds[OF ab'] bex_simps]
 13.1652 +          note *[OF this(1)] *[OF this(2)] note this[unfolded interval_bounds[OF uv(1)]]
 13.1653 +          moreover
 13.1654 +          have "a\<bullet>j \<le> u\<bullet>j" "v\<bullet>j \<le> b\<bullet>j"
 13.1655 +            using division_ofD(2,2,3)[OF \<open>d division_of cbox a b\<close> as]
 13.1656 +            apply (metis j subset_box(1) uv(1))
 13.1657 +            by (metis \<open>cbox u v \<subseteq> cbox a b\<close> j subset_box(1) uv(1))
 13.1658 +          ultimately have "u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = a\<bullet>j \<or> u\<bullet>j = b\<bullet>j \<and> v\<bullet>j = b\<bullet>j \<or> u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = b\<bullet>j"
 13.1659 +            unfolding not_less de_Morgan_disj using ab[rule_format,of j] uv(2) j by force }
 13.1660 +        then have d': "\<forall>i\<in>d. \<exists>u v. i = cbox u v \<and>
 13.1661 +          (\<forall>j\<in>Basis. u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = a\<bullet>j \<or> u\<bullet>j = b\<bullet>j \<and> v\<bullet>j = b\<bullet>j \<or> u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = b\<bullet>j)"
 13.1662 +          unfolding forall_in_division[OF less.prems] by blast
 13.1663 +        have "(1/2) *\<^sub>R (a+b) \<in> cbox a b"
 13.1664 +          unfolding mem_box using ab by (auto simp: inner_simps)
 13.1665 +        note this[unfolded division_ofD(6)[OF \<open>d division_of cbox a b\<close>,symmetric] Union_iff]
 13.1666 +        then guess i .. note i=this
 13.1667 +        guess u v using d'[rule_format,OF i(1)] by (elim exE conjE) note uv=this
 13.1668 +        have "cbox a b \<in> d"
 13.1669 +        proof -
 13.1670 +          have "u = a" "v = b"
 13.1671 +            unfolding euclidean_eq_iff[where 'a='b]
 13.1672 +          proof safe
 13.1673 +            fix j :: 'b
 13.1674 +            assume j: "j \<in> Basis"
 13.1675 +            note i(2)[unfolded uv mem_box,rule_format,of j]
 13.1676 +            then show "u \<bullet> j = a \<bullet> j" and "v \<bullet> j = b \<bullet> j"
 13.1677 +              using uv(2)[rule_format,of j] j by (auto simp: inner_simps)
 13.1678 +          qed
 13.1679 +          then have "i = cbox a b" using uv by auto
 13.1680 +          then show ?thesis using i by auto
 13.1681 +        qed
 13.1682 +        then have deq: "d = insert (cbox a b) (d - {cbox a b})"
 13.1683 +          by auto
 13.1684 +        have "F g (d - {cbox a b}) = \<^bold>1"
 13.1685 +        proof (intro neutral ballI)
 13.1686 +          fix x
 13.1687 +          assume x: "x \<in> d - {cbox a b}"
 13.1688 +          then have "x\<in>d"
 13.1689 +            by auto note d'[rule_format,OF this]
 13.1690 +          then guess u v by (elim exE conjE) note uv=this
 13.1691 +          have "u \<noteq> a \<or> v \<noteq> b"
 13.1692 +            using x[unfolded uv] by auto
 13.1693 +          then obtain j where "u\<bullet>j \<noteq> a\<bullet>j \<or> v\<bullet>j \<noteq> b\<bullet>j" and j: "j \<in> Basis"
 13.1694 +            unfolding euclidean_eq_iff[where 'a='b] by auto
 13.1695 +          then have "u\<bullet>j = v\<bullet>j"
 13.1696 +            using uv(2)[rule_format,OF j] by auto
 13.1697 +          then have "box u v = {}"
 13.1698 +            using j unfolding box_eq_empty by (auto intro!: bexI[of _ j])
 13.1699 +          then show "g x = \<^bold>1"
 13.1700 +            unfolding uv(1) by (rule operativeD(1)[OF g])
 13.1701 +        qed
 13.1702 +        then show "F g d = g (cbox a b)"
 13.1703 +          using division_ofD[OF less.prems]
 13.1704 +          apply (subst deq)
 13.1705 +          apply (subst insert)
 13.1706 +          apply auto
 13.1707 +          done
 13.1708 +      next
 13.1709 +        case False
 13.1710 +        then have "\<exists>x. x \<in> division_points (cbox a b) d"
 13.1711 +          by auto
 13.1712 +        then guess k c
 13.1713 +          unfolding split_paired_Ex division_points_def mem_Collect_eq split_conv
 13.1714 +          apply (elim exE conjE)
 13.1715 +          done
 13.1716 +        note this(2-4,1) note kc=this[unfolded interval_bounds[OF ab']]
 13.1717 +        from this(3) guess j .. note j=this
 13.1718 +        define d1 where "d1 = {l \<inter> {x. x\<bullet>k \<le> c} | l. l \<in> d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
 13.1719 +        define d2 where "d2 = {l \<inter> {x. x\<bullet>k \<ge> c} | l. l \<in> d \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
 13.1720 +        define cb where "cb = (\<Sum>i\<in>Basis. (if i = k then c else b\<bullet>i) *\<^sub>R i)"
 13.1721 +        define ca where "ca = (\<Sum>i\<in>Basis. (if i = k then c else a\<bullet>i) *\<^sub>R i)"
 13.1722 +        note division_points_psubset[OF \<open>d division_of cbox a b\<close> ab kc(1-2) j]
 13.1723 +        note psubset_card_mono[OF _ this(1)] psubset_card_mono[OF _ this(2)]
 13.1724 +        then have *: "F g d1 = g (cbox a b \<inter> {x. x\<bullet>k \<le> c})" "F g d2 = g (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
 13.1725 +          unfolding interval_split[OF kc(4)]
 13.1726 +          apply (rule_tac[!] "less.hyps"[rule_format])
 13.1727 +          using division_split[OF \<open>d division_of cbox a b\<close>, where k=k and c=c]
 13.1728 +          apply (simp_all add: interval_split kc d1_def d2_def division_points_finite[OF \<open>d division_of cbox a b\<close>])
 13.1729 +          done
 13.1730 +        { fix l y
 13.1731 +          assume as: "l \<in> d" "y \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} = y \<inter> {x. x \<bullet> k \<le> c}" "l \<noteq> y"
 13.1732 +          from division_ofD(4)[OF \<open>d division_of cbox a b\<close> this(1)] guess u v by (elim exE) note leq=this
 13.1733 +          have "g (l \<inter> {x. x \<bullet> k \<le> c}) = \<^bold>1"
 13.1734 +            unfolding leq interval_split[OF kc(4)]
 13.1735 +            apply (rule operativeD[OF g])
 13.1736 +            unfolding interior_cbox[symmetric] interval_split[symmetric, OF kc(4)]
 13.1737 +            using division_split_left_inj less as kc leq by blast
 13.1738 +        } note fxk_le = this
 13.1739 +        { fix l y
 13.1740 +          assume as: "l \<in> d" "y \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} = y \<inter> {x. c \<le> x \<bullet> k}" "l \<noteq> y"
 13.1741 +          from division_ofD(4)[OF \<open>d division_of cbox a b\<close> this(1)] guess u v by (elim exE) note leq=this
 13.1742 +          have "g (l \<inter> {x. x \<bullet> k \<ge> c}) = \<^bold>1"
 13.1743 +            unfolding leq interval_split[OF kc(4)]
 13.1744 +            apply (rule operativeD(1)[OF g])
 13.1745 +            unfolding interior_cbox[symmetric] interval_split[symmetric,OF kc(4)]
 13.1746 +            using division_split_right_inj less leq as kc by blast
 13.1747 +        } note fxk_ge = this
 13.1748 +        have d1_alt: "d1 = (\<lambda>l. l \<inter> {x. x\<bullet>k \<le> c}) ` {l \<in> d. l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
 13.1749 +          using d1_def by auto
 13.1750 +        have d2_alt: "d2 = (\<lambda>l. l \<inter> {x. x\<bullet>k \<ge> c}) ` {l \<in> d. l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
 13.1751 +          using d2_def by auto
 13.1752 +        have "g (cbox a b) = F g d1 \<^bold>* F g d2" (is "_ = ?prev")
 13.1753 +          unfolding * using g kc(4) by blast
 13.1754 +        also have "F g d1 = F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<le> c})) d"
 13.1755 +          unfolding d1_alt using division_of_finite[OF less.prems] fxk_le
 13.1756 +          by (subst reindex_nontrivial) (auto intro!: mono_neutral_cong_left simp: operative_empty[OF g])
 13.1757 +        also have "F g d2 = F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<ge> c})) d"
 13.1758 +          unfolding d2_alt using division_of_finite[OF less.prems] fxk_ge
 13.1759 +          by (subst reindex_nontrivial) (auto intro!: mono_neutral_cong_left simp: operative_empty[OF g])
 13.1760 +        also have *: "\<forall>x\<in>d. g x = g (x \<inter> {x. x \<bullet> k \<le> c}) \<^bold>* g (x \<inter> {x. c \<le> x \<bullet> k})"
 13.1761 +          unfolding forall_in_division[OF \<open>d division_of cbox a b\<close>]
 13.1762 +          using g kc(4) by blast
 13.1763 +        have "F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<le> c})) d \<^bold>* F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<ge> c})) d = F g d"
 13.1764 +          using * by (simp add: distrib)
 13.1765 +        finally show ?thesis by auto
 13.1766 +      qed
 13.1767 +    qed
 13.1768 +  qed
 13.1769 +qed
 13.1770 +
 13.1771 +lemma (in comm_monoid_set) over_tagged_division_lemma:
 13.1772 +  assumes "p tagged_division_of i"
 13.1773 +    and "\<And>u v. cbox u v \<noteq> {} \<Longrightarrow> box u v = {} \<Longrightarrow> d (cbox u v) = \<^bold>1"
 13.1774 +  shows "F (\<lambda>(x,k). d k) p = F d (snd ` p)"
 13.1775 +proof -
 13.1776 +  have *: "(\<lambda>(x,k). d k) = d \<circ> snd"
 13.1777 +    unfolding o_def by (rule ext) auto
 13.1778 +  note assm = tagged_division_ofD[OF assms(1)]
 13.1779 +  show ?thesis
 13.1780 +    unfolding *
 13.1781 +  proof (rule reindex_nontrivial[symmetric])
 13.1782 +    show "finite p"
 13.1783 +      using assm by auto
 13.1784 +    fix x y
 13.1785 +    assume "x\<in>p" "y\<in>p" "x\<noteq>y" "snd x = snd y"
 13.1786 +    obtain a b where ab: "snd x = cbox a b"
 13.1787 +      using assm(4)[of "fst x" "snd x"] \<open>x\<in>p\<close> by auto
 13.1788 +    have "(fst x, snd y) \<in> p" "(fst x, snd y) \<noteq> y"
 13.1789 +      by (metis prod.collapse \<open>x\<in>p\<close> \<open>snd x = snd y\<close> \<open>x \<noteq> y\<close>)+
 13.1790 +    with \<open>x\<in>p\<close> \<open>y\<in>p\<close> have "interior (snd x) \<inter> interior (snd y) = {}"
 13.1791 +      by (intro assm(5)[of "fst x" _ "fst y"]) auto
 13.1792 +    then have "box a b = {}"
 13.1793 +      unfolding \<open>snd x = snd y\<close>[symmetric] ab by auto
 13.1794 +    then have "d (cbox a b) = \<^bold>1"
 13.1795 +      using assm(2)[of "fst x" "snd x"] \<open>x\<in>p\<close> ab[symmetric] by (intro assms(2)) auto
 13.1796 +    then show "d (snd x) = \<^bold>1"
 13.1797 +      unfolding ab by auto
 13.1798 +  qed
 13.1799 +qed
 13.1800 +
 13.1801 +lemma (in comm_monoid_set) operative_tagged_division:
 13.1802 +  assumes f: "operative g" and d: "d tagged_division_of (cbox a b)"
 13.1803 +  shows "F (\<lambda>(x, l). g l) d = g (cbox a b)"
 13.1804 +  unfolding d[THEN division_of_tagged_division, THEN operative_division[OF f], symmetric]
 13.1805 +  by (simp add: f[THEN operativeD(1)] over_tagged_division_lemma[OF d])
 13.1806 +
 13.1807 +lemma interval_real_split:
 13.1808 +  "{a .. b::real} \<inter> {x. x \<le> c} = {a .. min b c}"
 13.1809 +  "{a .. b} \<inter> {x. c \<le> x} = {max a c .. b}"
 13.1810 +  apply (metis Int_atLeastAtMostL1 atMost_def)
 13.1811 +  apply (metis Int_atLeastAtMostL2 atLeast_def)
 13.1812 +  done
 13.1813 +
 13.1814 +lemma (in comm_monoid) operative_1_lt:
 13.1815 +  "operative (g :: real set \<Rightarrow> 'a) \<longleftrightarrow>
 13.1816 +    ((\<forall>a b. b \<le> a \<longrightarrow> g {a .. b} = \<^bold>1) \<and> (\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a .. c} \<^bold>* g {c .. b} = g {a .. b}))"
 13.1817 +  apply (simp add: operative_def atMost_def[symmetric] atLeast_def[symmetric])
 13.1818 +proof safe
 13.1819 +  fix a b c :: real
 13.1820 +  assume *: "\<forall>a b c. g {a..b} = g {a..min b c} \<^bold>* g {max a c..b}"
 13.1821 +  assume "a < c" "c < b"
 13.1822 +  with *[rule_format, of a b c] show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
 13.1823 +    by (simp add: less_imp_le min.absorb2 max.absorb2)
 13.1824 +next
 13.1825 +  fix a b c :: real
 13.1826 +  assume as: "\<forall>a b. b \<le> a \<longrightarrow> g {a..b} = \<^bold>1"
 13.1827 +    "\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
 13.1828 +  from as(1)[rule_format, of 0 1] as(1)[rule_format, of a a for a] as(2)
 13.1829 +  have [simp]: "g {} = \<^bold>1" "\<And>a. g {a} = \<^bold>1"
 13.1830 +    "\<And>a b c. a < c \<Longrightarrow> c < b \<Longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
 13.1831 +    by auto
 13.1832 +  show "g {a..b} = g {a..min b c} \<^bold>* g {max a c..b}"
 13.1833 +    by (auto simp: min_def max_def le_less)
 13.1834 +qed
 13.1835 +
 13.1836 +lemma (in comm_monoid) operative_1_le:
 13.1837 +  "operative (g :: real set \<Rightarrow> 'a) \<longleftrightarrow>
 13.1838 +    ((\<forall>a b. b \<le> a \<longrightarrow> g {a..b} = \<^bold>1) \<and> (\<forall>a b c. a \<le> c \<and> c \<le> b \<longrightarrow> g {a .. c} \<^bold>* g {c .. b} = g {a .. b}))"
 13.1839 +  unfolding operative_1_lt
 13.1840 +proof safe
 13.1841 +  fix a b c :: real
 13.1842 +  assume as: "\<forall>a b c. a \<le> c \<and> c \<le> b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}" "a < c" "c < b"
 13.1843 +  show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
 13.1844 +    apply (rule as(1)[rule_format])
 13.1845 +    using as(2-)
 13.1846 +    apply auto
 13.1847 +    done
 13.1848 +next
 13.1849 +  fix a b c :: real
 13.1850 +  assume "\<forall>a b. b \<le> a \<longrightarrow> g {a .. b} = \<^bold>1"
 13.1851 +    and "\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
 13.1852 +    and "a \<le> c"
 13.1853 +    and "c \<le> b"
 13.1854 +  note as = this[rule_format]
 13.1855 +  show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
 13.1856 +  proof (cases "c = a \<or> c = b")
 13.1857 +    case False
 13.1858 +    then show ?thesis
 13.1859 +      apply -
 13.1860 +      apply (subst as(2))
 13.1861 +      using as(3-)
 13.1862 +      apply auto
 13.1863 +      done
 13.1864 +  next
 13.1865 +    case True
 13.1866 +    then show ?thesis
 13.1867 +    proof
 13.1868 +      assume *: "c = a"
 13.1869 +      then have "g {a .. c} = \<^bold>1"
 13.1870 +        apply -
 13.1871 +        apply (rule as(1)[rule_format])
 13.1872 +        apply auto
 13.1873 +        done
 13.1874 +      then show ?thesis
 13.1875 +        unfolding * by auto
 13.1876 +    next
 13.1877 +      assume *: "c = b"
 13.1878 +      then have "g {c .. b} = \<^bold>1"
 13.1879 +        apply -
 13.1880 +        apply (rule as(1)[rule_format])
 13.1881 +        apply auto
 13.1882 +        done
 13.1883 +      then show ?thesis
 13.1884 +        unfolding * by auto
 13.1885 +    qed
 13.1886 +  qed
 13.1887 +qed
 13.1888 +
 13.1889 +lemma tagged_division_union_interval:
 13.1890 +  fixes a :: "'a::euclidean_space"
 13.1891 +  assumes "p1 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<le> (c::real)})"
 13.1892 +    and "p2 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
 13.1893 +    and k: "k \<in> Basis"
 13.1894 +  shows "(p1 \<union> p2) tagged_division_of (cbox a b)"
 13.1895 +proof -
 13.1896 +  have *: "cbox a b = (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<union> (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
 13.1897 +    by auto
 13.1898 +  show ?thesis
 13.1899 +    apply (subst *)
 13.1900 +    apply (rule tagged_division_union[OF assms(1-2)])
 13.1901 +    unfolding interval_split[OF k] interior_cbox
 13.1902 +    using k
 13.1903 +    apply (auto simp add: box_def elim!: ballE[where x=k])
 13.1904 +    done
 13.1905 +qed
 13.1906 +
 13.1907 +lemma tagged_division_union_interval_real:
 13.1908 +  fixes a :: real
 13.1909 +  assumes "p1 tagged_division_of ({a .. b} \<inter> {x. x\<bullet>k \<le> (c::real)})"
 13.1910 +    and "p2 tagged_division_of ({a .. b} \<inter> {x. x\<bullet>k \<ge> c})"
 13.1911 +    and k: "k \<in> Basis"
 13.1912 +  shows "(p1 \<union> p2) tagged_division_of {a .. b}"
 13.1913 +  using assms
 13.1914 +  unfolding box_real[symmetric]
 13.1915 +  by (rule tagged_division_union_interval)
 13.1916 +
 13.1917 +lemma tagged_division_split_left_inj:
 13.1918 +  "d tagged_division_of i \<Longrightarrow> (x1, k1) \<in> d \<Longrightarrow> (x2, k2) \<in> d \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow>
 13.1919 +    k1 \<inter> {x. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c} \<Longrightarrow> k \<in> Basis \<Longrightarrow>
 13.1920 +    interior (k1 \<inter> {x. x\<bullet>k \<le> c}) = {}"
 13.1921 +  by (intro division_split_left_inj[of "snd`d" i k1 k2, OF division_of_tagged_division])
 13.1922 +     (auto simp add: snd_def[abs_def] image_iff split: prod.split )
 13.1923 +
 13.1924 +lemma tagged_division_split_right_inj:
 13.1925 +  "d tagged_division_of i \<Longrightarrow> (x1, k1) \<in> d \<Longrightarrow> (x2, k2) \<in> d \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow>
 13.1926 +    k1 \<inter> {x. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c} \<Longrightarrow> k \<in> Basis \<Longrightarrow>
 13.1927 +    interior (k1 \<inter> {x. x\<bullet>k \<ge> c}) = {}"
 13.1928 +  by (intro division_split_right_inj[of "snd`d" i k1 k2, OF division_of_tagged_division])
 13.1929 +     (auto simp add: snd_def[abs_def] image_iff split: prod.split )
 13.1930 +
 13.1931 +subsection \<open>Special case of additivity we need for the FTC.\<close>
 13.1932 +
 13.1933 +lemma additive_tagged_division_1:
 13.1934 +  fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
 13.1935 +  assumes "a \<le> b"
 13.1936 +    and "p tagged_division_of {a..b}"
 13.1937 +  shows "setsum (\<lambda>(x,k). f(Sup k) - f(Inf k)) p = f b - f a"
 13.1938 +proof -
 13.1939 +  let ?f = "(\<lambda>k::(real) set. if k = {} then 0 else f(interval_upperbound k) - f(interval_lowerbound k))"
 13.1940 +  have ***: "\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i"
 13.1941 +    using assms by auto
 13.1942 +  have *: "add.operative ?f"
 13.1943 +    unfolding add.operative_1_lt box_eq_empty
 13.1944 +    by auto
 13.1945 +  have **: "cbox a b \<noteq> {}"
 13.1946 +    using assms(1) by auto
 13.1947 +  note setsum.operative_tagged_division[OF * assms(2)[simplified box_real[symmetric]]]
 13.1948 +  note * = this[unfolded if_not_P[OF **] interval_bounds[OF ***],symmetric]
 13.1949 +  show ?thesis
 13.1950 +    unfolding *
 13.1951 +    apply (rule setsum.cong)
 13.1952 +    unfolding split_paired_all split_conv
 13.1953 +    using assms(2)
 13.1954 +    apply auto
 13.1955 +    done
 13.1956 +qed
 13.1957 +
 13.1958 +lemma bgauge_existence_lemma: "(\<forall>x\<in>s. \<exists>d::real. 0 < d \<and> q d x) \<longleftrightarrow> (\<forall>x. \<exists>d>0. x\<in>s \<longrightarrow> q d x)"
 13.1959 +  by (meson zero_less_one)
 13.1960 +
 13.1961 +lemma additive_tagged_division_1':
 13.1962 +  fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
 13.1963 +  assumes "a \<le> b"
 13.1964 +    and "p tagged_division_of {a..b}"
 13.1965 +  shows "setsum (\<lambda>(x,k). f (Sup k) - f(Inf k)) p = f b - f a"
 13.1966 +  using additive_tagged_division_1[OF _ assms(2), of f]
 13.1967 +  using assms(1)
 13.1968 +  by auto
 13.1969 +
 13.1970 +subsection \<open>Fine-ness of a partition w.r.t. a gauge.\<close>
 13.1971 +
 13.1972 +definition fine  (infixr "fine" 46)
 13.1973 +  where "d fine s \<longleftrightarrow> (\<forall>(x,k) \<in> s. k \<subseteq> d x)"
 13.1974 +
 13.1975 +lemma fineI:
 13.1976 +  assumes "\<And>x k. (x, k) \<in> s \<Longrightarrow> k \<subseteq> d x"
 13.1977 +  shows "d fine s"
 13.1978 +  using assms unfolding fine_def by auto
 13.1979 +
 13.1980 +lemma fineD[dest]:
 13.1981 +  assumes "d fine s"
 13.1982 +  shows "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> d x"
 13.1983 +  using assms unfolding fine_def by auto
 13.1984 +
 13.1985 +lemma fine_inter: "(\<lambda>x. d1 x \<inter> d2 x) fine p \<longleftrightarrow> d1 fine p \<and> d2 fine p"
 13.1986 +  unfolding fine_def by auto
 13.1987 +
 13.1988 +lemma fine_inters:
 13.1989 + "(\<lambda>x. \<Inter>{f d x | d.  d \<in> s}) fine p \<longleftrightarrow> (\<forall>d\<in>s. (f d) fine p)"
 13.1990 +  unfolding fine_def by blast
 13.1991 +
 13.1992 +lemma fine_union: "d fine p1 \<Longrightarrow> d fine p2 \<Longrightarrow> d fine (p1 \<union> p2)"
 13.1993 +  unfolding fine_def by blast
 13.1994 +
 13.1995 +lemma fine_unions: "(\<And>p. p \<in> ps \<Longrightarrow> d fine p) \<Longrightarrow> d fine (\<Union>ps)"
 13.1996 +  unfolding fine_def by auto
 13.1997 +
 13.1998 +lemma fine_subset: "p \<subseteq> q \<Longrightarrow> d fine q \<Longrightarrow> d fine p"
 13.1999 +  unfolding fine_def by blast
 13.2000 +
 13.2001 +subsection \<open>Some basic combining lemmas.\<close>
 13.2002 +
 13.2003 +lemma tagged_division_unions_exists:
 13.2004 +  assumes "finite iset"
 13.2005 +    and "\<forall>i\<in>iset. \<exists>p. p tagged_division_of i \<and> d fine p"
 13.2006 +    and "\<forall>i1\<in>iset. \<forall>i2\<in>iset. i1 \<noteq> i2 \<longrightarrow> interior i1 \<inter> interior i2 = {}"
 13.2007 +    and "\<Union>iset = i"
 13.2008 +   obtains p where "p tagged_division_of i" and "d fine p"
 13.2009 +proof -
 13.2010 +  obtain pfn where pfn:
 13.2011 +    "\<And>x. x \<in> iset \<Longrightarrow> pfn x tagged_division_of x"
 13.2012 +    "\<And>x. x \<in> iset \<Longrightarrow> d fine pfn x"
 13.2013 +    using bchoice[OF assms(2)] by auto
 13.2014 +  show thesis
 13.2015 +    apply (rule_tac p="\<Union>(pfn ` iset)" in that)
 13.2016 +    using assms(1) assms(3) assms(4) pfn(1) tagged_division_unions apply force
 13.2017 +    by (metis (mono_tags, lifting) fine_unions imageE pfn(2))
 13.2018 +qed
 13.2019 +
 13.2020 +
 13.2021 +subsection \<open>The set we're concerned with must be closed.\<close>
 13.2022 +
 13.2023 +lemma division_of_closed:
 13.2024 +  fixes i :: "'n::euclidean_space set"
 13.2025 +  shows "s division_of i \<Longrightarrow> closed i"
 13.2026 +  unfolding division_of_def by fastforce
 13.2027 +
 13.2028 +subsection \<open>General bisection principle for intervals; might be useful elsewhere.\<close>
 13.2029 +
 13.2030 +lemma interval_bisection_step:
 13.2031 +  fixes type :: "'a::euclidean_space"
 13.2032 +  assumes "P {}"
 13.2033 +    and "\<forall>s t. P s \<and> P t \<and> interior(s) \<inter> interior(t) = {} \<longrightarrow> P (s \<union> t)"
 13.2034 +    and "\<not> P (cbox a (b::'a))"
 13.2035 +  obtains c d where "\<not> P (cbox c d)"
 13.2036 +    and "\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> c\<bullet>i \<le> d\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i \<and> 2 * (d\<bullet>i - c\<bullet>i) \<le> b\<bullet>i - a\<bullet>i"
 13.2037 +proof -
 13.2038 +  have "cbox a b \<noteq> {}"
 13.2039 +    using assms(1,3) by metis
 13.2040 +  then have ab: "\<And>i. i\<in>Basis \<Longrightarrow> a \<bullet> i \<le> b \<bullet> i"
 13.2041 +    by (force simp: mem_box)
 13.2042 +  { fix f
 13.2043 +    have "\<lbrakk>finite f;
 13.2044 +           \<And>s. s\<in>f \<Longrightarrow> P s;
 13.2045 +           \<And>s. s\<in>f \<Longrightarrow> \<exists>a b. s = cbox a b;
 13.2046 +           \<And>s t. s\<in>f \<Longrightarrow> t\<in>f \<Longrightarrow> s \<noteq> t \<Longrightarrow> interior s \<inter> interior t = {}\<rbrakk> \<Longrightarrow> P (\<Union>f)"
 13.2047 +    proof (induct f rule: finite_induct)
 13.2048 +      case empty
 13.2049 +      show ?case
 13.2050 +        using assms(1) by auto
 13.2051 +    next
 13.2052 +      case (insert x f)
 13.2053 +      show ?case
 13.2054 +        unfolding Union_insert
 13.2055 +        apply (rule assms(2)[rule_format])
 13.2056 +        using inter_interior_unions_intervals [of f "interior x"]
 13.2057 +        apply (auto simp: insert)
 13.2058 +        by (metis IntI empty_iff insert.hyps(2) insert.prems(3) insert_iff)
 13.2059 +    qed
 13.2060 +  } note UN_cases = this
 13.2061 +  let ?A = "{cbox c d | c d::'a. \<forall>i\<in>Basis. (c\<bullet>i = a\<bullet>i) \<and> (d\<bullet>i = (a\<bullet>i + b\<bullet>i) / 2) \<or>
 13.2062 +    (c\<bullet>i = (a\<bullet>i + b\<bullet>i) / 2) \<and> (d\<bullet>i = b\<bullet>i)}"
 13.2063 +  let ?PP = "\<lambda>c d. \<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> c\<bullet>i \<le> d\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i \<and> 2 * (d\<bullet>i - c\<bullet>i) \<le> b\<bullet>i - a\<bullet>i"
 13.2064 +  {
 13.2065 +    presume "\<forall>c d. ?PP c d \<longrightarrow> P (cbox c d) \<Longrightarrow> False"
 13.2066 +    then show thesis
 13.2067 +      unfolding atomize_not not_all
 13.2068 +      by (blast intro: that)
 13.2069 +  }
 13.2070 +  assume as: "\<forall>c d. ?PP c d \<longrightarrow> P (cbox c d)"
 13.2071 +  have "P (\<Union>?A)"
 13.2072 +  proof (rule UN_cases)
 13.2073 +    let ?B = "(\<lambda>s. cbox (\<Sum>i\<in>Basis. (if i \<in> s then a\<bullet>i else (a\<bullet>i + b\<bullet>i) / 2) *\<^sub>R i::'a)
 13.2074 +      (\<Sum>i\<in>Basis. (if i \<in> s then (a\<bullet>i + b\<bullet>i) / 2 else b\<bullet>i) *\<^sub>R i)) ` {s. s \<subseteq> Basis}"
 13.2075 +    have "?A \<subseteq> ?B"
 13.2076 +    proof
 13.2077 +      fix x
 13.2078 +      assume "x \<in> ?A"
 13.2079 +      then obtain c d
 13.2080 +        where x:  "x = cbox c d"
 13.2081 +                  "\<And>i. i \<in> Basis \<Longrightarrow>
 13.2082 +                        c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
 13.2083 +                        c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i" by blast
 13.2084 +      show "x \<in> ?B"
 13.2085 +        unfolding image_iff x
 13.2086 +        apply (rule_tac x="{i. i\<in>Basis \<and> c\<bullet>i = a\<bullet>i}" in bexI)
 13.2087 +        apply (rule arg_cong2 [where f = cbox])
 13.2088 +        using x(2) ab
 13.2089 +        apply (auto simp add: euclidean_eq_iff[where 'a='a])
 13.2090 +        by fastforce
 13.2091 +    qed
 13.2092 +    then show "finite ?A"
 13.2093 +      by (rule finite_subset) auto
 13.2094 +  next
 13.2095 +    fix s
 13.2096 +    assume "s \<in> ?A"
 13.2097 +    then obtain c d
 13.2098 +      where s: "s = cbox c d"
 13.2099 +               "\<And>i. i \<in> Basis \<Longrightarrow>
 13.2100 +                     c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
 13.2101 +                     c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i"
 13.2102 +      by blast
 13.2103 +    show "P s"
 13.2104 +      unfolding s
 13.2105 +      apply (rule as[rule_format])
 13.2106 +      using ab s(2) by force
 13.2107 +    show "\<exists>a b. s = cbox a b"
 13.2108 +      unfolding s by auto
 13.2109 +    fix t
 13.2110 +    assume "t \<in> ?A"
 13.2111 +    then obtain e f where t:
 13.2112 +      "t = cbox e f"
 13.2113 +      "\<And>i. i \<in> Basis \<Longrightarrow>
 13.2114 +        e \<bullet> i = a \<bullet> i \<and> f \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
 13.2115 +        e \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> f \<bullet> i = b \<bullet> i"
 13.2116 +      by blast
 13.2117 +    assume "s \<noteq> t"
 13.2118 +    then have "\<not> (c = e \<and> d = f)"
 13.2119 +      unfolding s t by auto
 13.2120 +    then obtain i where "c\<bullet>i \<noteq> e\<bullet>i \<or> d\<bullet>i \<noteq> f\<bullet>i" and i': "i \<in> Basis"
 13.2121 +      unfolding euclidean_eq_iff[where 'a='a] by auto
 13.2122 +    then have i: "c\<bullet>i \<noteq> e\<bullet>i" "d\<bullet>i \<noteq> f\<bullet>i"
 13.2123 +      using s(2) t(2) apply fastforce
 13.2124 +      using t(2)[OF i'] \<open>c \<bullet> i \<noteq> e \<bullet> i \<or> d \<bullet> i \<noteq> f \<bullet> i\<close> i' s(2) t(2) by fastforce
 13.2125 +    have *: "\<And>s t. (\<And>a. a \<in> s \<Longrightarrow> a \<in> t \<Longrightarrow> False) \<Longrightarrow> s \<inter> t = {}"
 13.2126 +      by auto
 13.2127 +    show "interior s \<inter> interior t = {}"
 13.2128 +      unfolding s t interior_cbox
 13.2129 +    proof (rule *)
 13.2130 +      fix x
 13.2131 +      assume "x \<in> box c d" "x \<in> box e f"
 13.2132 +      then have x: "c\<bullet>i < d\<bullet>i" "e\<bullet>i < f\<bullet>i" "c\<bullet>i < f\<bullet>i" "e\<bullet>i < d\<bullet>i"
 13.2133 +        unfolding mem_box using i'
 13.2134 +        by force+
 13.2135 +      show False  using s(2)[OF i']
 13.2136 +      proof safe
 13.2137 +        assume as: "c \<bullet> i = a \<bullet> i" "d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2"
 13.2138 +        show False
 13.2139 +          using t(2)[OF i'] and i x unfolding as by (fastforce simp add:field_simps)
 13.2140 +      next
 13.2141 +        assume as: "c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2" "d \<bullet> i = b \<bullet> i"
 13.2142 +        show False
 13.2143 +          using t(2)[OF i'] and i x unfolding as by(fastforce simp add:field_simps)
 13.2144 +      qed
 13.2145 +    qed
 13.2146 +  qed
 13.2147 +  also have "\<Union>?A = cbox a b"
 13.2148 +  proof (rule set_eqI,rule)
 13.2149 +    fix x
 13.2150 +    assume "x \<in> \<Union>?A"
 13.2151 +    then obtain c d where x:
 13.2152 +      "x \<in> cbox c d"
 13.2153 +      "\<And>i. i \<in> Basis \<Longrightarrow>
 13.2154 +        c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
 13.2155 +        c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i"
 13.2156 +      by blast
 13.2157 +    show "x\<in>cbox a b"
 13.2158 +      unfolding mem_box
 13.2159 +    proof safe
 13.2160 +      fix i :: 'a
 13.2161 +      assume i: "i \<in> Basis"
 13.2162 +      then show "a \<bullet> i \<le> x \<bullet> i" "x \<bullet> i \<le> b \<bullet> i"
 13.2163 +        using x(2)[OF i] x(1)[unfolded mem_box,THEN bspec, OF i] by auto
 13.2164 +    qed
 13.2165 +  next
 13.2166 +    fix x
 13.2167 +    assume x: "x \<in> cbox a b"
 13.2168 +    have "\<forall>i\<in>Basis.
 13.2169 +      \<exists>c d. (c = a\<bullet>i \<and> d = (a\<bullet>i + b\<bullet>i) / 2 \<or> c = (a\<bullet>i + b\<bullet>i) / 2 \<and> d = b\<bullet>i) \<and> c\<le>x\<bullet>i \<and> x\<bullet>i \<le> d"
 13.2170 +      (is "\<forall>i\<in>Basis. \<exists>c d. ?P i c d")
 13.2171 +      unfolding mem_box
 13.2172 +    proof
 13.2173 +      fix i :: 'a
 13.2174 +      assume i: "i \<in> Basis"
 13.2175 +      have "?P i (a\<bullet>i) ((a \<bullet> i + b \<bullet> i) / 2) \<or> ?P i ((a \<bullet> i + b \<bullet> i) / 2) (b\<bullet>i)"
 13.2176 +        using x[unfolded mem_box,THEN bspec, OF i] by auto
 13.2177 +      then show "\<exists>c d. ?P i c d"
 13.2178 +        by blast
 13.2179 +    qed
 13.2180 +    then show "x\<in>\<Union>?A"
 13.2181 +      unfolding Union_iff Bex_def mem_Collect_eq choice_Basis_iff
 13.2182 +      apply auto
 13.2183 +      apply (rule_tac x="cbox xa xaa" in exI)
 13.2184 +      unfolding mem_box
 13.2185 +      apply auto
 13.2186 +      done
 13.2187 +  qed
 13.2188 +  finally show False
 13.2189 +    using assms by auto
 13.2190 +qed
 13.2191 +
 13.2192 +lemma interval_bisection:
 13.2193 +  fixes type :: "'a::euclidean_space"
 13.2194 +  assumes "P {}"
 13.2195 +    and "(\<forall>s t. P s \<and> P t \<and> interior(s) \<inter> interior(t) = {} \<longrightarrow> P(s \<union> t))"
 13.2196 +    and "\<not> P (cbox a (b::'a))"
 13.2197 +  obtains x where "x \<in> cbox a b"
 13.2198 +    and "\<forall>e>0. \<exists>c d. x \<in> cbox c d \<and> cbox c d \<subseteq> ball x e \<and> cbox c d \<subseteq> cbox a b \<and> \<not> P (cbox c d)"
 13.2199 +proof -
 13.2200 +  have "\<forall>x. \<exists>y. \<not> P (cbox (fst x) (snd x)) \<longrightarrow> (\<not> P (cbox (fst y) (snd y)) \<and>
 13.2201 +    (\<forall>i\<in>Basis. fst x\<bullet>i \<le> fst y\<bullet>i \<and> fst y\<bullet>i \<le> snd y\<bullet>i \<and> snd y\<bullet>i \<le> snd x\<bullet>i \<and>
 13.2202 +       2 * (snd y\<bullet>i - fst y\<bullet>i) \<le> snd x\<bullet>i - fst x\<bullet>i))" (is "\<forall>x. ?P x")
 13.2203 +  proof
 13.2204 +    show "?P x" for x
 13.2205 +    proof (cases "P (cbox (fst x) (snd x))")
 13.2206 +      case True
 13.2207 +      then show ?thesis by auto
 13.2208 +    next
 13.2209 +      case as: False
 13.2210 +      obtain c d where "\<not> P (cbox c d)"
 13.2211 +        "\<forall>i\<in>Basis.
 13.2212 +           fst x \<bullet> i \<le> c \<bullet> i \<and>
 13.2213 +           c \<bullet> i \<le> d \<bullet> i \<and>
 13.2214 +           d \<bullet> i \<le> snd x \<bullet> i \<and>
 13.2215 +           2 * (d \<bullet> i - c \<bullet> i) \<le> snd x \<bullet> i - fst x \<bullet> i"
 13.2216 +        by (rule interval_bisection_step[of P, OF assms(1-2) as])
 13.2217 +      then show ?thesis
 13.2218 +        apply -
 13.2219 +        apply (rule_tac x="(c,d)" in exI)
 13.2220 +        apply auto
 13.2221 +        done
 13.2222 +    qed
 13.2223 +  qed
 13.2224 +  then obtain f where f:
 13.2225 +    "\<forall>x.
 13.2226 +      \<not> P (cbox (fst x) (snd x)) \<longrightarrow>
 13.2227 +      \<not> P (cbox (fst (f x)) (snd (f x))) \<and>
 13.2228 +        (\<forall>i\<in>Basis.
 13.2229 +            fst x \<bullet> i \<le> fst (f x) \<bullet> i \<and>
 13.2230 +            fst (f x) \<bullet> i \<le> snd (f x) \<bullet> i \<and>
 13.2231 +            snd (f x) \<bullet> i \<le> snd x \<bullet> i \<and>
 13.2232 +            2 * (snd (f x) \<bullet> i - fst (f x) \<bullet> i) \<le> snd x \<bullet> i - fst x \<bullet> i)"
 13.2233 +    apply -
 13.2234 +    apply (drule choice)
 13.2235 +    apply blast
 13.2236 +    done
 13.2237 +  define AB A B where ab_def: "AB n = (f ^^ n) (a,b)" "A n = fst(AB n)" "B n = snd(AB n)" for n
 13.2238 +  have "A 0 = a" "B 0 = b" "\<And>n. \<not> P (cbox (A(Suc n)) (B(Suc n))) \<and>
 13.2239 +    (\<forall>i\<in>Basis. A(n)\<bullet>i \<le> A(Suc n)\<bullet>i \<and> A(Suc n)\<bullet>i \<le> B(Suc n)\<bullet>i \<and> B(Suc n)\<bullet>i \<le> B(n)\<bullet>i \<and>
 13.2240 +    2 * (B(Suc n)\<bullet>i - A(Suc n)\<bullet>i) \<le> B(n)\<bullet>i - A(n)\<bullet>i)" (is "\<And>n. ?P n")
 13.2241 +  proof -
 13.2242 +    show "A 0 = a" "B 0 = b"
 13.2243 +      unfolding ab_def by auto
 13.2244 +    note S = ab_def funpow.simps o_def id_apply
 13.2245 +    show "?P n" for n
 13.2246 +    proof (induct n)
 13.2247 +      case 0
 13.2248 +      then show ?case
 13.2249 +        unfolding S
 13.2250 +        apply (rule f[rule_format]) using assms(3)
 13.2251 +        apply auto
 13.2252 +        done
 13.2253 +    next
 13.2254 +      case (Suc n)
 13.2255 +      show ?case
 13.2256 +        unfolding S
 13.2257 +        apply (rule f[rule_format])
 13.2258 +        using Suc
 13.2259 +        unfolding S
 13.2260 +        apply auto
 13.2261 +        done
 13.2262 +    qed
 13.2263 +  qed
 13.2264 +  note AB = this(1-2) conjunctD2[OF this(3),rule_format]
 13.2265 +
 13.2266 +  have interv: "\<exists>n. \<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e"
 13.2267 +    if e: "0 < e" for e
 13.2268 +  proof -
 13.2269 +    obtain n where n: "(\<Sum>i\<in>Basis. b \<bullet> i - a \<bullet> i) / e < 2 ^ n"
 13.2270 +      using real_arch_pow[of 2 "(setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis) / e"] by auto
 13.2271 +    show ?thesis
 13.2272 +    proof (rule exI [where x=n], clarify)
 13.2273 +      fix x y
 13.2274 +      assume xy: "x\<in>cbox (A n) (B n)" "y\<in>cbox (A n) (B n)"
 13.2275 +      have "dist x y \<le> setsum (\<lambda>i. \<bar>(x - y)\<bullet>i\<bar>) Basis"
 13.2276 +        unfolding dist_norm by(rule norm_le_l1)
 13.2277 +      also have "\<dots> \<le> setsum (\<lambda>i. B n\<bullet>i - A n\<bullet>i) Basis"
 13.2278 +      proof (rule setsum_mono)
 13.2279 +        fix i :: 'a
 13.2280 +        assume i: "i \<in> Basis"
 13.2281 +        show "\<bar>(x - y) \<bullet> i\<bar> \<le> B n \<bullet> i - A n \<bullet> i"
 13.2282 +          using xy[unfolded mem_box,THEN bspec, OF i]
 13.2283 +          by (auto simp: inner_diff_left)
 13.2284 +      qed
 13.2285 +      also have "\<dots> \<le> setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis / 2^n"
 13.2286 +        unfolding setsum_divide_distrib
 13.2287 +      proof (rule setsum_mono)
 13.2288 +        show "B n \<bullet> i - A n \<bullet> i \<le> (b \<bullet> i - a \<bullet> i) / 2 ^ n" if i: "i \<in> Basis" for i
 13.2289 +        proof (induct n)
 13.2290 +          case 0
 13.2291 +          then show ?case
 13.2292 +            unfolding AB by auto
 13.2293 +        next
 13.2294 +          case (Suc n)
 13.2295 +          have "B (Suc n) \<bullet> i - A (Suc n) \<bullet> i \<le> (B n \<bullet> i - A n \<bullet> i) / 2"
 13.2296 +            using AB(4)[of i n] using i by auto
 13.2297 +          also have "\<dots> \<le> (b \<bullet> i - a \<bullet> i) / 2 ^ Suc n"
 13.2298 +            using Suc by (auto simp add: field_simps)
 13.2299 +          finally show ?case .
 13.2300 +        qed
 13.2301 +      qed
 13.2302 +      also have "\<dots> < e"
 13.2303 +        using n using e by (auto simp add: field_simps)
 13.2304 +      finally show "dist x y < e" .
 13.2305 +    qed
 13.2306 +  qed
 13.2307 +  {
 13.2308 +    fix n m :: nat
 13.2309 +    assume "m \<le> n" then have "cbox (A n) (B n) \<subseteq> cbox (A m) (B m)"
 13.2310 +    proof (induction rule: inc_induct)
 13.2311 +      case (step i)
 13.2312 +      show ?case
 13.2313 +        using AB(4) by (intro order_trans[OF step.IH] subset_box_imp) auto
 13.2314 +    qed simp
 13.2315 +  } note ABsubset = this
 13.2316 +  have "\<exists>a. \<forall>n. a\<in> cbox (A n) (B n)"
 13.2317 +    by (rule decreasing_closed_nest[rule_format,OF closed_cbox _ ABsubset interv])
 13.2318 +      (metis nat.exhaust AB(1-3) assms(1,3))
 13.2319 +  then obtain x0 where x0: "\<And>n. x0 \<in> cbox (A n) (B n)"
 13.2320 +    by blast
 13.2321 +  show thesis
 13.2322 +  proof (rule that[rule_format, of x0])
 13.2323 +    show "x0\<in>cbox a b"
 13.2324 +      using x0[of 0] unfolding AB .
 13.2325 +    fix e :: real
 13.2326 +    assume "e > 0"
 13.2327 +    from interv[OF this] obtain n
 13.2328 +      where n: "\<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e" ..
 13.2329 +    have "\<not> P (cbox (A n) (B n))"
 13.2330 +      apply (cases "0 < n")
 13.2331 +      using AB(3)[of "n - 1"] assms(3) AB(1-2)
 13.2332 +      apply auto
 13.2333 +      done
 13.2334 +    moreover have "cbox (A n) (B n) \<subseteq> ball x0 e"
 13.2335 +      using n using x0[of n] by auto
 13.2336 +    moreover have "cbox (A n) (B n) \<subseteq> cbox a b"
 13.2337 +      unfolding AB(1-2)[symmetric] by (rule ABsubset) auto
 13.2338 +    ultimately show "\<exists>c d. x0 \<in> cbox c d \<and> cbox c d \<subseteq> ball x0 e \<and> cbox c d \<subseteq> cbox a b \<and> \<not> P (cbox c d)"
 13.2339 +      apply (rule_tac x="A n" in exI)
 13.2340 +      apply (rule_tac x="B n" in exI)
 13.2341 +      apply (auto simp: x0)
 13.2342 +      done
 13.2343 +  qed
 13.2344 +qed
 13.2345 +
 13.2346 +
 13.2347 +subsection \<open>Cousin's lemma.\<close>
 13.2348 +
 13.2349 +lemma fine_division_exists:
 13.2350 +  fixes a b :: "'a::euclidean_space"
 13.2351 +  assumes "gauge g"
 13.2352 +  obtains p where "p tagged_division_of (cbox a b)" "g fine p"
 13.2353 +proof -
 13.2354 +  presume "\<not> (\<exists>p. p tagged_division_of (cbox a b) \<and> g fine p) \<Longrightarrow> False"
 13.2355 +  then obtain p where "p tagged_division_of (cbox a b)" "g fine p"
 13.2356 +    by blast
 13.2357 +  then show thesis ..
 13.2358 +next
 13.2359 +  assume as: "\<not> (\<exists>p. p tagged_division_of (cbox a b) \<and> g fine p)"
 13.2360 +  obtain x where x:
 13.2361 +      "x \<in> (cbox a b)"
 13.2362 +      "\<And>e. 0 < e \<Longrightarrow>
 13.2363 +        \<exists>c d.
 13.2364 +          x \<in> cbox c d \<and>
 13.2365 +          cbox c d \<subseteq> ball x e \<and>
 13.2366 +          cbox c d \<subseteq> (cbox a b) \<and>
 13.2367 +          \<not> (\<exists>p. p tagged_division_of cbox c d \<and> g fine p)"
 13.2368 +    apply (rule interval_bisection[of "\<lambda>s. \<exists>p. p tagged_division_of s \<and> g fine p", OF _ _ as])
 13.2369 +    apply (simp add: fine_def)
 13.2370 +    apply (metis tagged_division_union fine_union)
 13.2371 +    apply (auto simp: )
 13.2372 +    done
 13.2373 +  obtain e where e: "e > 0" "ball x e \<subseteq> g x"
 13.2374 +    using gaugeD[OF assms, of x] unfolding open_contains_ball by auto
 13.2375 +  from x(2)[OF e(1)]
 13.2376 +  obtain c d where c_d: "x \<in> cbox c d"
 13.2377 +                        "cbox c d \<subseteq> ball x e"
 13.2378 +                        "cbox c d \<subseteq> cbox a b"
 13.2379 +                        "\<not> (\<exists>p. p tagged_division_of cbox c d \<and> g fine p)"
 13.2380 +    by blast
 13.2381 +  have "g fine {(x, cbox c d)}"
 13.2382 +    unfolding fine_def using e using c_d(2) by auto
 13.2383 +  then show False
 13.2384 +    using tagged_division_of_self[OF c_d(1)] using c_d by auto
 13.2385 +qed
 13.2386 +
 13.2387 +lemma fine_division_exists_real:
 13.2388 +  fixes a b :: real
 13.2389 +  assumes "gauge g"
 13.2390 +  obtains p where "p tagged_division_of {a .. b}" "g fine p"
 13.2391 +  by (metis assms box_real(2) fine_division_exists)
 13.2392 +
 13.2393 +subsection \<open>A technical lemma about "refinement" of division.\<close>
 13.2394 +
 13.2395 +lemma tagged_division_finer:
 13.2396 +  fixes p :: "('a::euclidean_space \<times> ('a::euclidean_space set)) set"
 13.2397 +  assumes "p tagged_division_of (cbox a b)"
 13.2398 +    and "gauge d"
 13.2399 +  obtains q where "q tagged_division_of (cbox a b)"
 13.2400 +    and "d fine q"
 13.2401 +    and "\<forall>(x,k) \<in> p. k \<subseteq> d(x) \<longrightarrow> (x,k) \<in> q"
 13.2402 +proof -
 13.2403 +  let ?P = "\<lambda>p. p tagged_partial_division_of (cbox a b) \<longrightarrow> gauge d \<longrightarrow>
 13.2404 +    (\<exists>q. q tagged_division_of (\<Union>{k. \<exists>x. (x,k) \<in> p}) \<and> d fine q \<and>
 13.2405 +      (\<forall>(x,k) \<in> p. k \<subseteq> d(x) \<longrightarrow> (x,k) \<in> q))"
 13.2406 +  {
 13.2407 +    have *: "finite p" "p tagged_partial_division_of (cbox a b)"
 13.2408 +      using assms(1)
 13.2409 +      unfolding tagged_division_of_def
 13.2410 +      by auto
 13.2411 +    presume "\<And>p. finite p \<Longrightarrow> ?P p"
 13.2412 +    from this[rule_format,OF * assms(2)] guess q .. note q=this
 13.2413 +    then show ?thesis
 13.2414 +      apply -
 13.2415 +      apply (rule that[of q])
 13.2416 +      unfolding tagged_division_ofD[OF assms(1)]
 13.2417 +      apply auto
 13.2418 +      done
 13.2419 +  }
 13.2420 +  fix p :: "('a::euclidean_space \<times> ('a::euclidean_space set)) set"
 13.2421 +  assume as: "finite p"
 13.2422 +  show "?P p"
 13.2423 +    apply rule
 13.2424 +    apply rule
 13.2425 +    using as
 13.2426 +  proof (induct p)
 13.2427 +    case empty
 13.2428 +    show ?case
 13.2429 +      apply (rule_tac x="{}" in exI)
 13.2430 +      unfolding fine_def
 13.2431 +      apply auto
 13.2432 +      done
 13.2433 +  next
 13.2434 +    case (insert xk p)
 13.2435 +    guess x k using surj_pair[of xk] by (elim exE) note xk=this
 13.2436 +    note tagged_partial_division_subset[OF insert(4) subset_insertI]
 13.2437 +    from insert(3)[OF this insert(5)] guess q1 .. note q1 = conjunctD3[OF this]
 13.2438 +    have *: "\<Union>{l. \<exists>y. (y,l) \<in> insert xk p} = k \<union> \<Union>{l. \<exists>y. (y,l) \<in> p}"
 13.2439 +      unfolding xk by auto
 13.2440 +    note p = tagged_partial_division_ofD[OF insert(4)]
 13.2441 +    from p(4)[unfolded xk, OF insertI1] guess u v by (elim exE) note uv=this
 13.2442 +
 13.2443 +    have "finite {k. \<exists>x. (x, k) \<in> p}"
 13.2444 +      apply (rule finite_subset[of _ "snd ` p"])
 13.2445 +      using p
 13.2446 +      apply safe
 13.2447 +      apply (metis image_iff snd_conv)
 13.2448 +      apply auto