src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
author hoelzl
Wed Sep 28 16:15:51 2016 +0200 (2016-09-28)
changeset 63956 b235e845c8e8
parent 63945 444eafb6e864
child 63957 c3da799b1b45
permissions -rw-r--r--
HOL-Analysis: add cover lemma ported by L. C. Paulson
     1 (*  Author:     John Harrison
     2     Author:     Robert Himmelmann, TU Muenchen (Translation from HOL light); proofs reworked by LCP
     3 *)
     4 
     5 section \<open>Henstock-Kurzweil gauge integration in many dimensions.\<close>
     6 
     7 theory Henstock_Kurzweil_Integration
     8 imports
     9   Lebesgue_Measure
    10 begin
    11 
    12 lemmas scaleR_simps = scaleR_zero_left scaleR_minus_left scaleR_left_diff_distrib
    13   scaleR_zero_right scaleR_minus_right scaleR_right_diff_distrib scaleR_eq_0_iff
    14   scaleR_cancel_left scaleR_cancel_right scaleR_add_right scaleR_add_left real_vector_class.scaleR_one
    15 
    16 
    17 subsection \<open>Sundries\<close>
    18 
    19 
    20 text\<open>A transitive relation is well-founded if all initial segments are finite.\<close>
    21 lemma wf_finite_segments:
    22   assumes "irrefl r" and "trans r" and "\<And>x. finite {y. (y, x) \<in> r}"
    23   shows "wf (r)"
    24   apply (simp add: trans_wf_iff wf_iff_acyclic_if_finite converse_def assms)
    25   using acyclic_def assms irrefl_def trans_Restr by fastforce
    26 
    27 text\<open>For creating values between @{term u} and @{term v}.\<close>
    28 lemma scaling_mono:
    29   fixes u::"'a::linordered_field"
    30   assumes "u \<le> v" "0 \<le> r" "r \<le> s"
    31     shows "u + r * (v - u) / s \<le> v"
    32 proof -
    33   have "r/s \<le> 1" using assms
    34     using divide_le_eq_1 by fastforce
    35   then have "(r/s) * (v - u) \<le> 1 * (v - u)"
    36     by (meson diff_ge_0_iff_ge mult_right_mono \<open>u \<le> v\<close>)
    37   then show ?thesis
    38     by (simp add: field_simps)
    39 qed
    40 
    41 lemma conjunctD2: assumes "a \<and> b" shows a b using assms by auto
    42 lemma conjunctD3: assumes "a \<and> b \<and> c" shows a b c using assms by auto
    43 lemma conjunctD4: assumes "a \<and> b \<and> c \<and> d" shows a b c d using assms by auto
    44 
    45 lemma cond_cases: "(P \<Longrightarrow> Q x) \<Longrightarrow> (\<not> P \<Longrightarrow> Q y) \<Longrightarrow> Q (if P then x else y)"
    46   by auto
    47 
    48 declare norm_triangle_ineq4[intro]
    49 
    50 lemma transitive_stepwise_le:
    51   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)"
    52   shows "\<forall>n\<ge>m. R m n"
    53 proof (intro allI impI)
    54   show "m \<le> n \<Longrightarrow> R m n" for n
    55     by (induction rule: dec_induct)
    56        (use assms in blast)+
    57 qed
    58 
    59 subsection \<open>Some useful lemmas about intervals.\<close>
    60 
    61 lemma empty_as_interval: "{} = cbox One (0::'a::euclidean_space)"
    62   using nonempty_Basis
    63   by (fastforce simp add: set_eq_iff mem_box)
    64 
    65 lemma interior_subset_union_intervals:
    66   assumes "i = cbox a b"
    67     and "j = cbox c d"
    68     and "interior j \<noteq> {}"
    69     and "i \<subseteq> j \<union> s"
    70     and "interior i \<inter> interior j = {}"
    71   shows "interior i \<subseteq> interior s"
    72 proof -
    73   have "box a b \<inter> cbox c d = {}"
    74      using inter_interval_mixed_eq_empty[of c d a b] and assms(3,5)
    75      unfolding assms(1,2) interior_cbox by auto
    76   moreover
    77   have "box a b \<subseteq> cbox c d \<union> s"
    78     apply (rule order_trans,rule box_subset_cbox)
    79     using assms(4) unfolding assms(1,2)
    80     apply auto
    81     done
    82   ultimately
    83   show ?thesis
    84     unfolding assms interior_cbox
    85       by auto (metis IntI UnE empty_iff interior_maximal open_box subsetCE subsetI)
    86 qed
    87 
    88 lemma interior_Union_subset_cbox:
    89   assumes "finite f"
    90   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"
    91     and t: "closed t"
    92   shows "interior (\<Union>f) \<subseteq> t"
    93 proof -
    94   have [simp]: "s \<in> f \<Longrightarrow> closed s" for s
    95     using f by auto
    96   define E where "E = {s\<in>f. interior s = {}}"
    97   then have "finite E" "E \<subseteq> {s\<in>f. interior s = {}}"
    98     using \<open>finite f\<close> by auto
    99   then have "interior (\<Union>f) = interior (\<Union>(f - E))"
   100   proof (induction E rule: finite_subset_induct')
   101     case (insert s f')
   102     have "interior (\<Union>(f - insert s f') \<union> s) = interior (\<Union>(f - insert s f'))"
   103       using insert.hyps \<open>finite f\<close> by (intro interior_closed_Un_empty_interior) auto
   104     also have "\<Union>(f - insert s f') \<union> s = \<Union>(f - f')"
   105       using insert.hyps by auto
   106     finally show ?case
   107       by (simp add: insert.IH)
   108   qed simp
   109   also have "\<dots> \<subseteq> \<Union>(f - E)"
   110     by (rule interior_subset)
   111   also have "\<dots> \<subseteq> t"
   112   proof (rule Union_least)
   113     fix s assume "s \<in> f - E"
   114     with f[of s] obtain a b where s: "s \<in> f" "s = cbox a b" "box a b \<noteq> {}"
   115       by (fastforce simp: E_def)
   116     have "closure (interior s) \<subseteq> closure t"
   117       by (intro closure_mono f \<open>s \<in> f\<close>)
   118     with s \<open>closed t\<close> show "s \<subseteq> t"
   119       by (simp add: closure_box)
   120   qed
   121   finally show ?thesis .
   122 qed
   123 
   124 lemma inter_interior_unions_intervals:
   125     "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) = {}"
   126   using interior_Union_subset_cbox[of f "UNIV - s"] by auto
   127 
   128 lemma interval_split:
   129   fixes a :: "'a::euclidean_space"
   130   assumes "k \<in> Basis"
   131   shows
   132     "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)"
   133     "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"
   134   apply (rule_tac[!] set_eqI)
   135   unfolding Int_iff mem_box mem_Collect_eq
   136   using assms
   137   apply auto
   138   done
   139 
   140 lemma interval_not_empty: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow> cbox a b \<noteq> {}"
   141   by (simp add: box_ne_empty)
   142 
   143 subsection \<open>Bounds on intervals where they exist.\<close>
   144 
   145 definition interval_upperbound :: "('a::euclidean_space) set \<Rightarrow> 'a"
   146   where "interval_upperbound s = (\<Sum>i\<in>Basis. (SUP x:s. x\<bullet>i) *\<^sub>R i)"
   147 
   148 definition interval_lowerbound :: "('a::euclidean_space) set \<Rightarrow> 'a"
   149   where "interval_lowerbound s = (\<Sum>i\<in>Basis. (INF x:s. x\<bullet>i) *\<^sub>R i)"
   150 
   151 lemma interval_upperbound[simp]:
   152   "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow>
   153     interval_upperbound (cbox a b) = (b::'a::euclidean_space)"
   154   unfolding interval_upperbound_def euclidean_representation_setsum cbox_def
   155   by (safe intro!: cSup_eq) auto
   156 
   157 lemma interval_lowerbound[simp]:
   158   "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow>
   159     interval_lowerbound (cbox a b) = (a::'a::euclidean_space)"
   160   unfolding interval_lowerbound_def euclidean_representation_setsum cbox_def
   161   by (safe intro!: cInf_eq) auto
   162 
   163 lemmas interval_bounds = interval_upperbound interval_lowerbound
   164 
   165 lemma
   166   fixes X::"real set"
   167   shows interval_upperbound_real[simp]: "interval_upperbound X = Sup X"
   168     and interval_lowerbound_real[simp]: "interval_lowerbound X = Inf X"
   169   by (auto simp: interval_upperbound_def interval_lowerbound_def)
   170 
   171 lemma interval_bounds'[simp]:
   172   assumes "cbox a b \<noteq> {}"
   173   shows "interval_upperbound (cbox a b) = b"
   174     and "interval_lowerbound (cbox a b) = a"
   175   using assms unfolding box_ne_empty by auto
   176 
   177 lemma interval_upperbound_Times:
   178   assumes "A \<noteq> {}" and "B \<noteq> {}"
   179   shows "interval_upperbound (A \<times> B) = (interval_upperbound A, interval_upperbound B)"
   180 proof-
   181   from assms have fst_image_times': "A = fst ` (A \<times> B)" by simp
   182   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)"
   183       by (subst (2) fst_image_times') (simp del: fst_image_times add: o_def inner_Pair_0)
   184   moreover from assms have snd_image_times': "B = snd ` (A \<times> B)" by simp
   185   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)"
   186       by (subst (2) snd_image_times') (simp del: snd_image_times add: o_def inner_Pair_0)
   187   ultimately show ?thesis unfolding interval_upperbound_def
   188       by (subst setsum_Basis_prod_eq) (auto simp add: setsum_prod)
   189 qed
   190 
   191 lemma interval_lowerbound_Times:
   192   assumes "A \<noteq> {}" and "B \<noteq> {}"
   193   shows "interval_lowerbound (A \<times> B) = (interval_lowerbound A, interval_lowerbound B)"
   194 proof-
   195   from assms have fst_image_times': "A = fst ` (A \<times> B)" by simp
   196   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)"
   197       by (subst (2) fst_image_times') (simp del: fst_image_times add: o_def inner_Pair_0)
   198   moreover from assms have snd_image_times': "B = snd ` (A \<times> B)" by simp
   199   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)"
   200       by (subst (2) snd_image_times') (simp del: snd_image_times add: o_def inner_Pair_0)
   201   ultimately show ?thesis unfolding interval_lowerbound_def
   202       by (subst setsum_Basis_prod_eq) (auto simp add: setsum_prod)
   203 qed
   204 
   205 subsection \<open>Content (length, area, volume...) of an interval.\<close>
   206 
   207 abbreviation content :: "'a::euclidean_space set \<Rightarrow> real"
   208   where "content s \<equiv> measure lborel s"
   209 
   210 lemma content_cbox_cases:
   211   "content (cbox a b) = (if \<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i then setprod (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis else 0)"
   212   by (simp add: measure_lborel_cbox_eq inner_diff)
   213 
   214 lemma content_cbox: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow> content (cbox a b) = (\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   215   unfolding content_cbox_cases by simp
   216 
   217 lemma content_cbox': "cbox a b \<noteq> {} \<Longrightarrow> content (cbox a b) = (\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   218   by (simp add: box_ne_empty inner_diff)
   219 
   220 lemma content_real: "a \<le> b \<Longrightarrow> content {a..b} = b - a"
   221   by simp
   222 
   223 lemma abs_eq_content: "\<bar>y - x\<bar> = (if x\<le>y then content {x .. y} else content {y..x})"
   224   by (auto simp: content_real)
   225 
   226 lemma content_singleton: "content {a} = 0"
   227   by simp
   228 
   229 lemma content_unit[iff]: "content (cbox 0 (One::'a::euclidean_space)) = 1"
   230   by simp
   231 
   232 lemma content_pos_le[intro]: "0 \<le> content (cbox a b)"
   233   by simp
   234 
   235 corollary content_nonneg [simp]: "~ content (cbox a b) < 0"
   236   using not_le by blast
   237 
   238 lemma content_pos_lt: "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i \<Longrightarrow> 0 < content (cbox a b)"
   239   by (auto simp: less_imp_le inner_diff box_eq_empty intro!: setprod_pos)
   240 
   241 lemma content_eq_0: "content (cbox a b) = 0 \<longleftrightarrow> (\<exists>i\<in>Basis. b\<bullet>i \<le> a\<bullet>i)"
   242   by (auto simp: content_cbox_cases not_le intro: less_imp_le antisym eq_refl)
   243 
   244 lemma content_eq_0_interior: "content (cbox a b) = 0 \<longleftrightarrow> interior(cbox a b) = {}"
   245   unfolding content_eq_0 interior_cbox box_eq_empty by auto
   246 
   247 lemma content_pos_lt_eq: "0 < content (cbox a (b::'a::euclidean_space)) \<longleftrightarrow> (\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i)"
   248   by (auto simp add: content_cbox_cases less_le setprod_nonneg)
   249 
   250 lemma content_empty [simp]: "content {} = 0"
   251   by simp
   252 
   253 lemma content_real_if [simp]: "content {a..b} = (if a \<le> b then b - a else 0)"
   254   by (simp add: content_real)
   255 
   256 lemma content_subset: "cbox a b \<subseteq> cbox c d \<Longrightarrow> content (cbox a b) \<le> content (cbox c d)"
   257   unfolding measure_def
   258   by (intro enn2real_mono emeasure_mono) (auto simp: emeasure_lborel_cbox_eq)
   259 
   260 lemma content_lt_nz: "0 < content (cbox a b) \<longleftrightarrow> content (cbox a b) \<noteq> 0"
   261   unfolding content_pos_lt_eq content_eq_0 unfolding not_ex not_le by fastforce
   262 
   263 lemma content_Pair: "content (cbox (a,c) (b,d)) = content (cbox a b) * content (cbox c d)"
   264   unfolding measure_lborel_cbox_eq Basis_prod_def
   265   apply (subst setprod.union_disjoint)
   266   apply (auto simp: bex_Un ball_Un)
   267   apply (subst (1 2) setprod.reindex_nontrivial)
   268   apply auto
   269   done
   270 
   271 lemma content_cbox_pair_eq0_D:
   272    "content (cbox (a,c) (b,d)) = 0 \<Longrightarrow> content (cbox a b) = 0 \<or> content (cbox c d) = 0"
   273   by (simp add: content_Pair)
   274 
   275 lemma content_0_subset: "content(cbox a b) = 0 \<Longrightarrow> s \<subseteq> cbox a b \<Longrightarrow> content s = 0"
   276   using emeasure_mono[of s "cbox a b" lborel]
   277   by (auto simp: measure_def enn2real_eq_0_iff emeasure_lborel_cbox_eq)
   278 
   279 lemma content_split:
   280   fixes a :: "'a::euclidean_space"
   281   assumes "k \<in> Basis"
   282   shows "content (cbox a b) = content(cbox a b \<inter> {x. x\<bullet>k \<le> c}) + content(cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
   283   -- \<open>Prove using measure theory\<close>
   284 proof cases
   285   note simps = interval_split[OF assms] content_cbox_cases
   286   have *: "Basis = insert k (Basis - {k})" "\<And>x. finite (Basis-{x})" "\<And>x. x\<notin>Basis-{x}"
   287     using assms by auto
   288   have *: "\<And>X Y Z. (\<Prod>i\<in>Basis. Z i (if i = k then X else Y i)) = Z k X * (\<Prod>i\<in>Basis-{k}. Z i (Y i))"
   289     "(\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i) = (\<Prod>i\<in>Basis-{k}. b\<bullet>i - a\<bullet>i) * (b\<bullet>k - a\<bullet>k)"
   290     apply (subst *(1))
   291     defer
   292     apply (subst *(1))
   293     unfolding setprod.insert[OF *(2-)]
   294     apply auto
   295     done
   296   assume as: "\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i"
   297   moreover
   298   have "\<And>x. min (b \<bullet> k) c = max (a \<bullet> k) c \<Longrightarrow>
   299     x * (b\<bullet>k - a\<bullet>k) = x * (max (a \<bullet> k) c - a \<bullet> k) + x * (b \<bullet> k - max (a \<bullet> k) c)"
   300     by  (auto simp add: field_simps)
   301   moreover
   302   have **: "(\<Prod>i\<in>Basis. ((\<Sum>i\<in>Basis. (if i = k then min (b \<bullet> k) c else b \<bullet> i) *\<^sub>R i) \<bullet> i - a \<bullet> i)) =
   303       (\<Prod>i\<in>Basis. (if i = k then min (b \<bullet> k) c else b \<bullet> i) - a \<bullet> i)"
   304     "(\<Prod>i\<in>Basis. b \<bullet> i - ((\<Sum>i\<in>Basis. (if i = k then max (a \<bullet> k) c else a \<bullet> i) *\<^sub>R i) \<bullet> i)) =
   305       (\<Prod>i\<in>Basis. b \<bullet> i - (if i = k then max (a \<bullet> k) c else a \<bullet> i))"
   306     by (auto intro!: setprod.cong)
   307   have "\<not> a \<bullet> k \<le> c \<Longrightarrow> \<not> c \<le> b \<bullet> k \<Longrightarrow> False"
   308     unfolding not_le
   309     using as[unfolded ,rule_format,of k] assms
   310     by auto
   311   ultimately show ?thesis
   312     using assms
   313     unfolding simps **
   314     unfolding *(1)[of "\<lambda>i x. b\<bullet>i - x"] *(1)[of "\<lambda>i x. x - a\<bullet>i"]
   315     unfolding *(2)
   316     by auto
   317 next
   318   assume "\<not> (\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i)"
   319   then have "cbox a b = {}"
   320     unfolding box_eq_empty by (auto simp: not_le)
   321   then show ?thesis
   322     by (auto simp: not_le)
   323 qed
   324 
   325 subsection \<open>The notion of a gauge --- simply an open set containing the point.\<close>
   326 
   327 definition "gauge d \<longleftrightarrow> (\<forall>x. x \<in> d x \<and> open (d x))"
   328 
   329 lemma gaugeI:
   330   assumes "\<And>x. x \<in> g x"
   331     and "\<And>x. open (g x)"
   332   shows "gauge g"
   333   using assms unfolding gauge_def by auto
   334 
   335 lemma gaugeD[dest]:
   336   assumes "gauge d"
   337   shows "x \<in> d x"
   338     and "open (d x)"
   339   using assms unfolding gauge_def by auto
   340 
   341 lemma gauge_ball_dependent: "\<forall>x. 0 < e x \<Longrightarrow> gauge (\<lambda>x. ball x (e x))"
   342   unfolding gauge_def by auto
   343 
   344 lemma gauge_ball[intro]: "0 < e \<Longrightarrow> gauge (\<lambda>x. ball x e)"
   345   unfolding gauge_def by auto
   346 
   347 lemma gauge_trivial[intro!]: "gauge (\<lambda>x. ball x 1)"
   348   by (rule gauge_ball) auto
   349 
   350 lemma gauge_inter[intro]: "gauge d1 \<Longrightarrow> gauge d2 \<Longrightarrow> gauge (\<lambda>x. d1 x \<inter> d2 x)"
   351   unfolding gauge_def by auto
   352 
   353 lemma gauge_inters:
   354   assumes "finite s"
   355     and "\<forall>d\<in>s. gauge (f d)"
   356   shows "gauge (\<lambda>x. \<Inter>{f d x | d. d \<in> s})"
   357 proof -
   358   have *: "\<And>x. {f d x |d. d \<in> s} = (\<lambda>d. f d x) ` s"
   359     by auto
   360   show ?thesis
   361     unfolding gauge_def unfolding *
   362     using assms unfolding Ball_def Inter_iff mem_Collect_eq gauge_def by auto
   363 qed
   364 
   365 lemma gauge_existence_lemma:
   366   "(\<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)"
   367   by (metis zero_less_one)
   368 
   369 
   370 subsection \<open>Divisions.\<close>
   371 
   372 definition division_of (infixl "division'_of" 40)
   373 where
   374   "s division_of i \<longleftrightarrow>
   375     finite s \<and>
   376     (\<forall>k\<in>s. k \<subseteq> i \<and> k \<noteq> {} \<and> (\<exists>a b. k = cbox a b)) \<and>
   377     (\<forall>k1\<in>s. \<forall>k2\<in>s. k1 \<noteq> k2 \<longrightarrow> interior(k1) \<inter> interior(k2) = {}) \<and>
   378     (\<Union>s = i)"
   379 
   380 lemma division_ofD[dest]:
   381   assumes "s division_of i"
   382   shows "finite s"
   383     and "\<And>k. k \<in> s \<Longrightarrow> k \<subseteq> i"
   384     and "\<And>k. k \<in> s \<Longrightarrow> k \<noteq> {}"
   385     and "\<And>k. k \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
   386     and "\<And>k1 k2. k1 \<in> s \<Longrightarrow> k2 \<in> s \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior(k1) \<inter> interior(k2) = {}"
   387     and "\<Union>s = i"
   388   using assms unfolding division_of_def by auto
   389 
   390 lemma division_ofI:
   391   assumes "finite s"
   392     and "\<And>k. k \<in> s \<Longrightarrow> k \<subseteq> i"
   393     and "\<And>k. k \<in> s \<Longrightarrow> k \<noteq> {}"
   394     and "\<And>k. k \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
   395     and "\<And>k1 k2. k1 \<in> s \<Longrightarrow> k2 \<in> s \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
   396     and "\<Union>s = i"
   397   shows "s division_of i"
   398   using assms unfolding division_of_def by auto
   399 
   400 lemma division_of_finite: "s division_of i \<Longrightarrow> finite s"
   401   unfolding division_of_def by auto
   402 
   403 lemma division_of_self[intro]: "cbox a b \<noteq> {} \<Longrightarrow> {cbox a b} division_of (cbox a b)"
   404   unfolding division_of_def by auto
   405 
   406 lemma division_of_trivial[simp]: "s division_of {} \<longleftrightarrow> s = {}"
   407   unfolding division_of_def by auto
   408 
   409 lemma division_of_sing[simp]:
   410   "s division_of cbox a (a::'a::euclidean_space) \<longleftrightarrow> s = {cbox a a}"
   411   (is "?l = ?r")
   412 proof
   413   assume ?r
   414   moreover
   415   { fix k
   416     assume "s = {{a}}" "k\<in>s"
   417     then have "\<exists>x y. k = cbox x y"
   418       apply (rule_tac x=a in exI)+
   419       apply (force simp: cbox_sing)
   420       done
   421   }
   422   ultimately show ?l
   423     unfolding division_of_def cbox_sing by auto
   424 next
   425   assume ?l
   426   note * = conjunctD4[OF this[unfolded division_of_def cbox_sing]]
   427   {
   428     fix x
   429     assume x: "x \<in> s" have "x = {a}"
   430       using *(2)[rule_format,OF x] by auto
   431   }
   432   moreover have "s \<noteq> {}"
   433     using *(4) by auto
   434   ultimately show ?r
   435     unfolding cbox_sing by auto
   436 qed
   437 
   438 lemma elementary_empty: obtains p where "p division_of {}"
   439   unfolding division_of_trivial by auto
   440 
   441 lemma elementary_interval: obtains p where "p division_of (cbox a b)"
   442   by (metis division_of_trivial division_of_self)
   443 
   444 lemma division_contains: "s division_of i \<Longrightarrow> \<forall>x\<in>i. \<exists>k\<in>s. x \<in> k"
   445   unfolding division_of_def by auto
   446 
   447 lemma forall_in_division:
   448   "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))"
   449   unfolding division_of_def by fastforce
   450 
   451 lemma division_of_subset:
   452   assumes "p division_of (\<Union>p)"
   453     and "q \<subseteq> p"
   454   shows "q division_of (\<Union>q)"
   455 proof (rule division_ofI)
   456   note * = division_ofD[OF assms(1)]
   457   show "finite q"
   458     using "*"(1) assms(2) infinite_super by auto
   459   {
   460     fix k
   461     assume "k \<in> q"
   462     then have kp: "k \<in> p"
   463       using assms(2) by auto
   464     show "k \<subseteq> \<Union>q"
   465       using \<open>k \<in> q\<close> by auto
   466     show "\<exists>a b. k = cbox a b"
   467       using *(4)[OF kp] by auto
   468     show "k \<noteq> {}"
   469       using *(3)[OF kp] by auto
   470   }
   471   fix k1 k2
   472   assume "k1 \<in> q" "k2 \<in> q" "k1 \<noteq> k2"
   473   then have **: "k1 \<in> p" "k2 \<in> p" "k1 \<noteq> k2"
   474     using assms(2) by auto
   475   show "interior k1 \<inter> interior k2 = {}"
   476     using *(5)[OF **] by auto
   477 qed auto
   478 
   479 lemma division_of_union_self[intro]: "p division_of s \<Longrightarrow> p division_of (\<Union>p)"
   480   unfolding division_of_def by auto
   481 
   482 lemma division_of_content_0:
   483   assumes "content (cbox a b) = 0" "d division_of (cbox a b)"
   484   shows "\<forall>k\<in>d. content k = 0"
   485   unfolding forall_in_division[OF assms(2)]
   486   by (metis antisym_conv assms content_pos_le content_subset division_ofD(2))
   487 
   488 lemma division_inter:
   489   fixes s1 s2 :: "'a::euclidean_space set"
   490   assumes "p1 division_of s1"
   491     and "p2 division_of s2"
   492   shows "{k1 \<inter> k2 | k1 k2. k1 \<in> p1 \<and> k2 \<in> p2 \<and> k1 \<inter> k2 \<noteq> {}} division_of (s1 \<inter> s2)"
   493   (is "?A' division_of _")
   494 proof -
   495   let ?A = "{s. s \<in>  (\<lambda>(k1,k2). k1 \<inter> k2) ` (p1 \<times> p2) \<and> s \<noteq> {}}"
   496   have *: "?A' = ?A" by auto
   497   show ?thesis
   498     unfolding *
   499   proof (rule division_ofI)
   500     have "?A \<subseteq> (\<lambda>(x, y). x \<inter> y) ` (p1 \<times> p2)"
   501       by auto
   502     moreover have "finite (p1 \<times> p2)"
   503       using assms unfolding division_of_def by auto
   504     ultimately show "finite ?A" by auto
   505     have *: "\<And>s. \<Union>{x\<in>s. x \<noteq> {}} = \<Union>s"
   506       by auto
   507     show "\<Union>?A = s1 \<inter> s2"
   508       apply (rule set_eqI)
   509       unfolding * and UN_iff
   510       using division_ofD(6)[OF assms(1)] and division_ofD(6)[OF assms(2)]
   511       apply auto
   512       done
   513     {
   514       fix k
   515       assume "k \<in> ?A"
   516       then obtain k1 k2 where k: "k = k1 \<inter> k2" "k1 \<in> p1" "k2 \<in> p2" "k \<noteq> {}"
   517         by auto
   518       then show "k \<noteq> {}"
   519         by auto
   520       show "k \<subseteq> s1 \<inter> s2"
   521         using division_ofD(2)[OF assms(1) k(2)] and division_ofD(2)[OF assms(2) k(3)]
   522         unfolding k by auto
   523       obtain a1 b1 where k1: "k1 = cbox a1 b1"
   524         using division_ofD(4)[OF assms(1) k(2)] by blast
   525       obtain a2 b2 where k2: "k2 = cbox a2 b2"
   526         using division_ofD(4)[OF assms(2) k(3)] by blast
   527       show "\<exists>a b. k = cbox a b"
   528         unfolding k k1 k2 unfolding Int_interval by auto
   529     }
   530     fix k1 k2
   531     assume "k1 \<in> ?A"
   532     then obtain x1 y1 where k1: "k1 = x1 \<inter> y1" "x1 \<in> p1" "y1 \<in> p2" "k1 \<noteq> {}"
   533       by auto
   534     assume "k2 \<in> ?A"
   535     then obtain x2 y2 where k2: "k2 = x2 \<inter> y2" "x2 \<in> p1" "y2 \<in> p2" "k2 \<noteq> {}"
   536       by auto
   537     assume "k1 \<noteq> k2"
   538     then have th: "x1 \<noteq> x2 \<or> y1 \<noteq> y2"
   539       unfolding k1 k2 by auto
   540     have *: "interior x1 \<inter> interior x2 = {} \<or> interior y1 \<inter> interior y2 = {} \<Longrightarrow>
   541       interior (x1 \<inter> y1) \<subseteq> interior x1 \<Longrightarrow> interior (x1 \<inter> y1) \<subseteq> interior y1 \<Longrightarrow>
   542       interior (x2 \<inter> y2) \<subseteq> interior x2 \<Longrightarrow> interior (x2 \<inter> y2) \<subseteq> interior y2 \<Longrightarrow>
   543       interior (x1 \<inter> y1) \<inter> interior (x2 \<inter> y2) = {}" by auto
   544     show "interior k1 \<inter> interior k2 = {}"
   545       unfolding k1 k2
   546       apply (rule *)
   547       using assms division_ofD(5) k1 k2(2) k2(3) th apply auto
   548       done
   549   qed
   550 qed
   551 
   552 lemma division_inter_1:
   553   assumes "d division_of i"
   554     and "cbox a (b::'a::euclidean_space) \<subseteq> i"
   555   shows "{cbox a b \<inter> k | k. k \<in> d \<and> cbox a b \<inter> k \<noteq> {}} division_of (cbox a b)"
   556 proof (cases "cbox a b = {}")
   557   case True
   558   show ?thesis
   559     unfolding True and division_of_trivial by auto
   560 next
   561   case False
   562   have *: "cbox a b \<inter> i = cbox a b" using assms(2) by auto
   563   show ?thesis
   564     using division_inter[OF division_of_self[OF False] assms(1)]
   565     unfolding * by auto
   566 qed
   567 
   568 lemma elementary_inter:
   569   fixes s t :: "'a::euclidean_space set"
   570   assumes "p1 division_of s"
   571     and "p2 division_of t"
   572   shows "\<exists>p. p division_of (s \<inter> t)"
   573 using assms division_inter by blast
   574 
   575 lemma elementary_inters:
   576   assumes "finite f"
   577     and "f \<noteq> {}"
   578     and "\<forall>s\<in>f. \<exists>p. p division_of (s::('a::euclidean_space) set)"
   579   shows "\<exists>p. p division_of (\<Inter>f)"
   580   using assms
   581 proof (induct f rule: finite_induct)
   582   case (insert x f)
   583   show ?case
   584   proof (cases "f = {}")
   585     case True
   586     then show ?thesis
   587       unfolding True using insert by auto
   588   next
   589     case False
   590     obtain p where "p division_of \<Inter>f"
   591       using insert(3)[OF False insert(5)[unfolded ball_simps,THEN conjunct2]] ..
   592     moreover obtain px where "px division_of x"
   593       using insert(5)[rule_format,OF insertI1] ..
   594     ultimately show ?thesis
   595       by (simp add: elementary_inter Inter_insert)
   596   qed
   597 qed auto
   598 
   599 lemma division_disjoint_union:
   600   assumes "p1 division_of s1"
   601     and "p2 division_of s2"
   602     and "interior s1 \<inter> interior s2 = {}"
   603   shows "(p1 \<union> p2) division_of (s1 \<union> s2)"
   604 proof (rule division_ofI)
   605   note d1 = division_ofD[OF assms(1)]
   606   note d2 = division_ofD[OF assms(2)]
   607   show "finite (p1 \<union> p2)"
   608     using d1(1) d2(1) by auto
   609   show "\<Union>(p1 \<union> p2) = s1 \<union> s2"
   610     using d1(6) d2(6) by auto
   611   {
   612     fix k1 k2
   613     assume as: "k1 \<in> p1 \<union> p2" "k2 \<in> p1 \<union> p2" "k1 \<noteq> k2"
   614     moreover
   615     let ?g="interior k1 \<inter> interior k2 = {}"
   616     {
   617       assume as: "k1\<in>p1" "k2\<in>p2"
   618       have ?g
   619         using interior_mono[OF d1(2)[OF as(1)]] interior_mono[OF d2(2)[OF as(2)]]
   620         using assms(3) by blast
   621     }
   622     moreover
   623     {
   624       assume as: "k1\<in>p2" "k2\<in>p1"
   625       have ?g
   626         using interior_mono[OF d1(2)[OF as(2)]] interior_mono[OF d2(2)[OF as(1)]]
   627         using assms(3) by blast
   628     }
   629     ultimately show ?g
   630       using d1(5)[OF _ _ as(3)] and d2(5)[OF _ _ as(3)] by auto
   631   }
   632   fix k
   633   assume k: "k \<in> p1 \<union> p2"
   634   show "k \<subseteq> s1 \<union> s2"
   635     using k d1(2) d2(2) by auto
   636   show "k \<noteq> {}"
   637     using k d1(3) d2(3) by auto
   638   show "\<exists>a b. k = cbox a b"
   639     using k d1(4) d2(4) by auto
   640 qed
   641 
   642 lemma partial_division_extend_1:
   643   fixes a b c d :: "'a::euclidean_space"
   644   assumes incl: "cbox c d \<subseteq> cbox a b"
   645     and nonempty: "cbox c d \<noteq> {}"
   646   obtains p where "p division_of (cbox a b)" "cbox c d \<in> p"
   647 proof
   648   let ?B = "\<lambda>f::'a\<Rightarrow>'a \<times> 'a.
   649     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)"
   650   define p where "p = ?B ` (Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)})"
   651 
   652   show "cbox c d \<in> p"
   653     unfolding p_def
   654     by (auto simp add: box_eq_empty cbox_def intro!: image_eqI[where x="\<lambda>(i::'a)\<in>Basis. (c, d)"])
   655   {
   656     fix i :: 'a
   657     assume "i \<in> Basis"
   658     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"
   659       unfolding box_eq_empty subset_box by (auto simp: not_le)
   660   }
   661   note ord = this
   662 
   663   show "p division_of (cbox a b)"
   664   proof (rule division_ofI)
   665     show "finite p"
   666       unfolding p_def by (auto intro!: finite_PiE)
   667     {
   668       fix k
   669       assume "k \<in> p"
   670       then obtain f where f: "f \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}" and k: "k = ?B f"
   671         by (auto simp: p_def)
   672       then show "\<exists>a b. k = cbox a b"
   673         by auto
   674       have "k \<subseteq> cbox a b \<and> k \<noteq> {}"
   675       proof (simp add: k box_eq_empty subset_box not_less, safe)
   676         fix i :: 'a
   677         assume i: "i \<in> Basis"
   678         with f have "f i = (a, c) \<or> f i = (c, d) \<or> f i = (d, b)"
   679           by (auto simp: PiE_iff)
   680         with i ord[of i]
   681         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"
   682           by auto
   683       qed
   684       then show "k \<noteq> {}" "k \<subseteq> cbox a b"
   685         by auto
   686       {
   687         fix l
   688         assume "l \<in> p"
   689         then obtain g where g: "g \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}" and l: "l = ?B g"
   690           by (auto simp: p_def)
   691         assume "l \<noteq> k"
   692         have "\<exists>i\<in>Basis. f i \<noteq> g i"
   693         proof (rule ccontr)
   694           assume "\<not> ?thesis"
   695           with f g have "f = g"
   696             by (auto simp: PiE_iff extensional_def intro!: ext)
   697           with \<open>l \<noteq> k\<close> show False
   698             by (simp add: l k)
   699         qed
   700         then obtain i where *: "i \<in> Basis" "f i \<noteq> g i" ..
   701         then have "f i = (a, c) \<or> f i = (c, d) \<or> f i = (d, b)"
   702                   "g i = (a, c) \<or> g i = (c, d) \<or> g i = (d, b)"
   703           using f g by (auto simp: PiE_iff)
   704         with * ord[of i] show "interior l \<inter> interior k = {}"
   705           by (auto simp add: l k interior_cbox disjoint_interval intro!: bexI[of _ i])
   706       }
   707       note \<open>k \<subseteq> cbox a b\<close>
   708     }
   709     moreover
   710     {
   711       fix x assume x: "x \<in> cbox a b"
   712       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)}"
   713       proof
   714         fix i :: 'a
   715         assume "i \<in> Basis"
   716         with x ord[of i]
   717         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>
   718             (d \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> b \<bullet> i)"
   719           by (auto simp: cbox_def)
   720         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)}"
   721           by auto
   722       qed
   723       then obtain f where
   724         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)}"
   725         unfolding bchoice_iff ..
   726       moreover from f have "restrict f Basis \<in> Basis \<rightarrow>\<^sub>E {(a, c), (c, d), (d, b)}"
   727         by auto
   728       moreover from f have "x \<in> ?B (restrict f Basis)"
   729         by (auto simp: mem_box)
   730       ultimately have "\<exists>k\<in>p. x \<in> k"
   731         unfolding p_def by blast
   732     }
   733     ultimately show "\<Union>p = cbox a b"
   734       by auto
   735   qed
   736 qed
   737 
   738 lemma partial_division_extend_interval:
   739   assumes "p division_of (\<Union>p)" "(\<Union>p) \<subseteq> cbox a b"
   740   obtains q where "p \<subseteq> q" "q division_of cbox a (b::'a::euclidean_space)"
   741 proof (cases "p = {}")
   742   case True
   743   obtain q where "q division_of (cbox a b)"
   744     by (rule elementary_interval)
   745   then show ?thesis
   746     using True that by blast
   747 next
   748   case False
   749   note p = division_ofD[OF assms(1)]
   750   have div_cbox: "\<forall>k\<in>p. \<exists>q. q division_of cbox a b \<and> k \<in> q"
   751   proof
   752     fix k
   753     assume kp: "k \<in> p"
   754     obtain c d where k: "k = cbox c d"
   755       using p(4)[OF kp] by blast
   756     have *: "cbox c d \<subseteq> cbox a b" "cbox c d \<noteq> {}"
   757       using p(2,3)[OF kp, unfolded k] using assms(2)
   758       by (blast intro: order.trans)+
   759     obtain q where "q division_of cbox a b" "cbox c d \<in> q"
   760       by (rule partial_division_extend_1[OF *])
   761     then show "\<exists>q. q division_of cbox a b \<and> k \<in> q"
   762       unfolding k by auto
   763   qed
   764   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"
   765     using bchoice[OF div_cbox] by blast
   766   { fix x
   767     assume x: "x \<in> p"
   768     have "q x division_of \<Union>q x"
   769       apply (rule division_ofI)
   770       using division_ofD[OF q(1)[OF x]]
   771       apply auto
   772       done }
   773   then have "\<And>x. x \<in> p \<Longrightarrow> \<exists>d. d division_of \<Union>(q x - {x})"
   774     by (meson Diff_subset division_of_subset)
   775   then have "\<exists>d. d division_of \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p)"
   776     apply -
   777     apply (rule elementary_inters [OF finite_imageI[OF p(1)]])
   778     apply (auto simp: False elementary_inters [OF finite_imageI[OF p(1)]])
   779     done
   780   then obtain d where d: "d division_of \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p)" ..
   781   have "d \<union> p division_of cbox a b"
   782   proof -
   783     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
   784     have cbox_eq: "cbox a b = \<Inter>((\<lambda>i. \<Union>(q i - {i})) ` p) \<union> \<Union>p"
   785     proof (rule te[OF False], clarify)
   786       fix i
   787       assume i: "i \<in> p"
   788       show "\<Union>(q i - {i}) \<union> i = cbox a b"
   789         using division_ofD(6)[OF q(1)[OF i]] using q(2)[OF i] by auto
   790     qed
   791     { fix k
   792       assume k: "k \<in> p"
   793       have *: "\<And>u t s. t \<inter> s = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<inter> t = {}"
   794         by auto
   795       have "interior (\<Inter>i\<in>p. \<Union>(q i - {i})) \<inter> interior k = {}"
   796       proof (rule *[OF inter_interior_unions_intervals])
   797         note qk=division_ofD[OF q(1)[OF k]]
   798         show "finite (q k - {k})" "open (interior k)" "\<forall>t\<in>q k - {k}. \<exists>a b. t = cbox a b"
   799           using qk by auto
   800         show "\<forall>t\<in>q k - {k}. interior k \<inter> interior t = {}"
   801           using qk(5) using q(2)[OF k] by auto
   802         show "interior (\<Inter>i\<in>p. \<Union>(q i - {i})) \<subseteq> interior (\<Union>(q k - {k}))"
   803           apply (rule interior_mono)+
   804           using k
   805           apply auto
   806           done
   807       qed } note [simp] = this
   808     show "d \<union> p division_of (cbox a b)"
   809       unfolding cbox_eq
   810       apply (rule division_disjoint_union[OF d assms(1)])
   811       apply (rule inter_interior_unions_intervals)
   812       apply (rule p open_interior ballI)+
   813       apply simp_all
   814       done
   815   qed
   816   then show ?thesis
   817     by (meson Un_upper2 that)
   818 qed
   819 
   820 lemma elementary_bounded[dest]:
   821   fixes s :: "'a::euclidean_space set"
   822   shows "p division_of s \<Longrightarrow> bounded s"
   823   unfolding division_of_def by (metis bounded_Union bounded_cbox)
   824 
   825 lemma elementary_subset_cbox:
   826   "p division_of s \<Longrightarrow> \<exists>a b. s \<subseteq> cbox a (b::'a::euclidean_space)"
   827   by (meson elementary_bounded bounded_subset_cbox)
   828 
   829 lemma division_union_intervals_exists:
   830   fixes a b :: "'a::euclidean_space"
   831   assumes "cbox a b \<noteq> {}"
   832   obtains p where "(insert (cbox a b) p) division_of (cbox a b \<union> cbox c d)"
   833 proof (cases "cbox c d = {}")
   834   case True
   835   show ?thesis
   836     apply (rule that[of "{}"])
   837     unfolding True
   838     using assms
   839     apply auto
   840     done
   841 next
   842   case False
   843   show ?thesis
   844   proof (cases "cbox a b \<inter> cbox c d = {}")
   845     case True
   846     then show ?thesis
   847       by (metis that False assms division_disjoint_union division_of_self insert_is_Un interior_Int interior_empty)
   848   next
   849     case False
   850     obtain u v where uv: "cbox a b \<inter> cbox c d = cbox u v"
   851       unfolding Int_interval by auto
   852     have uv_sub: "cbox u v \<subseteq> cbox c d" using uv by auto
   853     obtain p where "p division_of cbox c d" "cbox u v \<in> p"
   854       by (rule partial_division_extend_1[OF uv_sub False[unfolded uv]])
   855     note p = this division_ofD[OF this(1)]
   856     have "interior (cbox a b \<inter> \<Union>(p - {cbox u v})) = interior(cbox u v \<inter> \<Union>(p - {cbox u v}))"
   857       apply (rule arg_cong[of _ _ interior])
   858       using p(8) uv by auto
   859     also have "\<dots> = {}"
   860       unfolding interior_Int
   861       apply (rule inter_interior_unions_intervals)
   862       using p(6) p(7)[OF p(2)] p(3)
   863       apply auto
   864       done
   865     finally have [simp]: "interior (cbox a b) \<inter> interior (\<Union>(p - {cbox u v})) = {}" by simp
   866     have cbe: "cbox a b \<union> cbox c d = cbox a b \<union> \<Union>(p - {cbox u v})"
   867       using p(8) unfolding uv[symmetric] by auto
   868     have "insert (cbox a b) (p - {cbox u v}) division_of cbox a b \<union> \<Union>(p - {cbox u v})"
   869     proof -
   870       have "{cbox a b} division_of cbox a b"
   871         by (simp add: assms division_of_self)
   872       then show "insert (cbox a b) (p - {cbox u v}) division_of cbox a b \<union> \<Union>(p - {cbox u v})"
   873         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))
   874     qed
   875     with that[of "p - {cbox u v}"] show ?thesis by (simp add: cbe)
   876   qed
   877 qed
   878 
   879 lemma division_of_unions:
   880   assumes "finite f"
   881     and "\<And>p. p \<in> f \<Longrightarrow> p division_of (\<Union>p)"
   882     and "\<And>k1 k2. k1 \<in> \<Union>f \<Longrightarrow> k2 \<in> \<Union>f \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
   883   shows "\<Union>f division_of \<Union>\<Union>f"
   884   using assms
   885   by (auto intro!: division_ofI)
   886 
   887 lemma elementary_union_interval:
   888   fixes a b :: "'a::euclidean_space"
   889   assumes "p division_of \<Union>p"
   890   obtains q where "q division_of (cbox a b \<union> \<Union>p)"
   891 proof -
   892   note assm = division_ofD[OF assms]
   893   have lem1: "\<And>f s. \<Union>\<Union>(f ` s) = \<Union>((\<lambda>x. \<Union>(f x)) ` s)"
   894     by auto
   895   have lem2: "\<And>f s. f \<noteq> {} \<Longrightarrow> \<Union>{s \<union> t |t. t \<in> f} = s \<union> \<Union>f"
   896     by auto
   897   {
   898     presume "p = {} \<Longrightarrow> thesis"
   899       "cbox a b = {} \<Longrightarrow> thesis"
   900       "cbox a b \<noteq> {} \<Longrightarrow> interior (cbox a b) = {} \<Longrightarrow> thesis"
   901       "p \<noteq> {} \<Longrightarrow> interior (cbox a b)\<noteq>{} \<Longrightarrow> cbox a b \<noteq> {} \<Longrightarrow> thesis"
   902     then show thesis by auto
   903   next
   904     assume as: "p = {}"
   905     obtain p where "p division_of (cbox a b)"
   906       by (rule elementary_interval)
   907     then show thesis
   908       using as that by auto
   909   next
   910     assume as: "cbox a b = {}"
   911     show thesis
   912       using as assms that by auto
   913   next
   914     assume as: "interior (cbox a b) = {}" "cbox a b \<noteq> {}"
   915     show thesis
   916       apply (rule that[of "insert (cbox a b) p"],rule division_ofI)
   917       unfolding finite_insert
   918       apply (rule assm(1)) unfolding Union_insert
   919       using assm(2-4) as
   920       apply -
   921       apply (fast dest: assm(5))+
   922       done
   923   next
   924     assume as: "p \<noteq> {}" "interior (cbox a b) \<noteq> {}" "cbox a b \<noteq> {}"
   925     have "\<forall>k\<in>p. \<exists>q. (insert (cbox a b) q) division_of (cbox a b \<union> k)"
   926     proof
   927       fix k
   928       assume kp: "k \<in> p"
   929       from assm(4)[OF kp] obtain c d where "k = cbox c d" by blast
   930       then show "\<exists>q. (insert (cbox a b) q) division_of (cbox a b \<union> k)"
   931         by (meson as(3) division_union_intervals_exists)
   932     qed
   933     from bchoice[OF this] obtain q where "\<forall>x\<in>p. insert (cbox a b) (q x) division_of (cbox a b) \<union> x" ..
   934     note q = division_ofD[OF this[rule_format]]
   935     let ?D = "\<Union>{insert (cbox a b) (q k) | k. k \<in> p}"
   936     show thesis
   937     proof (rule that[OF division_ofI])
   938       have *: "{insert (cbox a b) (q k) |k. k \<in> p} = (\<lambda>k. insert (cbox a b) (q k)) ` p"
   939         by auto
   940       show "finite ?D"
   941         using "*" assm(1) q(1) by auto
   942       show "\<Union>?D = cbox a b \<union> \<Union>p"
   943         unfolding * lem1
   944         unfolding lem2[OF as(1), of "cbox a b", symmetric]
   945         using q(6)
   946         by auto
   947       fix k
   948       assume k: "k \<in> ?D"
   949       then show "k \<subseteq> cbox a b \<union> \<Union>p"
   950         using q(2) by auto
   951       show "k \<noteq> {}"
   952         using q(3) k by auto
   953       show "\<exists>a b. k = cbox a b"
   954         using q(4) k by auto
   955       fix k'
   956       assume k': "k' \<in> ?D" "k \<noteq> k'"
   957       obtain x where x: "k \<in> insert (cbox a b) (q x)" "x\<in>p"
   958         using k by auto
   959       obtain x' where x': "k'\<in>insert (cbox a b) (q x')" "x'\<in>p"
   960         using k' by auto
   961       show "interior k \<inter> interior k' = {}"
   962       proof (cases "x = x'")
   963         case True
   964         show ?thesis
   965           using True k' q(5) x' x by auto
   966       next
   967         case False
   968         {
   969           presume "k = cbox a b \<Longrightarrow> ?thesis"
   970             and "k' = cbox a b \<Longrightarrow> ?thesis"
   971             and "k \<noteq> cbox a b \<Longrightarrow> k' \<noteq> cbox a b \<Longrightarrow> ?thesis"
   972           then show ?thesis by linarith
   973         next
   974           assume as': "k  = cbox a b"
   975           show ?thesis
   976             using as' k' q(5) x' by blast
   977         next
   978           assume as': "k' = cbox a b"
   979           show ?thesis
   980             using as' k'(2) q(5) x by blast
   981         }
   982         assume as': "k \<noteq> cbox a b" "k' \<noteq> cbox a b"
   983         obtain c d where k: "k = cbox c d"
   984           using q(4)[OF x(2,1)] by blast
   985         have "interior k \<inter> interior (cbox a b) = {}"
   986           using as' k'(2) q(5) x by blast
   987         then have "interior k \<subseteq> interior x"
   988         using interior_subset_union_intervals
   989           by (metis as(2) k q(2) x interior_subset_union_intervals)
   990         moreover
   991         obtain c d where c_d: "k' = cbox c d"
   992           using q(4)[OF x'(2,1)] by blast
   993         have "interior k' \<inter> interior (cbox a b) = {}"
   994           using as'(2) q(5) x' by blast
   995         then have "interior k' \<subseteq> interior x'"
   996           by (metis as(2) c_d interior_subset_union_intervals q(2) x'(1) x'(2))
   997         ultimately show ?thesis
   998           using assm(5)[OF x(2) x'(2) False] by auto
   999       qed
  1000     qed
  1001   }
  1002 qed
  1003 
  1004 lemma elementary_unions_intervals:
  1005   assumes fin: "finite f"
  1006     and "\<And>s. s \<in> f \<Longrightarrow> \<exists>a b. s = cbox a (b::'a::euclidean_space)"
  1007   obtains p where "p division_of (\<Union>f)"
  1008 proof -
  1009   have "\<exists>p. p division_of (\<Union>f)"
  1010   proof (induct_tac f rule:finite_subset_induct)
  1011     show "\<exists>p. p division_of \<Union>{}" using elementary_empty by auto
  1012   next
  1013     fix x F
  1014     assume as: "finite F" "x \<notin> F" "\<exists>p. p division_of \<Union>F" "x\<in>f"
  1015     from this(3) obtain p where p: "p division_of \<Union>F" ..
  1016     from assms(2)[OF as(4)] obtain a b where x: "x = cbox a b" by blast
  1017     have *: "\<Union>F = \<Union>p"
  1018       using division_ofD[OF p] by auto
  1019     show "\<exists>p. p division_of \<Union>insert x F"
  1020       using elementary_union_interval[OF p[unfolded *], of a b]
  1021       unfolding Union_insert x * by metis
  1022   qed (insert assms, auto)
  1023   then show ?thesis
  1024     using that by auto
  1025 qed
  1026 
  1027 lemma elementary_union:
  1028   fixes s t :: "'a::euclidean_space set"
  1029   assumes "ps division_of s" "pt division_of t"
  1030   obtains p where "p division_of (s \<union> t)"
  1031 proof -
  1032   have *: "s \<union> t = \<Union>ps \<union> \<Union>pt"
  1033     using assms unfolding division_of_def by auto
  1034   show ?thesis
  1035     apply (rule elementary_unions_intervals[of "ps \<union> pt"])
  1036     using assms apply auto
  1037     by (simp add: * that)
  1038 qed
  1039 
  1040 lemma partial_division_extend:
  1041   fixes t :: "'a::euclidean_space set"
  1042   assumes "p division_of s"
  1043     and "q division_of t"
  1044     and "s \<subseteq> t"
  1045   obtains r where "p \<subseteq> r" and "r division_of t"
  1046 proof -
  1047   note divp = division_ofD[OF assms(1)] and divq = division_ofD[OF assms(2)]
  1048   obtain a b where ab: "t \<subseteq> cbox a b"
  1049     using elementary_subset_cbox[OF assms(2)] by auto
  1050   obtain r1 where "p \<subseteq> r1" "r1 division_of (cbox a b)"
  1051     using assms
  1052     by (metis ab dual_order.trans partial_division_extend_interval divp(6))
  1053   note r1 = this division_ofD[OF this(2)]
  1054   obtain p' where "p' division_of \<Union>(r1 - p)"
  1055     apply (rule elementary_unions_intervals[of "r1 - p"])
  1056     using r1(3,6)
  1057     apply auto
  1058     done
  1059   then obtain r2 where r2: "r2 division_of (\<Union>(r1 - p)) \<inter> (\<Union>q)"
  1060     by (metis assms(2) divq(6) elementary_inter)
  1061   {
  1062     fix x
  1063     assume x: "x \<in> t" "x \<notin> s"
  1064     then have "x\<in>\<Union>r1"
  1065       unfolding r1 using ab by auto
  1066     then obtain r where r: "r \<in> r1" "x \<in> r"
  1067       unfolding Union_iff ..
  1068     moreover
  1069     have "r \<notin> p"
  1070     proof
  1071       assume "r \<in> p"
  1072       then have "x \<in> s" using divp(2) r by auto
  1073       then show False using x by auto
  1074     qed
  1075     ultimately have "x\<in>\<Union>(r1 - p)" by auto
  1076   }
  1077   then have *: "t = \<Union>p \<union> (\<Union>(r1 - p) \<inter> \<Union>q)"
  1078     unfolding divp divq using assms(3) by auto
  1079   show ?thesis
  1080     apply (rule that[of "p \<union> r2"])
  1081     unfolding *
  1082     defer
  1083     apply (rule division_disjoint_union)
  1084     unfolding divp(6)
  1085     apply(rule assms r2)+
  1086   proof -
  1087     have "interior s \<inter> interior (\<Union>(r1-p)) = {}"
  1088     proof (rule inter_interior_unions_intervals)
  1089       show "finite (r1 - p)" and "open (interior s)" and "\<forall>t\<in>r1-p. \<exists>a b. t = cbox a b"
  1090         using r1 by auto
  1091       have *: "\<And>s. (\<And>x. x \<in> s \<Longrightarrow> False) \<Longrightarrow> s = {}"
  1092         by auto
  1093       show "\<forall>t\<in>r1-p. interior s \<inter> interior t = {}"
  1094       proof
  1095         fix m x
  1096         assume as: "m \<in> r1 - p"
  1097         have "interior m \<inter> interior (\<Union>p) = {}"
  1098         proof (rule inter_interior_unions_intervals)
  1099           show "finite p" and "open (interior m)" and "\<forall>t\<in>p. \<exists>a b. t = cbox a b"
  1100             using divp by auto
  1101           show "\<forall>t\<in>p. interior m \<inter> interior t = {}"
  1102             by (metis DiffD1 DiffD2 as r1(1) r1(7) set_rev_mp)
  1103         qed
  1104         then show "interior s \<inter> interior m = {}"
  1105           unfolding divp by auto
  1106       qed
  1107     qed
  1108     then show "interior s \<inter> interior (\<Union>(r1-p) \<inter> (\<Union>q)) = {}"
  1109       using interior_subset by auto
  1110   qed auto
  1111 qed
  1112 
  1113 lemma division_split_left_inj:
  1114   fixes type :: "'a::euclidean_space"
  1115   assumes "d division_of i"
  1116     and "k1 \<in> d"
  1117     and "k2 \<in> d"
  1118     and "k1 \<noteq> k2"
  1119     and "k1 \<inter> {x::'a. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  1120     and k: "k\<in>Basis"
  1121   shows "content(k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  1122 proof -
  1123   note d=division_ofD[OF assms(1)]
  1124   have *: "\<And>(a::'a) b c. content (cbox a b \<inter> {x. x\<bullet>k \<le> c}) = 0 \<longleftrightarrow>
  1125     interior(cbox a b \<inter> {x. x\<bullet>k \<le> c}) = {}"
  1126     unfolding  interval_split[OF k] content_eq_0_interior by auto
  1127   guess u1 v1 using d(4)[OF assms(2)] by (elim exE) note uv1=this
  1128   guess u2 v2 using d(4)[OF assms(3)] by (elim exE) note uv2=this
  1129   have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
  1130     by auto
  1131   show ?thesis
  1132     unfolding uv1 uv2 *
  1133     apply (rule **[OF d(5)[OF assms(2-4)]])
  1134     apply (simp add: uv1)
  1135     using assms(5) uv1 by auto
  1136 qed
  1137 
  1138 lemma division_split_right_inj:
  1139   fixes type :: "'a::euclidean_space"
  1140   assumes "d division_of i"
  1141     and "k1 \<in> d"
  1142     and "k2 \<in> d"
  1143     and "k1 \<noteq> k2"
  1144     and "k1 \<inter> {x::'a. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}"
  1145     and k: "k \<in> Basis"
  1146   shows "content (k1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
  1147 proof -
  1148   note d=division_ofD[OF assms(1)]
  1149   have *: "\<And>a b::'a. \<And>c. content(cbox a b \<inter> {x. x\<bullet>k \<ge> c}) = 0 \<longleftrightarrow>
  1150     interior(cbox a b \<inter> {x. x\<bullet>k \<ge> c}) = {}"
  1151     unfolding interval_split[OF k] content_eq_0_interior by auto
  1152   guess u1 v1 using d(4)[OF assms(2)] by (elim exE) note uv1=this
  1153   guess u2 v2 using d(4)[OF assms(3)] by (elim exE) note uv2=this
  1154   have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
  1155     by auto
  1156   show ?thesis
  1157     unfolding uv1 uv2 *
  1158     apply (rule **[OF d(5)[OF assms(2-4)]])
  1159     apply (simp add: uv1)
  1160     using assms(5) uv1 by auto
  1161 qed
  1162 
  1163 
  1164 lemma division_split:
  1165   fixes a :: "'a::euclidean_space"
  1166   assumes "p division_of (cbox a b)"
  1167     and k: "k\<in>Basis"
  1168   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})"
  1169       (is "?p1 division_of ?I1")
  1170     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})"
  1171       (is "?p2 division_of ?I2")
  1172 proof (rule_tac[!] division_ofI)
  1173   note p = division_ofD[OF assms(1)]
  1174   show "finite ?p1" "finite ?p2"
  1175     using p(1) by auto
  1176   show "\<Union>?p1 = ?I1" "\<Union>?p2 = ?I2"
  1177     unfolding p(6)[symmetric] by auto
  1178   {
  1179     fix k
  1180     assume "k \<in> ?p1"
  1181     then guess l unfolding mem_Collect_eq by (elim exE conjE) note l=this
  1182     guess u v using p(4)[OF l(2)] by (elim exE) note uv=this
  1183     show "k \<subseteq> ?I1"
  1184       using l p(2) uv by force
  1185     show  "k \<noteq> {}"
  1186       by (simp add: l)
  1187     show  "\<exists>a b. k = cbox a b"
  1188       apply (simp add: l uv p(2-3)[OF l(2)])
  1189       apply (subst interval_split[OF k])
  1190       apply (auto intro: order.trans)
  1191       done
  1192     fix k'
  1193     assume "k' \<in> ?p1"
  1194     then guess l' unfolding mem_Collect_eq by (elim exE conjE) note l'=this
  1195     assume "k \<noteq> k'"
  1196     then show "interior k \<inter> interior k' = {}"
  1197       unfolding l l' using p(5)[OF l(2) l'(2)] by auto
  1198   }
  1199   {
  1200     fix k
  1201     assume "k \<in> ?p2"
  1202     then guess l unfolding mem_Collect_eq by (elim exE conjE) note l=this
  1203     guess u v using p(4)[OF l(2)] by (elim exE) note uv=this
  1204     show "k \<subseteq> ?I2"
  1205       using l p(2) uv by force
  1206     show  "k \<noteq> {}"
  1207       by (simp add: l)
  1208     show  "\<exists>a b. k = cbox a b"
  1209       apply (simp add: l uv p(2-3)[OF l(2)])
  1210       apply (subst interval_split[OF k])
  1211       apply (auto intro: order.trans)
  1212       done
  1213     fix k'
  1214     assume "k' \<in> ?p2"
  1215     then guess l' unfolding mem_Collect_eq by (elim exE conjE) note l'=this
  1216     assume "k \<noteq> k'"
  1217     then show "interior k \<inter> interior k' = {}"
  1218       unfolding l l' using p(5)[OF l(2) l'(2)] by auto
  1219   }
  1220 qed
  1221 
  1222 subsection \<open>Tagged (partial) divisions.\<close>
  1223 
  1224 definition tagged_partial_division_of (infixr "tagged'_partial'_division'_of" 40)
  1225   where "s tagged_partial_division_of i \<longleftrightarrow>
  1226     finite s \<and>
  1227     (\<forall>x k. (x, k) \<in> s \<longrightarrow> x \<in> k \<and> k \<subseteq> i \<and> (\<exists>a b. k = cbox a b)) \<and>
  1228     (\<forall>x1 k1 x2 k2. (x1, k1) \<in> s \<and> (x2, k2) \<in> s \<and> (x1, k1) \<noteq> (x2, k2) \<longrightarrow>
  1229       interior k1 \<inter> interior k2 = {})"
  1230 
  1231 lemma tagged_partial_division_ofD[dest]:
  1232   assumes "s tagged_partial_division_of i"
  1233   shows "finite s"
  1234     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
  1235     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
  1236     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
  1237     and "\<And>x1 k1 x2 k2. (x1,k1) \<in> s \<Longrightarrow>
  1238       (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow> interior k1 \<inter> interior k2 = {}"
  1239   using assms unfolding tagged_partial_division_of_def by blast+
  1240 
  1241 definition tagged_division_of (infixr "tagged'_division'_of" 40)
  1242   where "s tagged_division_of i \<longleftrightarrow> s tagged_partial_division_of i \<and> (\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
  1243 
  1244 lemma tagged_division_of_finite: "s tagged_division_of i \<Longrightarrow> finite s"
  1245   unfolding tagged_division_of_def tagged_partial_division_of_def by auto
  1246 
  1247 lemma tagged_division_of:
  1248   "s tagged_division_of i \<longleftrightarrow>
  1249     finite s \<and>
  1250     (\<forall>x k. (x, k) \<in> s \<longrightarrow> x \<in> k \<and> k \<subseteq> i \<and> (\<exists>a b. k = cbox a b)) \<and>
  1251     (\<forall>x1 k1 x2 k2. (x1, k1) \<in> s \<and> (x2, k2) \<in> s \<and> (x1, k1) \<noteq> (x2, k2) \<longrightarrow>
  1252       interior k1 \<inter> interior k2 = {}) \<and>
  1253     (\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
  1254   unfolding tagged_division_of_def tagged_partial_division_of_def by auto
  1255 
  1256 lemma tagged_division_ofI:
  1257   assumes "finite s"
  1258     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
  1259     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
  1260     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
  1261     and "\<And>x1 k1 x2 k2. (x1,k1) \<in> s \<Longrightarrow> (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow>
  1262       interior k1 \<inter> interior k2 = {}"
  1263     and "(\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
  1264   shows "s tagged_division_of i"
  1265   unfolding tagged_division_of
  1266   using assms
  1267   apply auto
  1268   apply fastforce+
  1269   done
  1270 
  1271 lemma tagged_division_ofD[dest]:  (*FIXME USE A LOCALE*)
  1272   assumes "s tagged_division_of i"
  1273   shows "finite s"
  1274     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> x \<in> k"
  1275     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> i"
  1276     and "\<And>x k. (x,k) \<in> s \<Longrightarrow> \<exists>a b. k = cbox a b"
  1277     and "\<And>x1 k1 x2 k2. (x1, k1) \<in> s \<Longrightarrow> (x2, k2) \<in> s \<Longrightarrow> (x1, k1) \<noteq> (x2, k2) \<Longrightarrow>
  1278       interior k1 \<inter> interior k2 = {}"
  1279     and "(\<Union>{k. \<exists>x. (x,k) \<in> s} = i)"
  1280   using assms unfolding tagged_division_of by blast+
  1281 
  1282 lemma division_of_tagged_division:
  1283   assumes "s tagged_division_of i"
  1284   shows "(snd ` s) division_of i"
  1285 proof (rule division_ofI)
  1286   note assm = tagged_division_ofD[OF assms]
  1287   show "\<Union>(snd ` s) = i" "finite (snd ` s)"
  1288     using assm by auto
  1289   fix k
  1290   assume k: "k \<in> snd ` s"
  1291   then obtain xk where xk: "(xk, k) \<in> s"
  1292     by auto
  1293   then show "k \<subseteq> i" "k \<noteq> {}" "\<exists>a b. k = cbox a b"
  1294     using assm by fastforce+
  1295   fix k'
  1296   assume k': "k' \<in> snd ` s" "k \<noteq> k'"
  1297   from this(1) obtain xk' where xk': "(xk', k') \<in> s"
  1298     by auto
  1299   then show "interior k \<inter> interior k' = {}"
  1300     using assm(5) k'(2) xk by blast
  1301 qed
  1302 
  1303 lemma partial_division_of_tagged_division:
  1304   assumes "s tagged_partial_division_of i"
  1305   shows "(snd ` s) division_of \<Union>(snd ` s)"
  1306 proof (rule division_ofI)
  1307   note assm = tagged_partial_division_ofD[OF assms]
  1308   show "finite (snd ` s)" "\<Union>(snd ` s) = \<Union>(snd ` s)"
  1309     using assm by auto
  1310   fix k
  1311   assume k: "k \<in> snd ` s"
  1312   then obtain xk where xk: "(xk, k) \<in> s"
  1313     by auto
  1314   then show "k \<noteq> {}" "\<exists>a b. k = cbox a b" "k \<subseteq> \<Union>(snd ` s)"
  1315     using assm by auto
  1316   fix k'
  1317   assume k': "k' \<in> snd ` s" "k \<noteq> k'"
  1318   from this(1) obtain xk' where xk': "(xk', k') \<in> s"
  1319     by auto
  1320   then show "interior k \<inter> interior k' = {}"
  1321     using assm(5) k'(2) xk by auto
  1322 qed
  1323 
  1324 lemma tagged_partial_division_subset:
  1325   assumes "s tagged_partial_division_of i"
  1326     and "t \<subseteq> s"
  1327   shows "t tagged_partial_division_of i"
  1328   using assms
  1329   unfolding tagged_partial_division_of_def
  1330   using finite_subset[OF assms(2)]
  1331   by blast
  1332 
  1333 lemma (in comm_monoid_set) over_tagged_division_lemma:
  1334   assumes "p tagged_division_of i"
  1335     and "\<And>u v. cbox u v \<noteq> {} \<Longrightarrow> content (cbox u v) = 0 \<Longrightarrow> d (cbox u v) = \<^bold>1"
  1336   shows "F (\<lambda>(x,k). d k) p = F d (snd ` p)"
  1337 proof -
  1338   have *: "(\<lambda>(x,k). d k) = d \<circ> snd"
  1339     unfolding o_def by (rule ext) auto
  1340   note assm = tagged_division_ofD[OF assms(1)]
  1341   show ?thesis
  1342     unfolding *
  1343   proof (rule reindex_nontrivial[symmetric])
  1344     show "finite p"
  1345       using assm by auto
  1346     fix x y
  1347     assume "x\<in>p" "y\<in>p" "x\<noteq>y" "snd x = snd y"
  1348     obtain a b where ab: "snd x = cbox a b"
  1349       using assm(4)[of "fst x" "snd x"] \<open>x\<in>p\<close> by auto
  1350     have "(fst x, snd y) \<in> p" "(fst x, snd y) \<noteq> y"
  1351       by (metis prod.collapse \<open>x\<in>p\<close> \<open>snd x = snd y\<close> \<open>x \<noteq> y\<close>)+
  1352     with \<open>x\<in>p\<close> \<open>y\<in>p\<close> have "interior (snd x) \<inter> interior (snd y) = {}"
  1353       by (intro assm(5)[of "fst x" _ "fst y"]) auto
  1354     then have "content (cbox a b) = 0"
  1355       unfolding \<open>snd x = snd y\<close>[symmetric] ab content_eq_0_interior by auto
  1356     then have "d (cbox a b) = \<^bold>1"
  1357       using assm(2)[of "fst x" "snd x"] \<open>x\<in>p\<close> ab[symmetric] by (intro assms(2)) auto
  1358     then show "d (snd x) = \<^bold>1"
  1359       unfolding ab by auto
  1360   qed
  1361 qed
  1362 
  1363 lemma tag_in_interval: "p tagged_division_of i \<Longrightarrow> (x, k) \<in> p \<Longrightarrow> x \<in> i"
  1364   by auto
  1365 
  1366 lemma tagged_division_of_empty: "{} tagged_division_of {}"
  1367   unfolding tagged_division_of by auto
  1368 
  1369 lemma tagged_partial_division_of_trivial[simp]: "p tagged_partial_division_of {} \<longleftrightarrow> p = {}"
  1370   unfolding tagged_partial_division_of_def by auto
  1371 
  1372 lemma tagged_division_of_trivial[simp]: "p tagged_division_of {} \<longleftrightarrow> p = {}"
  1373   unfolding tagged_division_of by auto
  1374 
  1375 lemma tagged_division_of_self: "x \<in> cbox a b \<Longrightarrow> {(x,cbox a b)} tagged_division_of (cbox a b)"
  1376   by (rule tagged_division_ofI) auto
  1377 
  1378 lemma tagged_division_of_self_real: "x \<in> {a .. b::real} \<Longrightarrow> {(x,{a .. b})} tagged_division_of {a .. b}"
  1379   unfolding box_real[symmetric]
  1380   by (rule tagged_division_of_self)
  1381 
  1382 lemma tagged_division_union:
  1383   assumes "p1 tagged_division_of s1"
  1384     and "p2 tagged_division_of s2"
  1385     and "interior s1 \<inter> interior s2 = {}"
  1386   shows "(p1 \<union> p2) tagged_division_of (s1 \<union> s2)"
  1387 proof (rule tagged_division_ofI)
  1388   note p1 = tagged_division_ofD[OF assms(1)]
  1389   note p2 = tagged_division_ofD[OF assms(2)]
  1390   show "finite (p1 \<union> p2)"
  1391     using p1(1) p2(1) by auto
  1392   show "\<Union>{k. \<exists>x. (x, k) \<in> p1 \<union> p2} = s1 \<union> s2"
  1393     using p1(6) p2(6) by blast
  1394   fix x k
  1395   assume xk: "(x, k) \<in> p1 \<union> p2"
  1396   show "x \<in> k" "\<exists>a b. k = cbox a b"
  1397     using xk p1(2,4) p2(2,4) by auto
  1398   show "k \<subseteq> s1 \<union> s2"
  1399     using xk p1(3) p2(3) by blast
  1400   fix x' k'
  1401   assume xk': "(x', k') \<in> p1 \<union> p2" "(x, k) \<noteq> (x', k')"
  1402   have *: "\<And>a b. a \<subseteq> s1 \<Longrightarrow> b \<subseteq> s2 \<Longrightarrow> interior a \<inter> interior b = {}"
  1403     using assms(3) interior_mono by blast
  1404   show "interior k \<inter> interior k' = {}"
  1405     apply (cases "(x, k) \<in> p1")
  1406     apply (meson "*" UnE assms(1) assms(2) p1(5) tagged_division_ofD(3) xk'(1) xk'(2))
  1407     by (metis "*" UnE assms(1) assms(2) inf_sup_aci(1) p2(5) tagged_division_ofD(3) xk xk'(1) xk'(2))
  1408 qed
  1409 
  1410 lemma tagged_division_unions:
  1411   assumes "finite iset"
  1412     and "\<forall>i\<in>iset. pfn i tagged_division_of i"
  1413     and "\<forall>i1\<in>iset. \<forall>i2\<in>iset. i1 \<noteq> i2 \<longrightarrow> interior(i1) \<inter> interior(i2) = {}"
  1414   shows "\<Union>(pfn ` iset) tagged_division_of (\<Union>iset)"
  1415 proof (rule tagged_division_ofI)
  1416   note assm = tagged_division_ofD[OF assms(2)[rule_format]]
  1417   show "finite (\<Union>(pfn ` iset))"
  1418     using assms by auto
  1419   have "\<Union>{k. \<exists>x. (x, k) \<in> \<Union>(pfn ` iset)} = \<Union>((\<lambda>i. \<Union>{k. \<exists>x. (x, k) \<in> pfn i}) ` iset)"
  1420     by blast
  1421   also have "\<dots> = \<Union>iset"
  1422     using assm(6) by auto
  1423   finally show "\<Union>{k. \<exists>x. (x, k) \<in> \<Union>(pfn ` iset)} = \<Union>iset" .
  1424   fix x k
  1425   assume xk: "(x, k) \<in> \<Union>(pfn ` iset)"
  1426   then obtain i where i: "i \<in> iset" "(x, k) \<in> pfn i"
  1427     by auto
  1428   show "x \<in> k" "\<exists>a b. k = cbox a b" "k \<subseteq> \<Union>iset"
  1429     using assm(2-4)[OF i] using i(1) by auto
  1430   fix x' k'
  1431   assume xk': "(x', k') \<in> \<Union>(pfn ` iset)" "(x, k) \<noteq> (x', k')"
  1432   then obtain i' where i': "i' \<in> iset" "(x', k') \<in> pfn i'"
  1433     by auto
  1434   have *: "\<And>a b. i \<noteq> i' \<Longrightarrow> a \<subseteq> i \<Longrightarrow> b \<subseteq> i' \<Longrightarrow> interior a \<inter> interior b = {}"
  1435     using i(1) i'(1)
  1436     using assms(3)[rule_format] interior_mono
  1437     by blast
  1438   show "interior k \<inter> interior k' = {}"
  1439     apply (cases "i = i'")
  1440     using assm(5) i' i(2) xk'(2) apply blast
  1441     using "*" assm(3) i' i by auto
  1442 qed
  1443 
  1444 lemma tagged_partial_division_of_union_self:
  1445   assumes "p tagged_partial_division_of s"
  1446   shows "p tagged_division_of (\<Union>(snd ` p))"
  1447   apply (rule tagged_division_ofI)
  1448   using tagged_partial_division_ofD[OF assms]
  1449   apply auto
  1450   done
  1451 
  1452 lemma tagged_division_of_union_self:
  1453   assumes "p tagged_division_of s"
  1454   shows "p tagged_division_of (\<Union>(snd ` p))"
  1455   apply (rule tagged_division_ofI)
  1456   using tagged_division_ofD[OF assms]
  1457   apply auto
  1458   done
  1459 
  1460 subsection \<open>Functions closed on boxes: morphisms from boxes to monoids\<close>
  1461 
  1462 text \<open>This auxiliary structure is used to sum up over the elements of a division. Main theorem is
  1463   @{text operative_division}. Instances for the monoid are @{typ "'a option"}, @{typ real}, and
  1464   @{typ bool}.\<close>
  1465 
  1466 lemma property_empty_interval: "\<forall>a b. content (cbox a b) = 0 \<longrightarrow> P (cbox a b) \<Longrightarrow> P {}"
  1467   using content_empty unfolding empty_as_interval by auto
  1468 
  1469 paragraph \<open>Using additivity of lifted function to encode definedness.\<close>
  1470 
  1471 definition lift_option :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a option \<Rightarrow> 'b option \<Rightarrow> 'c option"
  1472 where
  1473   "lift_option f a' b' = Option.bind a' (\<lambda>a. Option.bind b' (\<lambda>b. Some (f a b)))"
  1474 
  1475 lemma lift_option_simps[simp]:
  1476   "lift_option f (Some a) (Some b) = Some (f a b)"
  1477   "lift_option f None b' = None"
  1478   "lift_option f a' None = None"
  1479   by (auto simp: lift_option_def)
  1480 
  1481 lemma comm_monoid_lift_option:
  1482   assumes "comm_monoid f z"
  1483   shows "comm_monoid (lift_option f) (Some z)"
  1484 proof -
  1485   from assms interpret comm_monoid f z .
  1486   show ?thesis
  1487     by standard (auto simp: lift_option_def ac_simps split: bind_split)
  1488 qed
  1489 
  1490 lemma comm_monoid_and: "comm_monoid HOL.conj True"
  1491   by standard auto
  1492 
  1493 lemma comm_monoid_set_and: "comm_monoid_set HOL.conj True"
  1494   by (rule comm_monoid_set.intro) (fact comm_monoid_and)
  1495 
  1496 paragraph \<open>Operative\<close>
  1497 
  1498 definition (in comm_monoid) operative :: "('b::euclidean_space set \<Rightarrow> 'a) \<Rightarrow> bool"
  1499   where "operative g \<longleftrightarrow>
  1500     (\<forall>a b. content (cbox a b) = 0 \<longrightarrow> g (cbox a b) = \<^bold>1) \<and>
  1501     (\<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}))"
  1502 
  1503 lemma (in comm_monoid) operativeD[dest]:
  1504   assumes "operative g"
  1505   shows "\<And>a b. content (cbox a b) = 0 \<Longrightarrow> g (cbox a b) = \<^bold>1"
  1506     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})"
  1507   using assms unfolding operative_def by auto
  1508 
  1509 lemma (in comm_monoid) operative_empty: "operative g \<Longrightarrow> g {} = \<^bold>1"
  1510   unfolding operative_def by (rule property_empty_interval) auto
  1511 
  1512 lemma operative_content[intro]: "add.operative content"
  1513   by (force simp add: add.operative_def content_split[symmetric])
  1514 
  1515 definition "division_points (k::('a::euclidean_space) set) d =
  1516    {(j,x). j \<in> Basis \<and> (interval_lowerbound k)\<bullet>j < x \<and> x < (interval_upperbound k)\<bullet>j \<and>
  1517      (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  1518 
  1519 lemma division_points_finite:
  1520   fixes i :: "'a::euclidean_space set"
  1521   assumes "d division_of i"
  1522   shows "finite (division_points i d)"
  1523 proof -
  1524   note assm = division_ofD[OF assms]
  1525   let ?M = "\<lambda>j. {(j,x)|x. (interval_lowerbound i)\<bullet>j < x \<and> x < (interval_upperbound i)\<bullet>j \<and>
  1526     (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  1527   have *: "division_points i d = \<Union>(?M ` Basis)"
  1528     unfolding division_points_def by auto
  1529   show ?thesis
  1530     unfolding * using assm by auto
  1531 qed
  1532 
  1533 lemma division_points_subset:
  1534   fixes a :: "'a::euclidean_space"
  1535   assumes "d division_of (cbox a b)"
  1536     and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  1537     and k: "k \<in> Basis"
  1538   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>
  1539       division_points (cbox a b) d" (is ?t1)
  1540     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>
  1541       division_points (cbox a b) d" (is ?t2)
  1542 proof -
  1543   note assm = division_ofD[OF assms(1)]
  1544   have *: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  1545     "\<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"
  1546     "\<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"
  1547     "min (b \<bullet> k) c = c" "max (a \<bullet> k) c = c"
  1548     using assms using less_imp_le by auto
  1549   show ?t1 (*FIXME a horrible mess*)
  1550     unfolding division_points_def interval_split[OF k, of a b]
  1551     unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  1552     unfolding *
  1553     apply (rule subsetI)
  1554     unfolding mem_Collect_eq split_beta
  1555     apply (erule bexE conjE)+
  1556     apply (simp add: )
  1557     apply (erule exE conjE)+
  1558   proof
  1559     fix i l x
  1560     assume as:
  1561       "a \<bullet> fst x < snd x" "snd x < (if fst x = k then c else b \<bullet> fst x)"
  1562       "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  1563       "i = l \<inter> {x. x \<bullet> k \<le> c}" "l \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
  1564       and fstx: "fst x \<in> Basis"
  1565     from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this
  1566     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"
  1567       using as(6) unfolding l interval_split[OF k] box_ne_empty as .
  1568     have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
  1569       using l using as(6) unfolding box_ne_empty[symmetric] by auto
  1570     show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  1571       apply (rule bexI[OF _ \<open>l \<in> d\<close>])
  1572       using as(1-3,5) fstx
  1573       unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  1574       apply (auto split: if_split_asm)
  1575       done
  1576     show "snd x < b \<bullet> fst x"
  1577       using as(2) \<open>c < b\<bullet>k\<close> by (auto split: if_split_asm)
  1578   qed
  1579   show ?t2
  1580     unfolding division_points_def interval_split[OF k, of a b]
  1581     unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  1582     unfolding *
  1583     unfolding subset_eq
  1584     apply rule
  1585     unfolding mem_Collect_eq split_beta
  1586     apply (erule bexE conjE)+
  1587     apply (simp only: mem_Collect_eq inner_setsum_left_Basis simp_thms)
  1588     apply (erule exE conjE)+
  1589   proof
  1590     fix i l x
  1591     assume as:
  1592       "(if fst x = k then c else a \<bullet> fst x) < snd x" "snd x < b \<bullet> fst x"
  1593       "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  1594       "i = l \<inter> {x. c \<le> x \<bullet> k}" "l \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} \<noteq> {}"
  1595       and fstx: "fst x \<in> Basis"
  1596     from assm(4)[OF this(5)] guess u v by (elim exE) note l=this
  1597     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"
  1598       using as(6) unfolding l interval_split[OF k] box_ne_empty as .
  1599     have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
  1600       using l using as(6) unfolding box_ne_empty[symmetric] by auto
  1601     show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  1602       apply (rule bexI[OF _ \<open>l \<in> d\<close>])
  1603       using as(1-3,5) fstx
  1604       unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  1605       apply (auto split: if_split_asm)
  1606       done
  1607     show "a \<bullet> fst x < snd x"
  1608       using as(1) \<open>a\<bullet>k < c\<close> by (auto split: if_split_asm)
  1609    qed
  1610 qed
  1611 
  1612 lemma division_points_psubset:
  1613   fixes a :: "'a::euclidean_space"
  1614   assumes "d division_of (cbox a b)"
  1615       and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  1616       and "l \<in> d"
  1617       and "interval_lowerbound l\<bullet>k = c \<or> interval_upperbound l\<bullet>k = c"
  1618       and k: "k \<in> Basis"
  1619   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>
  1620          division_points (cbox a b) d" (is "?D1 \<subset> ?D")
  1621     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>
  1622          division_points (cbox a b) d" (is "?D2 \<subset> ?D")
  1623 proof -
  1624   have ab: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  1625     using assms(2) by (auto intro!:less_imp_le)
  1626   guess u v using division_ofD(4)[OF assms(1,5)] by (elim exE) note l=this
  1627   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"
  1628     using division_ofD(2,2,3)[OF assms(1,5)] unfolding l box_ne_empty
  1629     using subset_box(1)
  1630     apply auto
  1631     apply blast+
  1632     done
  1633   have *: "interval_upperbound (cbox a b \<inter> {x. x \<bullet> k \<le> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  1634           "interval_upperbound (cbox a b \<inter> {x. x \<bullet> k \<le> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  1635     unfolding l interval_split[OF k] interval_bounds[OF uv(1)]
  1636     using uv[rule_format, of k] ab k
  1637     by auto
  1638   have "\<exists>x. x \<in> ?D - ?D1"
  1639     using assms(3-)
  1640     unfolding division_points_def interval_bounds[OF ab]
  1641     apply -
  1642     apply (erule disjE)
  1643     apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI, force simp add: *)
  1644     apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI, force simp add: *)
  1645     done
  1646   moreover have "?D1 \<subseteq> ?D"
  1647     by (auto simp add: assms division_points_subset)
  1648   ultimately show "?D1 \<subset> ?D"
  1649     by blast
  1650   have *: "interval_lowerbound (cbox a b \<inter> {x. x \<bullet> k \<ge> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  1651     "interval_lowerbound (cbox a b \<inter> {x. x \<bullet> k \<ge> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  1652     unfolding l interval_split[OF k] interval_bounds[OF uv(1)]
  1653     using uv[rule_format, of k] ab k
  1654     by auto
  1655   have "\<exists>x. x \<in> ?D - ?D2"
  1656     using assms(3-)
  1657     unfolding division_points_def interval_bounds[OF ab]
  1658     apply -
  1659     apply (erule disjE)
  1660     apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI, force simp add: *)
  1661     apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI, force simp add: *)
  1662     done
  1663   moreover have "?D2 \<subseteq> ?D"
  1664     by (auto simp add: assms division_points_subset)
  1665   ultimately show "?D2 \<subset> ?D"
  1666     by blast
  1667 qed
  1668 
  1669 lemma (in comm_monoid_set) operative_division:
  1670   fixes g :: "'b::euclidean_space set \<Rightarrow> 'a"
  1671   assumes g: "operative g" and d: "d division_of (cbox a b)" shows "F g d = g (cbox a b)"
  1672 proof -
  1673   define C where [abs_def]: "C = card (division_points (cbox a b) d)"
  1674   then show ?thesis
  1675     using d
  1676   proof (induction C arbitrary: a b d rule: less_induct)
  1677     case (less a b d)
  1678     show ?case
  1679     proof cases
  1680       show "content (cbox a b) = 0 \<Longrightarrow> F g d = g (cbox a b)"
  1681         using division_of_content_0[OF _ less.prems] operativeD(1)[OF  g] division_ofD(4)[OF less.prems]
  1682         by (fastforce intro!: neutral)
  1683     next
  1684       assume "content (cbox a b) \<noteq> 0"
  1685       note ab = this[unfolded content_lt_nz[symmetric] content_pos_lt_eq]
  1686       then have ab': "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  1687         by (auto intro!: less_imp_le)
  1688       show "F g d = g (cbox a b)"
  1689       proof (cases "division_points (cbox a b) d = {}")
  1690         case True
  1691         { fix u v and j :: 'b
  1692           assume j: "j \<in> Basis" and as: "cbox u v \<in> d"
  1693           then have "cbox u v \<noteq> {}"
  1694             using less.prems by blast
  1695           then have uv: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "u\<bullet>j \<le> v\<bullet>j"
  1696             using j unfolding box_ne_empty by auto
  1697           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)"
  1698             using as j by auto
  1699           have "(j, u\<bullet>j) \<notin> division_points (cbox a b) d"
  1700                "(j, v\<bullet>j) \<notin> division_points (cbox a b) d" using True by auto
  1701           note this[unfolded de_Morgan_conj division_points_def mem_Collect_eq split_conv interval_bounds[OF ab'] bex_simps]
  1702           note *[OF this(1)] *[OF this(2)] note this[unfolded interval_bounds[OF uv(1)]]
  1703           moreover
  1704           have "a\<bullet>j \<le> u\<bullet>j" "v\<bullet>j \<le> b\<bullet>j"
  1705             using division_ofD(2,2,3)[OF \<open>d division_of cbox a b\<close> as]
  1706             apply (metis j subset_box(1) uv(1))
  1707             by (metis \<open>cbox u v \<subseteq> cbox a b\<close> j subset_box(1) uv(1))
  1708           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"
  1709             unfolding not_less de_Morgan_disj using ab[rule_format,of j] uv(2) j by force }
  1710         then have d': "\<forall>i\<in>d. \<exists>u v. i = cbox u v \<and>
  1711           (\<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)"
  1712           unfolding forall_in_division[OF less.prems] by blast
  1713         have "(1/2) *\<^sub>R (a+b) \<in> cbox a b"
  1714           unfolding mem_box using ab by(auto intro!: less_imp_le simp: inner_simps)
  1715         note this[unfolded division_ofD(6)[OF \<open>d division_of cbox a b\<close>,symmetric] Union_iff]
  1716         then guess i .. note i=this
  1717         guess u v using d'[rule_format,OF i(1)] by (elim exE conjE) note uv=this
  1718         have "cbox a b \<in> d"
  1719         proof -
  1720           have "u = a" "v = b"
  1721             unfolding euclidean_eq_iff[where 'a='b]
  1722           proof safe
  1723             fix j :: 'b
  1724             assume j: "j \<in> Basis"
  1725             note i(2)[unfolded uv mem_box,rule_format,of j]
  1726             then show "u \<bullet> j = a \<bullet> j" and "v \<bullet> j = b \<bullet> j"
  1727               using uv(2)[rule_format,of j] j by (auto simp: inner_simps)
  1728           qed
  1729           then have "i = cbox a b" using uv by auto
  1730           then show ?thesis using i by auto
  1731         qed
  1732         then have deq: "d = insert (cbox a b) (d - {cbox a b})"
  1733           by auto
  1734         have "F g (d - {cbox a b}) = \<^bold>1"
  1735         proof (intro neutral ballI)
  1736           fix x
  1737           assume x: "x \<in> d - {cbox a b}"
  1738           then have "x\<in>d"
  1739             by auto note d'[rule_format,OF this]
  1740           then guess u v by (elim exE conjE) note uv=this
  1741           have "u \<noteq> a \<or> v \<noteq> b"
  1742             using x[unfolded uv] by auto
  1743           then obtain j where "u\<bullet>j \<noteq> a\<bullet>j \<or> v\<bullet>j \<noteq> b\<bullet>j" and j: "j \<in> Basis"
  1744             unfolding euclidean_eq_iff[where 'a='b] by auto
  1745           then have "u\<bullet>j = v\<bullet>j"
  1746             using uv(2)[rule_format,OF j] by auto
  1747           then have "content (cbox u v) = 0"
  1748             unfolding content_eq_0 using j
  1749             by force
  1750           then show "g x = \<^bold>1"
  1751             unfolding uv(1) by (rule operativeD(1)[OF g])
  1752         qed
  1753         then show "F g d = g (cbox a b)"
  1754           using division_ofD[OF less.prems]
  1755           apply (subst deq)
  1756           apply (subst insert)
  1757           apply auto
  1758           done
  1759       next
  1760         case False
  1761         then have "\<exists>x. x \<in> division_points (cbox a b) d"
  1762           by auto
  1763         then guess k c
  1764           unfolding split_paired_Ex division_points_def mem_Collect_eq split_conv
  1765           apply (elim exE conjE)
  1766           done
  1767         note this(2-4,1) note kc=this[unfolded interval_bounds[OF ab']]
  1768         from this(3) guess j .. note j=this
  1769         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> {}}"
  1770         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> {}}"
  1771         define cb where "cb = (\<Sum>i\<in>Basis. (if i = k then c else b\<bullet>i) *\<^sub>R i)"
  1772         define ca where "ca = (\<Sum>i\<in>Basis. (if i = k then c else a\<bullet>i) *\<^sub>R i)"
  1773         note division_points_psubset[OF \<open>d division_of cbox a b\<close> ab kc(1-2) j]
  1774         note psubset_card_mono[OF _ this(1)] psubset_card_mono[OF _ this(2)]
  1775         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})"
  1776           unfolding interval_split[OF kc(4)]
  1777           apply (rule_tac[!] "less.hyps"[rule_format])
  1778           using division_split[OF \<open>d division_of cbox a b\<close>, where k=k and c=c]
  1779           apply (simp_all add: interval_split kc d1_def d2_def division_points_finite[OF \<open>d division_of cbox a b\<close>])
  1780           done
  1781         { fix l y
  1782           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"
  1783           from division_ofD(4)[OF \<open>d division_of cbox a b\<close> this(1)] guess u v by (elim exE) note leq=this
  1784           have "g (l \<inter> {x. x \<bullet> k \<le> c}) = \<^bold>1"
  1785             unfolding leq interval_split[OF kc(4)]
  1786             apply (rule operativeD[OF g])
  1787             unfolding interval_split[symmetric, OF kc(4)]
  1788             using division_split_left_inj less as kc leq by blast
  1789         } note fxk_le = this
  1790         { fix l y
  1791           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"
  1792           from division_ofD(4)[OF \<open>d division_of cbox a b\<close> this(1)] guess u v by (elim exE) note leq=this
  1793           have "g (l \<inter> {x. x \<bullet> k \<ge> c}) = \<^bold>1"
  1794             unfolding leq interval_split[OF kc(4)]
  1795             apply (rule operativeD(1)[OF g])
  1796             unfolding interval_split[symmetric,OF kc(4)]
  1797             using division_split_right_inj less leq as kc by blast
  1798         } note fxk_ge = this
  1799         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> {}}"
  1800           using d1_def by auto
  1801         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> {}}"
  1802           using d2_def by auto
  1803         have "g (cbox a b) = F g d1 \<^bold>* F g d2" (is "_ = ?prev")
  1804           unfolding * using g kc(4) by blast
  1805         also have "F g d1 = F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<le> c})) d"
  1806           unfolding d1_alt using division_of_finite[OF less.prems] fxk_le
  1807           by (subst reindex_nontrivial) (auto intro!: mono_neutral_cong_left simp: operative_empty[OF g])
  1808         also have "F g d2 = F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<ge> c})) d"
  1809           unfolding d2_alt using division_of_finite[OF less.prems] fxk_ge
  1810           by (subst reindex_nontrivial) (auto intro!: mono_neutral_cong_left simp: operative_empty[OF g])
  1811         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})"
  1812           unfolding forall_in_division[OF \<open>d division_of cbox a b\<close>]
  1813           using g kc(4) by blast
  1814         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"
  1815           using * by (simp add: distrib)
  1816         finally show ?thesis by auto
  1817       qed
  1818     qed
  1819   qed
  1820 qed
  1821 
  1822 lemma (in comm_monoid_set) operative_tagged_division:
  1823   assumes f: "operative g" and d: "d tagged_division_of (cbox a b)"
  1824   shows "F (\<lambda>(x, l). g l) d = g (cbox a b)"
  1825   unfolding d[THEN division_of_tagged_division, THEN operative_division[OF f], symmetric]
  1826   by (simp add: f[THEN operativeD(1)] over_tagged_division_lemma[OF d])
  1827 
  1828 lemma additive_content_division: "d division_of (cbox a b) \<Longrightarrow> setsum content d = content (cbox a b)"
  1829   by (metis operative_content setsum.operative_division)
  1830 
  1831 lemma additive_content_tagged_division:
  1832   "d tagged_division_of (cbox a b) \<Longrightarrow> setsum (\<lambda>(x,l). content l) d = content (cbox a b)"
  1833   unfolding setsum.operative_tagged_division[OF operative_content, symmetric] by blast
  1834 
  1835 lemma content_real_eq_0: "content {a .. b::real} = 0 \<longleftrightarrow> a \<ge> b"
  1836   by (metis atLeastatMost_empty_iff2 content_empty content_real diff_self eq_iff le_cases le_iff_diff_le_0)
  1837 
  1838 lemma interval_real_split:
  1839   "{a .. b::real} \<inter> {x. x \<le> c} = {a .. min b c}"
  1840   "{a .. b} \<inter> {x. c \<le> x} = {max a c .. b}"
  1841   apply (metis Int_atLeastAtMostL1 atMost_def)
  1842   apply (metis Int_atLeastAtMostL2 atLeast_def)
  1843   done
  1844 
  1845 lemma (in comm_monoid) operative_1_lt:
  1846   "operative (g :: real set \<Rightarrow> 'a) \<longleftrightarrow>
  1847     ((\<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}))"
  1848   apply (simp add: operative_def content_real_eq_0 atMost_def[symmetric] atLeast_def[symmetric]
  1849               del: content_real_if)
  1850 proof safe
  1851   fix a b c :: real
  1852   assume *: "\<forall>a b c. g {a..b} = g {a..min b c} \<^bold>* g {max a c..b}"
  1853   assume "a < c" "c < b"
  1854   with *[rule_format, of a b c] show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1855     by (simp add: less_imp_le min.absorb2 max.absorb2)
  1856 next
  1857   fix a b c :: real
  1858   assume as: "\<forall>a b. b \<le> a \<longrightarrow> g {a..b} = \<^bold>1"
  1859     "\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1860   from as(1)[rule_format, of 0 1] as(1)[rule_format, of a a for a] as(2)
  1861   have [simp]: "g {} = \<^bold>1" "\<And>a. g {a} = \<^bold>1"
  1862     "\<And>a b c. a < c \<Longrightarrow> c < b \<Longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1863     by auto
  1864   show "g {a..b} = g {a..min b c} \<^bold>* g {max a c..b}"
  1865     by (auto simp: min_def max_def le_less)
  1866 qed
  1867 
  1868 lemma (in comm_monoid) operative_1_le:
  1869   "operative (g :: real set \<Rightarrow> 'a) \<longleftrightarrow>
  1870     ((\<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}))"
  1871   unfolding operative_1_lt
  1872 proof safe
  1873   fix a b c :: real
  1874   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"
  1875   show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1876     apply (rule as(1)[rule_format])
  1877     using as(2-)
  1878     apply auto
  1879     done
  1880 next
  1881   fix a b c :: real
  1882   assume "\<forall>a b. b \<le> a \<longrightarrow> g {a .. b} = \<^bold>1"
  1883     and "\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1884     and "a \<le> c"
  1885     and "c \<le> b"
  1886   note as = this[rule_format]
  1887   show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1888   proof (cases "c = a \<or> c = b")
  1889     case False
  1890     then show ?thesis
  1891       apply -
  1892       apply (subst as(2))
  1893       using as(3-)
  1894       apply auto
  1895       done
  1896   next
  1897     case True
  1898     then show ?thesis
  1899     proof
  1900       assume *: "c = a"
  1901       then have "g {a .. c} = \<^bold>1"
  1902         apply -
  1903         apply (rule as(1)[rule_format])
  1904         apply auto
  1905         done
  1906       then show ?thesis
  1907         unfolding * by auto
  1908     next
  1909       assume *: "c = b"
  1910       then have "g {c .. b} = \<^bold>1"
  1911         apply -
  1912         apply (rule as(1)[rule_format])
  1913         apply auto
  1914         done
  1915       then show ?thesis
  1916         unfolding * by auto
  1917     qed
  1918   qed
  1919 qed
  1920 
  1921 subsection \<open>Fine-ness of a partition w.r.t. a gauge.\<close>
  1922 
  1923 definition fine  (infixr "fine" 46)
  1924   where "d fine s \<longleftrightarrow> (\<forall>(x,k) \<in> s. k \<subseteq> d x)"
  1925 
  1926 lemma fineI:
  1927   assumes "\<And>x k. (x, k) \<in> s \<Longrightarrow> k \<subseteq> d x"
  1928   shows "d fine s"
  1929   using assms unfolding fine_def by auto
  1930 
  1931 lemma fineD[dest]:
  1932   assumes "d fine s"
  1933   shows "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> d x"
  1934   using assms unfolding fine_def by auto
  1935 
  1936 lemma fine_inter: "(\<lambda>x. d1 x \<inter> d2 x) fine p \<longleftrightarrow> d1 fine p \<and> d2 fine p"
  1937   unfolding fine_def by auto
  1938 
  1939 lemma fine_inters:
  1940  "(\<lambda>x. \<Inter>{f d x | d.  d \<in> s}) fine p \<longleftrightarrow> (\<forall>d\<in>s. (f d) fine p)"
  1941   unfolding fine_def by blast
  1942 
  1943 lemma fine_union: "d fine p1 \<Longrightarrow> d fine p2 \<Longrightarrow> d fine (p1 \<union> p2)"
  1944   unfolding fine_def by blast
  1945 
  1946 lemma fine_unions: "(\<And>p. p \<in> ps \<Longrightarrow> d fine p) \<Longrightarrow> d fine (\<Union>ps)"
  1947   unfolding fine_def by auto
  1948 
  1949 lemma fine_subset: "p \<subseteq> q \<Longrightarrow> d fine q \<Longrightarrow> d fine p"
  1950   unfolding fine_def by blast
  1951 
  1952 subsection \<open>Some basic combining lemmas.\<close>
  1953 
  1954 lemma tagged_division_unions_exists:
  1955   assumes "finite iset"
  1956     and "\<forall>i\<in>iset. \<exists>p. p tagged_division_of i \<and> d fine p"
  1957     and "\<forall>i1\<in>iset. \<forall>i2\<in>iset. i1 \<noteq> i2 \<longrightarrow> interior i1 \<inter> interior i2 = {}"
  1958     and "\<Union>iset = i"
  1959    obtains p where "p tagged_division_of i" and "d fine p"
  1960 proof -
  1961   obtain pfn where pfn:
  1962     "\<And>x. x \<in> iset \<Longrightarrow> pfn x tagged_division_of x"
  1963     "\<And>x. x \<in> iset \<Longrightarrow> d fine pfn x"
  1964     using bchoice[OF assms(2)] by auto
  1965   show thesis
  1966     apply (rule_tac p="\<Union>(pfn ` iset)" in that)
  1967     using assms(1) assms(3) assms(4) pfn(1) tagged_division_unions apply force
  1968     by (metis (mono_tags, lifting) fine_unions imageE pfn(2))
  1969 qed
  1970 
  1971 
  1972 subsection \<open>The set we're concerned with must be closed.\<close>
  1973 
  1974 lemma division_of_closed:
  1975   fixes i :: "'n::euclidean_space set"
  1976   shows "s division_of i \<Longrightarrow> closed i"
  1977   unfolding division_of_def by fastforce
  1978 
  1979 subsection \<open>General bisection principle for intervals; might be useful elsewhere.\<close>
  1980 
  1981 lemma interval_bisection_step:
  1982   fixes type :: "'a::euclidean_space"
  1983   assumes "P {}"
  1984     and "\<forall>s t. P s \<and> P t \<and> interior(s) \<inter> interior(t) = {} \<longrightarrow> P (s \<union> t)"
  1985     and "\<not> P (cbox a (b::'a))"
  1986   obtains c d where "\<not> P (cbox c d)"
  1987     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"
  1988 proof -
  1989   have "cbox a b \<noteq> {}"
  1990     using assms(1,3) by metis
  1991   then have ab: "\<And>i. i\<in>Basis \<Longrightarrow> a \<bullet> i \<le> b \<bullet> i"
  1992     by (force simp: mem_box)
  1993   { fix f
  1994     have "\<lbrakk>finite f;
  1995            \<And>s. s\<in>f \<Longrightarrow> P s;
  1996            \<And>s. s\<in>f \<Longrightarrow> \<exists>a b. s = cbox a b;
  1997            \<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)"
  1998     proof (induct f rule: finite_induct)
  1999       case empty
  2000       show ?case
  2001         using assms(1) by auto
  2002     next
  2003       case (insert x f)
  2004       show ?case
  2005         unfolding Union_insert
  2006         apply (rule assms(2)[rule_format])
  2007         using inter_interior_unions_intervals [of f "interior x"]
  2008         apply (auto simp: insert)
  2009         by (metis IntI empty_iff insert.hyps(2) insert.prems(3) insert_iff)
  2010     qed
  2011   } note UN_cases = this
  2012   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>
  2013     (c\<bullet>i = (a\<bullet>i + b\<bullet>i) / 2) \<and> (d\<bullet>i = b\<bullet>i)}"
  2014   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"
  2015   {
  2016     presume "\<forall>c d. ?PP c d \<longrightarrow> P (cbox c d) \<Longrightarrow> False"
  2017     then show thesis
  2018       unfolding atomize_not not_all
  2019       by (blast intro: that)
  2020   }
  2021   assume as: "\<forall>c d. ?PP c d \<longrightarrow> P (cbox c d)"
  2022   have "P (\<Union>?A)"
  2023   proof (rule UN_cases)
  2024     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)
  2025       (\<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}"
  2026     have "?A \<subseteq> ?B"
  2027     proof
  2028       fix x
  2029       assume "x \<in> ?A"
  2030       then obtain c d
  2031         where x:  "x = cbox c d"
  2032                   "\<And>i. i \<in> Basis \<Longrightarrow>
  2033                         c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  2034                         c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i" by blast
  2035       show "x \<in> ?B"
  2036         unfolding image_iff x
  2037         apply (rule_tac x="{i. i\<in>Basis \<and> c\<bullet>i = a\<bullet>i}" in bexI)
  2038         apply (rule arg_cong2 [where f = cbox])
  2039         using x(2) ab
  2040         apply (auto simp add: euclidean_eq_iff[where 'a='a])
  2041         by fastforce
  2042     qed
  2043     then show "finite ?A"
  2044       by (rule finite_subset) auto
  2045   next
  2046     fix s
  2047     assume "s \<in> ?A"
  2048     then obtain c d
  2049       where s: "s = cbox c d"
  2050                "\<And>i. i \<in> Basis \<Longrightarrow>
  2051                      c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  2052                      c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i"
  2053       by blast
  2054     show "P s"
  2055       unfolding s
  2056       apply (rule as[rule_format])
  2057       using ab s(2) by force
  2058     show "\<exists>a b. s = cbox a b"
  2059       unfolding s by auto
  2060     fix t
  2061     assume "t \<in> ?A"
  2062     then obtain e f where t:
  2063       "t = cbox e f"
  2064       "\<And>i. i \<in> Basis \<Longrightarrow>
  2065         e \<bullet> i = a \<bullet> i \<and> f \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  2066         e \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> f \<bullet> i = b \<bullet> i"
  2067       by blast
  2068     assume "s \<noteq> t"
  2069     then have "\<not> (c = e \<and> d = f)"
  2070       unfolding s t by auto
  2071     then obtain i where "c\<bullet>i \<noteq> e\<bullet>i \<or> d\<bullet>i \<noteq> f\<bullet>i" and i': "i \<in> Basis"
  2072       unfolding euclidean_eq_iff[where 'a='a] by auto
  2073     then have i: "c\<bullet>i \<noteq> e\<bullet>i" "d\<bullet>i \<noteq> f\<bullet>i"
  2074       using s(2) t(2) apply fastforce
  2075       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
  2076     have *: "\<And>s t. (\<And>a. a \<in> s \<Longrightarrow> a \<in> t \<Longrightarrow> False) \<Longrightarrow> s \<inter> t = {}"
  2077       by auto
  2078     show "interior s \<inter> interior t = {}"
  2079       unfolding s t interior_cbox
  2080     proof (rule *)
  2081       fix x
  2082       assume "x \<in> box c d" "x \<in> box e f"
  2083       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"
  2084         unfolding mem_box using i'
  2085         by force+
  2086       show False  using s(2)[OF i']
  2087       proof safe
  2088         assume as: "c \<bullet> i = a \<bullet> i" "d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2"
  2089         show False
  2090           using t(2)[OF i'] and i x unfolding as by (fastforce simp add:field_simps)
  2091       next
  2092         assume as: "c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2" "d \<bullet> i = b \<bullet> i"
  2093         show False
  2094           using t(2)[OF i'] and i x unfolding as by(fastforce simp add:field_simps)
  2095       qed
  2096     qed
  2097   qed
  2098   also have "\<Union>?A = cbox a b"
  2099   proof (rule set_eqI,rule)
  2100     fix x
  2101     assume "x \<in> \<Union>?A"
  2102     then obtain c d where x:
  2103       "x \<in> cbox c d"
  2104       "\<And>i. i \<in> Basis \<Longrightarrow>
  2105         c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  2106         c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i"
  2107       by blast
  2108     show "x\<in>cbox a b"
  2109       unfolding mem_box
  2110     proof safe
  2111       fix i :: 'a
  2112       assume i: "i \<in> Basis"
  2113       then show "a \<bullet> i \<le> x \<bullet> i" "x \<bullet> i \<le> b \<bullet> i"
  2114         using x(2)[OF i] x(1)[unfolded mem_box,THEN bspec, OF i] by auto
  2115     qed
  2116   next
  2117     fix x
  2118     assume x: "x \<in> cbox a b"
  2119     have "\<forall>i\<in>Basis.
  2120       \<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"
  2121       (is "\<forall>i\<in>Basis. \<exists>c d. ?P i c d")
  2122       unfolding mem_box
  2123     proof
  2124       fix i :: 'a
  2125       assume i: "i \<in> Basis"
  2126       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)"
  2127         using x[unfolded mem_box,THEN bspec, OF i] by auto
  2128       then show "\<exists>c d. ?P i c d"
  2129         by blast
  2130     qed
  2131     then show "x\<in>\<Union>?A"
  2132       unfolding Union_iff Bex_def mem_Collect_eq choice_Basis_iff
  2133       apply auto
  2134       apply (rule_tac x="cbox xa xaa" in exI)
  2135       unfolding mem_box
  2136       apply auto
  2137       done
  2138   qed
  2139   finally show False
  2140     using assms by auto
  2141 qed
  2142 
  2143 lemma interval_bisection:
  2144   fixes type :: "'a::euclidean_space"
  2145   assumes "P {}"
  2146     and "(\<forall>s t. P s \<and> P t \<and> interior(s) \<inter> interior(t) = {} \<longrightarrow> P(s \<union> t))"
  2147     and "\<not> P (cbox a (b::'a))"
  2148   obtains x where "x \<in> cbox a b"
  2149     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)"
  2150 proof -
  2151   have "\<forall>x. \<exists>y. \<not> P (cbox (fst x) (snd x)) \<longrightarrow> (\<not> P (cbox (fst y) (snd y)) \<and>
  2152     (\<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>
  2153        2 * (snd y\<bullet>i - fst y\<bullet>i) \<le> snd x\<bullet>i - fst x\<bullet>i))" (is "\<forall>x. ?P x")
  2154   proof
  2155     show "?P x" for x
  2156     proof (cases "P (cbox (fst x) (snd x))")
  2157       case True
  2158       then show ?thesis by auto
  2159     next
  2160       case as: False
  2161       obtain c d where "\<not> P (cbox c d)"
  2162         "\<forall>i\<in>Basis.
  2163            fst x \<bullet> i \<le> c \<bullet> i \<and>
  2164            c \<bullet> i \<le> d \<bullet> i \<and>
  2165            d \<bullet> i \<le> snd x \<bullet> i \<and>
  2166            2 * (d \<bullet> i - c \<bullet> i) \<le> snd x \<bullet> i - fst x \<bullet> i"
  2167         by (rule interval_bisection_step[of P, OF assms(1-2) as])
  2168       then show ?thesis
  2169         apply -
  2170         apply (rule_tac x="(c,d)" in exI)
  2171         apply auto
  2172         done
  2173     qed
  2174   qed
  2175   then obtain f where f:
  2176     "\<forall>x.
  2177       \<not> P (cbox (fst x) (snd x)) \<longrightarrow>
  2178       \<not> P (cbox (fst (f x)) (snd (f x))) \<and>
  2179         (\<forall>i\<in>Basis.
  2180             fst x \<bullet> i \<le> fst (f x) \<bullet> i \<and>
  2181             fst (f x) \<bullet> i \<le> snd (f x) \<bullet> i \<and>
  2182             snd (f x) \<bullet> i \<le> snd x \<bullet> i \<and>
  2183             2 * (snd (f x) \<bullet> i - fst (f x) \<bullet> i) \<le> snd x \<bullet> i - fst x \<bullet> i)"
  2184     apply -
  2185     apply (drule choice)
  2186     apply blast
  2187     done
  2188   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
  2189   have "A 0 = a" "B 0 = b" "\<And>n. \<not> P (cbox (A(Suc n)) (B(Suc n))) \<and>
  2190     (\<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>
  2191     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")
  2192   proof -
  2193     show "A 0 = a" "B 0 = b"
  2194       unfolding ab_def by auto
  2195     note S = ab_def funpow.simps o_def id_apply
  2196     show "?P n" for n
  2197     proof (induct n)
  2198       case 0
  2199       then show ?case
  2200         unfolding S
  2201         apply (rule f[rule_format]) using assms(3)
  2202         apply auto
  2203         done
  2204     next
  2205       case (Suc n)
  2206       show ?case
  2207         unfolding S
  2208         apply (rule f[rule_format])
  2209         using Suc
  2210         unfolding S
  2211         apply auto
  2212         done
  2213     qed
  2214   qed
  2215   note AB = this(1-2) conjunctD2[OF this(3),rule_format]
  2216 
  2217   have interv: "\<exists>n. \<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e"
  2218     if e: "0 < e" for e
  2219   proof -
  2220     obtain n where n: "(\<Sum>i\<in>Basis. b \<bullet> i - a \<bullet> i) / e < 2 ^ n"
  2221       using real_arch_pow[of 2 "(setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis) / e"] by auto
  2222     show ?thesis
  2223     proof (rule exI [where x=n], clarify)
  2224       fix x y
  2225       assume xy: "x\<in>cbox (A n) (B n)" "y\<in>cbox (A n) (B n)"
  2226       have "dist x y \<le> setsum (\<lambda>i. \<bar>(x - y)\<bullet>i\<bar>) Basis"
  2227         unfolding dist_norm by(rule norm_le_l1)
  2228       also have "\<dots> \<le> setsum (\<lambda>i. B n\<bullet>i - A n\<bullet>i) Basis"
  2229       proof (rule setsum_mono)
  2230         fix i :: 'a
  2231         assume i: "i \<in> Basis"
  2232         show "\<bar>(x - y) \<bullet> i\<bar> \<le> B n \<bullet> i - A n \<bullet> i"
  2233           using xy[unfolded mem_box,THEN bspec, OF i]
  2234           by (auto simp: inner_diff_left)
  2235       qed
  2236       also have "\<dots> \<le> setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis / 2^n"
  2237         unfolding setsum_divide_distrib
  2238       proof (rule setsum_mono)
  2239         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
  2240         proof (induct n)
  2241           case 0
  2242           then show ?case
  2243             unfolding AB by auto
  2244         next
  2245           case (Suc n)
  2246           have "B (Suc n) \<bullet> i - A (Suc n) \<bullet> i \<le> (B n \<bullet> i - A n \<bullet> i) / 2"
  2247             using AB(4)[of i n] using i by auto
  2248           also have "\<dots> \<le> (b \<bullet> i - a \<bullet> i) / 2 ^ Suc n"
  2249             using Suc by (auto simp add: field_simps)
  2250           finally show ?case .
  2251         qed
  2252       qed
  2253       also have "\<dots> < e"
  2254         using n using e by (auto simp add: field_simps)
  2255       finally show "dist x y < e" .
  2256     qed
  2257   qed
  2258   {
  2259     fix n m :: nat
  2260     assume "m \<le> n" then have "cbox (A n) (B n) \<subseteq> cbox (A m) (B m)"
  2261     proof (induction rule: inc_induct)
  2262       case (step i)
  2263       show ?case
  2264         using AB(4) by (intro order_trans[OF step.IH] subset_box_imp) auto
  2265     qed simp
  2266   } note ABsubset = this
  2267   have "\<exists>a. \<forall>n. a\<in> cbox (A n) (B n)"
  2268     by (rule decreasing_closed_nest[rule_format,OF closed_cbox _ ABsubset interv])
  2269       (metis nat.exhaust AB(1-3) assms(1,3))
  2270   then obtain x0 where x0: "\<And>n. x0 \<in> cbox (A n) (B n)"
  2271     by blast
  2272   show thesis
  2273   proof (rule that[rule_format, of x0])
  2274     show "x0\<in>cbox a b"
  2275       using x0[of 0] unfolding AB .
  2276     fix e :: real
  2277     assume "e > 0"
  2278     from interv[OF this] obtain n
  2279       where n: "\<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e" ..
  2280     have "\<not> P (cbox (A n) (B n))"
  2281       apply (cases "0 < n")
  2282       using AB(3)[of "n - 1"] assms(3) AB(1-2)
  2283       apply auto
  2284       done
  2285     moreover have "cbox (A n) (B n) \<subseteq> ball x0 e"
  2286       using n using x0[of n] by auto
  2287     moreover have "cbox (A n) (B n) \<subseteq> cbox a b"
  2288       unfolding AB(1-2)[symmetric] by (rule ABsubset) auto
  2289     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)"
  2290       apply (rule_tac x="A n" in exI)
  2291       apply (rule_tac x="B n" in exI)
  2292       apply (auto simp: x0)
  2293       done
  2294   qed
  2295 qed
  2296 
  2297 
  2298 subsection \<open>Cousin's lemma.\<close>
  2299 
  2300 lemma fine_division_exists:
  2301   fixes a b :: "'a::euclidean_space"
  2302   assumes "gauge g"
  2303   obtains p where "p tagged_division_of (cbox a b)" "g fine p"
  2304 proof -
  2305   presume "\<not> (\<exists>p. p tagged_division_of (cbox a b) \<and> g fine p) \<Longrightarrow> False"
  2306   then obtain p where "p tagged_division_of (cbox a b)" "g fine p"
  2307     by blast
  2308   then show thesis ..
  2309 next
  2310   assume as: "\<not> (\<exists>p. p tagged_division_of (cbox a b) \<and> g fine p)"
  2311   obtain x where x:
  2312       "x \<in> (cbox a b)"
  2313       "\<And>e. 0 < e \<Longrightarrow>
  2314         \<exists>c d.
  2315           x \<in> cbox c d \<and>
  2316           cbox c d \<subseteq> ball x e \<and>
  2317           cbox c d \<subseteq> (cbox a b) \<and>
  2318           \<not> (\<exists>p. p tagged_division_of cbox c d \<and> g fine p)"
  2319     apply (rule interval_bisection[of "\<lambda>s. \<exists>p. p tagged_division_of s \<and> g fine p", OF _ _ as])
  2320     apply (simp add: fine_def)
  2321     apply (metis tagged_division_union fine_union)
  2322     apply (auto simp: )
  2323     done
  2324   obtain e where e: "e > 0" "ball x e \<subseteq> g x"
  2325     using gaugeD[OF assms, of x] unfolding open_contains_ball by auto
  2326   from x(2)[OF e(1)]
  2327   obtain c d where c_d: "x \<in> cbox c d"
  2328                         "cbox c d \<subseteq> ball x e"
  2329                         "cbox c d \<subseteq> cbox a b"
  2330                         "\<not> (\<exists>p. p tagged_division_of cbox c d \<and> g fine p)"
  2331     by blast
  2332   have "g fine {(x, cbox c d)}"
  2333     unfolding fine_def using e using c_d(2) by auto
  2334   then show False
  2335     using tagged_division_of_self[OF c_d(1)] using c_d by auto
  2336 qed
  2337 
  2338 lemma fine_division_exists_real:
  2339   fixes a b :: real
  2340   assumes "gauge g"
  2341   obtains p where "p tagged_division_of {a .. b}" "g fine p"
  2342   by (metis assms box_real(2) fine_division_exists)
  2343 
  2344 subsection \<open>Division filter\<close>
  2345 
  2346 text \<open>Divisions over all gauges towards finer divisions.\<close>
  2347 
  2348 definition division_filter :: "'a::euclidean_space set \<Rightarrow> ('a \<times> 'a set) set filter"
  2349   where "division_filter s = (INF g:{g. gauge g}. principal {p. p tagged_division_of s \<and> g fine p})"
  2350 
  2351 lemma eventually_division_filter:
  2352   "(\<forall>\<^sub>F p in division_filter s. P p) \<longleftrightarrow>
  2353     (\<exists>g. gauge g \<and> (\<forall>p. p tagged_division_of s \<and> g fine p \<longrightarrow> P p))"
  2354   unfolding division_filter_def
  2355 proof (subst eventually_INF_base; clarsimp)
  2356   fix g1 g2 :: "'a \<Rightarrow> 'a set" show "gauge g1 \<Longrightarrow> gauge g2 \<Longrightarrow> \<exists>x. gauge x \<and>
  2357     {p. p tagged_division_of s \<and> x fine p} \<subseteq> {p. p tagged_division_of s \<and> g1 fine p} \<and>
  2358     {p. p tagged_division_of s \<and> x fine p} \<subseteq> {p. p tagged_division_of s \<and> g2 fine p}"
  2359     by (intro exI[of _ "\<lambda>x. g1 x \<inter> g2 x"]) (auto simp: fine_inter)
  2360 qed (auto simp: eventually_principal)
  2361 
  2362 lemma division_filter_not_empty: "division_filter (cbox a b) \<noteq> bot"
  2363   unfolding trivial_limit_def eventually_division_filter
  2364   by (auto elim: fine_division_exists)
  2365 
  2366 lemma eventually_division_filter_tagged_division:
  2367   "eventually (\<lambda>p. p tagged_division_of s) (division_filter s)"
  2368   unfolding eventually_division_filter by (intro exI[of _ "\<lambda>x. ball x 1"]) auto
  2369 
  2370 subsection \<open>Gauge integral\<close>
  2371 
  2372 text \<open>Case distinction to define it first on compact intervals first, then use a limit. This is only
  2373 much later unified. In Fremlin: Measure Theory, Volume 4I this is generalized using residual sets.\<close>
  2374 
  2375 definition has_integral :: "('n::euclidean_space \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'b \<Rightarrow> 'n set \<Rightarrow> bool"
  2376   (infixr "has'_integral" 46)
  2377   where "(f has_integral I) s \<longleftrightarrow>
  2378     (if \<exists>a b. s = cbox a b
  2379       then ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R f x) \<longlongrightarrow> I) (division_filter s)
  2380       else (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  2381         (\<exists>z. ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R (if x \<in> s then f x else 0)) \<longlongrightarrow> z) (division_filter (cbox a b)) \<and>
  2382           norm (z - I) < e)))"
  2383 
  2384 lemma has_integral_cbox:
  2385   "(f has_integral I) (cbox a b) \<longleftrightarrow> ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R f x) \<longlongrightarrow> I) (division_filter (cbox a b))"
  2386   by (auto simp add: has_integral_def)
  2387 
  2388 lemma has_integral:
  2389   "(f has_integral y) (cbox a b) \<longleftrightarrow>
  2390     (\<forall>e>0. \<exists>d. gauge d \<and>
  2391       (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  2392         norm (setsum (\<lambda>(x,k). content(k) *\<^sub>R f x) p - y) < e))"
  2393   by (auto simp: dist_norm eventually_division_filter has_integral_def tendsto_iff)
  2394 
  2395 lemma has_integral_real:
  2396   "(f has_integral y) {a .. b::real} \<longleftrightarrow>
  2397     (\<forall>e>0. \<exists>d. gauge d \<and>
  2398       (\<forall>p. p tagged_division_of {a .. b} \<and> d fine p \<longrightarrow>
  2399         norm (setsum (\<lambda>(x,k). content(k) *\<^sub>R f x) p - y) < e))"
  2400   unfolding box_real[symmetric]
  2401   by (rule has_integral)
  2402 
  2403 lemma has_integralD[dest]:
  2404   assumes "(f has_integral y) (cbox a b)"
  2405     and "e > 0"
  2406   obtains d
  2407     where "gauge d"
  2408       and "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> d fine p \<Longrightarrow>
  2409         norm ((\<Sum>(x,k)\<in>p. content k *\<^sub>R f x) - y) < e"
  2410   using assms unfolding has_integral by auto
  2411 
  2412 lemma has_integral_alt:
  2413   "(f has_integral y) i \<longleftrightarrow>
  2414     (if \<exists>a b. i = cbox a b
  2415      then (f has_integral y) i
  2416      else (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  2417       (\<exists>z. ((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b) \<and> norm (z - y) < e)))"
  2418   by (subst has_integral_def) (auto simp add: has_integral_cbox)
  2419 
  2420 lemma has_integral_altD:
  2421   assumes "(f has_integral y) i"
  2422     and "\<not> (\<exists>a b. i = cbox a b)"
  2423     and "e>0"
  2424   obtains B where "B > 0"
  2425     and "\<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  2426       (\<exists>z. ((\<lambda>x. if x \<in> i then f(x) else 0) has_integral z) (cbox a b) \<and> norm(z - y) < e)"
  2427   using assms has_integral_alt[of f y i] by auto
  2428 
  2429 definition integrable_on (infixr "integrable'_on" 46)
  2430   where "f integrable_on i \<longleftrightarrow> (\<exists>y. (f has_integral y) i)"
  2431 
  2432 definition "integral i f = (SOME y. (f has_integral y) i \<or> ~ f integrable_on i \<and> y=0)"
  2433 
  2434 lemma integrable_integral[dest]: "f integrable_on i \<Longrightarrow> (f has_integral (integral i f)) i"
  2435   unfolding integrable_on_def integral_def by (metis (mono_tags, lifting) someI_ex)
  2436 
  2437 lemma not_integrable_integral: "~ f integrable_on i \<Longrightarrow> integral i f = 0"
  2438   unfolding integrable_on_def integral_def by blast
  2439 
  2440 lemma has_integral_integrable[intro]: "(f has_integral i) s \<Longrightarrow> f integrable_on s"
  2441   unfolding integrable_on_def by auto
  2442 
  2443 lemma has_integral_integral: "f integrable_on s \<longleftrightarrow> (f has_integral (integral s f)) s"
  2444   by auto
  2445 
  2446 lemma setsum_content_null:
  2447   assumes "content (cbox a b) = 0"
  2448     and "p tagged_division_of (cbox a b)"
  2449   shows "setsum (\<lambda>(x,k). content k *\<^sub>R f x) p = (0::'a::real_normed_vector)"
  2450 proof (rule setsum.neutral, rule)
  2451   fix y
  2452   assume y: "y \<in> p"
  2453   obtain x k where xk: "y = (x, k)"
  2454     using surj_pair[of y] by blast
  2455   note assm = tagged_division_ofD(3-4)[OF assms(2) y[unfolded xk]]
  2456   from this(2) obtain c d where k: "k = cbox c d" by blast
  2457   have "(\<lambda>(x, k). content k *\<^sub>R f x) y = content k *\<^sub>R f x"
  2458     unfolding xk by auto
  2459   also have "\<dots> = 0"
  2460     using content_subset[OF assm(1)[unfolded k]] content_pos_le[of c d]
  2461     unfolding assms(1) k
  2462     by auto
  2463   finally show "(\<lambda>(x, k). content k *\<^sub>R f x) y = 0" .
  2464 qed
  2465 
  2466 subsection \<open>Basic theorems about integrals.\<close>
  2467 
  2468 lemma has_integral_unique:
  2469   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  2470   assumes "(f has_integral k1) i"
  2471     and "(f has_integral k2) i"
  2472   shows "k1 = k2"
  2473 proof (rule ccontr)
  2474   let ?e = "norm (k1 - k2) / 2"
  2475   assume as: "k1 \<noteq> k2"
  2476   then have e: "?e > 0"
  2477     by auto
  2478   have lem: "(f has_integral k1) (cbox a b) \<Longrightarrow> (f has_integral k2) (cbox a b) \<Longrightarrow> k1 = k2"
  2479     for f :: "'n \<Rightarrow> 'a" and a b k1 k2
  2480     by (auto simp: has_integral_cbox intro: tendsto_unique[OF division_filter_not_empty])
  2481   {
  2482     presume "\<not> (\<exists>a b. i = cbox a b) \<Longrightarrow> False"
  2483     then show False
  2484       using as assms lem by blast
  2485   }
  2486   assume as: "\<not> (\<exists>a b. i = cbox a b)"
  2487   obtain B1 where B1:
  2488       "0 < B1"
  2489       "\<And>a b. ball 0 B1 \<subseteq> cbox a b \<Longrightarrow>
  2490         \<exists>z. ((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b) \<and>
  2491           norm (z - k1) < norm (k1 - k2) / 2"
  2492     by (rule has_integral_altD[OF assms(1) as,OF e]) blast
  2493   obtain B2 where B2:
  2494       "0 < B2"
  2495       "\<And>a b. ball 0 B2 \<subseteq> cbox a b \<Longrightarrow>
  2496         \<exists>z. ((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b) \<and>
  2497           norm (z - k2) < norm (k1 - k2) / 2"
  2498     by (rule has_integral_altD[OF assms(2) as,OF e]) blast
  2499   have "\<exists>a b::'n. ball 0 B1 \<union> ball 0 B2 \<subseteq> cbox a b"
  2500     apply (rule bounded_subset_cbox)
  2501     using bounded_Un bounded_ball
  2502     apply auto
  2503     done
  2504   then obtain a b :: 'n where ab: "ball 0 B1 \<subseteq> cbox a b" "ball 0 B2 \<subseteq> cbox a b"
  2505     by blast
  2506   obtain w where w:
  2507     "((\<lambda>x. if x \<in> i then f x else 0) has_integral w) (cbox a b)"
  2508     "norm (w - k1) < norm (k1 - k2) / 2"
  2509     using B1(2)[OF ab(1)] by blast
  2510   obtain z where z:
  2511     "((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b)"
  2512     "norm (z - k2) < norm (k1 - k2) / 2"
  2513     using B2(2)[OF ab(2)] by blast
  2514   have "z = w"
  2515     using lem[OF w(1) z(1)] by auto
  2516   then have "norm (k1 - k2) \<le> norm (z - k2) + norm (w - k1)"
  2517     using norm_triangle_ineq4 [of "k1 - w" "k2 - z"]
  2518     by (auto simp add: norm_minus_commute)
  2519   also have "\<dots> < norm (k1 - k2) / 2 + norm (k1 - k2) / 2"
  2520     apply (rule add_strict_mono)
  2521     apply (rule_tac[!] z(2) w(2))
  2522     done
  2523   finally show False by auto
  2524 qed
  2525 
  2526 lemma integral_unique [intro]: "(f has_integral y) k \<Longrightarrow> integral k f = y"
  2527   unfolding integral_def
  2528   by (rule some_equality) (auto intro: has_integral_unique)
  2529 
  2530 lemma eq_integralD: "integral k f = y \<Longrightarrow> (f has_integral y) k \<or> ~ f integrable_on k \<and> y=0"
  2531   unfolding integral_def integrable_on_def
  2532   apply (erule subst)
  2533   apply (rule someI_ex)
  2534   by blast
  2535 
  2536 
  2537 lemma has_integral_const [intro]:
  2538   fixes a b :: "'a::euclidean_space"
  2539   shows "((\<lambda>x. c) has_integral (content (cbox a b) *\<^sub>R c)) (cbox a b)"
  2540   using eventually_division_filter_tagged_division[of "cbox a b"]
  2541      additive_content_tagged_division[of _ a b]
  2542   by (auto simp: has_integral_cbox split_beta' scaleR_setsum_left[symmetric]
  2543            elim!: eventually_mono intro!: tendsto_cong[THEN iffD1, OF _ tendsto_const])
  2544 
  2545 lemma has_integral_const_real [intro]:
  2546   fixes a b :: real
  2547   shows "((\<lambda>x. c) has_integral (content {a .. b} *\<^sub>R c)) {a .. b}"
  2548   by (metis box_real(2) has_integral_const)
  2549 
  2550 lemma integral_const [simp]:
  2551   fixes a b :: "'a::euclidean_space"
  2552   shows "integral (cbox a b) (\<lambda>x. c) = content (cbox a b) *\<^sub>R c"
  2553   by (rule integral_unique) (rule has_integral_const)
  2554 
  2555 lemma integral_const_real [simp]:
  2556   fixes a b :: real
  2557   shows "integral {a .. b} (\<lambda>x. c) = content {a .. b} *\<^sub>R c"
  2558   by (metis box_real(2) integral_const)
  2559 
  2560 lemma has_integral_is_0:
  2561   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  2562   assumes "\<forall>x\<in>s. f x = 0"
  2563   shows "(f has_integral 0) s"
  2564 proof -
  2565   have lem: "(\<forall>x\<in>cbox a b. f x = 0) \<Longrightarrow> (f has_integral 0) (cbox a b)" for a  b and f :: "'n \<Rightarrow> 'a"
  2566     unfolding has_integral_cbox
  2567     using eventually_division_filter_tagged_division[of "cbox a b"]
  2568     by (subst tendsto_cong[where g="\<lambda>_. 0"])
  2569        (auto elim!: eventually_mono intro!: setsum.neutral simp: tag_in_interval)
  2570   {
  2571     presume "\<not> (\<exists>a b. s = cbox a b) \<Longrightarrow> ?thesis"
  2572     with assms lem show ?thesis
  2573       by blast
  2574   }
  2575   have *: "(\<lambda>x. if x \<in> s then f x else 0) = (\<lambda>x. 0)"
  2576     apply (rule ext)
  2577     using assms
  2578     apply auto
  2579     done
  2580   assume "\<not> (\<exists>a b. s = cbox a b)"
  2581   then show ?thesis
  2582     using lem
  2583     by (subst has_integral_alt) (force simp add: *)
  2584 qed
  2585 
  2586 lemma has_integral_0[simp]: "((\<lambda>x::'n::euclidean_space. 0) has_integral 0) s"
  2587   by (rule has_integral_is_0) auto
  2588 
  2589 lemma has_integral_0_eq[simp]: "((\<lambda>x. 0) has_integral i) s \<longleftrightarrow> i = 0"
  2590   using has_integral_unique[OF has_integral_0] by auto
  2591 
  2592 lemma has_integral_linear:
  2593   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  2594   assumes "(f has_integral y) s"
  2595     and "bounded_linear h"
  2596   shows "((h \<circ> f) has_integral ((h y))) s"
  2597 proof -
  2598   interpret bounded_linear h
  2599     using assms(2) .
  2600   from pos_bounded obtain B where B: "0 < B" "\<And>x. norm (h x) \<le> norm x * B"
  2601     by blast
  2602   have lem: "\<And>a b y f::'n\<Rightarrow>'a. (f has_integral y) (cbox a b) \<Longrightarrow> ((h \<circ> f) has_integral h y) (cbox a b)"
  2603     unfolding has_integral_cbox by (drule tendsto) (simp add: setsum scaleR split_beta')
  2604   {
  2605     presume "\<not> (\<exists>a b. s = cbox a b) \<Longrightarrow> ?thesis"
  2606     then show ?thesis
  2607       using assms(1) lem by blast
  2608   }
  2609   assume as: "\<not> (\<exists>a b. s = cbox a b)"
  2610   then show ?thesis
  2611   proof (subst has_integral_alt, clarsimp)
  2612     fix e :: real
  2613     assume e: "e > 0"
  2614     have *: "0 < e/B" using e B(1) by simp
  2615     obtain M where M:
  2616       "M > 0"
  2617       "\<And>a b. ball 0 M \<subseteq> cbox a b \<Longrightarrow>
  2618         \<exists>z. ((\<lambda>x. if x \<in> s then f x else 0) has_integral z) (cbox a b) \<and> norm (z - y) < e / B"
  2619       using has_integral_altD[OF assms(1) as *] by blast
  2620     show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  2621       (\<exists>z. ((\<lambda>x. if x \<in> s then (h \<circ> f) x else 0) has_integral z) (cbox a b) \<and> norm (z - h y) < e)"
  2622     proof (rule_tac x=M in exI, clarsimp simp add: M, goal_cases)
  2623       case prems: (1 a b)
  2624       obtain z where z:
  2625         "((\<lambda>x. if x \<in> s then f x else 0) has_integral z) (cbox a b)"
  2626         "norm (z - y) < e / B"
  2627         using M(2)[OF prems(1)] by blast
  2628       have *: "(\<lambda>x. if x \<in> s then (h \<circ> f) x else 0) = h \<circ> (\<lambda>x. if x \<in> s then f x else 0)"
  2629         using zero by auto
  2630       show ?case
  2631         apply (rule_tac x="h z" in exI)
  2632         apply (simp add: * lem[OF z(1)])
  2633         apply (metis B diff le_less_trans pos_less_divide_eq z(2))
  2634         done
  2635     qed
  2636   qed
  2637 qed
  2638 
  2639 lemma has_integral_scaleR_left:
  2640   "(f has_integral y) s \<Longrightarrow> ((\<lambda>x. f x *\<^sub>R c) has_integral (y *\<^sub>R c)) s"
  2641   using has_integral_linear[OF _ bounded_linear_scaleR_left] by (simp add: comp_def)
  2642 
  2643 lemma has_integral_mult_left:
  2644   fixes c :: "_ :: real_normed_algebra"
  2645   shows "(f has_integral y) s \<Longrightarrow> ((\<lambda>x. f x * c) has_integral (y * c)) s"
  2646   using has_integral_linear[OF _ bounded_linear_mult_left] by (simp add: comp_def)
  2647 
  2648 text\<open>The case analysis eliminates the condition @{term "f integrable_on s"} at the cost
  2649      of the type class constraint \<open>division_ring\<close>\<close>
  2650 corollary integral_mult_left [simp]:
  2651   fixes c:: "'a::{real_normed_algebra,division_ring}"
  2652   shows "integral s (\<lambda>x. f x * c) = integral s f * c"
  2653 proof (cases "f integrable_on s \<or> c = 0")
  2654   case True then show ?thesis
  2655     by (force intro: has_integral_mult_left)
  2656 next
  2657   case False then have "~ (\<lambda>x. f x * c) integrable_on s"
  2658     using has_integral_mult_left [of "(\<lambda>x. f x * c)" _ s "inverse c"]
  2659     by (force simp add: mult.assoc)
  2660   with False show ?thesis by (simp add: not_integrable_integral)
  2661 qed
  2662 
  2663 corollary integral_mult_right [simp]:
  2664   fixes c:: "'a::{real_normed_field}"
  2665   shows "integral s (\<lambda>x. c * f x) = c * integral s f"
  2666 by (simp add: mult.commute [of c])
  2667 
  2668 corollary integral_divide [simp]:
  2669   fixes z :: "'a::real_normed_field"
  2670   shows "integral S (\<lambda>x. f x / z) = integral S (\<lambda>x. f x) / z"
  2671 using integral_mult_left [of S f "inverse z"]
  2672   by (simp add: divide_inverse_commute)
  2673 
  2674 lemma has_integral_mult_right:
  2675   fixes c :: "'a :: real_normed_algebra"
  2676   shows "(f has_integral y) i \<Longrightarrow> ((\<lambda>x. c * f x) has_integral (c * y)) i"
  2677   using has_integral_linear[OF _ bounded_linear_mult_right] by (simp add: comp_def)
  2678 
  2679 lemma has_integral_cmul: "(f has_integral k) s \<Longrightarrow> ((\<lambda>x. c *\<^sub>R f x) has_integral (c *\<^sub>R k)) s"
  2680   unfolding o_def[symmetric]
  2681   by (metis has_integral_linear bounded_linear_scaleR_right)
  2682 
  2683 lemma has_integral_cmult_real:
  2684   fixes c :: real
  2685   assumes "c \<noteq> 0 \<Longrightarrow> (f has_integral x) A"
  2686   shows "((\<lambda>x. c * f x) has_integral c * x) A"
  2687 proof (cases "c = 0")
  2688   case True
  2689   then show ?thesis by simp
  2690 next
  2691   case False
  2692   from has_integral_cmul[OF assms[OF this], of c] show ?thesis
  2693     unfolding real_scaleR_def .
  2694 qed
  2695 
  2696 lemma has_integral_neg: "(f has_integral k) s \<Longrightarrow> ((\<lambda>x. -(f x)) has_integral -k) s"
  2697   by (drule_tac c="-1" in has_integral_cmul) auto
  2698 
  2699 lemma has_integral_add:
  2700   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  2701   assumes "(f has_integral k) s"
  2702     and "(g has_integral l) s"
  2703   shows "((\<lambda>x. f x + g x) has_integral (k + l)) s"
  2704 proof -
  2705   have lem: "(f has_integral k) (cbox a b) \<Longrightarrow> (g has_integral l) (cbox a b) \<Longrightarrow>
  2706     ((\<lambda>x. f x + g x) has_integral (k + l)) (cbox a b)"
  2707     for f :: "'n \<Rightarrow> 'a" and g a b k l
  2708     unfolding has_integral_cbox
  2709     by (simp add: split_beta' scaleR_add_right setsum.distrib[abs_def] tendsto_add)
  2710   {
  2711     presume "\<not> (\<exists>a b. s = cbox a b) \<Longrightarrow> ?thesis"
  2712     then show ?thesis
  2713       using assms lem by force
  2714   }
  2715   assume as: "\<not> (\<exists>a b. s = cbox a b)"
  2716   then show ?thesis
  2717   proof (subst has_integral_alt, clarsimp, goal_cases)
  2718     case (1 e)
  2719     then have *: "e / 2 > 0"
  2720       by auto
  2721     from has_integral_altD[OF assms(1) as *]
  2722     obtain B1 where B1:
  2723         "0 < B1"
  2724         "\<And>a b. ball 0 B1 \<subseteq> cbox a b \<Longrightarrow>
  2725           \<exists>z. ((\<lambda>x. if x \<in> s then f x else 0) has_integral z) (cbox a b) \<and> norm (z - k) < e / 2"
  2726       by blast
  2727     from has_integral_altD[OF assms(2) as *]
  2728     obtain B2 where B2:
  2729         "0 < B2"
  2730         "\<And>a b. ball 0 B2 \<subseteq> (cbox a b) \<Longrightarrow>
  2731           \<exists>z. ((\<lambda>x. if x \<in> s then g x else 0) has_integral z) (cbox a b) \<and> norm (z - l) < e / 2"
  2732       by blast
  2733     show ?case
  2734     proof (rule_tac x="max B1 B2" in exI, clarsimp simp add: max.strict_coboundedI1 B1)
  2735       fix a b
  2736       assume "ball 0 (max B1 B2) \<subseteq> cbox a (b::'n)"
  2737       then have *: "ball 0 B1 \<subseteq> cbox a (b::'n)" "ball 0 B2 \<subseteq> cbox a (b::'n)"
  2738         by auto
  2739       obtain w where w:
  2740         "((\<lambda>x. if x \<in> s then f x else 0) has_integral w) (cbox a b)"
  2741         "norm (w - k) < e / 2"
  2742         using B1(2)[OF *(1)] by blast
  2743       obtain z where z:
  2744         "((\<lambda>x. if x \<in> s then g x else 0) has_integral z) (cbox a b)"
  2745         "norm (z - l) < e / 2"
  2746         using B2(2)[OF *(2)] by blast
  2747       have *: "\<And>x. (if x \<in> s then f x + g x else 0) =
  2748         (if x \<in> s then f x else 0) + (if x \<in> s then g x else 0)"
  2749         by auto
  2750       show "\<exists>z. ((\<lambda>x. if x \<in> s then f x + g x else 0) has_integral z) (cbox a b) \<and> norm (z - (k + l)) < e"
  2751         apply (rule_tac x="w + z" in exI)
  2752         apply (simp add: lem[OF w(1) z(1), unfolded *[symmetric]])
  2753         using norm_triangle_ineq[of "w - k" "z - l"] w(2) z(2)
  2754         apply (auto simp add: field_simps)
  2755         done
  2756     qed
  2757   qed
  2758 qed
  2759 
  2760 lemma has_integral_sub:
  2761   "(f has_integral k) s \<Longrightarrow> (g has_integral l) s \<Longrightarrow>
  2762     ((\<lambda>x. f x - g x) has_integral (k - l)) s"
  2763   using has_integral_add[OF _ has_integral_neg, of f k s g l]
  2764   by (auto simp: algebra_simps)
  2765 
  2766 lemma integral_0 [simp]:
  2767   "integral s (\<lambda>x::'n::euclidean_space. 0::'m::real_normed_vector) = 0"
  2768   by (rule integral_unique has_integral_0)+
  2769 
  2770 lemma integral_add: "f integrable_on s \<Longrightarrow> g integrable_on s \<Longrightarrow>
  2771     integral s (\<lambda>x. f x + g x) = integral s f + integral s g"
  2772   by (rule integral_unique) (metis integrable_integral has_integral_add)
  2773 
  2774 lemma integral_cmul [simp]: "integral s (\<lambda>x. c *\<^sub>R f x) = c *\<^sub>R integral s f"
  2775 proof (cases "f integrable_on s \<or> c = 0")
  2776   case True with has_integral_cmul show ?thesis by force
  2777 next
  2778   case False then have "~ (\<lambda>x. c *\<^sub>R f x) integrable_on s"
  2779     using has_integral_cmul [of "(\<lambda>x. c *\<^sub>R f x)" _ s "inverse c"]
  2780     by force
  2781   with False show ?thesis by (simp add: not_integrable_integral)
  2782 qed
  2783 
  2784 lemma integral_neg [simp]: "integral s (\<lambda>x. - f x) = - integral s f"
  2785 proof (cases "f integrable_on s")
  2786   case True then show ?thesis
  2787     by (simp add: has_integral_neg integrable_integral integral_unique)
  2788 next
  2789   case False then have "~ (\<lambda>x. - f x) integrable_on s"
  2790     using has_integral_neg [of "(\<lambda>x. - f x)" _ s ]
  2791     by force
  2792   with False show ?thesis by (simp add: not_integrable_integral)
  2793 qed
  2794 
  2795 lemma integral_diff: "f integrable_on s \<Longrightarrow> g integrable_on s \<Longrightarrow>
  2796     integral s (\<lambda>x. f x - g x) = integral s f - integral s g"
  2797   by (rule integral_unique) (metis integrable_integral has_integral_sub)
  2798 
  2799 lemma integrable_0: "(\<lambda>x. 0) integrable_on s"
  2800   unfolding integrable_on_def using has_integral_0 by auto
  2801 
  2802 lemma integrable_add: "f integrable_on s \<Longrightarrow> g integrable_on s \<Longrightarrow> (\<lambda>x. f x + g x) integrable_on s"
  2803   unfolding integrable_on_def by(auto intro: has_integral_add)
  2804 
  2805 lemma integrable_cmul: "f integrable_on s \<Longrightarrow> (\<lambda>x. c *\<^sub>R f(x)) integrable_on s"
  2806   unfolding integrable_on_def by(auto intro: has_integral_cmul)
  2807 
  2808 lemma integrable_on_cmult_iff:
  2809   fixes c :: real
  2810   assumes "c \<noteq> 0"
  2811   shows "(\<lambda>x. c * f x) integrable_on s \<longleftrightarrow> f integrable_on s"
  2812   using integrable_cmul[of "\<lambda>x. c * f x" s "1 / c"] integrable_cmul[of f s c] \<open>c \<noteq> 0\<close>
  2813   by auto
  2814 
  2815 lemma integrable_on_cmult_left:
  2816   assumes "f integrable_on s"
  2817   shows "(\<lambda>x. of_real c * f x) integrable_on s"
  2818     using integrable_cmul[of f s "of_real c"] assms
  2819     by (simp add: scaleR_conv_of_real)
  2820 
  2821 lemma integrable_neg: "f integrable_on s \<Longrightarrow> (\<lambda>x. -f(x)) integrable_on s"
  2822   unfolding integrable_on_def by(auto intro: has_integral_neg)
  2823 
  2824 lemma integrable_diff:
  2825   "f integrable_on s \<Longrightarrow> g integrable_on s \<Longrightarrow> (\<lambda>x. f x - g x) integrable_on s"
  2826   unfolding integrable_on_def by(auto intro: has_integral_sub)
  2827 
  2828 lemma integrable_linear:
  2829   "f integrable_on s \<Longrightarrow> bounded_linear h \<Longrightarrow> (h \<circ> f) integrable_on s"
  2830   unfolding integrable_on_def by(auto intro: has_integral_linear)
  2831 
  2832 lemma integral_linear:
  2833   "f integrable_on s \<Longrightarrow> bounded_linear h \<Longrightarrow> integral s (h \<circ> f) = h (integral s f)"
  2834   apply (rule has_integral_unique [where i=s and f = "h \<circ> f"])
  2835   apply (simp_all add: integrable_integral integrable_linear has_integral_linear )
  2836   done
  2837 
  2838 lemma integral_component_eq[simp]:
  2839   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  2840   assumes "f integrable_on s"
  2841   shows "integral s (\<lambda>x. f x \<bullet> k) = integral s f \<bullet> k"
  2842   unfolding integral_linear[OF assms(1) bounded_linear_inner_left,unfolded o_def] ..
  2843 
  2844 lemma has_integral_setsum:
  2845   assumes "finite t"
  2846     and "\<forall>a\<in>t. ((f a) has_integral (i a)) s"
  2847   shows "((\<lambda>x. setsum (\<lambda>a. f a x) t) has_integral (setsum i t)) s"
  2848   using assms(1) subset_refl[of t]
  2849 proof (induct rule: finite_subset_induct)
  2850   case empty
  2851   then show ?case by auto
  2852 next
  2853   case (insert x F)
  2854   with assms show ?case
  2855     by (simp add: has_integral_add)
  2856 qed
  2857 
  2858 lemma integral_setsum:
  2859   "\<lbrakk>finite t;  \<forall>a\<in>t. (f a) integrable_on s\<rbrakk> \<Longrightarrow>
  2860    integral s (\<lambda>x. setsum (\<lambda>a. f a x) t) = setsum (\<lambda>a. integral s (f a)) t"
  2861   by (auto intro: has_integral_setsum integrable_integral)
  2862 
  2863 lemma integrable_setsum:
  2864   "\<lbrakk>finite t;  \<forall>a\<in>t. (f a) integrable_on s\<rbrakk> \<Longrightarrow> (\<lambda>x. setsum (\<lambda>a. f a x) t) integrable_on s"
  2865   unfolding integrable_on_def
  2866   apply (drule bchoice)
  2867   using has_integral_setsum[of t]
  2868   apply auto
  2869   done
  2870 
  2871 lemma has_integral_eq:
  2872   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
  2873     and "(f has_integral k) s"
  2874   shows "(g has_integral k) s"
  2875   using has_integral_sub[OF assms(2), of "\<lambda>x. f x - g x" 0]
  2876   using has_integral_is_0[of s "\<lambda>x. f x - g x"]
  2877   using assms(1)
  2878   by auto
  2879 
  2880 lemma integrable_eq: "(\<And>x. x \<in> s \<Longrightarrow> f x = g x) \<Longrightarrow> f integrable_on s \<Longrightarrow> g integrable_on s"
  2881   unfolding integrable_on_def
  2882   using has_integral_eq[of s f g] has_integral_eq by blast
  2883 
  2884 lemma has_integral_cong:
  2885   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
  2886   shows "(f has_integral i) s = (g has_integral i) s"
  2887   using has_integral_eq[of s f g] has_integral_eq[of s g f] assms
  2888   by auto
  2889 
  2890 lemma integral_cong:
  2891   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
  2892   shows "integral s f = integral s g"
  2893   unfolding integral_def
  2894 by (metis (full_types, hide_lams) assms has_integral_cong integrable_eq)
  2895 
  2896 lemma integrable_on_cmult_left_iff [simp]:
  2897   assumes "c \<noteq> 0"
  2898   shows "(\<lambda>x. of_real c * f x) integrable_on s \<longleftrightarrow> f integrable_on s"
  2899         (is "?lhs = ?rhs")
  2900 proof
  2901   assume ?lhs
  2902   then have "(\<lambda>x. of_real (1 / c) * (of_real c * f x)) integrable_on s"
  2903     using integrable_cmul[of "\<lambda>x. of_real c * f x" s "1 / of_real c"]
  2904     by (simp add: scaleR_conv_of_real)
  2905   then have "(\<lambda>x. (of_real (1 / c) * of_real c * f x)) integrable_on s"
  2906     by (simp add: algebra_simps)
  2907   with \<open>c \<noteq> 0\<close> show ?rhs
  2908     by (metis (no_types, lifting) integrable_eq mult.left_neutral nonzero_divide_eq_eq of_real_1 of_real_mult)
  2909 qed (blast intro: integrable_on_cmult_left)
  2910 
  2911 lemma integrable_on_cmult_right:
  2912   fixes f :: "_ \<Rightarrow> 'b :: {comm_ring,real_algebra_1,real_normed_vector}"
  2913   assumes "f integrable_on s"
  2914   shows "(\<lambda>x. f x * of_real c) integrable_on s"
  2915 using integrable_on_cmult_left [OF assms] by (simp add: mult.commute)
  2916 
  2917 lemma integrable_on_cmult_right_iff [simp]:
  2918   fixes f :: "_ \<Rightarrow> 'b :: {comm_ring,real_algebra_1,real_normed_vector}"
  2919   assumes "c \<noteq> 0"
  2920   shows "(\<lambda>x. f x * of_real c) integrable_on s \<longleftrightarrow> f integrable_on s"
  2921 using integrable_on_cmult_left_iff [OF assms] by (simp add: mult.commute)
  2922 
  2923 lemma integrable_on_cdivide:
  2924   fixes f :: "_ \<Rightarrow> 'b :: real_normed_field"
  2925   assumes "f integrable_on s"
  2926   shows "(\<lambda>x. f x / of_real c) integrable_on s"
  2927 by (simp add: integrable_on_cmult_right divide_inverse assms of_real_inverse [symmetric] del: of_real_inverse)
  2928 
  2929 lemma integrable_on_cdivide_iff [simp]:
  2930   fixes f :: "_ \<Rightarrow> 'b :: real_normed_field"
  2931   assumes "c \<noteq> 0"
  2932   shows "(\<lambda>x. f x / of_real c) integrable_on s \<longleftrightarrow> f integrable_on s"
  2933 by (simp add: divide_inverse assms of_real_inverse [symmetric] del: of_real_inverse)
  2934 
  2935 lemma has_integral_null [intro]: "content(cbox a b) = 0 \<Longrightarrow> (f has_integral 0) (cbox a b)"
  2936   unfolding has_integral_cbox
  2937   using eventually_division_filter_tagged_division[of "cbox a b"]
  2938   by (subst tendsto_cong[where g="\<lambda>_. 0"]) (auto elim: eventually_mono intro: setsum_content_null)
  2939 
  2940 lemma has_integral_null_real [intro]: "content {a .. b::real} = 0 \<Longrightarrow> (f has_integral 0) {a .. b}"
  2941   by (metis box_real(2) has_integral_null)
  2942 
  2943 lemma has_integral_null_eq[simp]: "content (cbox a b) = 0 \<Longrightarrow> (f has_integral i) (cbox a b) \<longleftrightarrow> i = 0"
  2944   by (auto simp add: has_integral_null dest!: integral_unique)
  2945 
  2946 lemma integral_null [simp]: "content (cbox a b) = 0 \<Longrightarrow> integral (cbox a b) f = 0"
  2947   by (metis has_integral_null integral_unique)
  2948 
  2949 lemma integrable_on_null [intro]: "content (cbox a b) = 0 \<Longrightarrow> f integrable_on (cbox a b)"
  2950   by (simp add: has_integral_integrable)
  2951 
  2952 lemma has_integral_empty[intro]: "(f has_integral 0) {}"
  2953   by (simp add: has_integral_is_0)
  2954 
  2955 lemma has_integral_empty_eq[simp]: "(f has_integral i) {} \<longleftrightarrow> i = 0"
  2956   by (auto simp add: has_integral_empty has_integral_unique)
  2957 
  2958 lemma integrable_on_empty[intro]: "f integrable_on {}"
  2959   unfolding integrable_on_def by auto
  2960 
  2961 lemma integral_empty[simp]: "integral {} f = 0"
  2962   by (rule integral_unique) (rule has_integral_empty)
  2963 
  2964 lemma has_integral_refl[intro]:
  2965   fixes a :: "'a::euclidean_space"
  2966   shows "(f has_integral 0) (cbox a a)"
  2967     and "(f has_integral 0) {a}"
  2968 proof -
  2969   have *: "{a} = cbox a a"
  2970     apply (rule set_eqI)
  2971     unfolding mem_box singleton_iff euclidean_eq_iff[where 'a='a]
  2972     apply safe
  2973     prefer 3
  2974     apply (erule_tac x=b in ballE)
  2975     apply (auto simp add: field_simps)
  2976     done
  2977   show "(f has_integral 0) (cbox a a)" "(f has_integral 0) {a}"
  2978     unfolding *
  2979     apply (rule_tac[!] has_integral_null)
  2980     unfolding content_eq_0_interior
  2981     unfolding interior_cbox
  2982     using box_sing
  2983     apply auto
  2984     done
  2985 qed
  2986 
  2987 lemma integrable_on_refl[intro]: "f integrable_on cbox a a"
  2988   unfolding integrable_on_def by auto
  2989 
  2990 lemma integral_refl [simp]: "integral (cbox a a) f = 0"
  2991   by (rule integral_unique) auto
  2992 
  2993 lemma integral_singleton [simp]: "integral {a} f = 0"
  2994   by auto
  2995 
  2996 lemma integral_blinfun_apply:
  2997   assumes "f integrable_on s"
  2998   shows "integral s (\<lambda>x. blinfun_apply h (f x)) = blinfun_apply h (integral s f)"
  2999   by (subst integral_linear[symmetric, OF assms blinfun.bounded_linear_right]) (simp add: o_def)
  3000 
  3001 lemma blinfun_apply_integral:
  3002   assumes "f integrable_on s"
  3003   shows "blinfun_apply (integral s f) x = integral s (\<lambda>y. blinfun_apply (f y) x)"
  3004   by (metis (no_types, lifting) assms blinfun.prod_left.rep_eq integral_blinfun_apply integral_cong)
  3005 
  3006 lemma has_integral_componentwise_iff:
  3007   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3008   shows "(f has_integral y) A \<longleftrightarrow> (\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
  3009 proof safe
  3010   fix b :: 'b assume "(f has_integral y) A"
  3011   from has_integral_linear[OF this(1) bounded_linear_inner_left, of b]
  3012     show "((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A" by (simp add: o_def)
  3013 next
  3014   assume "(\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
  3015   hence "\<forall>b\<in>Basis. (((\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. f x \<bullet> b)) has_integral ((y \<bullet> b) *\<^sub>R b)) A"
  3016     by (intro ballI has_integral_linear) (simp_all add: bounded_linear_scaleR_left)
  3017   hence "((\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b) has_integral (\<Sum>b\<in>Basis. (y \<bullet> b) *\<^sub>R b)) A"
  3018     by (intro has_integral_setsum) (simp_all add: o_def)
  3019   thus "(f has_integral y) A" by (simp add: euclidean_representation)
  3020 qed
  3021 
  3022 lemma has_integral_componentwise:
  3023   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3024   shows "(\<And>b. b \<in> Basis \<Longrightarrow> ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A) \<Longrightarrow> (f has_integral y) A"
  3025   by (subst has_integral_componentwise_iff) blast
  3026 
  3027 lemma integrable_componentwise_iff:
  3028   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3029   shows "f integrable_on A \<longleftrightarrow> (\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)"
  3030 proof
  3031   assume "f integrable_on A"
  3032   then obtain y where "(f has_integral y) A" by (auto simp: integrable_on_def)
  3033   hence "(\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
  3034     by (subst (asm) has_integral_componentwise_iff)
  3035   thus "(\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)" by (auto simp: integrable_on_def)
  3036 next
  3037   assume "(\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)"
  3038   then obtain y where "\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral y b) A"
  3039     unfolding integrable_on_def by (subst (asm) bchoice_iff) blast
  3040   hence "\<forall>b\<in>Basis. (((\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. f x \<bullet> b)) has_integral (y b *\<^sub>R b)) A"
  3041     by (intro ballI has_integral_linear) (simp_all add: bounded_linear_scaleR_left)
  3042   hence "((\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b) has_integral (\<Sum>b\<in>Basis. y b *\<^sub>R b)) A"
  3043     by (intro has_integral_setsum) (simp_all add: o_def)
  3044   thus "f integrable_on A" by (auto simp: integrable_on_def o_def euclidean_representation)
  3045 qed
  3046 
  3047 lemma integrable_componentwise:
  3048   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3049   shows "(\<And>b. b \<in> Basis \<Longrightarrow> (\<lambda>x. f x \<bullet> b) integrable_on A) \<Longrightarrow> f integrable_on A"
  3050   by (subst integrable_componentwise_iff) blast
  3051 
  3052 lemma integral_componentwise:
  3053   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3054   assumes "f integrable_on A"
  3055   shows "integral A f = (\<Sum>b\<in>Basis. integral A (\<lambda>x. (f x \<bullet> b) *\<^sub>R b))"
  3056 proof -
  3057   from assms have integrable: "\<forall>b\<in>Basis. (\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. (f x \<bullet> b)) integrable_on A"
  3058     by (subst (asm) integrable_componentwise_iff, intro integrable_linear ballI)
  3059        (simp_all add: bounded_linear_scaleR_left)
  3060   have "integral A f = integral A (\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b)"
  3061     by (simp add: euclidean_representation)
  3062   also from integrable have "\<dots> = (\<Sum>a\<in>Basis. integral A (\<lambda>x. (f x \<bullet> a) *\<^sub>R a))"
  3063     by (subst integral_setsum) (simp_all add: o_def)
  3064   finally show ?thesis .
  3065 qed
  3066 
  3067 lemma integrable_component:
  3068   "f integrable_on A \<Longrightarrow> (\<lambda>x. f x \<bullet> (y :: 'b :: euclidean_space)) integrable_on A"
  3069   by (drule integrable_linear[OF _ bounded_linear_inner_left[of y]]) (simp add: o_def)
  3070 
  3071 
  3072 
  3073 subsection \<open>Cauchy-type criterion for integrability.\<close>
  3074 
  3075 (* XXXXXXX *)
  3076 lemma integrable_cauchy:
  3077   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::{real_normed_vector,complete_space}"
  3078   shows "f integrable_on cbox a b \<longleftrightarrow>
  3079     (\<forall>e>0. \<exists>d. gauge d \<and>
  3080       (\<forall>p1 p2. p1 tagged_division_of (cbox a b) \<and> d fine p1 \<and>
  3081         p2 tagged_division_of (cbox a b) \<and> d fine p2 \<longrightarrow>
  3082         norm ((\<Sum>(x,k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x,k)\<in>p2. content k *\<^sub>R f x)) < e))"
  3083   (is "?l = (\<forall>e>0. \<exists>d. ?P e d)")
  3084 proof
  3085   assume ?l
  3086   then guess y unfolding integrable_on_def has_integral .. note y=this
  3087   show "\<forall>e>0. \<exists>d. ?P e d"
  3088   proof (clarify, goal_cases)
  3089     case (1 e)
  3090     then have "e/2 > 0" by auto
  3091     then guess d
  3092       apply -
  3093       apply (drule y[rule_format])
  3094       apply (elim exE conjE)
  3095       done
  3096     note d=this[rule_format]
  3097     show ?case
  3098     proof (rule_tac x=d in exI, clarsimp simp: d)
  3099       fix p1 p2
  3100       assume as: "p1 tagged_division_of (cbox a b)" "d fine p1"
  3101                  "p2 tagged_division_of (cbox a b)" "d fine p2"
  3102       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
  3103         apply (rule dist_triangle_half_l[where y=y,unfolded dist_norm])
  3104         using d(2)[OF conjI[OF as(1-2)]] d(2)[OF conjI[OF as(3-4)]] .
  3105     qed
  3106   qed
  3107 next
  3108   assume "\<forall>e>0. \<exists>d. ?P e d"
  3109   then have "\<forall>n::nat. \<exists>d. ?P (inverse(of_nat (n + 1))) d"
  3110     by auto
  3111   from choice[OF this] guess d .. note d=conjunctD2[OF this[rule_format],rule_format]
  3112   have "\<And>n. gauge (\<lambda>x. \<Inter>{d i x |i. i \<in> {0..n}})"
  3113     apply (rule gauge_inters)
  3114     using d(1)
  3115     apply auto
  3116     done
  3117   then have "\<forall>n. \<exists>p. p tagged_division_of (cbox a b) \<and> (\<lambda>x. \<Inter>{d i x |i. i \<in> {0..n}}) fine p"
  3118     by (meson fine_division_exists)
  3119   from choice[OF this] guess p .. note p = conjunctD2[OF this[rule_format]]
  3120   have dp: "\<And>i n. i\<le>n \<Longrightarrow> d i fine p n"
  3121     using p(2) unfolding fine_inters by auto
  3122   have "Cauchy (\<lambda>n. setsum (\<lambda>(x,k). content k *\<^sub>R (f x)) (p n))"
  3123   proof (rule CauchyI, goal_cases)
  3124     case (1 e)
  3125     then guess N unfolding real_arch_inverse[of e] .. note N=this
  3126     show ?case
  3127       apply (rule_tac x=N in exI)
  3128     proof clarify
  3129       fix m n
  3130       assume mn: "N \<le> m" "N \<le> n"
  3131       have *: "N = (N - 1) + 1" using N by auto
  3132       show "norm ((\<Sum>(x, k)\<in>p m. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p n. content k *\<^sub>R f x)) < e"
  3133         apply (rule less_trans[OF _ N[THEN conjunct2,THEN conjunct2]])
  3134         apply(subst *)
  3135         using dp p(1) mn d(2) by auto
  3136     qed
  3137   qed
  3138   then guess y unfolding convergent_eq_cauchy[symmetric] .. note y=this[THEN LIMSEQ_D]
  3139   show ?l
  3140     unfolding integrable_on_def has_integral
  3141   proof (rule_tac x=y in exI, clarify)
  3142     fix e :: real
  3143     assume "e>0"
  3144     then have *:"e/2 > 0" by auto
  3145     then guess N1 unfolding real_arch_inverse[of "e/2"] .. note N1=this
  3146     then have N1': "N1 = N1 - 1 + 1"
  3147       by auto
  3148     guess N2 using y[OF *] .. note N2=this
  3149     have "gauge (d (N1 + N2))"
  3150       using d by auto
  3151     moreover
  3152     {
  3153       fix q
  3154       assume as: "q tagged_division_of (cbox a b)" "d (N1 + N2) fine q"
  3155       have *: "inverse (of_nat (N1 + N2 + 1)) < e / 2"
  3156         apply (rule less_trans)
  3157         using N1
  3158         apply auto
  3159         done
  3160       have "norm ((\<Sum>(x, k)\<in>q. content k *\<^sub>R f x) - y) < e"
  3161         apply (rule norm_triangle_half_r)
  3162         apply (rule less_trans[OF _ *])
  3163         apply (subst N1', rule d(2)[of "p (N1+N2)"])
  3164         using N1' as(1) as(2) dp
  3165         apply (simp add: \<open>\<forall>x. p x tagged_division_of cbox a b \<and> (\<lambda>xa. \<Inter>{d i xa |i. i \<in> {0..x}}) fine p x\<close>)
  3166         using N2 le_add2 by blast
  3167     }
  3168     ultimately show "\<exists>d. gauge d \<and>
  3169       (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  3170         norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - y) < e)"
  3171       by (rule_tac x="d (N1 + N2)" in exI) auto
  3172   qed
  3173 qed
  3174 
  3175 
  3176 subsection \<open>Additivity of integral on abutting intervals.\<close>
  3177 
  3178 lemma tagged_division_split_left_inj:
  3179   fixes x1 :: "'a::euclidean_space"
  3180   assumes d: "d tagged_division_of i"
  3181     and k12: "(x1, k1) \<in> d"
  3182              "(x2, k2) \<in> d"
  3183              "k1 \<noteq> k2"
  3184              "k1 \<inter> {x. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  3185              "k \<in> Basis"
  3186   shows "content (k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  3187 proof -
  3188   have *: "\<And>a b c. (a,b) \<in> c \<Longrightarrow> b \<in> snd ` c"
  3189     by force
  3190   show ?thesis
  3191     using k12
  3192     by (fastforce intro!:  division_split_left_inj[OF division_of_tagged_division[OF d]] *)
  3193 qed
  3194 
  3195 lemma tagged_division_split_right_inj:
  3196   fixes x1 :: "'a::euclidean_space"
  3197   assumes d: "d tagged_division_of i"
  3198     and k12: "(x1, k1) \<in> d"
  3199              "(x2, k2) \<in> d"
  3200              "k1 \<noteq> k2"
  3201              "k1 \<inter> {x. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}"
  3202              "k \<in> Basis"
  3203   shows "content (k1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
  3204 proof -
  3205   have *: "\<And>a b c. (a,b) \<in> c \<Longrightarrow> b \<in> snd ` c"
  3206     by force
  3207   show ?thesis
  3208     using k12
  3209     by (fastforce intro!:  division_split_right_inj[OF division_of_tagged_division[OF d]] *)
  3210 qed
  3211 
  3212 lemma has_integral_split:
  3213   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3214   assumes fi: "(f has_integral i) (cbox a b \<inter> {x. x\<bullet>k \<le> c})"
  3215       and fj: "(f has_integral j) (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  3216       and k: "k \<in> Basis"
  3217   shows "(f has_integral (i + j)) (cbox a b)"
  3218 proof (unfold has_integral, rule, rule, goal_cases)
  3219   case (1 e)
  3220   then have e: "e/2 > 0"
  3221     by auto
  3222     obtain d1
  3223     where d1: "gauge d1"
  3224       and d1norm:
  3225         "\<And>p. \<lbrakk>p tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c};
  3226                d1 fine p\<rbrakk> \<Longrightarrow> norm ((\<Sum>(x, k) \<in> p. content k *\<^sub>R f x) - i) < e / 2"
  3227        apply (rule has_integralD[OF fi[unfolded interval_split[OF k]] e])
  3228        apply (simp add: interval_split[symmetric] k)
  3229        done
  3230     obtain d2
  3231     where d2: "gauge d2"
  3232       and d2norm:
  3233         "\<And>p. \<lbrakk>p tagged_division_of cbox a b \<inter> {x. c \<le> x \<bullet> k};
  3234                d2 fine p\<rbrakk> \<Longrightarrow> norm ((\<Sum>(x, k) \<in> p. content k *\<^sub>R f x) - j) < e / 2"
  3235        apply (rule has_integralD[OF fj[unfolded interval_split[OF k]] e])
  3236        apply (simp add: interval_split[symmetric] k)
  3237        done
  3238   let ?d = "\<lambda>x. if x\<bullet>k = c then (d1 x \<inter> d2 x) else ball x \<bar>x\<bullet>k - c\<bar> \<inter> d1 x \<inter> d2 x"
  3239   have "gauge ?d"
  3240     using d1 d2 unfolding gauge_def by auto
  3241   then show ?case
  3242   proof (rule_tac x="?d" in exI, safe)
  3243     fix p
  3244     assume "p tagged_division_of (cbox a b)" "?d fine p"
  3245     note p = this tagged_division_ofD[OF this(1)]
  3246     have xk_le_c: "\<And>x kk. (x, kk) \<in> p \<Longrightarrow> kk \<inter> {x. x\<bullet>k \<le> c} \<noteq> {} \<Longrightarrow> x\<bullet>k \<le> c"
  3247     proof -
  3248       fix x kk
  3249       assume as: "(x, kk) \<in> p" and kk: "kk \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}"
  3250       show "x\<bullet>k \<le> c"
  3251       proof (rule ccontr)
  3252         assume **: "\<not> ?thesis"
  3253         from this[unfolded not_le]
  3254         have "kk \<subseteq> ball x \<bar>x \<bullet> k - c\<bar>"
  3255           using p(2)[unfolded fine_def, rule_format,OF as] by auto
  3256         with kk obtain y where y: "y \<in> ball x \<bar>x \<bullet> k - c\<bar>" "y\<bullet>k \<le> c"
  3257           by blast
  3258         then have "\<bar>x \<bullet> k - y \<bullet> k\<bar> < \<bar>x \<bullet> k - c\<bar>"
  3259           using Basis_le_norm[OF k, of "x - y"]
  3260           by (auto simp add: dist_norm inner_diff_left intro: le_less_trans)
  3261         with y show False
  3262           using ** by (auto simp add: field_simps)
  3263       qed
  3264     qed
  3265     have xk_ge_c: "\<And>x kk. (x, kk) \<in> p \<Longrightarrow> kk \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {} \<Longrightarrow> x\<bullet>k \<ge> c"
  3266     proof -
  3267       fix x kk
  3268       assume as: "(x, kk) \<in> p" and kk: "kk \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}"
  3269       show "x\<bullet>k \<ge> c"
  3270       proof (rule ccontr)
  3271         assume **: "\<not> ?thesis"
  3272         from this[unfolded not_le] have "kk \<subseteq> ball x \<bar>x \<bullet> k - c\<bar>"
  3273           using p(2)[unfolded fine_def,rule_format,OF as,unfolded split_conv] by auto
  3274         with kk obtain y where y: "y \<in> ball x \<bar>x \<bullet> k - c\<bar>" "y\<bullet>k \<ge> c"
  3275           by blast
  3276         then have "\<bar>x \<bullet> k - y \<bullet> k\<bar> < \<bar>x \<bullet> k - c\<bar>"
  3277           using Basis_le_norm[OF k, of "x - y"]
  3278           by (auto simp add: dist_norm inner_diff_left intro: le_less_trans)
  3279         with y show False
  3280           using ** by (auto simp add: field_simps)
  3281       qed
  3282     qed
  3283 
  3284     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>
  3285                          (\<forall>x k. P x k \<longrightarrow> Q x (f k))"
  3286       by auto
  3287     have fin_finite: "finite {(x,f k) | x k. (x,k) \<in> s \<and> P x k}" if "finite s" for f s P
  3288     proof -
  3289       from that have "finite ((\<lambda>(x, k). (x, f k)) ` s)"
  3290         by auto
  3291       then show ?thesis
  3292         by (rule rev_finite_subset) auto
  3293     qed
  3294     { fix g :: "'a set \<Rightarrow> 'a set"
  3295       fix i :: "'a \<times> 'a set"
  3296       assume "i \<in> (\<lambda>(x, k). (x, g k)) ` p - {(x, g k) |x k. (x, k) \<in> p \<and> g k \<noteq> {}}"
  3297       then obtain x k where xk:
  3298               "i = (x, g k)"  "(x, k) \<in> p"
  3299               "(x, g k) \<notin> {(x, g k) |x k. (x, k) \<in> p \<and> g k \<noteq> {}}"
  3300           by auto
  3301       have "content (g k) = 0"
  3302         using xk using content_empty by auto
  3303       then have "(\<lambda>(x, k). content k *\<^sub>R f x) i = 0"
  3304         unfolding xk split_conv by auto
  3305     } note [simp] = this
  3306     have lem3: "\<And>g :: 'a set \<Rightarrow> 'a set. finite p \<Longrightarrow>
  3307                   setsum (\<lambda>(x, k). content k *\<^sub>R f x) {(x,g k) |x k. (x,k) \<in> p \<and> g k \<noteq> {}} =
  3308                   setsum (\<lambda>(x, k). content k *\<^sub>R f x) ((\<lambda>(x, k). (x, g k)) ` p)"
  3309       by (rule setsum.mono_neutral_left) auto
  3310     let ?M1 = "{(x, kk \<inter> {x. x\<bullet>k \<le> c}) |x kk. (x, kk) \<in> p \<and> kk \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
  3311     have d1_fine: "d1 fine ?M1"
  3312       by (force intro: fineI dest: fineD[OF p(2)] simp add: split: if_split_asm)
  3313     have "norm ((\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) - i) < e/2"
  3314     proof (rule d1norm [OF tagged_division_ofI d1_fine])
  3315       show "finite ?M1"
  3316         by (rule fin_finite p(3))+
  3317       show "\<Union>{k. \<exists>x. (x, k) \<in> ?M1} = cbox a b \<inter> {x. x\<bullet>k \<le> c}"
  3318         unfolding p(8)[symmetric] by auto
  3319       fix x l
  3320       assume xl: "(x, l) \<in> ?M1"
  3321       then guess x' l' unfolding mem_Collect_eq unfolding prod.inject by (elim exE conjE) note xl'=this
  3322       show "x \<in> l" "l \<subseteq> cbox a b \<inter> {x. x \<bullet> k \<le> c}"
  3323         unfolding xl'
  3324         using p(4-6)[OF xl'(3)] using xl'(4)
  3325         using xk_le_c[OF xl'(3-4)] by auto
  3326       show "\<exists>a b. l = cbox a b"
  3327         unfolding xl'
  3328         using p(6)[OF xl'(3)]
  3329         by (fastforce simp add: interval_split[OF k,where c=c])
  3330       fix y r
  3331       let ?goal = "interior l \<inter> interior r = {}"
  3332       assume yr: "(y, r) \<in> ?M1"
  3333       then guess y' r' unfolding mem_Collect_eq unfolding prod.inject by (elim exE conjE) note yr'=this
  3334       assume as: "(x, l) \<noteq> (y, r)"
  3335       show "interior l \<inter> interior r = {}"
  3336       proof (cases "l' = r' \<longrightarrow> x' = y'")
  3337         case False
  3338         then show ?thesis
  3339           using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto
  3340       next
  3341         case True
  3342         then have "l' \<noteq> r'"
  3343           using as unfolding xl' yr' by auto
  3344         then show ?thesis
  3345           using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto
  3346       qed
  3347     qed
  3348     moreover
  3349     let ?M2 = "{(x,kk \<inter> {x. x\<bullet>k \<ge> c}) |x kk. (x,kk) \<in> p \<and> kk \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
  3350     have d2_fine: "d2 fine ?M2"
  3351       by (force intro: fineI dest: fineD[OF p(2)] simp add: split: if_split_asm)
  3352     have "norm ((\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - j) < e/2"
  3353     proof (rule d2norm [OF tagged_division_ofI d2_fine])
  3354       show "finite ?M2"
  3355         by (rule fin_finite p(3))+
  3356       show "\<Union>{k. \<exists>x. (x, k) \<in> ?M2} = cbox a b \<inter> {x. x\<bullet>k \<ge> c}"
  3357         unfolding p(8)[symmetric] by auto
  3358       fix x l
  3359       assume xl: "(x, l) \<in> ?M2"
  3360       then guess x' l' unfolding mem_Collect_eq unfolding prod.inject by (elim exE conjE) note xl'=this
  3361       show "x \<in> l" "l \<subseteq> cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
  3362         unfolding xl'
  3363         using p(4-6)[OF xl'(3)] xl'(4) xk_ge_c[OF xl'(3-4)]
  3364         by auto
  3365       show "\<exists>a b. l = cbox a b"
  3366         unfolding xl'
  3367         using p(6)[OF xl'(3)]
  3368         by (fastforce simp add: interval_split[OF k, where c=c])
  3369       fix y r
  3370       let ?goal = "interior l \<inter> interior r = {}"
  3371       assume yr: "(y, r) \<in> ?M2"
  3372       then guess y' r' unfolding mem_Collect_eq unfolding prod.inject by (elim exE conjE) note yr'=this
  3373       assume as: "(x, l) \<noteq> (y, r)"
  3374       show "interior l \<inter> interior r = {}"
  3375       proof (cases "l' = r' \<longrightarrow> x' = y'")
  3376         case False
  3377         then show ?thesis
  3378           using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto
  3379       next
  3380         case True
  3381         then have "l' \<noteq> r'"
  3382           using as unfolding xl' yr' by auto
  3383         then show ?thesis
  3384           using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto
  3385       qed
  3386     qed
  3387     ultimately
  3388     have "norm (((\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) - i) + ((\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - j)) < e/2 + e/2"
  3389       using norm_add_less by blast
  3390     also {
  3391       have eq0: "\<And>x y. x = (0::real) \<Longrightarrow> x *\<^sub>R (y::'b) = 0"
  3392         using scaleR_zero_left by auto
  3393       have cont_eq: "\<And>g. (\<lambda>(x,l). content l *\<^sub>R f x) \<circ> (\<lambda>(x,l). (x,g l)) = (\<lambda>(x,l). content (g l) *\<^sub>R f x)"
  3394         by auto
  3395       have "((\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) - i) + ((\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - j) =
  3396         (\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - (i + j)"
  3397         by auto
  3398       also have "\<dots> = (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) +
  3399         (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) - (i + j)"
  3400         unfolding lem3[OF p(3)]
  3401         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)]
  3402               simp: cont_eq)+
  3403       also note setsum.distrib[symmetric]
  3404       also have "\<And>x. x \<in> p \<Longrightarrow>
  3405                     (\<lambda>(x,ka). content (ka \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) x +
  3406                     (\<lambda>(x,ka). content (ka \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) x =
  3407                     (\<lambda>(x,ka). content ka *\<^sub>R f x) x"
  3408       proof clarify
  3409         fix a b
  3410         assume "(a, b) \<in> p"
  3411         from p(6)[OF this] guess u v by (elim exE) note uv=this
  3412         then show "content (b \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f a + content (b \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f a =
  3413           content b *\<^sub>R f a"
  3414           unfolding scaleR_left_distrib[symmetric]
  3415           unfolding uv content_split[OF k,of u v c]
  3416           by auto
  3417       qed
  3418       note setsum.cong [OF _ this]
  3419       finally have "(\<Sum>(x, k)\<in>{(x, kk \<inter> {x. x \<bullet> k \<le> c}) |x kk. (x, kk) \<in> p \<and> kk \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}}. content k *\<^sub>R f x) - i +
  3420         ((\<Sum>(x, k)\<in>{(x, kk \<inter> {x. c \<le> x \<bullet> k}) |x kk. (x, kk) \<in> p \<and> kk \<inter> {x. c \<le> x \<bullet> k} \<noteq> {}}. content k *\<^sub>R f x) - j) =
  3421         (\<Sum>(x, ka)\<in>p. content ka *\<^sub>R f x) - (i + j)"
  3422         by auto
  3423     }
  3424     finally show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - (i + j)) < e"
  3425       by auto
  3426   qed
  3427 qed
  3428 
  3429 
  3430 subsection \<open>A sort of converse, integrability on subintervals.\<close>
  3431 
  3432 lemma tagged_division_union_interval:
  3433   fixes a :: "'a::euclidean_space"
  3434   assumes "p1 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<le> (c::real)})"
  3435     and "p2 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  3436     and k: "k \<in> Basis"
  3437   shows "(p1 \<union> p2) tagged_division_of (cbox a b)"
  3438 proof -
  3439   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})"
  3440     by auto
  3441   show ?thesis
  3442     apply (subst *)
  3443     apply (rule tagged_division_union[OF assms(1-2)])
  3444     unfolding interval_split[OF k] interior_cbox
  3445     using k
  3446     apply (auto simp add: box_def elim!: ballE[where x=k])
  3447     done
  3448 qed
  3449 
  3450 lemma tagged_division_union_interval_real:
  3451   fixes a :: real
  3452   assumes "p1 tagged_division_of ({a .. b} \<inter> {x. x\<bullet>k \<le> (c::real)})"
  3453     and "p2 tagged_division_of ({a .. b} \<inter> {x. x\<bullet>k \<ge> c})"
  3454     and k: "k \<in> Basis"
  3455   shows "(p1 \<union> p2) tagged_division_of {a .. b}"
  3456   using assms
  3457   unfolding box_real[symmetric]
  3458   by (rule tagged_division_union_interval)
  3459 
  3460 lemma has_integral_separate_sides:
  3461   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3462   assumes "(f has_integral i) (cbox a b)"
  3463     and "e > 0"
  3464     and k: "k \<in> Basis"
  3465   obtains d where "gauge d"
  3466     "\<forall>p1 p2. p1 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<and> d fine p1 \<and>
  3467         p2 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) \<and> d fine p2 \<longrightarrow>
  3468         norm ((setsum (\<lambda>(x,k). content k *\<^sub>R f x) p1 + setsum (\<lambda>(x,k). content k *\<^sub>R f x) p2) - i) < e"
  3469 proof -
  3470   guess d using has_integralD[OF assms(1-2)] . note d=this
  3471   { fix p1 p2
  3472     assume "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p1"
  3473     note p1=tagged_division_ofD[OF this(1)] this
  3474     assume "p2 tagged_division_of (cbox a b) \<inter> {x. c \<le> x \<bullet> k}" "d fine p2"
  3475     note p2=tagged_division_ofD[OF this(1)] this
  3476     note tagged_division_union_interval[OF p1(7) p2(7)] note p12 = tagged_division_ofD[OF this] this
  3477     { fix a b
  3478       assume ab: "(a, b) \<in> p1 \<inter> p2"
  3479       have "(a, b) \<in> p1"
  3480         using ab by auto
  3481       with p1 obtain u v where uv: "b = cbox u v" by auto
  3482       have "b \<subseteq> {x. x\<bullet>k = c}"
  3483         using ab p1(3)[of a b] p2(3)[of a b] by fastforce
  3484       moreover
  3485       have "interior {x::'a. x \<bullet> k = c} = {}"
  3486       proof (rule ccontr)
  3487         assume "\<not> ?thesis"
  3488         then obtain x where x: "x \<in> interior {x::'a. x\<bullet>k = c}"
  3489           by auto
  3490         then guess e unfolding mem_interior .. note e=this
  3491         have x: "x\<bullet>k = c"
  3492           using x interior_subset by fastforce
  3493         have *: "\<And>i. i \<in> Basis \<Longrightarrow> \<bar>(x - (x + (e / 2) *\<^sub>R k)) \<bullet> i\<bar> = (if i = k then e/2 else 0)"
  3494           using e k by (auto simp: inner_simps inner_not_same_Basis)
  3495         have "(\<Sum>i\<in>Basis. \<bar>(x - (x + (e / 2 ) *\<^sub>R k)) \<bullet> i\<bar>) =
  3496               (\<Sum>i\<in>Basis. (if i = k then e / 2 else 0))"
  3497           using "*" by (blast intro: setsum.cong)
  3498         also have "\<dots> < e"
  3499           apply (subst setsum.delta)
  3500           using e
  3501           apply auto
  3502           done
  3503         finally have "x + (e/2) *\<^sub>R k \<in> ball x e"
  3504           unfolding mem_ball dist_norm by(rule le_less_trans[OF norm_le_l1])
  3505         then have "x + (e/2) *\<^sub>R k \<in> {x. x\<bullet>k = c}"
  3506           using e by auto
  3507         then show False
  3508           unfolding mem_Collect_eq using e x k by (auto simp: inner_simps)
  3509       qed
  3510       ultimately have "content b = 0"
  3511         unfolding uv content_eq_0_interior
  3512         using interior_mono by blast
  3513       then have "content b *\<^sub>R f a = 0"
  3514         by auto
  3515     }
  3516     then have "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) =
  3517                norm ((\<Sum>(x, k)\<in>p1 \<union> p2. content k *\<^sub>R f x) - i)"
  3518       by (subst setsum.union_inter_neutral) (auto simp: p1 p2)
  3519     also have "\<dots> < e"
  3520       by (rule k d(2) p12 fine_union p1 p2)+
  3521     finally have "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) < e" .
  3522    }
  3523   then show ?thesis
  3524     by (auto intro: that[of d] d elim: )
  3525 qed
  3526 
  3527 lemma integrable_split[intro]:
  3528   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
  3529   assumes "f integrable_on cbox a b"
  3530     and k: "k \<in> Basis"
  3531   shows "f integrable_on (cbox a b \<inter> {x. x\<bullet>k \<le> c})" (is ?t1)
  3532     and "f integrable_on (cbox a b \<inter> {x. x\<bullet>k \<ge> c})" (is ?t2)
  3533 proof -
  3534   guess y using assms(1) unfolding integrable_on_def .. note y=this
  3535   define b' where "b' = (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) c else b\<bullet>i)*\<^sub>R i)"
  3536   define a' where "a' = (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) c else a\<bullet>i)*\<^sub>R i)"
  3537   show ?t1 ?t2
  3538     unfolding interval_split[OF k] integrable_cauchy
  3539     unfolding interval_split[symmetric,OF k]
  3540   proof (rule_tac[!] allI impI)+
  3541     fix e :: real
  3542     assume "e > 0"
  3543     then have "e/2>0"
  3544       by auto
  3545     from has_integral_separate_sides[OF y this k,of c] guess d . note d=this[rule_format]
  3546     let ?P = "\<lambda>A. \<exists>d. gauge d \<and> (\<forall>p1 p2. p1 tagged_division_of (cbox a b) \<inter> A \<and> d fine p1 \<and>
  3547       p2 tagged_division_of (cbox a b) \<inter> A \<and> d fine p2 \<longrightarrow>
  3548       norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e)"
  3549     show "?P {x. x \<bullet> k \<le> c}"
  3550     proof (rule_tac x=d in exI, clarsimp simp add: d)
  3551       fix p1 p2
  3552       assume as: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p1"
  3553                  "p2 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p2"
  3554       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
  3555       proof (rule fine_division_exists[OF d(1), of a' b] )
  3556         fix p
  3557         assume "p tagged_division_of cbox a' b" "d fine p"
  3558         then show ?thesis
  3559           using as norm_triangle_half_l[OF d(2)[of p1 p] d(2)[of p2 p]]
  3560           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
  3561           by (auto simp add: algebra_simps)
  3562       qed
  3563     qed
  3564     show "?P {x. x \<bullet> k \<ge> c}"
  3565     proof (rule_tac x=d in exI, clarsimp simp add: d)
  3566       fix p1 p2
  3567       assume as: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<ge> c}" "d fine p1"
  3568                  "p2 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<ge> c}" "d fine p2"
  3569       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
  3570       proof (rule fine_division_exists[OF d(1), of a b'] )
  3571         fix p
  3572         assume "p tagged_division_of cbox a b'" "d fine p"
  3573         then show ?thesis
  3574           using as norm_triangle_half_l[OF d(2)[of p p1] d(2)[of p p2]]
  3575           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
  3576           by (auto simp add: algebra_simps)
  3577       qed
  3578     qed
  3579   qed
  3580 qed
  3581 
  3582 lemma operative_integral:
  3583   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
  3584   shows "comm_monoid.operative (lift_option op +) (Some 0)
  3585     (\<lambda>i. if f integrable_on i then Some (integral i f) else None)"
  3586 proof -
  3587   interpret comm_monoid "lift_option plus" "Some (0::'b)"
  3588     by (rule comm_monoid_lift_option)
  3589       (rule add.comm_monoid_axioms)
  3590   show ?thesis
  3591   proof (unfold operative_def, safe)
  3592     fix a b c
  3593     fix k :: 'a
  3594     assume k: "k \<in> Basis"
  3595     show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) =
  3596           lift_option op + (if f integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c} then Some (integral (cbox a b \<inter> {x. x \<bullet> k \<le> c}) f) else None)
  3597           (if f integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k} then Some (integral (cbox a b \<inter> {x. c \<le> x \<bullet> k}) f) else None)"
  3598     proof (cases "f integrable_on cbox a b")
  3599       case True
  3600       with k show ?thesis
  3601         apply (simp add: integrable_split)
  3602         apply (rule integral_unique [OF has_integral_split[OF _ _ k]])
  3603         apply (auto intro: integrable_integral)
  3604         done
  3605     next
  3606     case False
  3607       have "\<not> (f integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}) \<or> \<not> ( f integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k})"
  3608       proof (rule ccontr)
  3609         assume "\<not> ?thesis"
  3610         then have "f integrable_on cbox a b"
  3611           unfolding integrable_on_def
  3612           apply (rule_tac x="integral (cbox a b \<inter> {x. x \<bullet> k \<le> c}) f + integral (cbox a b \<inter> {x. x \<bullet> k \<ge> c}) f" in exI)
  3613           apply (rule has_integral_split[OF _ _ k])
  3614           apply (auto intro: integrable_integral)
  3615           done
  3616         then show False
  3617           using False by auto
  3618       qed
  3619       then show ?thesis
  3620         using False by auto
  3621     qed
  3622   next
  3623     fix a b :: 'a
  3624     assume "content (cbox a b) = 0"
  3625     then show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) = Some 0"
  3626       using has_integral_null_eq
  3627       by (auto simp: integrable_on_null)
  3628   qed
  3629 qed
  3630 
  3631 subsection \<open>Bounds on the norm of Riemann sums and the integral itself.\<close>
  3632 
  3633 lemma dsum_bound:
  3634   assumes "p division_of (cbox a b)"
  3635     and "norm c \<le> e"
  3636   shows "norm (setsum (\<lambda>l. content l *\<^sub>R c) p) \<le> e * content(cbox a b)"
  3637 proof -
  3638   have sumeq: "(\<Sum>i\<in>p. \<bar>content i\<bar>) = setsum content p"
  3639     apply (rule setsum.cong)
  3640     using assms
  3641     apply simp
  3642     apply (metis abs_of_nonneg assms(1) content_pos_le division_ofD(4))
  3643     done
  3644   have e: "0 \<le> e"
  3645     using assms(2) norm_ge_zero order_trans by blast
  3646   have "norm (setsum (\<lambda>l. content l *\<^sub>R c) p) \<le> (\<Sum>i\<in>p. norm (content i *\<^sub>R c))"
  3647     using norm_setsum by blast
  3648   also have "...  \<le> e * (\<Sum>i\<in>p. \<bar>content i\<bar>)"
  3649     by (simp add: setsum_distrib_left[symmetric] mult.commute assms(2) mult_right_mono setsum_nonneg)
  3650   also have "... \<le> e * content (cbox a b)"
  3651     apply (rule mult_left_mono [OF _ e])
  3652     apply (simp add: sumeq)
  3653     using additive_content_division assms(1) eq_iff apply blast
  3654     done
  3655   finally show ?thesis .
  3656 qed
  3657 
  3658 lemma rsum_bound:
  3659   assumes p: "p tagged_division_of (cbox a b)"
  3660       and "\<forall>x\<in>cbox a b. norm (f x) \<le> e"
  3661     shows "norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> e * content (cbox a b)"
  3662 proof (cases "cbox a b = {}")
  3663   case True show ?thesis
  3664     using p unfolding True tagged_division_of_trivial by auto
  3665 next
  3666   case False
  3667   then have e: "e \<ge> 0"
  3668     by (meson ex_in_conv assms(2) norm_ge_zero order_trans)
  3669   have setsum_le: "setsum (content \<circ> snd) p \<le> content (cbox a b)"
  3670     unfolding additive_content_tagged_division[OF p, symmetric] split_def
  3671     by (auto intro: eq_refl)
  3672   have con: "\<And>xk. xk \<in> p \<Longrightarrow> 0 \<le> content (snd xk)"
  3673     using tagged_division_ofD(4) [OF p] content_pos_le
  3674     by force
  3675   have norm: "\<And>xk. xk \<in> p \<Longrightarrow> norm (f (fst xk)) \<le> e"
  3676     unfolding fst_conv using tagged_division_ofD(2,3)[OF p] assms
  3677     by (metis prod.collapse subset_eq)
  3678   have "norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> (\<Sum>i\<in>p. norm (case i of (x, k) \<Rightarrow> content k *\<^sub>R f x))"
  3679     by (rule norm_setsum)
  3680   also have "...  \<le> e * content (cbox a b)"
  3681     unfolding split_def norm_scaleR
  3682     apply (rule order_trans[OF setsum_mono])
  3683     apply (rule mult_left_mono[OF _ abs_ge_zero, of _ e])
  3684     apply (metis norm)
  3685     unfolding setsum_distrib_right[symmetric]
  3686     using con setsum_le
  3687     apply (auto simp: mult.commute intro: mult_left_mono [OF _ e])
  3688     done
  3689   finally show ?thesis .
  3690 qed
  3691 
  3692 lemma rsum_diff_bound:
  3693   assumes "p tagged_division_of (cbox a b)"
  3694     and "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e"
  3695   shows "norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - setsum (\<lambda>(x,k). content k *\<^sub>R g x) p) \<le>
  3696          e * content (cbox a b)"
  3697   apply (rule order_trans[OF _ rsum_bound[OF assms]])
  3698   apply (simp add: split_def scaleR_diff_right setsum_subtractf eq_refl)
  3699   done
  3700 
  3701 lemma has_integral_bound:
  3702   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3703   assumes "0 \<le> B"
  3704       and *: "(f has_integral i) (cbox a b)"
  3705       and "\<forall>x\<in>cbox a b. norm (f x) \<le> B"
  3706     shows "norm i \<le> B * content (cbox a b)"
  3707 proof (rule ccontr)
  3708   assume "\<not> ?thesis"
  3709   then have *: "norm i - B * content (cbox a b) > 0"
  3710     by auto
  3711   from assms(2)[unfolded has_integral,rule_format,OF *]
  3712   guess d by (elim exE conjE) note d=this[rule_format]
  3713   from fine_division_exists[OF this(1), of a b] guess p . note p=this
  3714   have *: "\<And>s B. norm s \<le> B \<Longrightarrow> \<not> norm (s - i) < norm i - B"
  3715     unfolding not_less
  3716     by (metis norm_triangle_sub[of i] add.commute le_less_trans less_diff_eq linorder_not_le norm_minus_commute)
  3717   show False
  3718     using d(2)[OF conjI[OF p]] *[OF rsum_bound[OF p(1) assms(3)]] by auto
  3719 qed
  3720 
  3721 corollary has_integral_bound_real:
  3722   fixes f :: "real \<Rightarrow> 'b::real_normed_vector"
  3723   assumes "0 \<le> B"
  3724       and "(f has_integral i) {a .. b}"
  3725       and "\<forall>x\<in>{a .. b}. norm (f x) \<le> B"
  3726     shows "norm i \<le> B * content {a .. b}"
  3727   by (metis assms box_real(2) has_integral_bound)
  3728 
  3729 corollary integrable_bound:
  3730   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3731   assumes "0 \<le> B"
  3732       and "f integrable_on (cbox a b)"
  3733       and "\<And>x. x\<in>cbox a b \<Longrightarrow> norm (f x) \<le> B"
  3734     shows "norm (integral (cbox a b) f) \<le> B * content (cbox a b)"
  3735 by (metis integrable_integral has_integral_bound assms)
  3736 
  3737 
  3738 subsection \<open>Similar theorems about relationship among components.\<close>
  3739 
  3740 lemma rsum_component_le:
  3741   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3742   assumes "p tagged_division_of (cbox a b)"
  3743       and "\<forall>x\<in>cbox a b. (f x)\<bullet>i \<le> (g x)\<bullet>i"
  3744     shows "(setsum (\<lambda>(x,k). content k *\<^sub>R f x) p)\<bullet>i \<le> (setsum (\<lambda>(x,k). content k *\<^sub>R g x) p)\<bullet>i"
  3745 unfolding inner_setsum_left
  3746 proof (rule setsum_mono, clarify)
  3747   fix a b
  3748   assume ab: "(a, b) \<in> p"
  3749   note tagged = tagged_division_ofD(2-4)[OF assms(1) ab]
  3750   from this(3) guess u v by (elim exE) note b=this
  3751   show "(content b *\<^sub>R f a) \<bullet> i \<le> (content b *\<^sub>R g a) \<bullet> i"
  3752     unfolding b inner_simps real_scaleR_def
  3753     apply (rule mult_left_mono)
  3754     using assms(2) tagged
  3755     by (auto simp add: content_pos_le)
  3756 qed
  3757 
  3758 lemma has_integral_component_le:
  3759   fixes f g :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3760   assumes k: "k \<in> Basis"
  3761   assumes "(f has_integral i) s" "(g has_integral j) s"
  3762     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  3763   shows "i\<bullet>k \<le> j\<bullet>k"
  3764 proof -
  3765   have lem: "i\<bullet>k \<le> j\<bullet>k"
  3766     if f_i: "(f has_integral i) (cbox a b)"
  3767     and g_j: "(g has_integral j) (cbox a b)"
  3768     and le: "\<forall>x\<in>cbox a b. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  3769     for a b i and j :: 'b and f g :: "'a \<Rightarrow> 'b"
  3770   proof (rule ccontr)
  3771     assume "\<not> ?thesis"
  3772     then have *: "0 < (i\<bullet>k - j\<bullet>k) / 3"
  3773       by auto
  3774     guess d1 using f_i[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d1=this[rule_format]
  3775     guess d2 using g_j[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d2=this[rule_format]
  3776     obtain p where p: "p tagged_division_of cbox a b" "d1 fine p" "d2 fine p"
  3777        using fine_division_exists[OF gauge_inter[OF d1(1) d2(1)], of a b] unfolding fine_inter
  3778        by metis
  3779     note le_less_trans[OF Basis_le_norm[OF k]]
  3780     then have "\<bar>((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
  3781               "\<bar>((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - j) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
  3782       using  k norm_bound_Basis_lt d1 d2 p
  3783       by blast+
  3784     then show False
  3785       unfolding inner_simps
  3786       using rsum_component_le[OF p(1) le]
  3787       by (simp add: abs_real_def split: if_split_asm)
  3788   qed
  3789   show ?thesis
  3790   proof (cases "\<exists>a b. s = cbox a b")
  3791     case True
  3792     with lem assms show ?thesis
  3793       by auto
  3794   next
  3795     case False
  3796     show ?thesis
  3797     proof (rule ccontr)
  3798       assume "\<not> i\<bullet>k \<le> j\<bullet>k"
  3799       then have ij: "(i\<bullet>k - j\<bullet>k) / 3 > 0"
  3800         by auto
  3801       note has_integral_altD[OF _ False this]
  3802       from this[OF assms(2)] this[OF assms(3)] guess B1 B2 . note B=this[rule_format]
  3803       have "bounded (ball 0 B1 \<union> ball (0::'a) B2)"
  3804         unfolding bounded_Un by(rule conjI bounded_ball)+
  3805       from bounded_subset_cbox[OF this] guess a b by (elim exE)
  3806       note ab = conjunctD2[OF this[unfolded Un_subset_iff]]
  3807       guess w1 using B(2)[OF ab(1)] .. note w1=conjunctD2[OF this]
  3808       guess w2 using B(4)[OF ab(2)] .. note w2=conjunctD2[OF this]
  3809       have *: "\<And>w1 w2 j i::real .\<bar>w1 - i\<bar> < (i - j) / 3 \<Longrightarrow> \<bar>w2 - j\<bar> < (i - j) / 3 \<Longrightarrow> w1 \<le> w2 \<Longrightarrow> False"
  3810         by (simp add: abs_real_def split: if_split_asm)
  3811       note le_less_trans[OF Basis_le_norm[OF k]]
  3812       note this[OF w1(2)] this[OF w2(2)]
  3813       moreover
  3814       have "w1\<bullet>k \<le> w2\<bullet>k"
  3815         by (rule lem[OF w1(1) w2(1)]) (simp add: assms(4))
  3816       ultimately show False
  3817         unfolding inner_simps by(rule *)
  3818     qed
  3819   qed
  3820 qed
  3821 
  3822 lemma integral_component_le:
  3823   fixes g f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3824   assumes "k \<in> Basis"
  3825     and "f integrable_on s" "g integrable_on s"
  3826     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  3827   shows "(integral s f)\<bullet>k \<le> (integral s g)\<bullet>k"
  3828   apply (rule has_integral_component_le)
  3829   using integrable_integral assms
  3830   apply auto
  3831   done
  3832 
  3833 lemma has_integral_component_nonneg:
  3834   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3835   assumes "k \<in> Basis"
  3836     and "(f has_integral i) s"
  3837     and "\<forall>x\<in>s. 0 \<le> (f x)\<bullet>k"
  3838   shows "0 \<le> i\<bullet>k"
  3839   using has_integral_component_le[OF assms(1) has_integral_0 assms(2)]
  3840   using assms(3-)
  3841   by auto
  3842 
  3843 lemma integral_component_nonneg:
  3844   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3845   assumes "k \<in> Basis"
  3846     and  "\<forall>x\<in>s. 0 \<le> (f x)\<bullet>k"
  3847   shows "0 \<le> (integral s f)\<bullet>k"
  3848 proof (cases "f integrable_on s")
  3849   case True show ?thesis
  3850     apply (rule has_integral_component_nonneg)
  3851     using assms True
  3852     apply auto
  3853     done
  3854 next
  3855   case False then show ?thesis by (simp add: not_integrable_integral)
  3856 qed
  3857 
  3858 lemma has_integral_component_neg:
  3859   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3860   assumes "k \<in> Basis"
  3861     and "(f has_integral i) s"
  3862     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> 0"
  3863   shows "i\<bullet>k \<le> 0"
  3864   using has_integral_component_le[OF assms(1,2) has_integral_0] assms(2-)
  3865   by auto
  3866 
  3867 lemma has_integral_component_lbound:
  3868   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3869   assumes "(f has_integral i) (cbox a b)"
  3870     and "\<forall>x\<in>cbox a b. B \<le> f(x)\<bullet>k"
  3871     and "k \<in> Basis"
  3872   shows "B * content (cbox a b) \<le> i\<bullet>k"
  3873   using has_integral_component_le[OF assms(3) has_integral_const assms(1),of "(\<Sum>i\<in>Basis. B *\<^sub>R i)::'b"] assms(2-)
  3874   by (auto simp add: field_simps)
  3875 
  3876 lemma has_integral_component_ubound:
  3877   fixes f::"'a::euclidean_space => 'b::euclidean_space"
  3878   assumes "(f has_integral i) (cbox a b)"
  3879     and "\<forall>x\<in>cbox a b. f x\<bullet>k \<le> B"
  3880     and "k \<in> Basis"
  3881   shows "i\<bullet>k \<le> B * content (cbox a b)"
  3882   using has_integral_component_le[OF assms(3,1) has_integral_const, of "\<Sum>i\<in>Basis. B *\<^sub>R i"] assms(2-)
  3883   by (auto simp add: field_simps)
  3884 
  3885 lemma integral_component_lbound:
  3886   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3887   assumes "f integrable_on cbox a b"
  3888     and "\<forall>x\<in>cbox a b. B \<le> f(x)\<bullet>k"
  3889     and "k \<in> Basis"
  3890   shows "B * content (cbox a b) \<le> (integral(cbox a b) f)\<bullet>k"
  3891   apply (rule has_integral_component_lbound)
  3892   using assms
  3893   unfolding has_integral_integral
  3894   apply auto
  3895   done
  3896 
  3897 lemma integral_component_lbound_real:
  3898   assumes "f integrable_on {a ::real .. b}"
  3899     and "\<forall>x\<in>{a .. b}. B \<le> f(x)\<bullet>k"
  3900     and "k \<in> Basis"
  3901   shows "B * content {a .. b} \<le> (integral {a .. b} f)\<bullet>k"
  3902   using assms
  3903   by (metis box_real(2) integral_component_lbound)
  3904 
  3905 lemma integral_component_ubound:
  3906   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3907   assumes "f integrable_on cbox a b"
  3908     and "\<forall>x\<in>cbox a b. f x\<bullet>k \<le> B"
  3909     and "k \<in> Basis"
  3910   shows "(integral (cbox a b) f)\<bullet>k \<le> B * content (cbox a b)"
  3911   apply (rule has_integral_component_ubound)
  3912   using assms
  3913   unfolding has_integral_integral
  3914   apply auto
  3915   done
  3916 
  3917 lemma integral_component_ubound_real:
  3918   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
  3919   assumes "f integrable_on {a .. b}"
  3920     and "\<forall>x\<in>{a .. b}. f x\<bullet>k \<le> B"
  3921     and "k \<in> Basis"
  3922   shows "(integral {a .. b} f)\<bullet>k \<le> B * content {a .. b}"
  3923   using assms
  3924   by (metis box_real(2) integral_component_ubound)
  3925 
  3926 subsection \<open>Uniform limit of integrable functions is integrable.\<close>
  3927 
  3928 lemma real_arch_invD:
  3929   "0 < (e::real) \<Longrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
  3930   by (subst(asm) real_arch_inverse)
  3931 
  3932 lemma integrable_uniform_limit:
  3933   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
  3934   assumes "\<forall>e>0. \<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
  3935   shows "f integrable_on cbox a b"
  3936 proof (cases "content (cbox a b) > 0")
  3937   case False then show ?thesis
  3938       using has_integral_null
  3939       by (simp add: content_lt_nz integrable_on_def)
  3940 next
  3941   case True
  3942   have *: "\<And>P. \<forall>e>(0::real). P e \<Longrightarrow> \<forall>n::nat. P (inverse (real n + 1))"
  3943     by auto
  3944   from choice[OF *[OF assms]] guess g .. note g=conjunctD2[OF this[rule_format],rule_format]
  3945   from choice[OF allI[OF g(2)[unfolded integrable_on_def], of "\<lambda>x. x"]]
  3946   obtain i where i: "\<And>x. (g x has_integral i x) (cbox a b)"
  3947       by auto
  3948   have "Cauchy i"
  3949     unfolding Cauchy_def
  3950   proof clarify
  3951     fix e :: real
  3952     assume "e>0"
  3953     then have "e / 4 / content (cbox a b) > 0"
  3954       using True by (auto simp add: field_simps)
  3955     then obtain M :: nat
  3956          where M: "M \<noteq> 0" "0 < inverse (real_of_nat M)" "inverse (of_nat M) < e / 4 / content (cbox a b)"
  3957       by (subst (asm) real_arch_inverse) auto
  3958     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (i m) (i n) < e"
  3959     proof (rule exI [where x=M], clarify)
  3960       fix m n
  3961       assume m: "M \<le> m" and n: "M \<le> n"
  3962       have "e/4>0" using \<open>e>0\<close> by auto
  3963       note * = i[unfolded has_integral,rule_format,OF this]
  3964       from *[of m] guess gm by (elim conjE exE) note gm=this[rule_format]
  3965       from *[of n] guess gn by (elim conjE exE) note gn=this[rule_format]
  3966       from fine_division_exists[OF gauge_inter[OF gm(1) gn(1)], of a b]
  3967       obtain p where p: "p tagged_division_of cbox a b" "(\<lambda>x. gm x \<inter> gn x) fine p"
  3968         by auto
  3969       { fix s1 s2 i1 and i2::'b
  3970         assume no: "norm(s2 - s1) \<le> e/2" "norm (s1 - i1) < e/4" "norm (s2 - i2) < e/4"
  3971         have "norm (i1 - i2) \<le> norm (i1 - s1) + norm (s1 - s2) + norm (s2 - i2)"
  3972           using norm_triangle_ineq[of "i1 - s1" "s1 - i2"]
  3973           using norm_triangle_ineq[of "s1 - s2" "s2 - i2"]
  3974           by (auto simp add: algebra_simps)
  3975         also have "\<dots> < e"
  3976           using no
  3977           unfolding norm_minus_commute
  3978           by (auto simp add: algebra_simps)
  3979         finally have "norm (i1 - i2) < e" .
  3980       } note triangle3 = this
  3981       have finep: "gm fine p" "gn fine p"
  3982         using fine_inter p  by auto
  3983       { fix x
  3984         assume x: "x \<in> cbox a b"
  3985         have "norm (f x - g n x) + norm (f x - g m x) \<le> inverse (real n + 1) + inverse (real m + 1)"
  3986           using g(1)[OF x, of n] g(1)[OF x, of m] by auto
  3987         also have "\<dots> \<le> inverse (real M) + inverse (real M)"
  3988           apply (rule add_mono)
  3989           using M(2) m n by auto
  3990         also have "\<dots> = 2 / real M"
  3991           unfolding divide_inverse by auto
  3992         finally have "norm (g n x - g m x) \<le> 2 / real M"
  3993           using norm_triangle_le[of "g n x - f x" "f x - g m x" "2 / real M"]
  3994           by (auto simp add: algebra_simps simp add: norm_minus_commute)
  3995       } note norm_le = this
  3996       have le_e2: "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g n x) - (\<Sum>(x, k)\<in>p. content k *\<^sub>R g m x)) \<le> e / 2"
  3997         apply (rule order_trans [OF rsum_diff_bound[OF p(1), where e="2 / real M"]])
  3998         apply (blast intro: norm_le)
  3999         using M True
  4000         by (auto simp add: field_simps)
  4001       then show "dist (i m) (i n) < e"
  4002         unfolding dist_norm
  4003         using gm gn p finep
  4004         by (auto intro!: triangle3)
  4005     qed
  4006   qed
  4007   then obtain s where s: "i \<longlonglongrightarrow> s"
  4008     using convergent_eq_cauchy[symmetric] by blast
  4009   show ?thesis
  4010     unfolding integrable_on_def has_integral
  4011   proof (rule_tac x=s in exI, clarify)
  4012     fix e::real
  4013     assume e: "0 < e"
  4014     then have *: "e/3 > 0" by auto
  4015     then obtain N1 where N1: "\<forall>n\<ge>N1. norm (i n - s) < e / 3"
  4016       using LIMSEQ_D [OF s] by metis
  4017     from e True have "e / 3 / content (cbox a b) > 0"
  4018       by (auto simp add: field_simps)
  4019     from real_arch_invD[OF this] guess N2 by (elim exE conjE) note N2=this
  4020     from i[of "N1 + N2",unfolded has_integral,rule_format,OF *] guess g' .. note g'=conjunctD2[OF this,rule_format]
  4021     { fix sf sg i
  4022       assume no: "norm (sf - sg) \<le> e / 3"
  4023                  "norm(i - s) < e / 3"
  4024                  "norm (sg - i) < e / 3"
  4025       have "norm (sf - s) \<le> norm (sf - sg) + norm (sg - i) + norm (i - s)"
  4026         using norm_triangle_ineq[of "sf - sg" "sg - s"]
  4027         using norm_triangle_ineq[of "sg -  i" " i - s"]
  4028         by (auto simp add: algebra_simps)
  4029       also have "\<dots> < e"
  4030         using no
  4031         unfolding norm_minus_commute
  4032         by (auto simp add: algebra_simps)
  4033       finally have "norm (sf - s) < e" .
  4034     } note lem = this
  4035     { fix p
  4036       assume p: "p tagged_division_of (cbox a b) \<and> g' fine p"
  4037       then have norm_less: "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g (N1 + N2) x) - i (N1 + N2)) < e / 3"
  4038         using g' by blast
  4039       have "content (cbox a b) < e / 3 * (of_nat N2)"
  4040         using N2 unfolding inverse_eq_divide using True by (auto simp add: field_simps)
  4041       moreover have "e / 3 * of_nat N2 \<le> e / 3 * (of_nat (N1 + N2) + 1)"
  4042         using \<open>e>0\<close> by auto
  4043       ultimately have "content (cbox a b) < e / 3 * (of_nat (N1 + N2) + 1)"
  4044         by linarith
  4045       then have le_e3: "inverse (real (N1 + N2) + 1) * content (cbox a b) \<le> e / 3"
  4046         unfolding inverse_eq_divide
  4047         by (auto simp add: field_simps)
  4048       have ne3: "norm (i (N1 + N2) - s) < e / 3"
  4049         using N1 by auto
  4050       have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - s) < e"
  4051         apply (rule lem[OF order_trans [OF _ le_e3] ne3 norm_less])
  4052         apply (rule rsum_diff_bound[OF p[THEN conjunct1]])
  4053         apply (blast intro: g)
  4054         done }
  4055     then show "\<exists>d. gauge d \<and>
  4056              (\<forall>p. p tagged_division_of cbox a b \<and> d fine p \<longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - s) < e)"
  4057       by (blast intro: g')
  4058   qed
  4059 qed
  4060 
  4061 lemmas integrable_uniform_limit_real = integrable_uniform_limit [where 'a=real, simplified]
  4062 
  4063 
  4064 subsection \<open>Negligible sets.\<close>
  4065 
  4066 definition "negligible (s:: 'a::euclidean_space set) \<longleftrightarrow>
  4067   (\<forall>a b. ((indicator s :: 'a\<Rightarrow>real) has_integral 0) (cbox a b))"
  4068 
  4069 
  4070 subsection \<open>Negligibility of hyperplane.\<close>
  4071 
  4072 lemma interval_doublesplit:
  4073   fixes a :: "'a::euclidean_space"
  4074   assumes "k \<in> Basis"
  4075   shows "cbox a b \<inter> {x . \<bar>x\<bullet>k - c\<bar> \<le> (e::real)} =
  4076     cbox (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) (c - e) else a\<bullet>i) *\<^sub>R i)
  4077      (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) (c + e) else b\<bullet>i) *\<^sub>R i)"
  4078 proof -
  4079   have *: "\<And>x c e::real. \<bar>x - c\<bar> \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
  4080     by auto
  4081   have **: "\<And>s P Q. s \<inter> {x. P x \<and> Q x} = (s \<inter> {x. Q x}) \<inter> {x. P x}"
  4082     by blast
  4083   show ?thesis
  4084     unfolding * ** interval_split[OF assms] by (rule refl)
  4085 qed
  4086 
  4087 lemma division_doublesplit:
  4088   fixes a :: "'a::euclidean_space"
  4089   assumes "p division_of (cbox a b)"
  4090     and k: "k \<in> Basis"
  4091   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> {}}
  4092          division_of  (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> e})"
  4093 proof -
  4094   have *: "\<And>x c. \<bar>x - c\<bar> \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
  4095     by auto
  4096   have **: "\<And>p q p' q'. p division_of q \<Longrightarrow> p = p' \<Longrightarrow> q = q' \<Longrightarrow> p' division_of q'"
  4097     by auto
  4098   note division_split(1)[OF assms, where c="c+e",unfolded interval_split[OF k]]
  4099   note division_split(2)[OF this, where c="c-e" and k=k,OF k]
  4100   then show ?thesis
  4101     apply (rule **)
  4102     subgoal
  4103       apply (simp add: abs_diff_le_iff field_simps Collect_conj_eq setcompr_eq_image[symmetric])
  4104       apply (rule equalityI)
  4105       apply blast
  4106       apply clarsimp
  4107       apply (rule_tac x="l \<inter> {x. c + e \<ge> x \<bullet> k}" in exI)
  4108       apply auto
  4109       done
  4110     by (simp add: interval_split k interval_doublesplit)
  4111 qed
  4112 
  4113 lemma content_doublesplit:
  4114   fixes a :: "'a::euclidean_space"
  4115   assumes "0 < e"
  4116     and k: "k \<in> Basis"
  4117   obtains d where "0 < d" and "content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d}) < e"
  4118 proof cases
  4119   assume *: "a \<bullet> k \<le> c \<and> c \<le> b \<bullet> k \<and> (\<forall>j\<in>Basis. a \<bullet> j \<le> b \<bullet> j)"
  4120   define a' where "a' d = (\<Sum>j\<in>Basis. (if j = k then max (a\<bullet>j) (c - d) else a\<bullet>j) *\<^sub>R j)" for d
  4121   define b' where "b' d = (\<Sum>j\<in>Basis. (if j = k then min (b\<bullet>j) (c + d) else b\<bullet>j) *\<^sub>R j)" for d
  4122 
  4123   have "((\<lambda>d. \<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) \<longlongrightarrow> (\<Prod>j\<in>Basis. (b' 0 - a' 0) \<bullet> j)) (at_right 0)"
  4124     by (auto simp: b'_def a'_def intro!: tendsto_min tendsto_max tendsto_eq_intros)
  4125   also have "(\<Prod>j\<in>Basis. (b' 0 - a' 0) \<bullet> j) = 0"
  4126     using k *
  4127     by (intro setprod_zero bexI[OF _ k])
  4128        (auto simp: b'_def a'_def inner_diff inner_setsum_left inner_not_same_Basis intro!: setsum.cong)
  4129   also have "((\<lambda>d. \<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) \<longlongrightarrow> 0) (at_right 0) =
  4130     ((\<lambda>d. content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d})) \<longlongrightarrow> 0) (at_right 0)"
  4131   proof (intro tendsto_cong eventually_at_rightI)
  4132     fix d :: real assume d: "d \<in> {0<..<1}"
  4133     have "cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d} = cbox (a' d) (b' d)" for d
  4134       using * d k by (auto simp add: cbox_def set_eq_iff Int_def ball_conj_distrib abs_diff_le_iff a'_def b'_def)
  4135     moreover have "j \<in> Basis \<Longrightarrow> a' d \<bullet> j \<le> b' d \<bullet> j" for j
  4136       using * d k by (auto simp: a'_def b'_def)
  4137     ultimately show "(\<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) = content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d})"
  4138       by simp
  4139   qed simp
  4140   finally have "((\<lambda>d. content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) \<longlongrightarrow> 0) (at_right 0)" .
  4141   from order_tendstoD(2)[OF this \<open>0<e\<close>]
  4142   obtain d' where "0 < d'" and d': "\<And>y. y > 0 \<Longrightarrow> y < d' \<Longrightarrow> content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> y}) < e"
  4143     by (subst (asm) eventually_at_right[of _ 1]) auto
  4144   show ?thesis
  4145     by (rule that[of "d'/2"], insert \<open>0<d'\<close> d'[of "d'/2"], auto)
  4146 next
  4147   assume *: "\<not> (a \<bullet> k \<le> c \<and> c \<le> b \<bullet> k \<and> (\<forall>j\<in>Basis. a \<bullet> j \<le> b \<bullet> j))"
  4148   then have "(\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j) \<or> (c < a \<bullet> k \<or> b \<bullet> k < c)"
  4149     by (auto simp: not_le)
  4150   show thesis
  4151   proof cases
  4152     assume "\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j"
  4153     then have [simp]: "cbox a b = {}"
  4154       using box_ne_empty(1)[of a b] by auto
  4155     show ?thesis
  4156       by (rule that[of 1]) (simp_all add: \<open>0<e\<close>)
  4157   next
  4158     assume "\<not> (\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j)"
  4159     with * have "c < a \<bullet> k \<or> b \<bullet> k < c"
  4160       by auto
  4161     then show thesis
  4162     proof
  4163       assume c: "c < a \<bullet> k"
  4164       moreover have "x \<in> cbox a b \<Longrightarrow> c \<le> x \<bullet> k" for x
  4165         using k c by (auto simp: cbox_def)
  4166       ultimately have "cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> (a \<bullet> k - c) / 2} = {}"
  4167         using k by (auto simp: cbox_def)
  4168       with \<open>0<e\<close> c that[of "(a \<bullet> k - c) / 2"] show ?thesis
  4169         by auto
  4170     next
  4171       assume c: "b \<bullet> k < c"
  4172       moreover have "x \<in> cbox a b \<Longrightarrow> x \<bullet> k \<le> c" for x
  4173         using k c by (auto simp: cbox_def)
  4174       ultimately have "cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> (c - b \<bullet> k) / 2} = {}"
  4175         using k by (auto simp: cbox_def)
  4176       with \<open>0<e\<close> c that[of "(c - b \<bullet> k) / 2"] show ?thesis
  4177         by auto
  4178     qed
  4179   qed
  4180 qed
  4181 
  4182 
  4183 lemma negligible_standard_hyperplane[intro]:
  4184   fixes k :: "'a::euclidean_space"
  4185   assumes k: "k \<in> Basis"
  4186   shows "negligible {x. x\<bullet>k = c}"
  4187   unfolding negligible_def has_integral
  4188 proof (clarify, goal_cases)
  4189   case (1 a b e)
  4190   from this and k obtain d where d: "0 < d" "content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) < e"
  4191     by (rule content_doublesplit)
  4192   let ?i = "indicator {x::'a. x\<bullet>k = c} :: 'a\<Rightarrow>real"
  4193   show ?case
  4194     apply (rule_tac x="\<lambda>x. ball x d" in exI)
  4195     apply rule
  4196     apply (rule gauge_ball)
  4197     apply (rule d)
  4198   proof (rule, rule)
  4199     fix p
  4200     assume p: "p tagged_division_of (cbox a b) \<and> (\<lambda>x. ball x d) fine p"
  4201     have *: "(\<Sum>(x, ka)\<in>p. content ka *\<^sub>R ?i x) =
  4202       (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d}) *\<^sub>R ?i x)"
  4203       apply (rule setsum.cong)
  4204       apply (rule refl)
  4205       unfolding split_paired_all real_scaleR_def mult_cancel_right split_conv
  4206       apply cases
  4207       apply (rule disjI1)
  4208       apply assumption
  4209       apply (rule disjI2)
  4210     proof -
  4211       fix x l
  4212       assume as: "(x, l) \<in> p" "?i x \<noteq> 0"
  4213       then have xk: "x\<bullet>k = c"
  4214         unfolding indicator_def
  4215         apply -
  4216         apply (rule ccontr)
  4217         apply auto
  4218         done
  4219       show "content l = content (l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})"
  4220         apply (rule arg_cong[where f=content])
  4221         apply (rule set_eqI)
  4222         apply rule
  4223         apply rule
  4224         unfolding mem_Collect_eq
  4225       proof -
  4226         fix y
  4227         assume y: "y \<in> l"
  4228         note p[THEN conjunct2,unfolded fine_def,rule_format,OF as(1),unfolded split_conv]
  4229         note this[unfolded subset_eq mem_ball dist_norm,rule_format,OF y]
  4230         note le_less_trans[OF Basis_le_norm[OF k] this]
  4231         then show "\<bar>y \<bullet> k - c\<bar> \<le> d"
  4232           unfolding inner_simps xk by auto
  4233       qed auto
  4234     qed
  4235     note p'= tagged_division_ofD[OF p[THEN conjunct1]] and p''=division_of_tagged_division[OF p[THEN conjunct1]]
  4236     show "norm ((\<Sum>(x, ka)\<in>p. content ka *\<^sub>R ?i x) - 0) < e"
  4237       unfolding diff_0_right *
  4238       unfolding real_scaleR_def real_norm_def
  4239       apply (subst abs_of_nonneg)
  4240       apply (rule setsum_nonneg)
  4241       apply rule
  4242       unfolding split_paired_all split_conv
  4243       apply (rule mult_nonneg_nonneg)
  4244       apply (drule p'(4))
  4245       apply (erule exE)+
  4246       apply(rule_tac b=b in back_subst)
  4247       prefer 2
  4248       apply (subst(asm) eq_commute)
  4249       apply assumption
  4250       apply (subst interval_doublesplit[OF k])
  4251       apply (rule content_pos_le)
  4252       apply (rule indicator_pos_le)
  4253     proof -
  4254       have "(\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * ?i x) \<le>
  4255         (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}))"
  4256         apply (rule setsum_mono)
  4257         unfolding split_paired_all split_conv
  4258         apply (rule mult_right_le_one_le)
  4259         apply (drule p'(4))
  4260         apply (auto simp add:interval_doublesplit[OF k])
  4261         done
  4262       also have "\<dots> < e"
  4263       proof (subst setsum.over_tagged_division_lemma[OF p[THEN conjunct1]], goal_cases)
  4264         case prems: (1 u v)
  4265         have "content (cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<le> content (cbox u v)"
  4266           unfolding interval_doublesplit[OF k]
  4267           apply (rule content_subset)
  4268           unfolding interval_doublesplit[symmetric,OF k]
  4269           apply auto
  4270           done
  4271         then show ?case
  4272           unfolding prems interval_doublesplit[OF k]
  4273           by (blast intro: antisym)
  4274       next
  4275         have "(\<Sum>l\<in>snd ` p. content (l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) =
  4276           setsum content ((\<lambda>l. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})`{l\<in>snd ` p. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}})"
  4277         proof (subst (2) setsum.reindex_nontrivial)
  4278           fix x y assume "x \<in> {l \<in> snd ` p. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}" "y \<in> {l \<in> snd ` p. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}"
  4279             "x \<noteq> y" and eq: "x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} = y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}"
  4280           then obtain x' y' where "(x', x) \<in> p" "x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}" "(y', y) \<in> p" "y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}"
  4281             by (auto)
  4282           from p'(5)[OF \<open>(x', x) \<in> p\<close> \<open>(y', y) \<in> p\<close>] \<open>x \<noteq> y\<close> have "interior (x \<inter> y) = {}"
  4283             by auto
  4284           moreover have "interior ((x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<inter> (y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) \<subseteq> interior (x \<inter> y)"
  4285             by (auto intro: interior_mono)
  4286           ultimately have "interior (x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = {}"
  4287             by (auto simp: eq)
  4288           then show "content (x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = 0"
  4289             using p'(4)[OF \<open>(x', x) \<in> p\<close>] by (auto simp: interval_doublesplit[OF k] content_eq_0_interior simp del: interior_Int)
  4290         qed (insert p'(1), auto intro!: setsum.mono_neutral_right)
  4291         also have "\<dots> \<le> norm (\<Sum>l\<in>(\<lambda>l. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})`{l\<in>snd ` p. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}. content l *\<^sub>R 1::real)"
  4292           by simp
  4293         also have "\<dots> \<le> 1 * content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})"
  4294           using division_doublesplit[OF p'' k, unfolded interval_doublesplit[OF k]]
  4295           unfolding interval_doublesplit[OF k] by (intro dsum_bound) auto
  4296         also have "\<dots> < e"
  4297           using d(2) by simp
  4298         finally show "(\<Sum>ka\<in>snd ` p. content (ka \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) < e" .
  4299       qed
  4300       finally show "(\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * ?i x) < e" .
  4301     qed
  4302   qed
  4303 qed
  4304 
  4305 
  4306 subsection \<open>A technical lemma about "refinement" of division.\<close>
  4307 
  4308 lemma tagged_division_finer:
  4309   fixes p :: "('a::euclidean_space \<times> ('a::euclidean_space set)) set"
  4310   assumes "p tagged_division_of (cbox a b)"
  4311     and "gauge d"
  4312   obtains q where "q tagged_division_of (cbox a b)"
  4313     and "d fine q"
  4314     and "\<forall>(x,k) \<in> p. k \<subseteq> d(x) \<longrightarrow> (x,k) \<in> q"
  4315 proof -
  4316   let ?P = "\<lambda>p. p tagged_partial_division_of (cbox a b) \<longrightarrow> gauge d \<longrightarrow>
  4317     (\<exists>q. q tagged_division_of (\<Union>{k. \<exists>x. (x,k) \<in> p}) \<and> d fine q \<and>
  4318       (\<forall>(x,k) \<in> p. k \<subseteq> d(x) \<longrightarrow> (x,k) \<in> q))"
  4319   {
  4320     have *: "finite p" "p tagged_partial_division_of (cbox a b)"
  4321       using assms(1)
  4322       unfolding tagged_division_of_def
  4323       by auto
  4324     presume "\<And>p. finite p \<Longrightarrow> ?P p"
  4325     from this[rule_format,OF * assms(2)] guess q .. note q=this
  4326     then show ?thesis
  4327       apply -
  4328       apply (rule that[of q])
  4329       unfolding tagged_division_ofD[OF assms(1)]
  4330       apply auto
  4331       done
  4332   }
  4333   fix p :: "('a::euclidean_space \<times> ('a::euclidean_space set)) set"
  4334   assume as: "finite p"
  4335   show "?P p"
  4336     apply rule
  4337     apply rule
  4338     using as
  4339   proof (induct p)
  4340     case empty
  4341     show ?case
  4342       apply (rule_tac x="{}" in exI)
  4343       unfolding fine_def
  4344       apply auto
  4345       done
  4346   next
  4347     case (insert xk p)
  4348     guess x k using surj_pair[of xk] by (elim exE) note xk=this
  4349     note tagged_partial_division_subset[OF insert(4) subset_insertI]
  4350     from insert(3)[OF this insert(5)] guess q1 .. note q1 = conjunctD3[OF this]
  4351     have *: "\<Union>{l. \<exists>y. (y,l) \<in> insert xk p} = k \<union> \<Union>{l. \<exists>y. (y,l) \<in> p}"
  4352       unfolding xk by auto
  4353     note p = tagged_partial_division_ofD[OF insert(4)]
  4354     from p(4)[unfolded xk, OF insertI1] guess u v by (elim exE) note uv=this
  4355 
  4356     have "finite {k. \<exists>x. (x, k) \<in> p}"
  4357       apply (rule finite_subset[of _ "snd ` p"])
  4358       using p
  4359       apply safe
  4360       apply (metis image_iff snd_conv)
  4361       apply auto
  4362       done
  4363     then have int: "interior (cbox u v) \<inter> interior (\<Union>{k. \<exists>x. (x, k) \<in> p}) = {}"
  4364       apply (rule inter_interior_unions_intervals)
  4365       apply (rule open_interior)
  4366       apply (rule_tac[!] ballI)
  4367       unfolding mem_Collect_eq
  4368       apply (erule_tac[!] exE)
  4369       apply (drule p(4)[OF insertI2])
  4370       apply assumption
  4371       apply (rule p(5))
  4372       unfolding uv xk
  4373       apply (rule insertI1)
  4374       apply (rule insertI2)
  4375       apply assumption
  4376       using insert(2)
  4377       unfolding uv xk
  4378       apply auto
  4379       done
  4380     show ?case
  4381     proof (cases "cbox u v \<subseteq> d x")
  4382       case True
  4383       then show ?thesis
  4384         apply (rule_tac x="{(x,cbox u v)} \<union> q1" in exI)
  4385         apply rule
  4386         unfolding * uv
  4387         apply (rule tagged_division_union)
  4388         apply (rule tagged_division_of_self)
  4389         apply (rule p[unfolded xk uv] insertI1)+
  4390         apply (rule q1)
  4391         apply (rule int)
  4392         apply rule
  4393         apply (rule fine_union)
  4394         apply (subst fine_def)
  4395         defer
  4396         apply (rule q1)
  4397         unfolding Ball_def split_paired_All split_conv
  4398         apply rule
  4399         apply rule
  4400         apply rule
  4401         apply rule
  4402         apply (erule insertE)
  4403         apply (simp add: uv xk)
  4404         apply (rule UnI2)
  4405         apply (drule q1(3)[rule_format])
  4406         unfolding xk uv
  4407         apply auto
  4408         done
  4409     next
  4410       case False
  4411       from fine_division_exists[OF assms(2), of u v] guess q2 . note q2=this
  4412       show ?thesis
  4413         apply (rule_tac x="q2 \<union> q1" in exI)
  4414         apply rule
  4415         unfolding * uv
  4416         apply (rule tagged_division_union q2 q1 int fine_union)+
  4417         unfolding Ball_def split_paired_All split_conv
  4418         apply rule
  4419         apply (rule fine_union)
  4420         apply (rule q1 q2)+
  4421         apply rule
  4422         apply rule
  4423         apply rule
  4424         apply rule
  4425         apply (erule insertE)
  4426         apply (rule UnI2)
  4427         apply (simp add: False uv xk)
  4428         apply (drule q1(3)[rule_format])
  4429         using False
  4430         unfolding xk uv
  4431         apply auto
  4432         done
  4433     qed
  4434   qed
  4435 qed
  4436 
  4437 
  4438 subsection \<open>Hence the main theorem about negligible sets.\<close>
  4439 
  4440 lemma finite_product_dependent:
  4441   assumes "finite s"
  4442     and "\<And>x. x \<in> s \<Longrightarrow> finite (t x)"
  4443   shows "finite {(i, j) |i j. i \<in> s \<and> j \<in> t i}"
  4444   using assms
  4445 proof induct
  4446   case (insert x s)
  4447   have *: "{(i, j) |i j. i \<in> insert x s \<and> j \<in> t i} =
  4448     (\<lambda>y. (x,y)) ` (t x) \<union> {(i, j) |i j. i \<in> s \<and> j \<in> t i}" by auto
  4449   show ?case
  4450     unfolding *
  4451     apply (rule finite_UnI)
  4452     using insert
  4453     apply auto
  4454     done
  4455 qed auto
  4456 
  4457 lemma sum_sum_product:
  4458   assumes "finite s"
  4459     and "\<forall>i\<in>s. finite (t i)"
  4460   shows "setsum (\<lambda>i. setsum (x i) (t i)::real) s =
  4461     setsum (\<lambda>(i,j). x i j) {(i,j) | i j. i \<in> s \<and> j \<in> t i}"
  4462   using assms
  4463 proof induct
  4464   case (insert a s)
  4465   have *: "{(i, j) |i j. i \<in> insert a s \<and> j \<in> t i} =
  4466     (\<lambda>y. (a,y)) ` (t a) \<union> {(i, j) |i j. i \<in> s \<and> j \<in> t i}" by auto
  4467   show ?case
  4468     unfolding *
  4469     apply (subst setsum.union_disjoint)
  4470     unfolding setsum.insert[OF insert(1-2)]
  4471     prefer 4
  4472     apply (subst insert(3))
  4473     unfolding add_right_cancel
  4474   proof -
  4475     show "setsum (x a) (t a) = (\<Sum>(xa, y)\<in> Pair a ` t a. x xa y)"
  4476       apply (subst setsum.reindex)
  4477       unfolding inj_on_def
  4478       apply auto
  4479       done
  4480     show "finite {(i, j) |i j. i \<in> s \<and> j \<in> t i}"
  4481       apply (rule finite_product_dependent)
  4482       using insert
  4483       apply auto
  4484       done
  4485   qed (insert insert, auto)
  4486 qed auto
  4487 
  4488 lemma has_integral_negligible:
  4489   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  4490   assumes "negligible s"
  4491     and "\<forall>x\<in>(t - s). f x = 0"
  4492   shows "(f has_integral 0) t"
  4493 proof -
  4494   presume P: "\<And>f::'b::euclidean_space \<Rightarrow> 'a.
  4495     \<And>a b. \<forall>x. x \<notin> s \<longrightarrow> f x = 0 \<Longrightarrow> (f has_integral 0) (cbox a b)"
  4496   let ?f = "(\<lambda>x. if x \<in> t then f x else 0)"
  4497   show ?thesis
  4498     apply (rule_tac f="?f" in has_integral_eq)
  4499     unfolding if_P
  4500     apply (rule refl)
  4501     apply (subst has_integral_alt)
  4502     apply cases
  4503     apply (subst if_P, assumption)
  4504     unfolding if_not_P
  4505   proof -
  4506     assume "\<exists>a b. t = cbox a b"
  4507     then guess a b apply - by (erule exE)+ note t = this
  4508     show "(?f has_integral 0) t"
  4509       unfolding t
  4510       apply (rule P)
  4511       using assms(2)
  4512       unfolding t
  4513       apply auto
  4514       done
  4515   next
  4516     show "\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  4517       (\<exists>z. ((\<lambda>x. if x \<in> t then ?f x else 0) has_integral z) (cbox a b) \<and> norm (z - 0) < e)"
  4518       apply safe
  4519       apply (rule_tac x=1 in exI)
  4520       apply rule
  4521       apply (rule zero_less_one)
  4522       apply safe
  4523       apply (rule_tac x=0 in exI)
  4524       apply rule
  4525       apply (rule P)
  4526       using assms(2)
  4527       apply auto
  4528       done
  4529   qed
  4530 next
  4531   fix f :: "'b \<Rightarrow> 'a"
  4532   fix a b :: 'b
  4533   assume assm: "\<forall>x. x \<notin> s \<longrightarrow> f x = 0"
  4534   show "(f has_integral 0) (cbox a b)"
  4535     unfolding has_integral
  4536   proof (safe, goal_cases)
  4537     case prems: (1 e)
  4538     then have "\<And>n. e / 2 / ((real n+1) * (2 ^ n)) > 0"
  4539       apply -
  4540       apply (rule divide_pos_pos)
  4541       defer
  4542       apply (rule mult_pos_pos)
  4543       apply (auto simp add:field_simps)
  4544       done
  4545     note assms(1)[unfolded negligible_def has_integral,rule_format,OF this,of a b]
  4546     note allI[OF this,of "\<lambda>x. x"]
  4547     from choice[OF this] guess d .. note d=conjunctD2[OF this[rule_format]]
  4548     show ?case
  4549       apply (rule_tac x="\<lambda>x. d (nat \<lfloor>norm (f x)\<rfloor>) x" in exI)
  4550     proof safe
  4551       show "gauge (\<lambda>x. d (nat \<lfloor>norm (f x)\<rfloor>) x)"
  4552         using d(1) unfolding gauge_def by auto
  4553       fix p
  4554       assume as: "p tagged_division_of (cbox a b)" "(\<lambda>x. d (nat \<lfloor>norm (f x)\<rfloor>) x) fine p"
  4555       let ?goal = "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) < e"
  4556       {
  4557         presume "p \<noteq> {} \<Longrightarrow> ?goal"
  4558         then show ?goal
  4559           apply (cases "p = {}")
  4560           using prems
  4561           apply auto
  4562           done
  4563       }
  4564       assume as': "p \<noteq> {}"
  4565       from real_arch_simple[of "Max((\<lambda>(x,k). norm(f x)) ` p)"] guess N ..
  4566       then have N: "\<forall>x\<in>(\<lambda>(x, k). norm (f x)) ` p. x \<le> real N"
  4567         by (meson Max_ge as(1) dual_order.trans finite_imageI tagged_division_of_finite)
  4568       have "\<forall>i. \<exists>q. q tagged_division_of (cbox a b) \<and> (d i) fine q \<and> (\<forall>(x, k)\<in>p. k \<subseteq> (d i) x \<longrightarrow> (x, k) \<in> q)"
  4569         by (auto intro: tagged_division_finer[OF as(1) d(1)])
  4570       from choice[OF this] guess q .. note q=conjunctD3[OF this[rule_format]]
  4571       have *: "\<And>i. (\<Sum>(x, k)\<in>q i. content k *\<^sub>R indicator s x) \<ge> (0::real)"
  4572         apply (rule setsum_nonneg)
  4573         apply safe
  4574         unfolding real_scaleR_def
  4575         apply (drule tagged_division_ofD(4)[OF q(1)])
  4576         apply (auto intro: mult_nonneg_nonneg)
  4577         done
  4578       have **: "finite s \<Longrightarrow> finite t \<Longrightarrow> (\<forall>(x,y) \<in> t. (0::real) \<le> g(x,y)) \<Longrightarrow>
  4579         (\<forall>y\<in>s. \<exists>x. (x,y) \<in> t \<and> f(y) \<le> g(x,y)) \<Longrightarrow> setsum f s \<le> setsum g t" for f g s t
  4580         apply (rule setsum_le_included[of s t g snd f])
  4581         prefer 4
  4582         apply safe
  4583         apply (erule_tac x=x in ballE)
  4584         apply (erule exE)
  4585         apply (rule_tac x="(xa,x)" in bexI)
  4586         apply auto
  4587         done
  4588       have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) \<le> setsum (\<lambda>i. (real i + 1) *
  4589         norm (setsum (\<lambda>(x,k). content k *\<^sub>R indicator s x :: real) (q i))) {..N+1}"
  4590         unfolding real_norm_def setsum_distrib_left abs_of_nonneg[OF *] diff_0_right
  4591         apply (rule order_trans)
  4592         apply (rule norm_setsum)
  4593         apply (subst sum_sum_product)
  4594         prefer 3
  4595       proof (rule **, safe)
  4596         show "finite {(i, j) |i j. i \<in> {..N + 1} \<and> j \<in> q i}"
  4597           apply (rule finite_product_dependent)
  4598           using q
  4599           apply auto
  4600           done
  4601         fix i a b
  4602         assume as'': "(a, b) \<in> q i"
  4603         show "0 \<le> (real i + 1) * (content b *\<^sub>R indicator s a)"
  4604           unfolding real_scaleR_def
  4605           using tagged_division_ofD(4)[OF q(1) as'']
  4606           by (auto intro!: mult_nonneg_nonneg)
  4607       next
  4608         fix i :: nat
  4609         show "finite (q i)"
  4610           using q by auto
  4611       next
  4612         fix x k
  4613         assume xk: "(x, k) \<in> p"
  4614         define n where "n = nat \<lfloor>norm (f x)\<rfloor>"
  4615         have *: "norm (f x) \<in> (\<lambda>(x, k). norm (f x)) ` p"
  4616           using xk by auto
  4617         have nfx: "real n \<le> norm (f x)" "norm (f x) \<le> real n + 1"
  4618           unfolding n_def by auto
  4619         then have "n \<in> {0..N + 1}"
  4620           using N[rule_format,OF *] by auto
  4621         moreover
  4622         note as(2)[unfolded fine_def,rule_format,OF xk,unfolded split_conv]
  4623         note q(3)[rule_format,OF xk,unfolded split_conv,rule_format,OF this]
  4624         note this[unfolded n_def[symmetric]]
  4625         moreover
  4626         have "norm (content k *\<^sub>R f x) \<le> (real n + 1) * (content k * indicator s x)"
  4627         proof (cases "x \<in> s")
  4628           case False
  4629           then show ?thesis
  4630             using assm by auto
  4631         next
  4632           case True
  4633           have *: "content k \<ge> 0"
  4634             using tagged_division_ofD(4)[OF as(1) xk] by auto
  4635           moreover
  4636           have "content k * norm (f x) \<le> content k * (real n + 1)"
  4637             apply (rule mult_mono)
  4638             using nfx *
  4639             apply auto
  4640             done
  4641           ultimately
  4642           show ?thesis
  4643             unfolding abs_mult
  4644             using nfx True
  4645             by (auto simp add: field_simps)
  4646         qed
  4647         ultimately show "\<exists>y. (y, x, k) \<in> {(i, j) |i j. i \<in> {..N + 1} \<and> j \<in> q i} \<and> norm (content k *\<^sub>R f x) \<le>
  4648           (real y + 1) * (content k *\<^sub>R indicator s x)"
  4649           apply (rule_tac x=n in exI)
  4650           apply safe
  4651           apply (rule_tac x=n in exI)
  4652           apply (rule_tac x="(x,k)" in exI)
  4653           apply safe
  4654           apply auto
  4655           done
  4656       qed (insert as, auto)
  4657       also have "\<dots> \<le> setsum (\<lambda>i. e / 2 / 2 ^ i) {..N+1}"
  4658       proof (rule setsum_mono, goal_cases)
  4659         case (1 i)
  4660         then show ?case
  4661           apply (subst mult.commute, subst pos_le_divide_eq[symmetric])
  4662           using d(2)[rule_format, of "q i" i]
  4663           using q[rule_format]
  4664           apply (auto simp add: field_simps)
  4665           done
  4666       qed
  4667       also have "\<dots> < e * inverse 2 * 2"
  4668         unfolding divide_inverse setsum_distrib_left[symmetric]
  4669         apply (rule mult_strict_left_mono)
  4670         unfolding power_inverse [symmetric] lessThan_Suc_atMost[symmetric]
  4671         apply (subst geometric_sum)
  4672         using prems
  4673         apply auto
  4674         done
  4675       finally show "?goal" by auto
  4676     qed
  4677   qed
  4678 qed
  4679 
  4680 lemma has_integral_spike:
  4681   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  4682   assumes "negligible s"
  4683     and "(\<forall>x\<in>(t - s). g x = f x)"
  4684     and "(f has_integral y) t"
  4685   shows "(g has_integral y) t"
  4686 proof -
  4687   {
  4688     fix a b :: 'b
  4689     fix f g :: "'b \<Rightarrow> 'a"
  4690     fix y :: 'a
  4691     assume as: "\<forall>x \<in> cbox a b - s. g x = f x" "(f has_integral y) (cbox a b)"
  4692     have "((\<lambda>x. f x + (g x - f x)) has_integral (y + 0)) (cbox a b)"
  4693       apply (rule has_integral_add[OF as(2)])
  4694       apply (rule has_integral_negligible[OF assms(1)])
  4695       using as
  4696       apply auto
  4697       done
  4698     then have "(g has_integral y) (cbox a b)"
  4699       by auto
  4700   } note * = this
  4701   show ?thesis
  4702     apply (subst has_integral_alt)
  4703     using assms(2-)
  4704     apply -
  4705     apply (rule cond_cases)
  4706     apply safe
  4707     apply (rule *)
  4708     apply assumption+
  4709     apply (subst(asm) has_integral_alt)
  4710     unfolding if_not_P
  4711     apply (erule_tac x=e in allE)
  4712     apply safe
  4713     apply (rule_tac x=B in exI)
  4714     apply safe
  4715     apply (erule_tac x=a in allE)
  4716     apply (erule_tac x=b in allE)
  4717     apply safe
  4718     apply (rule_tac x=z in exI)
  4719     apply safe
  4720     apply (rule *[where fa2="\<lambda>x. if x\<in>t then f x else 0"])
  4721     apply auto
  4722     done
  4723 qed
  4724 
  4725 lemma has_integral_spike_eq:
  4726   assumes "negligible s"
  4727     and "\<forall>x\<in>(t - s). g x = f x"
  4728   shows "((f has_integral y) t \<longleftrightarrow> (g has_integral y) t)"
  4729   apply rule
  4730   apply (rule_tac[!] has_integral_spike[OF assms(1)])
  4731   using assms(2)
  4732   apply auto
  4733   done
  4734 
  4735 lemma integrable_spike:
  4736   assumes "negligible s"
  4737     and "\<forall>x\<in>(t - s). g x = f x"
  4738     and "f integrable_on t"
  4739   shows "g integrable_on  t"
  4740   using assms
  4741   unfolding integrable_on_def
  4742   apply -
  4743   apply (erule exE)
  4744   apply rule
  4745   apply (rule has_integral_spike)
  4746   apply fastforce+
  4747   done
  4748 
  4749 lemma integral_spike:
  4750   assumes "negligible s"
  4751     and "\<forall>x\<in>(t - s). g x = f x"
  4752   shows "integral t f = integral t g"
  4753   using has_integral_spike_eq[OF assms] by (simp add: integral_def integrable_on_def)
  4754 
  4755 
  4756 subsection \<open>Some other trivialities about negligible sets.\<close>
  4757 
  4758 lemma negligible_subset:
  4759   assumes "negligible s" "t \<subseteq> s"
  4760   shows "negligible t"
  4761   unfolding negligible_def
  4762     by (metis (no_types) Diff_iff assms contra_subsetD has_integral_negligible indicator_simps(2))
  4763 
  4764 lemma negligible_diff[intro?]:
  4765   assumes "negligible s"
  4766   shows "negligible (s - t)"
  4767   using assms by (meson Diff_subset negligible_subset)
  4768 
  4769 lemma negligible_Int:
  4770   assumes "negligible s \<or> negligible t"
  4771   shows "negligible (s \<inter> t)"
  4772   using assms negligible_subset by force
  4773 
  4774 lemma negligible_Un:
  4775   assumes "negligible s"
  4776     and "negligible t"
  4777   shows "negligible (s \<union> t)"
  4778   unfolding negligible_def
  4779 proof (safe, goal_cases)
  4780   case (1 a b)
  4781   note assm = assms[unfolded negligible_def,rule_format,of a b]
  4782   then show ?case
  4783     apply (subst has_integral_spike_eq[OF assms(2)])
  4784     defer
  4785     apply assumption
  4786     unfolding indicator_def
  4787     apply auto
  4788     done
  4789 qed
  4790 
  4791 lemma negligible_Un_eq[simp]: "negligible (s \<union> t) \<longleftrightarrow> negligible s \<and> negligible t"
  4792   using negligible_Un negligible_subset by blast
  4793 
  4794 lemma negligible_sing[intro]: "negligible {a::'a::euclidean_space}"
  4795   using negligible_standard_hyperplane[OF SOME_Basis, of "a \<bullet> (SOME i. i \<in> Basis)"] negligible_subset by blast
  4796 
  4797 lemma negligible_insert[simp]: "negligible (insert a s) \<longleftrightarrow> negligible s"
  4798   apply (subst insert_is_Un)
  4799   unfolding negligible_Un_eq
  4800   apply auto
  4801   done
  4802 
  4803 lemma negligible_empty[iff]: "negligible {}"
  4804   using negligible_insert by blast
  4805 
  4806 lemma negligible_finite[intro]:
  4807   assumes "finite s"
  4808   shows "negligible s"
  4809   using assms by (induct s) auto
  4810 
  4811 lemma negligible_Union[intro]:
  4812   assumes "finite s"
  4813     and "\<forall>t\<in>s. negligible t"
  4814   shows "negligible(\<Union>s)"
  4815   using assms by induct auto
  4816 
  4817 lemma negligible:
  4818   "negligible s \<longleftrightarrow> (\<forall>t::('a::euclidean_space) set. ((indicator s::'a\<Rightarrow>real) has_integral 0) t)"
  4819   apply safe
  4820   defer
  4821   apply (subst negligible_def)
  4822 proof -
  4823   fix t :: "'a set"
  4824   assume as: "negligible s"
  4825   have *: "(\<lambda>x. if x \<in> s \<inter> t then 1 else 0) = (\<lambda>x. if x\<in>t then if x\<in>s then 1 else 0 else 0)"
  4826     by auto
  4827   show "((indicator s::'a\<Rightarrow>real) has_integral 0) t"
  4828     apply (subst has_integral_alt)
  4829     apply cases
  4830     apply (subst if_P,assumption)
  4831     unfolding if_not_P
  4832     apply safe
  4833     apply (rule as[unfolded negligible_def,rule_format])
  4834     apply (rule_tac x=1 in exI)
  4835     apply safe
  4836     apply (rule zero_less_one)
  4837     apply (rule_tac x=0 in exI)
  4838     using negligible_subset[OF as,of "s \<inter> t"]
  4839     unfolding negligible_def indicator_def [abs_def]
  4840     unfolding *
  4841     apply auto
  4842     done
  4843 qed auto
  4844 
  4845 
  4846 subsection \<open>Finite case of the spike theorem is quite commonly needed.\<close>
  4847 
  4848 lemma has_integral_spike_finite:
  4849   assumes "finite s"
  4850     and "\<forall>x\<in>t-s. g x = f x"
  4851     and "(f has_integral y) t"
  4852   shows "(g has_integral y) t"
  4853   apply (rule has_integral_spike)
  4854   using assms
  4855   apply auto
  4856   done
  4857 
  4858 lemma has_integral_spike_finite_eq:
  4859   assumes "finite s"
  4860     and "\<forall>x\<in>t-s. g x = f x"
  4861   shows "((f has_integral y) t \<longleftrightarrow> (g has_integral y) t)"
  4862   apply rule
  4863   apply (rule_tac[!] has_integral_spike_finite)
  4864   using assms
  4865   apply auto
  4866   done
  4867 
  4868 lemma integrable_spike_finite:
  4869   assumes "finite s"
  4870     and "\<forall>x\<in>t-s. g x = f x"
  4871     and "f integrable_on t"
  4872   shows "g integrable_on  t"
  4873   using assms
  4874   unfolding integrable_on_def
  4875   apply safe
  4876   apply (rule_tac x=y in exI)
  4877   apply (rule has_integral_spike_finite)
  4878   apply auto
  4879   done
  4880 
  4881 
  4882 subsection \<open>In particular, the boundary of an interval is negligible.\<close>
  4883 
  4884 lemma negligible_frontier_interval: "negligible(cbox (a::'a::euclidean_space) b - box a b)"
  4885 proof -
  4886   let ?A = "\<Union>((\<lambda>k. {x. x\<bullet>k = a\<bullet>k} \<union> {x::'a. x\<bullet>k = b\<bullet>k}) ` Basis)"
  4887   have "cbox a b - box a b \<subseteq> ?A"
  4888     apply rule unfolding Diff_iff mem_box
  4889     apply simp
  4890     apply(erule conjE bexE)+
  4891     apply(rule_tac x=i in bexI)
  4892     apply auto
  4893     done
  4894   then show ?thesis
  4895     apply -
  4896     apply (rule negligible_subset[of ?A])
  4897     apply (rule negligible_Union[OF finite_imageI])
  4898     apply auto
  4899     done
  4900 qed
  4901 
  4902 lemma has_integral_spike_interior:
  4903   assumes "\<forall>x\<in>box a b. g x = f x"
  4904     and "(f has_integral y) (cbox a b)"
  4905   shows "(g has_integral y) (cbox a b)"
  4906   apply (rule has_integral_spike[OF negligible_frontier_interval _ assms(2)])
  4907   using assms(1)
  4908   apply auto
  4909   done
  4910 
  4911 lemma has_integral_spike_interior_eq:
  4912   assumes "\<forall>x\<in>box a b. g x = f x"
  4913   shows "(f has_integral y) (cbox a b) \<longleftrightarrow> (g has_integral y) (cbox a b)"
  4914   apply rule
  4915   apply (rule_tac[!] has_integral_spike_interior)
  4916   using assms
  4917   apply auto
  4918   done
  4919 
  4920 lemma integrable_spike_interior:
  4921   assumes "\<forall>x\<in>box a b. g x = f x"
  4922     and "f integrable_on cbox a b"
  4923   shows "g integrable_on cbox a b"
  4924   using assms
  4925   unfolding integrable_on_def
  4926   using has_integral_spike_interior[OF assms(1)]
  4927   by auto
  4928 
  4929 
  4930 subsection \<open>Integrability of continuous functions.\<close>
  4931 
  4932 lemma operative_approximable:
  4933   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  4934   assumes "0 \<le> e"
  4935   shows "comm_monoid.operative op \<and> True (\<lambda>i. \<exists>g. (\<forall>x\<in>i. norm (f x - g (x::'b)) \<le> e) \<and> g integrable_on i)"
  4936   unfolding comm_monoid.operative_def[OF comm_monoid_and]
  4937 proof safe
  4938   fix a b :: 'b
  4939   show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
  4940     if "content (cbox a b) = 0"
  4941     apply (rule_tac x=f in exI)
  4942     using assms that
  4943     apply (auto intro!: integrable_on_null)
  4944     done
  4945   {
  4946     fix c g
  4947     fix k :: 'b
  4948     assume as: "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e" "g integrable_on cbox a b"
  4949     assume k: "k \<in> Basis"
  4950     show "\<exists>g. (\<forall>x\<in>cbox a b \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
  4951       "\<exists>g. (\<forall>x\<in>cbox a b \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k}"
  4952       apply (rule_tac[!] x=g in exI)
  4953       using as(1) integrable_split[OF as(2) k]
  4954       apply auto
  4955       done
  4956   }
  4957   fix c k g1 g2
  4958   assume as: "\<forall>x\<in>cbox a b \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g1 x) \<le> e" "g1 integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
  4959     "\<forall>x\<in>cbox a b \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g2 x) \<le> e" "g2 integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k}"
  4960   assume k: "k \<in> Basis"
  4961   let ?g = "\<lambda>x. if x\<bullet>k = c then f x else if x\<bullet>k \<le> c then g1 x else g2 x"
  4962   show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
  4963     apply (rule_tac x="?g" in exI)
  4964     apply safe
  4965   proof goal_cases
  4966     case (1 x)
  4967     then show ?case
  4968       apply -
  4969       apply (cases "x\<bullet>k=c")
  4970       apply (case_tac "x\<bullet>k < c")
  4971       using as assms
  4972       apply auto
  4973       done
  4974   next
  4975     case 2
  4976     presume "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
  4977       and "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
  4978     then guess h1 h2 unfolding integrable_on_def by auto
  4979     from has_integral_split[OF this k] show ?case
  4980       unfolding integrable_on_def by auto
  4981   next
  4982     show "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}" "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
  4983       apply(rule_tac[!] integrable_spike[OF negligible_standard_hyperplane[of k c]])
  4984       using k as(2,4)
  4985       apply auto
  4986       done
  4987   qed
  4988 qed
  4989 
  4990 lemma comm_monoid_set_F_and: "comm_monoid_set.F op \<and> True f s \<longleftrightarrow> (finite s \<longrightarrow> (\<forall>x\<in>s. f x))"
  4991 proof -
  4992   interpret bool: comm_monoid_set "op \<and>" True
  4993     proof qed auto
  4994   show ?thesis
  4995     by (induction s rule: infinite_finite_induct) auto
  4996 qed
  4997 
  4998 lemma approximable_on_division:
  4999   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5000   assumes "0 \<le> e"
  5001     and "d division_of (cbox a b)"
  5002     and "\<forall>i\<in>d. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
  5003   obtains g where "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e" "g integrable_on cbox a b"
  5004 proof -
  5005   note * = comm_monoid_set.operative_division[OF comm_monoid_set_and operative_approximable[OF assms(1)] assms(2)]
  5006   from assms(3) this[unfolded comm_monoid_set_F_and, of f] division_of_finite[OF assms(2)]
  5007   guess g by auto
  5008   then show thesis
  5009     apply -
  5010     apply (rule that[of g])
  5011     apply auto
  5012     done
  5013 qed
  5014 
  5015 lemma integrable_continuous:
  5016   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5017   assumes "continuous_on (cbox a b) f"
  5018   shows "f integrable_on cbox a b"
  5019 proof (rule integrable_uniform_limit, safe)
  5020   fix e :: real
  5021   assume e: "e > 0"
  5022   from compact_uniformly_continuous[OF assms compact_cbox,unfolded uniformly_continuous_on_def,rule_format,OF e] guess d ..
  5023   note d=conjunctD2[OF this,rule_format]
  5024   from fine_division_exists[OF gauge_ball[OF d(1)], of a b] guess p . note p=this
  5025   note p' = tagged_division_ofD[OF p(1)]
  5026   have *: "\<forall>i\<in>snd ` p. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
  5027   proof (safe, unfold snd_conv)
  5028     fix x l
  5029     assume as: "(x, l) \<in> p"
  5030     from p'(4)[OF this] guess a b by (elim exE) note l=this
  5031     show "\<exists>g. (\<forall>x\<in>l. norm (f x - g x) \<le> e) \<and> g integrable_on l"
  5032       apply (rule_tac x="\<lambda>y. f x" in exI)
  5033     proof safe
  5034       show "(\<lambda>y. f x) integrable_on l"
  5035         unfolding integrable_on_def l
  5036         apply rule
  5037         apply (rule has_integral_const)
  5038         done
  5039       fix y
  5040       assume y: "y \<in> l"
  5041       note fineD[OF p(2) as,unfolded subset_eq,rule_format,OF this]
  5042       note d(2)[OF _ _ this[unfolded mem_ball]]
  5043       then show "norm (f y - f x) \<le> e"
  5044         using y p'(2-3)[OF as] unfolding dist_norm l norm_minus_commute by fastforce
  5045     qed
  5046   qed
  5047   from e have "e \<ge> 0"
  5048     by auto
  5049   from approximable_on_division[OF this division_of_tagged_division[OF p(1)] *] guess g .
  5050   then show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
  5051     by auto
  5052 qed
  5053 
  5054 lemma integrable_continuous_real:
  5055   fixes f :: "real \<Rightarrow> 'a::banach"
  5056   assumes "continuous_on {a .. b} f"
  5057   shows "f integrable_on {a .. b}"
  5058   by (metis assms box_real(2) integrable_continuous)
  5059 
  5060 subsection \<open>Specialization of additivity to one dimension.\<close>
  5061 
  5062 subsection \<open>Special case of additivity we need for the FTC.\<close>
  5063 
  5064 lemma additive_tagged_division_1:
  5065   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
  5066   assumes "a \<le> b"
  5067     and "p tagged_division_of {a..b}"
  5068   shows "setsum (\<lambda>(x,k). f(Sup k) - f(Inf k)) p = f b - f a"
  5069 proof -
  5070   let ?f = "(\<lambda>k::(real) set. if k = {} then 0 else f(interval_upperbound k) - f(interval_lowerbound k))"
  5071   have ***: "\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i"
  5072     using assms by auto
  5073   have *: "add.operative ?f"
  5074     unfolding add.operative_1_lt box_eq_empty
  5075     by auto
  5076   have **: "cbox a b \<noteq> {}"
  5077     using assms(1) by auto
  5078   note setsum.operative_tagged_division[OF * assms(2)[simplified box_real[symmetric]]]
  5079   note * = this[unfolded if_not_P[OF **] interval_bounds[OF ***],symmetric]
  5080   show ?thesis
  5081     unfolding *
  5082     apply (rule setsum.cong)
  5083     unfolding split_paired_all split_conv
  5084     using assms(2)
  5085     apply auto
  5086     done
  5087 qed
  5088 
  5089 
  5090 subsection \<open>A useful lemma allowing us to factor out the content size.\<close>
  5091 
  5092 lemma has_integral_factor_content:
  5093   "(f has_integral i) (cbox a b) \<longleftrightarrow>
  5094     (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  5095       norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content (cbox a b)))"
  5096 proof (cases "content (cbox a b) = 0")
  5097   case True
  5098   show ?thesis
  5099     unfolding has_integral_null_eq[OF True]
  5100     apply safe
  5101     apply (rule, rule, rule gauge_trivial, safe)
  5102     unfolding setsum_content_null[OF True] True
  5103     defer
  5104     apply (erule_tac x=1 in allE)
  5105     apply safe
  5106     defer
  5107     apply (rule fine_division_exists[of _ a b])
  5108     apply assumption
  5109     apply (erule_tac x=p in allE)
  5110     unfolding setsum_content_null[OF True]
  5111     apply auto
  5112     done
  5113 next
  5114   case False
  5115   note F = this[unfolded content_lt_nz[symmetric]]
  5116   let ?P = "\<lambda>e opp. \<exists>d. gauge d \<and>
  5117     (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow> opp (norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i)) e)"
  5118   show ?thesis
  5119     apply (subst has_integral)
  5120   proof safe
  5121     fix e :: real
  5122     assume e: "e > 0"
  5123     {
  5124       assume "\<forall>e>0. ?P e op <"
  5125       then show "?P (e * content (cbox a b)) op \<le>"
  5126         apply (erule_tac x="e * content (cbox a b)" in allE)
  5127         apply (erule impE)
  5128         defer
  5129         apply (erule exE,rule_tac x=d in exI)
  5130         using F e
  5131         apply (auto simp add:field_simps)
  5132         done
  5133     }
  5134     {
  5135       assume "\<forall>e>0. ?P (e * content (cbox a b)) op \<le>"
  5136       then show "?P e op <"
  5137         apply (erule_tac x="e / 2 / content (cbox a b)" in allE)
  5138         apply (erule impE)
  5139         defer
  5140         apply (erule exE,rule_tac x=d in exI)
  5141         using F e
  5142         apply (auto simp add: field_simps)
  5143         done
  5144     }
  5145   qed
  5146 qed
  5147 
  5148 lemma has_integral_factor_content_real:
  5149   "(f has_integral i) {a .. b::real} \<longleftrightarrow>
  5150     (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a .. b}  \<and> d fine p \<longrightarrow>
  5151       norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content {a .. b} ))"
  5152   unfolding box_real[symmetric]
  5153   by (rule has_integral_factor_content)
  5154 
  5155 
  5156 subsection \<open>Fundamental theorem of calculus.\<close>
  5157 
  5158 lemma interval_bounds_real:
  5159   fixes q b :: real
  5160   assumes "a \<le> b"
  5161   shows "Sup {a..b} = b"
  5162     and "Inf {a..b} = a"
  5163   using assms by auto
  5164 
  5165 lemma fundamental_theorem_of_calculus:
  5166   fixes f :: "real \<Rightarrow> 'a::banach"
  5167   assumes "a \<le> b"
  5168     and "\<forall>x\<in>{a .. b}. (f has_vector_derivative f' x) (at x within {a .. b})"
  5169   shows "(f' has_integral (f b - f a)) {a .. b}"
  5170   unfolding has_integral_factor_content box_real[symmetric]
  5171 proof safe
  5172   fix e :: real
  5173   assume e: "e > 0"
  5174   note assm = assms(2)[unfolded has_vector_derivative_def has_derivative_within_alt]
  5175   have *: "\<And>P Q. \<forall>x\<in>{a .. b}. P x \<and> (\<forall>e>0. \<exists>d>0. Q x e d) \<Longrightarrow> \<forall>x. \<exists>(d::real)>0. x\<in>{a .. b} \<longrightarrow> Q x e d"
  5176     using e by blast
  5177   note this[OF assm,unfolded gauge_existence_lemma]
  5178   from choice[OF this,unfolded Ball_def[symmetric]] guess d ..
  5179   note d=conjunctD2[OF this[rule_format],rule_format]
  5180   show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  5181     norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content (cbox a b))"
  5182     apply (rule_tac x="\<lambda>x. ball x (d x)" in exI)
  5183     apply safe
  5184     apply (rule gauge_ball_dependent)
  5185     apply rule
  5186     apply (rule d(1))
  5187   proof -
  5188     fix p
  5189     assume as: "p tagged_division_of cbox a b" "(\<lambda>x. ball x (d x)) fine p"
  5190     show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content (cbox a b)"
  5191       unfolding content_real[OF assms(1), simplified box_real[symmetric]] additive_tagged_division_1[OF assms(1) as(1)[simplified box_real],of f,symmetric]
  5192       unfolding additive_tagged_division_1[OF assms(1) as(1)[simplified box_real],of "\<lambda>x. x",symmetric]
  5193       unfolding setsum_distrib_left
  5194       defer
  5195       unfolding setsum_subtractf[symmetric]
  5196     proof (rule setsum_norm_le,safe)
  5197       fix x k
  5198       assume "(x, k) \<in> p"
  5199       note xk = tagged_division_ofD(2-4)[OF as(1) this]
  5200       from this(3) guess u v by (elim exE) note k=this
  5201       have *: "u \<le> v"
  5202         using xk unfolding k by auto
  5203       have ball: "\<forall>xa\<in>k. xa \<in> ball x (d x)"
  5204         using as(2)[unfolded fine_def,rule_format,OF \<open>(x,k)\<in>p\<close>,unfolded split_conv subset_eq] .
  5205       have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) \<le>
  5206         norm (f u - f x - (u - x) *\<^sub>R f' x) + norm (f v - f x - (v - x) *\<^sub>R f' x)"
  5207         apply (rule order_trans[OF _ norm_triangle_ineq4])
  5208         apply (rule eq_refl)
  5209         apply (rule arg_cong[where f=norm])
  5210         unfolding scaleR_diff_left
  5211         apply (auto simp add:algebra_simps)
  5212         done
  5213       also have "\<dots> \<le> e * norm (u - x) + e * norm (v - x)"
  5214         apply (rule add_mono)
  5215         apply (rule d(2)[of "x" "u",unfolded o_def])
  5216         prefer 4
  5217         apply (rule d(2)[of "x" "v",unfolded o_def])
  5218         using ball[rule_format,of u] ball[rule_format,of v]
  5219         using xk(1-2)
  5220         unfolding k subset_eq
  5221         apply (auto simp add:dist_real_def)
  5222         done
  5223       also have "\<dots> \<le> e * (Sup k - Inf k)"
  5224         unfolding k interval_bounds_real[OF *]
  5225         using xk(1)
  5226         unfolding k
  5227         by (auto simp add: dist_real_def field_simps)
  5228       finally show "norm (content k *\<^sub>R f' x - (f (Sup k) - f (Inf k))) \<le>
  5229         e * (Sup k - Inf k)"
  5230         unfolding box_real k interval_bounds_real[OF *] content_real[OF *]
  5231           interval_upperbound_real interval_lowerbound_real
  5232           .
  5233     qed
  5234   qed
  5235 qed
  5236 
  5237 lemma ident_has_integral:
  5238   fixes a::real
  5239   assumes "a \<le> b"
  5240   shows "((\<lambda>x. x) has_integral (b\<^sup>2 - a\<^sup>2) / 2) {a..b}"
  5241 proof -
  5242   have "((\<lambda>x. x) has_integral inverse 2 * b\<^sup>2 - inverse 2 * a\<^sup>2) {a..b}"
  5243     apply (rule fundamental_theorem_of_calculus [OF assms], clarify)
  5244     unfolding power2_eq_square
  5245     by (rule derivative_eq_intros | simp)+
  5246   then show ?thesis
  5247     by (simp add: field_simps)
  5248 qed
  5249 
  5250 lemma integral_ident [simp]:
  5251   fixes a::real
  5252   assumes "a \<le> b"
  5253   shows "integral {a..b} (\<lambda>x. x) = (if a \<le> b then (b\<^sup>2 - a\<^sup>2) / 2 else 0)"
  5254 using ident_has_integral integral_unique by fastforce
  5255 
  5256 lemma ident_integrable_on:
  5257   fixes a::real
  5258   shows "(\<lambda>x. x) integrable_on {a..b}"
  5259 by (metis atLeastatMost_empty_iff integrable_on_def has_integral_empty ident_has_integral)
  5260 
  5261 
  5262 subsection \<open>Taylor series expansion\<close>
  5263 
  5264 lemma (in bounded_bilinear) setsum_prod_derivatives_has_vector_derivative:
  5265   assumes "p>0"
  5266   and f0: "Df 0 = f"
  5267   and Df: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5268     (Df m has_vector_derivative Df (Suc m) t) (at t within {a .. b})"
  5269   and g0: "Dg 0 = g"
  5270   and Dg: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5271     (Dg m has_vector_derivative Dg (Suc m) t) (at t within {a .. b})"
  5272   and ivl: "a \<le> t" "t \<le> b"
  5273   shows "((\<lambda>t. \<Sum>i<p. (-1)^i *\<^sub>R prod (Df i t) (Dg (p - Suc i) t))
  5274     has_vector_derivative
  5275       prod (f t) (Dg p t) - (-1)^p *\<^sub>R prod (Df p t) (g t))
  5276     (at t within {a .. b})"
  5277   using assms
  5278 proof cases
  5279   assume p: "p \<noteq> 1"
  5280   define p' where "p' = p - 2"
  5281   from assms p have p': "{..<p} = {..Suc p'}" "p = Suc (Suc p')"
  5282     by (auto simp: p'_def)
  5283   have *: "\<And>i. i \<le> p' \<Longrightarrow> Suc (Suc p' - i) = (Suc (Suc p') - i)"
  5284     by auto
  5285   let ?f = "\<lambda>i. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg ((p - i)) t))"
  5286   have "(\<Sum>i<p. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg (Suc (p - Suc i)) t) +
  5287     prod (Df (Suc i) t) (Dg (p - Suc i) t))) =
  5288     (\<Sum>i\<le>(Suc p'). ?f i - ?f (Suc i))"
  5289     by (auto simp: algebra_simps p'(2) numeral_2_eq_2 * lessThan_Suc_atMost)
  5290   also note setsum_telescope
  5291   finally
  5292   have "(\<Sum>i<p. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg (Suc (p - Suc i)) t) +
  5293     prod (Df (Suc i) t) (Dg (p - Suc i) t)))
  5294     = prod (f t) (Dg p t) - (- 1) ^ p *\<^sub>R prod (Df p t) (g t)"
  5295     unfolding p'[symmetric]
  5296     by (simp add: assms)
  5297   thus ?thesis
  5298     using assms
  5299     by (auto intro!: derivative_eq_intros has_vector_derivative)
  5300 qed (auto intro!: derivative_eq_intros has_vector_derivative)
  5301 
  5302 lemma
  5303   fixes f::"real\<Rightarrow>'a::banach"
  5304   assumes "p>0"
  5305   and f0: "Df 0 = f"
  5306   and Df: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5307     (Df m has_vector_derivative Df (Suc m) t) (at t within {a .. b})"
  5308   and ivl: "a \<le> b"
  5309   defines "i \<equiv> \<lambda>x. ((b - x) ^ (p - 1) / fact (p - 1)) *\<^sub>R Df p x"
  5310   shows taylor_has_integral:
  5311     "(i has_integral f b - (\<Sum>i<p. ((b - a) ^ i / fact i) *\<^sub>R Df i a)) {a..b}"
  5312   and taylor_integral:
  5313     "f b = (\<Sum>i<p. ((b - a) ^ i / fact i) *\<^sub>R Df i a) + integral {a..b} i"
  5314   and taylor_integrable:
  5315     "i integrable_on {a .. b}"
  5316 proof goal_cases
  5317   case 1
  5318   interpret bounded_bilinear "scaleR::real\<Rightarrow>'a\<Rightarrow>'a"
  5319     by (rule bounded_bilinear_scaleR)
  5320   define g where "g s = (b - s)^(p - 1)/fact (p - 1)" for s
  5321   define Dg where [abs_def]:
  5322     "Dg n s = (if n < p then (-1)^n * (b - s)^(p - 1 - n) / fact (p - 1 - n) else 0)" for n s
  5323   have g0: "Dg 0 = g"
  5324     using \<open>p > 0\<close>
  5325     by (auto simp add: Dg_def divide_simps g_def split: if_split_asm)
  5326   {
  5327     fix m
  5328     assume "p > Suc m"
  5329     hence "p - Suc m = Suc (p - Suc (Suc m))"
  5330       by auto
  5331     hence "real (p - Suc m) * fact (p - Suc (Suc m)) = fact (p - Suc m)"
  5332       by auto
  5333   } note fact_eq = this
  5334   have Dg: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5335     (Dg m has_vector_derivative Dg (Suc m) t) (at t within {a .. b})"
  5336     unfolding Dg_def
  5337     by (auto intro!: derivative_eq_intros simp: has_vector_derivative_def fact_eq divide_simps)
  5338   let ?sum = "\<lambda>t. \<Sum>i<p. (- 1) ^ i *\<^sub>R Dg i t *\<^sub>R Df (p - Suc i) t"
  5339   from setsum_prod_derivatives_has_vector_derivative[of _ Dg _ _ _ Df,
  5340       OF \<open>p > 0\<close> g0 Dg f0 Df]
  5341   have deriv: "\<And>t. a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5342     (?sum has_vector_derivative
  5343       g t *\<^sub>R Df p t - (- 1) ^ p *\<^sub>R Dg p t *\<^sub>R f t) (at t within {a..b})"
  5344     by auto
  5345   from fundamental_theorem_of_calculus[rule_format, OF \<open>a \<le> b\<close> deriv]
  5346   have "(i has_integral ?sum b - ?sum a) {a .. b}"
  5347     using atLeastatMost_empty'[simp del]
  5348     by (simp add: i_def g_def Dg_def)
  5349   also
  5350   have one: "(- 1) ^ p' * (- 1) ^ p' = (1::real)"
  5351     and "{..<p} \<inter> {i. p = Suc i} = {p - 1}"
  5352     for p'
  5353     using \<open>p > 0\<close>
  5354     by (auto simp: power_mult_distrib[symmetric])
  5355   then have "?sum b = f b"
  5356     using Suc_pred'[OF \<open>p > 0\<close>]
  5357     by (simp add: diff_eq_eq Dg_def power_0_left le_Suc_eq if_distrib
  5358         cond_application_beta setsum.If_cases f0)
  5359   also
  5360   have "{..<p} = (\<lambda>x. p - x - 1) ` {..<p}"
  5361   proof safe
  5362     fix x
  5363     assume "x < p"
  5364     thus "x \<in> (\<lambda>x. p - x - 1) ` {..<p}"
  5365       by (auto intro!: image_eqI[where x = "p - x - 1"])
  5366   qed simp
  5367   from _ this
  5368   have "?sum a = (\<Sum>i<p. ((b - a) ^ i / fact i) *\<^sub>R Df i a)"
  5369     by (rule setsum.reindex_cong) (auto simp add: inj_on_def Dg_def one)
  5370   finally show c: ?case .
  5371   case 2 show ?case using c integral_unique by force
  5372   case 3 show ?case using c by force
  5373 qed
  5374 
  5375 
  5376 subsection \<open>Attempt a systematic general set of "offset" results for components.\<close>
  5377 
  5378 lemma gauge_modify:
  5379   assumes "(\<forall>s. open s \<longrightarrow> open {x. f(x) \<in> s})" "gauge d"
  5380   shows "gauge (\<lambda>x. {y. f y \<in> d (f x)})"
  5381   using assms
  5382   unfolding gauge_def
  5383   apply safe
  5384   defer
  5385   apply (erule_tac x="f x" in allE)
  5386   apply (erule_tac x="d (f x)" in allE)
  5387   apply auto
  5388   done
  5389 
  5390 
  5391 subsection \<open>Only need trivial subintervals if the interval itself is trivial.\<close>
  5392 
  5393 lemma division_of_nontrivial:
  5394   fixes s :: "'a::euclidean_space set set"
  5395   assumes "s division_of (cbox a b)"
  5396     and "content (cbox a b) \<noteq> 0"
  5397   shows "{k. k \<in> s \<and> content k \<noteq> 0} division_of (cbox a b)"
  5398   using assms(1)
  5399   apply -
  5400 proof (induct "card s" arbitrary: s rule: nat_less_induct)
  5401   fix s::"'a set set"
  5402   assume assm: "s division_of (cbox a b)"
  5403     "\<forall>m<card s. \<forall>x. m = card x \<longrightarrow>
  5404       x division_of (cbox a b) \<longrightarrow> {k \<in> x. content k \<noteq> 0} division_of (cbox a b)"
  5405   note s = division_ofD[OF assm(1)]
  5406   let ?thesis = "{k \<in> s. content k \<noteq> 0} division_of (cbox a b)"
  5407   {
  5408     presume *: "{k \<in> s. content k \<noteq> 0} \<noteq> s \<Longrightarrow> ?thesis"
  5409     show ?thesis
  5410       apply cases
  5411       defer
  5412       apply (rule *)
  5413       apply assumption
  5414       using assm(1)
  5415       apply auto
  5416       done
  5417   }
  5418   assume noteq: "{k \<in> s. content k \<noteq> 0} \<noteq> s"
  5419   then obtain k where k: "k \<in> s" "content k = 0"
  5420     by auto
  5421   from s(4)[OF k(1)] guess c d by (elim exE) note k=k this
  5422   from k have "card s > 0"
  5423     unfolding card_gt_0_iff using assm(1) by auto
  5424   then have card: "card (s - {k}) < card s"
  5425     using assm(1) k(1)
  5426     apply (subst card_Diff_singleton_if)
  5427     apply auto
  5428     done
  5429   have *: "closed (\<Union>(s - {k}))"
  5430     apply (rule closed_Union)
  5431     defer
  5432     apply rule
  5433     apply (drule DiffD1,drule s(4))
  5434     using assm(1)
  5435     apply auto
  5436     done
  5437   have "k \<subseteq> \<Union>(s - {k})"
  5438     apply safe
  5439     apply (rule *[unfolded closed_limpt,rule_format])
  5440     unfolding islimpt_approachable
  5441   proof safe
  5442     fix x
  5443     fix e :: real
  5444     assume as: "x \<in> k" "e > 0"
  5445     from k(2)[unfolded k content_eq_0] guess i ..
  5446     then have i:"c\<bullet>i = d\<bullet>i" "i\<in>Basis"
  5447       using s(3)[OF k(1),unfolded k] unfolding box_ne_empty by auto
  5448     then have xi: "x\<bullet>i = d\<bullet>i"
  5449       using as unfolding k mem_box by (metis antisym)
  5450     define y where "y = (\<Sum>j\<in>Basis. (if j = i then if c\<bullet>i \<le> (a\<bullet>i + b\<bullet>i) / 2 then c\<bullet>i +
  5451       min e (b\<bullet>i - c\<bullet>i) / 2 else c\<bullet>i - min e (c\<bullet>i - a\<bullet>i) / 2 else x\<bullet>j) *\<^sub>R j)"
  5452     show "\<exists>x'\<in>\<Union>(s - {k}). x' \<noteq> x \<and> dist x' x < e"
  5453       apply (rule_tac x=y in bexI)
  5454     proof
  5455       have "d \<in> cbox c d"
  5456         using s(3)[OF k(1)]
  5457         unfolding k box_eq_empty mem_box
  5458         by (fastforce simp add: not_less)
  5459       then have "d \<in> cbox a b"
  5460         using s(2)[OF k(1)]
  5461         unfolding k
  5462         by auto
  5463       note di = this[unfolded mem_box,THEN bspec[where x=i]]
  5464       then have xyi: "y\<bullet>i \<noteq> x\<bullet>i"
  5465         unfolding y_def i xi
  5466         using as(2) assms(2)[unfolded content_eq_0] i(2)
  5467         by (auto elim!: ballE[of _ _ i])
  5468       then show "y \<noteq> x"
  5469         unfolding euclidean_eq_iff[where 'a='a] using i by auto
  5470       have *: "Basis = insert i (Basis - {i})"
  5471         using i by auto
  5472       have "norm (y - x) < e + setsum (\<lambda>i. 0) Basis"
  5473         apply (rule le_less_trans[OF norm_le_l1])
  5474         apply (subst *)
  5475         apply (subst setsum.insert)
  5476         prefer 3
  5477         apply (rule add_less_le_mono)
  5478       proof -
  5479         show "\<bar>(y - x) \<bullet> i\<bar> < e"
  5480           using di as(2) y_def i xi by (auto simp: inner_simps)
  5481         show "(\<Sum>i\<in>Basis - {i}. \<bar>(y - x) \<bullet> i\<bar>) \<le> (\<Sum>i\<in>Basis. 0)"
  5482           unfolding y_def by (auto simp: inner_simps)
  5483       qed auto
  5484       then show "dist y x < e"
  5485         unfolding dist_norm by auto
  5486       have "y \<notin> k"
  5487         unfolding k mem_box
  5488         apply rule
  5489         apply (erule_tac x=i in ballE)
  5490         using xyi k i xi
  5491         apply auto
  5492         done
  5493       moreover
  5494       have "y \<in> \<Union>s"
  5495         using set_rev_mp[OF as(1) s(2)[OF k(1)]] as(2) di i
  5496         unfolding s mem_box y_def
  5497         by (auto simp: field_simps elim!: ballE[of _ _ i])
  5498       ultimately
  5499       show "y \<in> \<Union>(s - {k})" by auto
  5500     qed
  5501   qed
  5502   then have "\<Union>(s - {k}) = cbox a b"
  5503     unfolding s(6)[symmetric] by auto
  5504   then have  "{ka \<in> s - {k}. content ka \<noteq> 0} division_of (cbox a b)"
  5505     apply -
  5506     apply (rule assm(2)[rule_format,OF card refl])
  5507     apply (rule division_ofI)
  5508     defer
  5509     apply (rule_tac[1-4] s)
  5510     using assm(1)
  5511     apply auto
  5512     done
  5513   moreover
  5514   have "{ka \<in> s - {k}. content ka \<noteq> 0} = {k \<in> s. content k \<noteq> 0}"
  5515     using k by auto
  5516   ultimately show ?thesis by auto
  5517 qed
  5518 
  5519 
  5520 subsection \<open>Integrability on subintervals.\<close>
  5521 
  5522 lemma operative_integrable:
  5523   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5524   shows "comm_monoid.operative op \<and> True (\<lambda>i. f integrable_on i)"
  5525   unfolding comm_monoid.operative_def[OF comm_monoid_and]
  5526   apply safe
  5527   apply (subst integrable_on_def)
  5528   unfolding has_integral_null_eq
  5529   apply (rule, rule refl)
  5530   apply (rule, assumption, assumption)+
  5531   unfolding integrable_on_def
  5532   by (auto intro!: has_integral_split)
  5533 
  5534 lemma integrable_subinterval:
  5535   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5536   assumes "f integrable_on cbox a b"
  5537     and "cbox c d \<subseteq> cbox a b"
  5538   shows "f integrable_on cbox c d"
  5539   apply (cases "cbox c d = {}")
  5540   defer
  5541   apply (rule partial_division_extend_1[OF assms(2)],assumption)
  5542   using comm_monoid_set.operative_division[OF comm_monoid_set_and operative_integrable,symmetric,of _ _ _ f] assms(1)
  5543   apply (auto simp: comm_monoid_set_F_and)
  5544   done
  5545 
  5546 lemma integrable_subinterval_real:
  5547   fixes f :: "real \<Rightarrow> 'a::banach"
  5548   assumes "f integrable_on {a .. b}"
  5549     and "{c .. d} \<subseteq> {a .. b}"
  5550   shows "f integrable_on {c .. d}"
  5551   by (metis assms(1) assms(2) box_real(2) integrable_subinterval)
  5552 
  5553 
  5554 subsection \<open>Combining adjacent intervals in 1 dimension.\<close>
  5555 
  5556 lemma has_integral_combine:
  5557   fixes a b c :: real
  5558   assumes "a \<le> c"
  5559     and "c \<le> b"
  5560     and "(f has_integral i) {a .. c}"
  5561     and "(f has_integral (j::'a::banach)) {c .. b}"
  5562   shows "(f has_integral (i + j)) {a .. b}"
  5563 proof -
  5564   interpret comm_monoid "lift_option plus" "Some (0::'a)"
  5565     by (rule comm_monoid_lift_option)
  5566       (rule add.comm_monoid_axioms)
  5567   note operative_integral [of f, unfolded operative_1_le]
  5568   note conjunctD2 [OF this, rule_format]
  5569   note * = this(2) [OF conjI [OF assms(1-2)],
  5570     unfolded if_P [OF assms(3)]]
  5571   then have "f integrable_on cbox a b"
  5572     apply -
  5573     apply (rule ccontr)
  5574     apply (subst(asm) if_P)
  5575     defer
  5576     apply (subst(asm) if_P)
  5577     using assms(3-)
  5578     apply auto
  5579     done
  5580   with *
  5581   show ?thesis
  5582     apply -
  5583     apply (subst(asm) if_P)
  5584     defer
  5585     apply (subst(asm) if_P)
  5586     defer
  5587     apply (subst(asm) if_P)
  5588     using assms(3-)
  5589     apply (auto simp add: integrable_on_def integral_unique)
  5590     done
  5591 qed
  5592 
  5593 lemma integral_combine:
  5594   fixes f :: "real \<Rightarrow> 'a::banach"
  5595   assumes "a \<le> c"
  5596     and "c \<le> b"
  5597     and "f integrable_on {a .. b}"
  5598   shows "integral {a .. c} f + integral {c .. b} f = integral {a .. b} f"
  5599   apply (rule integral_unique[symmetric])
  5600   apply (rule has_integral_combine[OF assms(1-2)])
  5601   apply (metis assms(2) assms(3) atLeastatMost_subset_iff box_real(2) content_pos_le content_real_eq_0 integrable_integral integrable_subinterval le_add_same_cancel2 monoid_add_class.add.left_neutral)
  5602   by (metis assms(1) assms(3) atLeastatMost_subset_iff box_real(2) content_pos_le content_real_eq_0 integrable_integral integrable_subinterval le_add_same_cancel1 monoid_add_class.add.right_neutral)
  5603 
  5604 lemma integrable_combine:
  5605   fixes f :: "real \<Rightarrow> 'a::banach"
  5606   assumes "a \<le> c"
  5607     and "c \<le> b"
  5608     and "f integrable_on {a .. c}"
  5609     and "f integrable_on {c .. b}"
  5610   shows "f integrable_on {a .. b}"
  5611   using assms
  5612   unfolding integrable_on_def
  5613   by (fastforce intro!:has_integral_combine)
  5614 
  5615 
  5616 subsection \<open>Reduce integrability to "local" integrability.\<close>
  5617 
  5618 lemma integrable_on_little_subintervals:
  5619   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5620   assumes "\<forall>x\<in>cbox a b. \<exists>d>0. \<forall>u v. x \<in> cbox u v \<and> cbox u v \<subseteq> ball x d \<and> cbox u v \<subseteq> cbox a b \<longrightarrow>
  5621     f integrable_on cbox u v"
  5622   shows "f integrable_on cbox a b"
  5623 proof -
  5624   have "\<forall>x. \<exists>d. x\<in>cbox a b \<longrightarrow> d>0 \<and> (\<forall>u v. x \<in> cbox u v \<and> cbox u v \<subseteq> ball x d \<and> cbox u v \<subseteq> cbox a b \<longrightarrow>
  5625     f integrable_on cbox u v)"
  5626     using assms by auto
  5627   note this[unfolded gauge_existence_lemma]
  5628   from choice[OF this] guess d .. note d=this[rule_format]
  5629   guess p
  5630     apply (rule fine_division_exists[OF gauge_ball_dependent,of d a b])
  5631     using d
  5632     by auto
  5633   note p=this(1-2)
  5634   note division_of_tagged_division[OF this(1)]
  5635   note * = comm_monoid_set.operative_division[OF comm_monoid_set_and operative_integrable, OF this, symmetric, of f]
  5636   show ?thesis
  5637     unfolding * comm_monoid_set_F_and
  5638     apply safe
  5639     unfolding snd_conv
  5640   proof -
  5641     fix x k
  5642     assume "(x, k) \<in> p"
  5643     note tagged_division_ofD(2-4)[OF p(1) this] fineD[OF p(2) this]
  5644     then show "f integrable_on k"
  5645       apply safe
  5646       apply (rule d[THEN conjunct2,rule_format,of x])
  5647       apply (auto intro: order.trans)
  5648       done
  5649   qed
  5650 qed
  5651 
  5652 
  5653 subsection \<open>Second FTC or existence of antiderivative.\<close>
  5654 
  5655 lemma integrable_const[intro]: "(\<lambda>x. c) integrable_on cbox a b"
  5656   unfolding integrable_on_def
  5657   apply rule
  5658   apply (rule has_integral_const)
  5659   done
  5660 
  5661 lemma integral_has_vector_derivative_continuous_at:
  5662   fixes f :: "real \<Rightarrow> 'a::banach"
  5663   assumes f: "f integrable_on {a..b}"
  5664       and x: "x \<in> {a..b}"
  5665       and fx: "continuous (at x within {a..b}) f"
  5666   shows "((\<lambda>u. integral {a..u} f) has_vector_derivative f x) (at x within {a..b})"
  5667 proof -
  5668   let ?I = "\<lambda>a b. integral {a..b} f"
  5669   { fix e::real
  5670     assume "e > 0"
  5671     obtain d where "d>0" and d: "\<And>x'. \<lbrakk>x' \<in> {a..b}; \<bar>x' - x\<bar> < d\<rbrakk> \<Longrightarrow> norm(f x' - f x) \<le> e"
  5672       using \<open>e>0\<close> fx by (auto simp: continuous_within_eps_delta dist_norm less_imp_le)
  5673     have "norm (integral {a..y} f - integral {a..x} f - (y - x) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
  5674            if y: "y \<in> {a..b}" and yx: "\<bar>y - x\<bar> < d" for y
  5675     proof (cases "y < x")
  5676       case False
  5677       have "f integrable_on {a..y}"
  5678         using f y by (simp add: integrable_subinterval_real)
  5679       then have Idiff: "?I a y - ?I a x = ?I x y"
  5680         using False x by (simp add: algebra_simps integral_combine)
  5681       have fux_int: "((\<lambda>u. f u - f x) has_integral integral {x..y} f - (y - x) *\<^sub>R f x) {x..y}"
  5682         apply (rule has_integral_sub)
  5683         using x y apply (force intro: integrable_integral [OF integrable_subinterval_real [OF f]])
  5684         using has_integral_const_real [of "f x" x y] False
  5685         apply (simp add: )
  5686         done
  5687       show ?thesis
  5688         using False
  5689         apply (simp add: abs_eq_content del: content_real_if measure_lborel_Icc)
  5690         apply (rule has_integral_bound_real[where f="(\<lambda>u. f u - f x)"])
  5691         using yx False d x y \<open>e>0\<close> apply (auto simp add: Idiff fux_int)
  5692         done
  5693     next
  5694       case True
  5695       have "f integrable_on {a..x}"
  5696         using f x by (simp add: integrable_subinterval_real)
  5697       then have Idiff: "?I a x - ?I a y = ?I y x"
  5698         using True x y by (simp add: algebra_simps integral_combine)
  5699       have fux_int: "((\<lambda>u. f u - f x) has_integral integral {y..x} f - (x - y) *\<^sub>R f x) {y..x}"
  5700         apply (rule has_integral_sub)
  5701         using x y apply (force intro: integrable_integral [OF integrable_subinterval_real [OF f]])
  5702         using has_integral_const_real [of "f x" y x] True
  5703         apply (simp add: )
  5704         done
  5705       have "norm (integral {a..x} f - integral {a..y} f - (x - y) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
  5706         using True
  5707         apply (simp add: abs_eq_content del: content_real_if measure_lborel_Icc)
  5708         apply (rule has_integral_bound_real[where f="(\<lambda>u. f u - f x)"])
  5709         using yx True d x y \<open>e>0\<close> apply (auto simp add: Idiff fux_int)
  5710         done
  5711       then show ?thesis
  5712         by (simp add: algebra_simps norm_minus_commute)
  5713     qed
  5714     then have "\<exists>d>0. \<forall>y\<in>{a..b}. \<bar>y - x\<bar> < d \<longrightarrow> norm (integral {a..y} f - integral {a..x} f - (y - x) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
  5715       using \<open>d>0\<close> by blast
  5716   }
  5717   then show ?thesis
  5718     by (simp add: has_vector_derivative_def has_derivative_within_alt bounded_linear_scaleR_left)
  5719 qed
  5720 
  5721 lemma integral_has_vector_derivative:
  5722   fixes f :: "real \<Rightarrow> 'a::banach"
  5723   assumes "continuous_on {a .. b} f"
  5724     and "x \<in> {a .. b}"
  5725   shows "((\<lambda>u. integral {a .. u} f) has_vector_derivative f(x)) (at x within {a .. b})"
  5726 apply (rule integral_has_vector_derivative_continuous_at [OF integrable_continuous_real])
  5727 using assms
  5728 apply (auto simp: continuous_on_eq_continuous_within)
  5729 done
  5730 
  5731 lemma antiderivative_continuous:
  5732   fixes q b :: real
  5733   assumes "continuous_on {a .. b} f"
  5734   obtains g where "\<forall>x\<in>{a .. b}. (g has_vector_derivative (f x::_::banach)) (at x within {a .. b})"
  5735   apply (rule that)
  5736   apply rule
  5737   using integral_has_vector_derivative[OF assms]
  5738   apply auto
  5739   done
  5740 
  5741 
  5742 subsection \<open>Combined fundamental theorem of calculus.\<close>
  5743 
  5744 lemma antiderivative_integral_continuous:
  5745   fixes f :: "real \<Rightarrow> 'a::banach"
  5746   assumes "continuous_on {a .. b} f"
  5747   obtains g where "\<forall>u\<in>{a .. b}. \<forall>v \<in> {a .. b}. u \<le> v \<longrightarrow> (f has_integral (g v - g u)) {u .. v}"
  5748 proof -
  5749   from antiderivative_continuous[OF assms] guess g . note g=this
  5750   show ?thesis
  5751     apply (rule that[of g])
  5752     apply safe
  5753   proof goal_cases
  5754     case prems: (1 u v)
  5755     have "\<forall>x\<in>cbox u v. (g has_vector_derivative f x) (at x within cbox u v)"
  5756       apply rule
  5757       apply (rule has_vector_derivative_within_subset)
  5758       apply (rule g[rule_format])
  5759       using prems(1,2)
  5760       apply auto
  5761       done
  5762     then show ?case
  5763       using fundamental_theorem_of_calculus[OF prems(3), of g f] by auto
  5764   qed
  5765 qed
  5766 
  5767 
  5768 subsection \<open>General "twiddling" for interval-to-interval function image.\<close>
  5769 
  5770 lemma has_integral_twiddle:
  5771   assumes "0 < r"
  5772     and "\<forall>x. h(g x) = x"
  5773     and "\<forall>x. g(h x) = x"
  5774     and contg: "\<And>x. continuous (at x) g"
  5775     and "\<forall>u v. \<exists>w z. g ` cbox u v = cbox w z"
  5776     and h: "\<forall>u v. \<exists>w z. h ` cbox u v = cbox w z"
  5777     and "\<forall>u v. content(g ` cbox u v) = r * content (cbox u v)"
  5778     and "(f has_integral i) (cbox a b)"
  5779   shows "((\<lambda>x. f(g x)) has_integral (1 / r) *\<^sub>R i) (h ` cbox a b)"
  5780 proof -
  5781   show ?thesis when *: "cbox a b \<noteq> {} \<Longrightarrow> ?thesis"
  5782     apply cases
  5783     defer
  5784     apply (rule *)
  5785     apply assumption
  5786   proof goal_cases
  5787     case prems: 1
  5788     then show ?thesis
  5789       unfolding prems assms(8)[unfolded prems has_integral_empty_eq] by auto
  5790   qed
  5791   assume "cbox a b \<noteq> {}"
  5792   from assms(6)[rule_format,of a b] guess w z by (elim exE) note wz=this
  5793   have inj: "inj g" "inj h"
  5794     unfolding inj_on_def
  5795     apply safe
  5796     apply(rule_tac[!] ccontr)
  5797     using assms(2)
  5798     apply(erule_tac x=x in allE)
  5799     using assms(2)
  5800     apply(erule_tac x=y in allE)
  5801     defer
  5802     using assms(3)
  5803     apply (erule_tac x=x in allE)
  5804     using assms(3)
  5805     apply(erule_tac x=y in allE)
  5806     apply auto
  5807     done
  5808   from h obtain ha hb where h_eq: "h ` cbox a b = cbox ha hb" by blast
  5809   show ?thesis
  5810     unfolding h_eq has_integral
  5811     unfolding h_eq[symmetric]
  5812   proof safe
  5813     fix e :: real
  5814     assume e: "e > 0"
  5815     with assms(1) have "e * r > 0" by simp
  5816     from assms(8)[unfolded has_integral,rule_format,OF this] guess d by (elim exE conjE) note d=this[rule_format]
  5817     define d' where "d' x = {y. g y \<in> d (g x)}" for x
  5818     have d': "\<And>x. d' x = {y. g y \<in> (d (g x))}"
  5819       unfolding d'_def ..
  5820     show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of h ` cbox a b \<and> d fine p \<longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e)"
  5821     proof (rule_tac x=d' in exI, safe)
  5822       show "gauge d'"
  5823         using d(1)
  5824         unfolding gauge_def d'
  5825         using continuous_open_preimage_univ[OF _ contg]
  5826         by auto
  5827       fix p
  5828       assume as: "p tagged_division_of h ` cbox a b" "d' fine p"
  5829       note p = tagged_division_ofD[OF as(1)]
  5830       have "(\<lambda>(x, k). (g x, g ` k)) ` p tagged_division_of (cbox a b) \<and> d fine (\<lambda>(x, k). (g x, g ` k)) ` p"
  5831         unfolding tagged_division_of
  5832       proof safe
  5833         show "finite ((\<lambda>(x, k). (g x, g ` k)) ` p)"
  5834           using as by auto
  5835         show "d fine (\<lambda>(x, k). (g x, g ` k)) ` p"
  5836           using as(2) unfolding fine_def d' by auto
  5837         fix x k
  5838         assume xk[intro]: "(x, k) \<in> p"
  5839         show "g x \<in> g ` k"
  5840           using p(2)[OF xk] by auto
  5841         show "\<exists>u v. g ` k = cbox u v"
  5842           using p(4)[OF xk] using assms(5-6) by auto
  5843         {
  5844           fix y
  5845           assume "y \<in> k"
  5846           then show "g y \<in> cbox a b" "g y \<in> cbox a b"
  5847             using p(3)[OF xk,unfolded subset_eq,rule_format,of "h (g y)"]
  5848             using assms(2)[rule_format,of y]
  5849             unfolding inj_image_mem_iff[OF inj(2)]
  5850             by auto
  5851         }
  5852         fix x' k'
  5853         assume xk': "(x', k') \<in> p"
  5854         fix z
  5855         assume z: "z \<in> interior (g ` k)" "z \<in> interior (g ` k')"
  5856         have same: "(x, k) = (x', k')"
  5857           apply -
  5858           apply (rule ccontr)
  5859           apply (drule p(5)[OF xk xk'])
  5860         proof -
  5861           assume as: "interior k \<inter> interior k' = {}"
  5862           have "z \<in> g ` (interior k \<inter> interior k')"
  5863             using interior_image_subset[OF \<open>inj g\<close> contg] z
  5864             unfolding image_Int[OF inj(1)] by blast
  5865           then show False
  5866             using as by blast
  5867         qed
  5868         then show "g x = g x'"
  5869           by auto
  5870         {
  5871           fix z
  5872           assume "z \<in> k"
  5873           then show "g z \<in> g ` k'"
  5874             using same by auto
  5875         }
  5876         {
  5877           fix z
  5878           assume "z \<in> k'"
  5879           then show "g z \<in> g ` k"
  5880             using same by auto
  5881         }
  5882       next
  5883         fix x
  5884         assume "x \<in> cbox a b"
  5885         then have "h x \<in>  \<Union>{k. \<exists>x. (x, k) \<in> p}"
  5886           using p(6) by auto
  5887         then guess X unfolding Union_iff .. note X=this
  5888         from this(1) guess y unfolding mem_Collect_eq ..
  5889         then show "x \<in> \<Union>{k. \<exists>x. (x, k) \<in> (\<lambda>(x, k). (g x, g ` k)) ` p}"
  5890           apply -
  5891           apply (rule_tac X="g ` X" in UnionI)
  5892           defer
  5893           apply (rule_tac x="h x" in image_eqI)
  5894           using X(2) assms(3)[rule_format,of x]
  5895           apply auto
  5896           done
  5897       qed
  5898         note ** = d(2)[OF this]
  5899         have *: "inj_on (\<lambda>(x, k). (g x, g ` k)) p"
  5900           using inj(1) unfolding inj_on_def by fastforce
  5901         have "(\<Sum>(x, k)\<in>(\<lambda>(x, k). (g x, g ` k)) ` p. content k *\<^sub>R f x) - i = r *\<^sub>R (\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - i" (is "?l = _")
  5902           using assms(7)
  5903           apply (simp only: algebra_simps add_left_cancel scaleR_right.setsum)
  5904           apply (subst setsum.reindex_bij_betw[symmetric, where h="\<lambda>(x, k). (g x, g ` k)" and S=p])
  5905           apply (auto intro!: * setsum.cong simp: bij_betw_def dest!: p(4))
  5906           done
  5907       also have "\<dots> = r *\<^sub>R ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i)" (is "_ = ?r")
  5908         unfolding scaleR_diff_right scaleR_scaleR
  5909         using assms(1)
  5910         by auto
  5911       finally have *: "?l = ?r" .
  5912       show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e"
  5913         using **
  5914         unfolding *
  5915         unfolding norm_scaleR
  5916         using assms(1)
  5917         by (auto simp add:field_simps)
  5918     qed
  5919   qed
  5920 qed
  5921 
  5922 
  5923 subsection \<open>Special case of a basic affine transformation.\<close>
  5924 
  5925 lemma AE_lborel_inner_neq:
  5926   assumes k: "k \<in> Basis"
  5927   shows "AE x in lborel. x \<bullet> k \<noteq> c"
  5928 proof -
  5929   interpret finite_product_sigma_finite "\<lambda>_. lborel" Basis