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