src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
author hoelzl
Fri Sep 23 10:26:04 2016 +0200 (2016-09-23)
changeset 63940 0d82c4c94014
parent 63938 f6ce08859d4c
child 63941 f353674c2528
permissions -rw-r--r--
prove HK-integrable implies Lebesgue measurable; prove HK-integral equals Lebesgue integral for nonneg functions
     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     using assms by auto
  1397   have "\<Union>{k. \<exists>x. (x, k) \<in> \<Union>(pfn ` iset)} = \<Union>((\<lambda>i. \<Union>{k. \<exists>x. (x, k) \<in> pfn i}) ` iset)"
  1398     by blast
  1399   also have "\<dots> = \<Union>iset"
  1400     using assm(6) by auto
  1401   finally show "\<Union>{k. \<exists>x. (x, k) \<in> \<Union>(pfn ` iset)} = \<Union>iset" .
  1402   fix x k
  1403   assume xk: "(x, k) \<in> \<Union>(pfn ` iset)"
  1404   then obtain i where i: "i \<in> iset" "(x, k) \<in> pfn i"
  1405     by auto
  1406   show "x \<in> k" "\<exists>a b. k = cbox a b" "k \<subseteq> \<Union>iset"
  1407     using assm(2-4)[OF i] using i(1) by auto
  1408   fix x' k'
  1409   assume xk': "(x', k') \<in> \<Union>(pfn ` iset)" "(x, k) \<noteq> (x', k')"
  1410   then obtain i' where i': "i' \<in> iset" "(x', k') \<in> pfn i'"
  1411     by auto
  1412   have *: "\<And>a b. i \<noteq> i' \<Longrightarrow> a \<subseteq> i \<Longrightarrow> b \<subseteq> i' \<Longrightarrow> interior a \<inter> interior b = {}"
  1413     using i(1) i'(1)
  1414     using assms(3)[rule_format] interior_mono
  1415     by blast
  1416   show "interior k \<inter> interior k' = {}"
  1417     apply (cases "i = i'")
  1418     using assm(5) i' i(2) xk'(2) apply blast
  1419     using "*" assm(3) i' i by auto
  1420 qed
  1421 
  1422 lemma tagged_partial_division_of_union_self:
  1423   assumes "p tagged_partial_division_of s"
  1424   shows "p tagged_division_of (\<Union>(snd ` p))"
  1425   apply (rule tagged_division_ofI)
  1426   using tagged_partial_division_ofD[OF assms]
  1427   apply auto
  1428   done
  1429 
  1430 lemma tagged_division_of_union_self:
  1431   assumes "p tagged_division_of s"
  1432   shows "p tagged_division_of (\<Union>(snd ` p))"
  1433   apply (rule tagged_division_ofI)
  1434   using tagged_division_ofD[OF assms]
  1435   apply auto
  1436   done
  1437 
  1438 subsection \<open>Functions closed on boxes: morphisms from boxes to monoids\<close>
  1439 
  1440 text \<open>This auxiliary structure is used to sum up over the elements of a division. Main theorem is
  1441   @{text operative_division}. Instances for the monoid are @{typ "'a option"}, @{typ real}, and
  1442   @{typ bool}.\<close>
  1443 
  1444 lemma property_empty_interval: "\<forall>a b. content (cbox a b) = 0 \<longrightarrow> P (cbox a b) \<Longrightarrow> P {}"
  1445   using content_empty unfolding empty_as_interval by auto
  1446 
  1447 paragraph \<open>Using additivity of lifted function to encode definedness.\<close>
  1448 
  1449 definition lift_option :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a option \<Rightarrow> 'b option \<Rightarrow> 'c option"
  1450 where
  1451   "lift_option f a' b' = Option.bind a' (\<lambda>a. Option.bind b' (\<lambda>b. Some (f a b)))"
  1452 
  1453 lemma lift_option_simps[simp]:
  1454   "lift_option f (Some a) (Some b) = Some (f a b)"
  1455   "lift_option f None b' = None"
  1456   "lift_option f a' None = None"
  1457   by (auto simp: lift_option_def)
  1458 
  1459 lemma comm_monoid_lift_option:
  1460   assumes "comm_monoid f z"
  1461   shows "comm_monoid (lift_option f) (Some z)"
  1462 proof -
  1463   from assms interpret comm_monoid f z .
  1464   show ?thesis
  1465     by standard (auto simp: lift_option_def ac_simps split: bind_split)
  1466 qed
  1467 
  1468 lemma comm_monoid_and: "comm_monoid HOL.conj True"
  1469   by standard auto
  1470 
  1471 lemma comm_monoid_set_and: "comm_monoid_set HOL.conj True"
  1472   by (rule comm_monoid_set.intro) (fact comm_monoid_and)
  1473 
  1474 paragraph \<open>Operative\<close>
  1475 
  1476 definition (in comm_monoid) operative :: "('b::euclidean_space set \<Rightarrow> 'a) \<Rightarrow> bool"
  1477   where "operative g \<longleftrightarrow>
  1478     (\<forall>a b. content (cbox a b) = 0 \<longrightarrow> g (cbox a b) = \<^bold>1) \<and>
  1479     (\<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}))"
  1480 
  1481 lemma (in comm_monoid) operativeD[dest]:
  1482   assumes "operative g"
  1483   shows "\<And>a b. content (cbox a b) = 0 \<Longrightarrow> g (cbox a b) = \<^bold>1"
  1484     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})"
  1485   using assms unfolding operative_def by auto
  1486 
  1487 lemma (in comm_monoid) operative_empty: "operative g \<Longrightarrow> g {} = \<^bold>1"
  1488   unfolding operative_def by (rule property_empty_interval) auto
  1489 
  1490 lemma operative_content[intro]: "add.operative content"
  1491   by (force simp add: add.operative_def content_split[symmetric])
  1492 
  1493 definition "division_points (k::('a::euclidean_space) set) d =
  1494    {(j,x). j \<in> Basis \<and> (interval_lowerbound k)\<bullet>j < x \<and> x < (interval_upperbound k)\<bullet>j \<and>
  1495      (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  1496 
  1497 lemma division_points_finite:
  1498   fixes i :: "'a::euclidean_space set"
  1499   assumes "d division_of i"
  1500   shows "finite (division_points i d)"
  1501 proof -
  1502   note assm = division_ofD[OF assms]
  1503   let ?M = "\<lambda>j. {(j,x)|x. (interval_lowerbound i)\<bullet>j < x \<and> x < (interval_upperbound i)\<bullet>j \<and>
  1504     (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  1505   have *: "division_points i d = \<Union>(?M ` Basis)"
  1506     unfolding division_points_def by auto
  1507   show ?thesis
  1508     unfolding * using assm by auto
  1509 qed
  1510 
  1511 lemma division_points_subset:
  1512   fixes a :: "'a::euclidean_space"
  1513   assumes "d division_of (cbox a b)"
  1514     and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  1515     and k: "k \<in> Basis"
  1516   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>
  1517       division_points (cbox a b) d" (is ?t1)
  1518     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>
  1519       division_points (cbox a b) d" (is ?t2)
  1520 proof -
  1521   note assm = division_ofD[OF assms(1)]
  1522   have *: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  1523     "\<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"
  1524     "\<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"
  1525     "min (b \<bullet> k) c = c" "max (a \<bullet> k) c = c"
  1526     using assms using less_imp_le by auto
  1527   show ?t1 (*FIXME a horrible mess*)
  1528     unfolding division_points_def interval_split[OF k, of a b]
  1529     unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  1530     unfolding *
  1531     apply (rule subsetI)
  1532     unfolding mem_Collect_eq split_beta
  1533     apply (erule bexE conjE)+
  1534     apply (simp add: )
  1535     apply (erule exE conjE)+
  1536   proof
  1537     fix i l x
  1538     assume as:
  1539       "a \<bullet> fst x < snd x" "snd x < (if fst x = k then c else b \<bullet> fst x)"
  1540       "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  1541       "i = l \<inter> {x. x \<bullet> k \<le> c}" "l \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
  1542       and fstx: "fst x \<in> Basis"
  1543     from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this
  1544     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"
  1545       using as(6) unfolding l interval_split[OF k] box_ne_empty as .
  1546     have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
  1547       using l using as(6) unfolding box_ne_empty[symmetric] by auto
  1548     show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  1549       apply (rule bexI[OF _ \<open>l \<in> d\<close>])
  1550       using as(1-3,5) fstx
  1551       unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  1552       apply (auto split: if_split_asm)
  1553       done
  1554     show "snd x < b \<bullet> fst x"
  1555       using as(2) \<open>c < b\<bullet>k\<close> by (auto split: if_split_asm)
  1556   qed
  1557   show ?t2
  1558     unfolding division_points_def interval_split[OF k, of a b]
  1559     unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  1560     unfolding *
  1561     unfolding subset_eq
  1562     apply rule
  1563     unfolding mem_Collect_eq split_beta
  1564     apply (erule bexE conjE)+
  1565     apply (simp only: mem_Collect_eq inner_setsum_left_Basis simp_thms)
  1566     apply (erule exE conjE)+
  1567   proof
  1568     fix i l x
  1569     assume as:
  1570       "(if fst x = k then c else a \<bullet> fst x) < snd x" "snd x < b \<bullet> fst x"
  1571       "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  1572       "i = l \<inter> {x. c \<le> x \<bullet> k}" "l \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} \<noteq> {}"
  1573       and fstx: "fst x \<in> Basis"
  1574     from assm(4)[OF this(5)] guess u v by (elim exE) note l=this
  1575     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"
  1576       using as(6) unfolding l interval_split[OF k] box_ne_empty as .
  1577     have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
  1578       using l using as(6) unfolding box_ne_empty[symmetric] by auto
  1579     show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  1580       apply (rule bexI[OF _ \<open>l \<in> d\<close>])
  1581       using as(1-3,5) fstx
  1582       unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  1583       apply (auto split: if_split_asm)
  1584       done
  1585     show "a \<bullet> fst x < snd x"
  1586       using as(1) \<open>a\<bullet>k < c\<close> by (auto split: if_split_asm)
  1587    qed
  1588 qed
  1589 
  1590 lemma division_points_psubset:
  1591   fixes a :: "'a::euclidean_space"
  1592   assumes "d division_of (cbox a b)"
  1593       and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  1594       and "l \<in> d"
  1595       and "interval_lowerbound l\<bullet>k = c \<or> interval_upperbound l\<bullet>k = c"
  1596       and k: "k \<in> Basis"
  1597   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>
  1598          division_points (cbox a b) d" (is "?D1 \<subset> ?D")
  1599     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>
  1600          division_points (cbox a b) d" (is "?D2 \<subset> ?D")
  1601 proof -
  1602   have ab: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  1603     using assms(2) by (auto intro!:less_imp_le)
  1604   guess u v using division_ofD(4)[OF assms(1,5)] by (elim exE) note l=this
  1605   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"
  1606     using division_ofD(2,2,3)[OF assms(1,5)] unfolding l box_ne_empty
  1607     using subset_box(1)
  1608     apply auto
  1609     apply blast+
  1610     done
  1611   have *: "interval_upperbound (cbox a b \<inter> {x. x \<bullet> k \<le> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  1612           "interval_upperbound (cbox a b \<inter> {x. x \<bullet> k \<le> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  1613     unfolding l interval_split[OF k] interval_bounds[OF uv(1)]
  1614     using uv[rule_format, of k] ab k
  1615     by auto
  1616   have "\<exists>x. x \<in> ?D - ?D1"
  1617     using assms(3-)
  1618     unfolding division_points_def interval_bounds[OF ab]
  1619     apply -
  1620     apply (erule disjE)
  1621     apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI, force simp add: *)
  1622     apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI, force simp add: *)
  1623     done
  1624   moreover have "?D1 \<subseteq> ?D"
  1625     by (auto simp add: assms division_points_subset)
  1626   ultimately show "?D1 \<subset> ?D"
  1627     by blast
  1628   have *: "interval_lowerbound (cbox a b \<inter> {x. x \<bullet> k \<ge> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  1629     "interval_lowerbound (cbox a b \<inter> {x. x \<bullet> k \<ge> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  1630     unfolding l interval_split[OF k] interval_bounds[OF uv(1)]
  1631     using uv[rule_format, of k] ab k
  1632     by auto
  1633   have "\<exists>x. x \<in> ?D - ?D2"
  1634     using assms(3-)
  1635     unfolding division_points_def interval_bounds[OF ab]
  1636     apply -
  1637     apply (erule disjE)
  1638     apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI, force simp add: *)
  1639     apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI, force simp add: *)
  1640     done
  1641   moreover have "?D2 \<subseteq> ?D"
  1642     by (auto simp add: assms division_points_subset)
  1643   ultimately show "?D2 \<subset> ?D"
  1644     by blast
  1645 qed
  1646 
  1647 lemma (in comm_monoid_set) operative_division:
  1648   fixes g :: "'b::euclidean_space set \<Rightarrow> 'a"
  1649   assumes g: "operative g" and d: "d division_of (cbox a b)" shows "F g d = g (cbox a b)"
  1650 proof -
  1651   define C where [abs_def]: "C = card (division_points (cbox a b) d)"
  1652   then show ?thesis
  1653     using d
  1654   proof (induction C arbitrary: a b d rule: less_induct)
  1655     case (less a b d)
  1656     show ?case
  1657     proof cases
  1658       show "content (cbox a b) = 0 \<Longrightarrow> F g d = g (cbox a b)"
  1659         using division_of_content_0[OF _ less.prems] operativeD(1)[OF  g] division_ofD(4)[OF less.prems]
  1660         by (fastforce intro!: neutral)
  1661     next
  1662       assume "content (cbox a b) \<noteq> 0"
  1663       note ab = this[unfolded content_lt_nz[symmetric] content_pos_lt_eq]
  1664       then have ab': "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  1665         by (auto intro!: less_imp_le)
  1666       show "F g d = g (cbox a b)"
  1667       proof (cases "division_points (cbox a b) d = {}")
  1668         case True
  1669         { fix u v and j :: 'b
  1670           assume j: "j \<in> Basis" and as: "cbox u v \<in> d"
  1671           then have "cbox u v \<noteq> {}"
  1672             using less.prems by blast
  1673           then have uv: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "u\<bullet>j \<le> v\<bullet>j"
  1674             using j unfolding box_ne_empty by auto
  1675           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)"
  1676             using as j by auto
  1677           have "(j, u\<bullet>j) \<notin> division_points (cbox a b) d"
  1678                "(j, v\<bullet>j) \<notin> division_points (cbox a b) d" using True by auto
  1679           note this[unfolded de_Morgan_conj division_points_def mem_Collect_eq split_conv interval_bounds[OF ab'] bex_simps]
  1680           note *[OF this(1)] *[OF this(2)] note this[unfolded interval_bounds[OF uv(1)]]
  1681           moreover
  1682           have "a\<bullet>j \<le> u\<bullet>j" "v\<bullet>j \<le> b\<bullet>j"
  1683             using division_ofD(2,2,3)[OF \<open>d division_of cbox a b\<close> as]
  1684             apply (metis j subset_box(1) uv(1))
  1685             by (metis \<open>cbox u v \<subseteq> cbox a b\<close> j subset_box(1) uv(1))
  1686           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"
  1687             unfolding not_less de_Morgan_disj using ab[rule_format,of j] uv(2) j by force }
  1688         then have d': "\<forall>i\<in>d. \<exists>u v. i = cbox u v \<and>
  1689           (\<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)"
  1690           unfolding forall_in_division[OF less.prems] by blast
  1691         have "(1/2) *\<^sub>R (a+b) \<in> cbox a b"
  1692           unfolding mem_box using ab by(auto intro!: less_imp_le simp: inner_simps)
  1693         note this[unfolded division_ofD(6)[OF \<open>d division_of cbox a b\<close>,symmetric] Union_iff]
  1694         then guess i .. note i=this
  1695         guess u v using d'[rule_format,OF i(1)] by (elim exE conjE) note uv=this
  1696         have "cbox a b \<in> d"
  1697         proof -
  1698           have "u = a" "v = b"
  1699             unfolding euclidean_eq_iff[where 'a='b]
  1700           proof safe
  1701             fix j :: 'b
  1702             assume j: "j \<in> Basis"
  1703             note i(2)[unfolded uv mem_box,rule_format,of j]
  1704             then show "u \<bullet> j = a \<bullet> j" and "v \<bullet> j = b \<bullet> j"
  1705               using uv(2)[rule_format,of j] j by (auto simp: inner_simps)
  1706           qed
  1707           then have "i = cbox a b" using uv by auto
  1708           then show ?thesis using i by auto
  1709         qed
  1710         then have deq: "d = insert (cbox a b) (d - {cbox a b})"
  1711           by auto
  1712         have "F g (d - {cbox a b}) = \<^bold>1"
  1713         proof (intro neutral ballI)
  1714           fix x
  1715           assume x: "x \<in> d - {cbox a b}"
  1716           then have "x\<in>d"
  1717             by auto note d'[rule_format,OF this]
  1718           then guess u v by (elim exE conjE) note uv=this
  1719           have "u \<noteq> a \<or> v \<noteq> b"
  1720             using x[unfolded uv] by auto
  1721           then obtain j where "u\<bullet>j \<noteq> a\<bullet>j \<or> v\<bullet>j \<noteq> b\<bullet>j" and j: "j \<in> Basis"
  1722             unfolding euclidean_eq_iff[where 'a='b] by auto
  1723           then have "u\<bullet>j = v\<bullet>j"
  1724             using uv(2)[rule_format,OF j] by auto
  1725           then have "content (cbox u v) = 0"
  1726             unfolding content_eq_0 using j
  1727             by force
  1728           then show "g x = \<^bold>1"
  1729             unfolding uv(1) by (rule operativeD(1)[OF g])
  1730         qed
  1731         then show "F g d = g (cbox a b)"
  1732           using division_ofD[OF less.prems]
  1733           apply (subst deq)
  1734           apply (subst insert)
  1735           apply auto
  1736           done
  1737       next
  1738         case False
  1739         then have "\<exists>x. x \<in> division_points (cbox a b) d"
  1740           by auto
  1741         then guess k c
  1742           unfolding split_paired_Ex division_points_def mem_Collect_eq split_conv
  1743           apply (elim exE conjE)
  1744           done
  1745         note this(2-4,1) note kc=this[unfolded interval_bounds[OF ab']]
  1746         from this(3) guess j .. note j=this
  1747         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> {}}"
  1748         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> {}}"
  1749         define cb where "cb = (\<Sum>i\<in>Basis. (if i = k then c else b\<bullet>i) *\<^sub>R i)"
  1750         define ca where "ca = (\<Sum>i\<in>Basis. (if i = k then c else a\<bullet>i) *\<^sub>R i)"
  1751         note division_points_psubset[OF \<open>d division_of cbox a b\<close> ab kc(1-2) j]
  1752         note psubset_card_mono[OF _ this(1)] psubset_card_mono[OF _ this(2)]
  1753         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})"
  1754           unfolding interval_split[OF kc(4)]
  1755           apply (rule_tac[!] "less.hyps"[rule_format])
  1756           using division_split[OF \<open>d division_of cbox a b\<close>, where k=k and c=c]
  1757           apply (simp_all add: interval_split kc d1_def d2_def division_points_finite[OF \<open>d division_of cbox a b\<close>])
  1758           done
  1759         { fix l y
  1760           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"
  1761           from division_ofD(4)[OF \<open>d division_of cbox a b\<close> this(1)] guess u v by (elim exE) note leq=this
  1762           have "g (l \<inter> {x. x \<bullet> k \<le> c}) = \<^bold>1"
  1763             unfolding leq interval_split[OF kc(4)]
  1764             apply (rule operativeD[OF g])
  1765             unfolding interval_split[symmetric, OF kc(4)]
  1766             using division_split_left_inj less as kc leq by blast
  1767         } note fxk_le = this
  1768         { fix l y
  1769           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"
  1770           from division_ofD(4)[OF \<open>d division_of cbox a b\<close> this(1)] guess u v by (elim exE) note leq=this
  1771           have "g (l \<inter> {x. x \<bullet> k \<ge> c}) = \<^bold>1"
  1772             unfolding leq interval_split[OF kc(4)]
  1773             apply (rule operativeD(1)[OF g])
  1774             unfolding interval_split[symmetric,OF kc(4)]
  1775             using division_split_right_inj less leq as kc by blast
  1776         } note fxk_ge = this
  1777         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> {}}"
  1778           using d1_def by auto
  1779         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> {}}"
  1780           using d2_def by auto
  1781         have "g (cbox a b) = F g d1 \<^bold>* F g d2" (is "_ = ?prev")
  1782           unfolding * using g kc(4) by blast
  1783         also have "F g d1 = F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<le> c})) d"
  1784           unfolding d1_alt using division_of_finite[OF less.prems] fxk_le
  1785           by (subst reindex_nontrivial) (auto intro!: mono_neutral_cong_left simp: operative_empty[OF g])
  1786         also have "F g d2 = F (\<lambda>l. g (l \<inter> {x. x\<bullet>k \<ge> c})) d"
  1787           unfolding d2_alt using division_of_finite[OF less.prems] fxk_ge
  1788           by (subst reindex_nontrivial) (auto intro!: mono_neutral_cong_left simp: operative_empty[OF g])
  1789         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})"
  1790           unfolding forall_in_division[OF \<open>d division_of cbox a b\<close>]
  1791           using g kc(4) by blast
  1792         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"
  1793           using * by (simp add: distrib)
  1794         finally show ?thesis by auto
  1795       qed
  1796     qed
  1797   qed
  1798 qed
  1799 
  1800 lemma (in comm_monoid_set) operative_tagged_division:
  1801   assumes f: "operative g" and d: "d tagged_division_of (cbox a b)"
  1802   shows "F (\<lambda>(x, l). g l) d = g (cbox a b)"
  1803   unfolding d[THEN division_of_tagged_division, THEN operative_division[OF f], symmetric]
  1804   by (simp add: f[THEN operativeD(1)] over_tagged_division_lemma[OF d])
  1805 
  1806 lemma additive_content_division: "d division_of (cbox a b) \<Longrightarrow> setsum content d = content (cbox a b)"
  1807   by (metis operative_content setsum.operative_division)
  1808 
  1809 lemma additive_content_tagged_division:
  1810   "d tagged_division_of (cbox a b) \<Longrightarrow> setsum (\<lambda>(x,l). content l) d = content (cbox a b)"
  1811   unfolding setsum.operative_tagged_division[OF operative_content, symmetric] by blast
  1812 
  1813 lemma content_real_eq_0: "content {a .. b::real} = 0 \<longleftrightarrow> a \<ge> b"
  1814   by (metis atLeastatMost_empty_iff2 content_empty content_real diff_self eq_iff le_cases le_iff_diff_le_0)
  1815 
  1816 lemma interval_real_split:
  1817   "{a .. b::real} \<inter> {x. x \<le> c} = {a .. min b c}"
  1818   "{a .. b} \<inter> {x. c \<le> x} = {max a c .. b}"
  1819   apply (metis Int_atLeastAtMostL1 atMost_def)
  1820   apply (metis Int_atLeastAtMostL2 atLeast_def)
  1821   done
  1822 
  1823 lemma (in comm_monoid) operative_1_lt:
  1824   "operative (g :: real set \<Rightarrow> 'a) \<longleftrightarrow>
  1825     ((\<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}))"
  1826   apply (simp add: operative_def content_real_eq_0 atMost_def[symmetric] atLeast_def[symmetric]
  1827               del: content_real_if)
  1828 proof safe
  1829   fix a b c :: real
  1830   assume *: "\<forall>a b c. g {a..b} = g {a..min b c} \<^bold>* g {max a c..b}"
  1831   assume "a < c" "c < b"
  1832   with *[rule_format, of a b c] show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1833     by (simp add: less_imp_le min.absorb2 max.absorb2)
  1834 next
  1835   fix a b c :: real
  1836   assume as: "\<forall>a b. b \<le> a \<longrightarrow> g {a..b} = \<^bold>1"
  1837     "\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1838   from as(1)[rule_format, of 0 1] as(1)[rule_format, of a a for a] as(2)
  1839   have [simp]: "g {} = \<^bold>1" "\<And>a. g {a} = \<^bold>1"
  1840     "\<And>a b c. a < c \<Longrightarrow> c < b \<Longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1841     by auto
  1842   show "g {a..b} = g {a..min b c} \<^bold>* g {max a c..b}"
  1843     by (auto simp: min_def max_def le_less)
  1844 qed
  1845 
  1846 lemma (in comm_monoid) operative_1_le:
  1847   "operative (g :: real set \<Rightarrow> 'a) \<longleftrightarrow>
  1848     ((\<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}))"
  1849   unfolding operative_1_lt
  1850 proof safe
  1851   fix a b c :: real
  1852   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"
  1853   show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1854     apply (rule as(1)[rule_format])
  1855     using as(2-)
  1856     apply auto
  1857     done
  1858 next
  1859   fix a b c :: real
  1860   assume "\<forall>a b. b \<le> a \<longrightarrow> g {a .. b} = \<^bold>1"
  1861     and "\<forall>a b c. a < c \<and> c < b \<longrightarrow> g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1862     and "a \<le> c"
  1863     and "c \<le> b"
  1864   note as = this[rule_format]
  1865   show "g {a..c} \<^bold>* g {c..b} = g {a..b}"
  1866   proof (cases "c = a \<or> c = b")
  1867     case False
  1868     then show ?thesis
  1869       apply -
  1870       apply (subst as(2))
  1871       using as(3-)
  1872       apply auto
  1873       done
  1874   next
  1875     case True
  1876     then show ?thesis
  1877     proof
  1878       assume *: "c = a"
  1879       then have "g {a .. c} = \<^bold>1"
  1880         apply -
  1881         apply (rule as(1)[rule_format])
  1882         apply auto
  1883         done
  1884       then show ?thesis
  1885         unfolding * by auto
  1886     next
  1887       assume *: "c = b"
  1888       then have "g {c .. b} = \<^bold>1"
  1889         apply -
  1890         apply (rule as(1)[rule_format])
  1891         apply auto
  1892         done
  1893       then show ?thesis
  1894         unfolding * by auto
  1895     qed
  1896   qed
  1897 qed
  1898 
  1899 subsection \<open>Fine-ness of a partition w.r.t. a gauge.\<close>
  1900 
  1901 definition fine  (infixr "fine" 46)
  1902   where "d fine s \<longleftrightarrow> (\<forall>(x,k) \<in> s. k \<subseteq> d x)"
  1903 
  1904 lemma fineI:
  1905   assumes "\<And>x k. (x, k) \<in> s \<Longrightarrow> k \<subseteq> d x"
  1906   shows "d fine s"
  1907   using assms unfolding fine_def by auto
  1908 
  1909 lemma fineD[dest]:
  1910   assumes "d fine s"
  1911   shows "\<And>x k. (x,k) \<in> s \<Longrightarrow> k \<subseteq> d x"
  1912   using assms unfolding fine_def by auto
  1913 
  1914 lemma fine_inter: "(\<lambda>x. d1 x \<inter> d2 x) fine p \<longleftrightarrow> d1 fine p \<and> d2 fine p"
  1915   unfolding fine_def by auto
  1916 
  1917 lemma fine_inters:
  1918  "(\<lambda>x. \<Inter>{f d x | d.  d \<in> s}) fine p \<longleftrightarrow> (\<forall>d\<in>s. (f d) fine p)"
  1919   unfolding fine_def by blast
  1920 
  1921 lemma fine_union: "d fine p1 \<Longrightarrow> d fine p2 \<Longrightarrow> d fine (p1 \<union> p2)"
  1922   unfolding fine_def by blast
  1923 
  1924 lemma fine_unions: "(\<And>p. p \<in> ps \<Longrightarrow> d fine p) \<Longrightarrow> d fine (\<Union>ps)"
  1925   unfolding fine_def by auto
  1926 
  1927 lemma fine_subset: "p \<subseteq> q \<Longrightarrow> d fine q \<Longrightarrow> d fine p"
  1928   unfolding fine_def by blast
  1929 
  1930 
  1931 subsection \<open>Gauge integral. Define on compact intervals first, then use a limit.\<close>
  1932 
  1933 definition has_integral_compact_interval (infixr "has'_integral'_compact'_interval" 46)
  1934   where "(f has_integral_compact_interval y) i \<longleftrightarrow>
  1935     (\<forall>e>0. \<exists>d. gauge d \<and>
  1936       (\<forall>p. p tagged_division_of i \<and> d fine p \<longrightarrow> norm ((\<Sum>(x,k)\<in>p. content k *\<^sub>R f x) - y) < e))"
  1937 
  1938 definition has_integral ::
  1939     "('n::euclidean_space \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'b \<Rightarrow> 'n set \<Rightarrow> bool"
  1940   (infixr "has'_integral" 46)
  1941   where "(f has_integral y) i \<longleftrightarrow>
  1942     (if \<exists>a b. i = cbox a b
  1943      then (f has_integral_compact_interval y) i
  1944      else (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  1945       (\<exists>z. ((\<lambda>x. if x \<in> i then f x else 0) has_integral_compact_interval z) (cbox a b) \<and>
  1946         norm (z - y) < e)))"
  1947 
  1948 lemma has_integral:
  1949   "(f has_integral y) (cbox a b) \<longleftrightarrow>
  1950     (\<forall>e>0. \<exists>d. gauge d \<and>
  1951       (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  1952         norm (setsum (\<lambda>(x,k). content(k) *\<^sub>R f x) p - y) < e))"
  1953   unfolding has_integral_def has_integral_compact_interval_def
  1954   by auto
  1955 
  1956 lemma has_integral_real:
  1957   "(f has_integral y) {a .. b::real} \<longleftrightarrow>
  1958     (\<forall>e>0. \<exists>d. gauge d \<and>
  1959       (\<forall>p. p tagged_division_of {a .. b} \<and> d fine p \<longrightarrow>
  1960         norm (setsum (\<lambda>(x,k). content(k) *\<^sub>R f x) p - y) < e))"
  1961   unfolding box_real[symmetric]
  1962   by (rule has_integral)
  1963 
  1964 lemma has_integralD[dest]:
  1965   assumes "(f has_integral y) (cbox a b)"
  1966     and "e > 0"
  1967   obtains d where "gauge d"
  1968     and "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> d fine p \<Longrightarrow>
  1969       norm (setsum (\<lambda>(x,k). content(k) *\<^sub>R f(x)) p - y) < e"
  1970   using assms unfolding has_integral by auto
  1971 
  1972 lemma has_integral_alt:
  1973   "(f has_integral y) i \<longleftrightarrow>
  1974     (if \<exists>a b. i = cbox a b
  1975      then (f has_integral y) i
  1976      else (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  1977       (\<exists>z. ((\<lambda>x. if x \<in> i then f(x) else 0) has_integral z) (cbox a b) \<and> norm (z - y) < e)))"
  1978   unfolding has_integral
  1979   unfolding has_integral_compact_interval_def has_integral_def
  1980   by auto
  1981 
  1982 lemma has_integral_altD:
  1983   assumes "(f has_integral y) i"
  1984     and "\<not> (\<exists>a b. i = cbox a b)"
  1985     and "e>0"
  1986   obtains B where "B > 0"
  1987     and "\<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  1988       (\<exists>z. ((\<lambda>x. if x \<in> i then f(x) else 0) has_integral z) (cbox a b) \<and> norm(z - y) < e)"
  1989   using assms
  1990   unfolding has_integral
  1991   unfolding has_integral_compact_interval_def has_integral_def
  1992   by auto
  1993 
  1994 definition integrable_on (infixr "integrable'_on" 46)
  1995   where "f integrable_on i \<longleftrightarrow> (\<exists>y. (f has_integral y) i)"
  1996 
  1997 definition "integral i f = (SOME y. (f has_integral y) i \<or> ~ f integrable_on i \<and> y=0)"
  1998 
  1999 lemma integrable_integral[dest]: "f integrable_on i \<Longrightarrow> (f has_integral (integral i f)) i"
  2000   unfolding integrable_on_def integral_def by (metis (mono_tags, lifting) someI_ex)
  2001 
  2002 lemma not_integrable_integral: "~ f integrable_on i \<Longrightarrow> integral i f = 0"
  2003   unfolding integrable_on_def integral_def by blast
  2004 
  2005 lemma has_integral_integrable[intro]: "(f has_integral i) s \<Longrightarrow> f integrable_on s"
  2006   unfolding integrable_on_def by auto
  2007 
  2008 lemma has_integral_integral: "f integrable_on s \<longleftrightarrow> (f has_integral (integral s f)) s"
  2009   by auto
  2010 
  2011 lemma setsum_content_null:
  2012   assumes "content (cbox a b) = 0"
  2013     and "p tagged_division_of (cbox a b)"
  2014   shows "setsum (\<lambda>(x,k). content k *\<^sub>R f x) p = (0::'a::real_normed_vector)"
  2015 proof (rule setsum.neutral, rule)
  2016   fix y
  2017   assume y: "y \<in> p"
  2018   obtain x k where xk: "y = (x, k)"
  2019     using surj_pair[of y] by blast
  2020   note assm = tagged_division_ofD(3-4)[OF assms(2) y[unfolded xk]]
  2021   from this(2) obtain c d where k: "k = cbox c d" by blast
  2022   have "(\<lambda>(x, k). content k *\<^sub>R f x) y = content k *\<^sub>R f x"
  2023     unfolding xk by auto
  2024   also have "\<dots> = 0"
  2025     using content_subset[OF assm(1)[unfolded k]] content_pos_le[of c d]
  2026     unfolding assms(1) k
  2027     by auto
  2028   finally show "(\<lambda>(x, k). content k *\<^sub>R f x) y = 0" .
  2029 qed
  2030 
  2031 
  2032 subsection \<open>Some basic combining lemmas.\<close>
  2033 
  2034 lemma tagged_division_unions_exists:
  2035   assumes "finite iset"
  2036     and "\<forall>i\<in>iset. \<exists>p. p tagged_division_of i \<and> d fine p"
  2037     and "\<forall>i1\<in>iset. \<forall>i2\<in>iset. i1 \<noteq> i2 \<longrightarrow> interior i1 \<inter> interior i2 = {}"
  2038     and "\<Union>iset = i"
  2039    obtains p where "p tagged_division_of i" and "d fine p"
  2040 proof -
  2041   obtain pfn where pfn:
  2042     "\<And>x. x \<in> iset \<Longrightarrow> pfn x tagged_division_of x"
  2043     "\<And>x. x \<in> iset \<Longrightarrow> d fine pfn x"
  2044     using bchoice[OF assms(2)] by auto
  2045   show thesis
  2046     apply (rule_tac p="\<Union>(pfn ` iset)" in that)
  2047     using assms(1) assms(3) assms(4) pfn(1) tagged_division_unions apply force
  2048     by (metis (mono_tags, lifting) fine_unions imageE pfn(2))
  2049 qed
  2050 
  2051 
  2052 subsection \<open>The set we're concerned with must be closed.\<close>
  2053 
  2054 lemma division_of_closed:
  2055   fixes i :: "'n::euclidean_space set"
  2056   shows "s division_of i \<Longrightarrow> closed i"
  2057   unfolding division_of_def by fastforce
  2058 
  2059 subsection \<open>General bisection principle for intervals; might be useful elsewhere.\<close>
  2060 
  2061 lemma interval_bisection_step:
  2062   fixes type :: "'a::euclidean_space"
  2063   assumes "P {}"
  2064     and "\<forall>s t. P s \<and> P t \<and> interior(s) \<inter> interior(t) = {} \<longrightarrow> P (s \<union> t)"
  2065     and "\<not> P (cbox a (b::'a))"
  2066   obtains c d where "\<not> P (cbox c d)"
  2067     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"
  2068 proof -
  2069   have "cbox a b \<noteq> {}"
  2070     using assms(1,3) by metis
  2071   then have ab: "\<And>i. i\<in>Basis \<Longrightarrow> a \<bullet> i \<le> b \<bullet> i"
  2072     by (force simp: mem_box)
  2073   { fix f
  2074     have "\<lbrakk>finite f;
  2075            \<And>s. s\<in>f \<Longrightarrow> P s;
  2076            \<And>s. s\<in>f \<Longrightarrow> \<exists>a b. s = cbox a b;
  2077            \<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)"
  2078     proof (induct f rule: finite_induct)
  2079       case empty
  2080       show ?case
  2081         using assms(1) by auto
  2082     next
  2083       case (insert x f)
  2084       show ?case
  2085         unfolding Union_insert
  2086         apply (rule assms(2)[rule_format])
  2087         using inter_interior_unions_intervals [of f "interior x"]
  2088         apply (auto simp: insert)
  2089         by (metis IntI empty_iff insert.hyps(2) insert.prems(3) insert_iff)
  2090     qed
  2091   } note UN_cases = this
  2092   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>
  2093     (c\<bullet>i = (a\<bullet>i + b\<bullet>i) / 2) \<and> (d\<bullet>i = b\<bullet>i)}"
  2094   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"
  2095   {
  2096     presume "\<forall>c d. ?PP c d \<longrightarrow> P (cbox c d) \<Longrightarrow> False"
  2097     then show thesis
  2098       unfolding atomize_not not_all
  2099       by (blast intro: that)
  2100   }
  2101   assume as: "\<forall>c d. ?PP c d \<longrightarrow> P (cbox c d)"
  2102   have "P (\<Union>?A)"
  2103   proof (rule UN_cases)
  2104     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)
  2105       (\<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}"
  2106     have "?A \<subseteq> ?B"
  2107     proof
  2108       fix x
  2109       assume "x \<in> ?A"
  2110       then obtain c d
  2111         where x:  "x = cbox c d"
  2112                   "\<And>i. i \<in> Basis \<Longrightarrow>
  2113                         c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  2114                         c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i" by blast
  2115       show "x \<in> ?B"
  2116         unfolding image_iff x
  2117         apply (rule_tac x="{i. i\<in>Basis \<and> c\<bullet>i = a\<bullet>i}" in bexI)
  2118         apply (rule arg_cong2 [where f = cbox])
  2119         using x(2) ab
  2120         apply (auto simp add: euclidean_eq_iff[where 'a='a])
  2121         by fastforce
  2122     qed
  2123     then show "finite ?A"
  2124       by (rule finite_subset) auto
  2125   next
  2126     fix s
  2127     assume "s \<in> ?A"
  2128     then obtain c d
  2129       where s: "s = cbox c d"
  2130                "\<And>i. i \<in> Basis \<Longrightarrow>
  2131                      c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  2132                      c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i"
  2133       by blast
  2134     show "P s"
  2135       unfolding s
  2136       apply (rule as[rule_format])
  2137       using ab s(2) by force
  2138     show "\<exists>a b. s = cbox a b"
  2139       unfolding s by auto
  2140     fix t
  2141     assume "t \<in> ?A"
  2142     then obtain e f where t:
  2143       "t = cbox e f"
  2144       "\<And>i. i \<in> Basis \<Longrightarrow>
  2145         e \<bullet> i = a \<bullet> i \<and> f \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  2146         e \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> f \<bullet> i = b \<bullet> i"
  2147       by blast
  2148     assume "s \<noteq> t"
  2149     then have "\<not> (c = e \<and> d = f)"
  2150       unfolding s t by auto
  2151     then obtain i where "c\<bullet>i \<noteq> e\<bullet>i \<or> d\<bullet>i \<noteq> f\<bullet>i" and i': "i \<in> Basis"
  2152       unfolding euclidean_eq_iff[where 'a='a] by auto
  2153     then have i: "c\<bullet>i \<noteq> e\<bullet>i" "d\<bullet>i \<noteq> f\<bullet>i"
  2154       using s(2) t(2) apply fastforce
  2155       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
  2156     have *: "\<And>s t. (\<And>a. a \<in> s \<Longrightarrow> a \<in> t \<Longrightarrow> False) \<Longrightarrow> s \<inter> t = {}"
  2157       by auto
  2158     show "interior s \<inter> interior t = {}"
  2159       unfolding s t interior_cbox
  2160     proof (rule *)
  2161       fix x
  2162       assume "x \<in> box c d" "x \<in> box e f"
  2163       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"
  2164         unfolding mem_box using i'
  2165         by force+
  2166       show False  using s(2)[OF i']
  2167       proof safe
  2168         assume as: "c \<bullet> i = a \<bullet> i" "d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2"
  2169         show False
  2170           using t(2)[OF i'] and i x unfolding as by (fastforce simp add:field_simps)
  2171       next
  2172         assume as: "c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2" "d \<bullet> i = b \<bullet> i"
  2173         show False
  2174           using t(2)[OF i'] and i x unfolding as by(fastforce simp add:field_simps)
  2175       qed
  2176     qed
  2177   qed
  2178   also have "\<Union>?A = cbox a b"
  2179   proof (rule set_eqI,rule)
  2180     fix x
  2181     assume "x \<in> \<Union>?A"
  2182     then obtain c d where x:
  2183       "x \<in> cbox c d"
  2184       "\<And>i. i \<in> Basis \<Longrightarrow>
  2185         c \<bullet> i = a \<bullet> i \<and> d \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<or>
  2186         c \<bullet> i = (a \<bullet> i + b \<bullet> i) / 2 \<and> d \<bullet> i = b \<bullet> i"
  2187       by blast
  2188     show "x\<in>cbox a b"
  2189       unfolding mem_box
  2190     proof safe
  2191       fix i :: 'a
  2192       assume i: "i \<in> Basis"
  2193       then show "a \<bullet> i \<le> x \<bullet> i" "x \<bullet> i \<le> b \<bullet> i"
  2194         using x(2)[OF i] x(1)[unfolded mem_box,THEN bspec, OF i] by auto
  2195     qed
  2196   next
  2197     fix x
  2198     assume x: "x \<in> cbox a b"
  2199     have "\<forall>i\<in>Basis.
  2200       \<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"
  2201       (is "\<forall>i\<in>Basis. \<exists>c d. ?P i c d")
  2202       unfolding mem_box
  2203     proof
  2204       fix i :: 'a
  2205       assume i: "i \<in> Basis"
  2206       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)"
  2207         using x[unfolded mem_box,THEN bspec, OF i] by auto
  2208       then show "\<exists>c d. ?P i c d"
  2209         by blast
  2210     qed
  2211     then show "x\<in>\<Union>?A"
  2212       unfolding Union_iff Bex_def mem_Collect_eq choice_Basis_iff
  2213       apply auto
  2214       apply (rule_tac x="cbox xa xaa" in exI)
  2215       unfolding mem_box
  2216       apply auto
  2217       done
  2218   qed
  2219   finally show False
  2220     using assms by auto
  2221 qed
  2222 
  2223 lemma interval_bisection:
  2224   fixes type :: "'a::euclidean_space"
  2225   assumes "P {}"
  2226     and "(\<forall>s t. P s \<and> P t \<and> interior(s) \<inter> interior(t) = {} \<longrightarrow> P(s \<union> t))"
  2227     and "\<not> P (cbox a (b::'a))"
  2228   obtains x where "x \<in> cbox a b"
  2229     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)"
  2230 proof -
  2231   have "\<forall>x. \<exists>y. \<not> P (cbox (fst x) (snd x)) \<longrightarrow> (\<not> P (cbox (fst y) (snd y)) \<and>
  2232     (\<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>
  2233        2 * (snd y\<bullet>i - fst y\<bullet>i) \<le> snd x\<bullet>i - fst x\<bullet>i))" (is "\<forall>x. ?P x")
  2234   proof
  2235     show "?P x" for x
  2236     proof (cases "P (cbox (fst x) (snd x))")
  2237       case True
  2238       then show ?thesis by auto
  2239     next
  2240       case as: False
  2241       obtain c d where "\<not> P (cbox c d)"
  2242         "\<forall>i\<in>Basis.
  2243            fst x \<bullet> i \<le> c \<bullet> i \<and>
  2244            c \<bullet> i \<le> d \<bullet> i \<and>
  2245            d \<bullet> i \<le> snd x \<bullet> i \<and>
  2246            2 * (d \<bullet> i - c \<bullet> i) \<le> snd x \<bullet> i - fst x \<bullet> i"
  2247         by (rule interval_bisection_step[of P, OF assms(1-2) as])
  2248       then show ?thesis
  2249         apply -
  2250         apply (rule_tac x="(c,d)" in exI)
  2251         apply auto
  2252         done
  2253     qed
  2254   qed
  2255   then obtain f where f:
  2256     "\<forall>x.
  2257       \<not> P (cbox (fst x) (snd x)) \<longrightarrow>
  2258       \<not> P (cbox (fst (f x)) (snd (f x))) \<and>
  2259         (\<forall>i\<in>Basis.
  2260             fst x \<bullet> i \<le> fst (f x) \<bullet> i \<and>
  2261             fst (f x) \<bullet> i \<le> snd (f x) \<bullet> i \<and>
  2262             snd (f x) \<bullet> i \<le> snd x \<bullet> i \<and>
  2263             2 * (snd (f x) \<bullet> i - fst (f x) \<bullet> i) \<le> snd x \<bullet> i - fst x \<bullet> i)"
  2264     apply -
  2265     apply (drule choice)
  2266     apply blast
  2267     done
  2268   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
  2269   have "A 0 = a" "B 0 = b" "\<And>n. \<not> P (cbox (A(Suc n)) (B(Suc n))) \<and>
  2270     (\<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>
  2271     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")
  2272   proof -
  2273     show "A 0 = a" "B 0 = b"
  2274       unfolding ab_def by auto
  2275     note S = ab_def funpow.simps o_def id_apply
  2276     show "?P n" for n
  2277     proof (induct n)
  2278       case 0
  2279       then show ?case
  2280         unfolding S
  2281         apply (rule f[rule_format]) using assms(3)
  2282         apply auto
  2283         done
  2284     next
  2285       case (Suc n)
  2286       show ?case
  2287         unfolding S
  2288         apply (rule f[rule_format])
  2289         using Suc
  2290         unfolding S
  2291         apply auto
  2292         done
  2293     qed
  2294   qed
  2295   note AB = this(1-2) conjunctD2[OF this(3),rule_format]
  2296 
  2297   have interv: "\<exists>n. \<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e"
  2298     if e: "0 < e" for e
  2299   proof -
  2300     obtain n where n: "(\<Sum>i\<in>Basis. b \<bullet> i - a \<bullet> i) / e < 2 ^ n"
  2301       using real_arch_pow[of 2 "(setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis) / e"] by auto
  2302     show ?thesis
  2303     proof (rule exI [where x=n], clarify)
  2304       fix x y
  2305       assume xy: "x\<in>cbox (A n) (B n)" "y\<in>cbox (A n) (B n)"
  2306       have "dist x y \<le> setsum (\<lambda>i. \<bar>(x - y)\<bullet>i\<bar>) Basis"
  2307         unfolding dist_norm by(rule norm_le_l1)
  2308       also have "\<dots> \<le> setsum (\<lambda>i. B n\<bullet>i - A n\<bullet>i) Basis"
  2309       proof (rule setsum_mono)
  2310         fix i :: 'a
  2311         assume i: "i \<in> Basis"
  2312         show "\<bar>(x - y) \<bullet> i\<bar> \<le> B n \<bullet> i - A n \<bullet> i"
  2313           using xy[unfolded mem_box,THEN bspec, OF i]
  2314           by (auto simp: inner_diff_left)
  2315       qed
  2316       also have "\<dots> \<le> setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis / 2^n"
  2317         unfolding setsum_divide_distrib
  2318       proof (rule setsum_mono)
  2319         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
  2320         proof (induct n)
  2321           case 0
  2322           then show ?case
  2323             unfolding AB by auto
  2324         next
  2325           case (Suc n)
  2326           have "B (Suc n) \<bullet> i - A (Suc n) \<bullet> i \<le> (B n \<bullet> i - A n \<bullet> i) / 2"
  2327             using AB(4)[of i n] using i by auto
  2328           also have "\<dots> \<le> (b \<bullet> i - a \<bullet> i) / 2 ^ Suc n"
  2329             using Suc by (auto simp add: field_simps)
  2330           finally show ?case .
  2331         qed
  2332       qed
  2333       also have "\<dots> < e"
  2334         using n using e by (auto simp add: field_simps)
  2335       finally show "dist x y < e" .
  2336     qed
  2337   qed
  2338   {
  2339     fix n m :: nat
  2340     assume "m \<le> n" then have "cbox (A n) (B n) \<subseteq> cbox (A m) (B m)"
  2341     proof (induction rule: inc_induct)
  2342       case (step i)
  2343       show ?case
  2344         using AB(4) by (intro order_trans[OF step.IH] subset_box_imp) auto
  2345     qed simp
  2346   } note ABsubset = this
  2347   have "\<exists>a. \<forall>n. a\<in> cbox (A n) (B n)"
  2348     by (rule decreasing_closed_nest[rule_format,OF closed_cbox _ ABsubset interv])
  2349       (metis nat.exhaust AB(1-3) assms(1,3))
  2350   then obtain x0 where x0: "\<And>n. x0 \<in> cbox (A n) (B n)"
  2351     by blast
  2352   show thesis
  2353   proof (rule that[rule_format, of x0])
  2354     show "x0\<in>cbox a b"
  2355       using x0[of 0] unfolding AB .
  2356     fix e :: real
  2357     assume "e > 0"
  2358     from interv[OF this] obtain n
  2359       where n: "\<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e" ..
  2360     have "\<not> P (cbox (A n) (B n))"
  2361       apply (cases "0 < n")
  2362       using AB(3)[of "n - 1"] assms(3) AB(1-2)
  2363       apply auto
  2364       done
  2365     moreover have "cbox (A n) (B n) \<subseteq> ball x0 e"
  2366       using n using x0[of n] by auto
  2367     moreover have "cbox (A n) (B n) \<subseteq> cbox a b"
  2368       unfolding AB(1-2)[symmetric] by (rule ABsubset) auto
  2369     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)"
  2370       apply (rule_tac x="A n" in exI)
  2371       apply (rule_tac x="B n" in exI)
  2372       apply (auto simp: x0)
  2373       done
  2374   qed
  2375 qed
  2376 
  2377 
  2378 subsection \<open>Cousin's lemma.\<close>
  2379 
  2380 lemma fine_division_exists:
  2381   fixes a b :: "'a::euclidean_space"
  2382   assumes "gauge g"
  2383   obtains p where "p tagged_division_of (cbox a b)" "g fine p"
  2384 proof -
  2385   presume "\<not> (\<exists>p. p tagged_division_of (cbox a b) \<and> g fine p) \<Longrightarrow> False"
  2386   then obtain p where "p tagged_division_of (cbox a b)" "g fine p"
  2387     by blast
  2388   then show thesis ..
  2389 next
  2390   assume as: "\<not> (\<exists>p. p tagged_division_of (cbox a b) \<and> g fine p)"
  2391   obtain x where x:
  2392       "x \<in> (cbox a b)"
  2393       "\<And>e. 0 < e \<Longrightarrow>
  2394         \<exists>c d.
  2395           x \<in> cbox c d \<and>
  2396           cbox c d \<subseteq> ball x e \<and>
  2397           cbox c d \<subseteq> (cbox a b) \<and>
  2398           \<not> (\<exists>p. p tagged_division_of cbox c d \<and> g fine p)"
  2399     apply (rule interval_bisection[of "\<lambda>s. \<exists>p. p tagged_division_of s \<and> g fine p", OF _ _ as])
  2400     apply (simp add: fine_def)
  2401     apply (metis tagged_division_union fine_union)
  2402     apply (auto simp: )
  2403     done
  2404   obtain e where e: "e > 0" "ball x e \<subseteq> g x"
  2405     using gaugeD[OF assms, of x] unfolding open_contains_ball by auto
  2406   from x(2)[OF e(1)]
  2407   obtain c d where c_d: "x \<in> cbox c d"
  2408                         "cbox c d \<subseteq> ball x e"
  2409                         "cbox c d \<subseteq> cbox a b"
  2410                         "\<not> (\<exists>p. p tagged_division_of cbox c d \<and> g fine p)"
  2411     by blast
  2412   have "g fine {(x, cbox c d)}"
  2413     unfolding fine_def using e using c_d(2) by auto
  2414   then show False
  2415     using tagged_division_of_self[OF c_d(1)] using c_d by auto
  2416 qed
  2417 
  2418 lemma fine_division_exists_real:
  2419   fixes a b :: real
  2420   assumes "gauge g"
  2421   obtains p where "p tagged_division_of {a .. b}" "g fine p"
  2422   by (metis assms box_real(2) fine_division_exists)
  2423 
  2424 subsection \<open>Basic theorems about integrals.\<close>
  2425 
  2426 lemma has_integral_unique:
  2427   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  2428   assumes "(f has_integral k1) i"
  2429     and "(f has_integral k2) i"
  2430   shows "k1 = k2"
  2431 proof (rule ccontr)
  2432   let ?e = "norm (k1 - k2) / 2"
  2433   assume as: "k1 \<noteq> k2"
  2434   then have e: "?e > 0"
  2435     by auto
  2436   have lem: False
  2437     if f_k1: "(f has_integral k1) (cbox a b)"
  2438     and f_k2: "(f has_integral k2) (cbox a b)"
  2439     and "k1 \<noteq> k2"
  2440     for f :: "'n \<Rightarrow> 'a" and a b k1 k2
  2441   proof -
  2442     let ?e = "norm (k1 - k2) / 2"
  2443     from \<open>k1 \<noteq> k2\<close> have e: "?e > 0" by auto
  2444     obtain d1 where d1:
  2445         "gauge d1"
  2446         "\<And>p. p tagged_division_of cbox a b \<Longrightarrow>
  2447           d1 fine p \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k1) < norm (k1 - k2) / 2"
  2448       by (rule has_integralD[OF f_k1 e]) blast
  2449     obtain d2 where d2:
  2450         "gauge d2"
  2451         "\<And>p. p tagged_division_of cbox a b \<Longrightarrow>
  2452           d2 fine p \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k2) < norm (k1 - k2) / 2"
  2453       by (rule has_integralD[OF f_k2 e]) blast
  2454     obtain p where p:
  2455         "p tagged_division_of cbox a b"
  2456         "(\<lambda>x. d1 x \<inter> d2 x) fine p"
  2457       by (rule fine_division_exists[OF gauge_inter[OF d1(1) d2(1)]])
  2458     let ?c = "(\<Sum>(x, k)\<in>p. content k *\<^sub>R f x)"
  2459     have "norm (k1 - k2) \<le> norm (?c - k2) + norm (?c - k1)"
  2460       using norm_triangle_ineq4[of "k1 - ?c" "k2 - ?c"]
  2461       by (auto simp add:algebra_simps norm_minus_commute)
  2462     also have "\<dots> < norm (k1 - k2) / 2 + norm (k1 - k2) / 2"
  2463       apply (rule add_strict_mono)
  2464       apply (rule_tac[!] d2(2) d1(2))
  2465       using p unfolding fine_def
  2466       apply auto
  2467       done
  2468     finally show False by auto
  2469   qed
  2470   {
  2471     presume "\<not> (\<exists>a b. i = cbox a b) \<Longrightarrow> False"
  2472     then show False
  2473       using as assms lem by blast
  2474   }
  2475   assume as: "\<not> (\<exists>a b. i = cbox a b)"
  2476   obtain B1 where B1:
  2477       "0 < B1"
  2478       "\<And>a b. ball 0 B1 \<subseteq> cbox a b \<Longrightarrow>
  2479         \<exists>z. ((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b) \<and>
  2480           norm (z - k1) < norm (k1 - k2) / 2"
  2481     by (rule has_integral_altD[OF assms(1) as,OF e]) blast
  2482   obtain B2 where B2:
  2483       "0 < B2"
  2484       "\<And>a b. ball 0 B2 \<subseteq> cbox a b \<Longrightarrow>
  2485         \<exists>z. ((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b) \<and>
  2486           norm (z - k2) < norm (k1 - k2) / 2"
  2487     by (rule has_integral_altD[OF assms(2) as,OF e]) blast
  2488   have "\<exists>a b::'n. ball 0 B1 \<union> ball 0 B2 \<subseteq> cbox a b"
  2489     apply (rule bounded_subset_cbox)
  2490     using bounded_Un bounded_ball
  2491     apply auto
  2492     done
  2493   then obtain a b :: 'n where ab: "ball 0 B1 \<subseteq> cbox a b" "ball 0 B2 \<subseteq> cbox a b"
  2494     by blast
  2495   obtain w where w:
  2496     "((\<lambda>x. if x \<in> i then f x else 0) has_integral w) (cbox a b)"
  2497     "norm (w - k1) < norm (k1 - k2) / 2"
  2498     using B1(2)[OF ab(1)] by blast
  2499   obtain z where z:
  2500     "((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b)"
  2501     "norm (z - k2) < norm (k1 - k2) / 2"
  2502     using B2(2)[OF ab(2)] by blast
  2503   have "z = w"
  2504     using lem[OF w(1) z(1)] by auto
  2505   then have "norm (k1 - k2) \<le> norm (z - k2) + norm (w - k1)"
  2506     using norm_triangle_ineq4 [of "k1 - w" "k2 - z"]
  2507     by (auto simp add: norm_minus_commute)
  2508   also have "\<dots> < norm (k1 - k2) / 2 + norm (k1 - k2) / 2"
  2509     apply (rule add_strict_mono)
  2510     apply (rule_tac[!] z(2) w(2))
  2511     done
  2512   finally show False by auto
  2513 qed
  2514 
  2515 lemma integral_unique [intro]: "(f has_integral y) k \<Longrightarrow> integral k f = y"
  2516   unfolding integral_def
  2517   by (rule some_equality) (auto intro: has_integral_unique)
  2518 
  2519 lemma eq_integralD: "integral k f = y \<Longrightarrow> (f has_integral y) k \<or> ~ f integrable_on k \<and> y=0"
  2520   unfolding integral_def integrable_on_def
  2521   apply (erule subst)
  2522   apply (rule someI_ex)
  2523   by blast
  2524 
  2525 lemma has_integral_is_0:
  2526   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  2527   assumes "\<forall>x\<in>s. f x = 0"
  2528   shows "(f has_integral 0) s"
  2529 proof -
  2530   have lem: "\<And>a b. \<And>f::'n \<Rightarrow> 'a.
  2531     (\<forall>x\<in>cbox a b. f(x) = 0) \<Longrightarrow> (f has_integral 0) (cbox a b)"
  2532     unfolding has_integral
  2533   proof clarify
  2534     fix a b e
  2535     fix f :: "'n \<Rightarrow> 'a"
  2536     assume as: "\<forall>x\<in>cbox a b. f x = 0" "0 < (e::real)"
  2537     have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) < e"
  2538       if p: "p tagged_division_of cbox a b" for p
  2539     proof -
  2540       have "(\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) = 0"
  2541       proof (rule setsum.neutral, rule)
  2542         fix x
  2543         assume x: "x \<in> p"
  2544         have "f (fst x) = 0"
  2545           using tagged_division_ofD(2-3)[OF p, of "fst x" "snd x"] using as x by auto
  2546         then show "(\<lambda>(x, k). content k *\<^sub>R f x) x = 0"
  2547           apply (subst surjective_pairing[of x])
  2548           unfolding split_conv
  2549           apply auto
  2550           done
  2551       qed
  2552       then show ?thesis
  2553         using as by auto
  2554     qed
  2555     then show "\<exists>d. gauge d \<and>
  2556         (\<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)"
  2557       by auto
  2558   qed
  2559   {
  2560     presume "\<not> (\<exists>a b. s = cbox a b) \<Longrightarrow> ?thesis"
  2561     with assms lem show ?thesis
  2562       by blast
  2563   }
  2564   have *: "(\<lambda>x. if x \<in> s then f x else 0) = (\<lambda>x. 0)"
  2565     apply (rule ext)
  2566     using assms
  2567     apply auto
  2568     done
  2569   assume "\<not> (\<exists>a b. s = cbox a b)"
  2570   then show ?thesis
  2571     using lem
  2572     by (subst has_integral_alt) (force simp add: *)
  2573 qed
  2574 
  2575 lemma has_integral_0[simp]: "((\<lambda>x::'n::euclidean_space. 0) has_integral 0) s"
  2576   by (rule has_integral_is_0) auto
  2577 
  2578 lemma has_integral_0_eq[simp]: "((\<lambda>x. 0) has_integral i) s \<longleftrightarrow> i = 0"
  2579   using has_integral_unique[OF has_integral_0] by auto
  2580 
  2581 lemma has_integral_linear:
  2582   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  2583   assumes "(f has_integral y) s"
  2584     and "bounded_linear h"
  2585   shows "((h \<circ> f) has_integral ((h y))) s"
  2586 proof -
  2587   interpret bounded_linear h
  2588     using assms(2) .
  2589   from pos_bounded obtain B where B: "0 < B" "\<And>x. norm (h x) \<le> norm x * B"
  2590     by blast
  2591   have lem: "\<And>(f :: 'n \<Rightarrow> 'a) y a b.
  2592     (f has_integral y) (cbox a b) \<Longrightarrow> ((h \<circ> f) has_integral h y) (cbox a b)"
  2593     unfolding has_integral
  2594   proof (clarify, goal_cases)
  2595     case prems: (1 f y a b e)
  2596     from pos_bounded
  2597     obtain B where B: "0 < B" "\<And>x. norm (h x) \<le> norm x * B"
  2598       by blast
  2599     have "e / B > 0" using prems(2) B by simp
  2600     then obtain g
  2601       where g: "gauge g"
  2602                "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> g fine p \<Longrightarrow>
  2603                     norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - y) < e / B"
  2604         using prems(1) by auto
  2605     {
  2606       fix p
  2607       assume as: "p tagged_division_of (cbox a b)" "g fine p"
  2608       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"
  2609         by auto
  2610       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"
  2611         unfolding o_def unfolding scaleR[symmetric] hc by simp
  2612       also have "\<dots> = h (\<Sum>(x, k)\<in>p. content k *\<^sub>R f x)"
  2613         using setsum[of "\<lambda>(x,k). content k *\<^sub>R f x" p] using as by auto
  2614       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)" .
  2615       then have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (h \<circ> f) x) - h y) < e"
  2616         apply (simp add: diff[symmetric])
  2617         apply (rule le_less_trans[OF B(2)])
  2618         using g(2)[OF as] B(1)
  2619         apply (auto simp add: field_simps)
  2620         done
  2621     }
  2622     with g show ?case
  2623       by (rule_tac x=g in exI) auto
  2624   qed
  2625   {
  2626     presume "\<not> (\<exists>a b. s = cbox a b) \<Longrightarrow> ?thesis"
  2627     then show ?thesis
  2628       using assms(1) lem by blast
  2629   }
  2630   assume as: "\<not> (\<exists>a b. s = cbox a b)"
  2631   then show ?thesis
  2632   proof (subst has_integral_alt, clarsimp)
  2633     fix e :: real
  2634     assume e: "e > 0"
  2635     have *: "0 < e/B" using e B(1) by simp
  2636     obtain M where M:
  2637       "M > 0"
  2638       "\<And>a b. ball 0 M \<subseteq> cbox a b \<Longrightarrow>
  2639         \<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"
  2640       using has_integral_altD[OF assms(1) as *] by blast
  2641     show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  2642       (\<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)"
  2643     proof (rule_tac x=M in exI, clarsimp simp add: M, goal_cases)
  2644       case prems: (1 a b)
  2645       obtain z where z:
  2646         "((\<lambda>x. if x \<in> s then f x else 0) has_integral z) (cbox a b)"
  2647         "norm (z - y) < e / B"
  2648         using M(2)[OF prems(1)] by blast
  2649       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)"
  2650         using zero by auto
  2651       show ?case
  2652         apply (rule_tac x="h z" in exI)
  2653         apply (simp add: * lem z(1))
  2654         apply (metis B diff le_less_trans pos_less_divide_eq z(2))
  2655         done
  2656     qed
  2657   qed
  2658 qed
  2659 
  2660 lemma has_integral_scaleR_left:
  2661   "(f has_integral y) s \<Longrightarrow> ((\<lambda>x. f x *\<^sub>R c) has_integral (y *\<^sub>R c)) s"
  2662   using has_integral_linear[OF _ bounded_linear_scaleR_left] by (simp add: comp_def)
  2663 
  2664 lemma has_integral_mult_left:
  2665   fixes c :: "_ :: real_normed_algebra"
  2666   shows "(f has_integral y) s \<Longrightarrow> ((\<lambda>x. f x * c) has_integral (y * c)) s"
  2667   using has_integral_linear[OF _ bounded_linear_mult_left] by (simp add: comp_def)
  2668 
  2669 text\<open>The case analysis eliminates the condition @{term "f integrable_on s"} at the cost
  2670      of the type class constraint \<open>division_ring\<close>\<close>
  2671 corollary integral_mult_left [simp]:
  2672   fixes c:: "'a::{real_normed_algebra,division_ring}"
  2673   shows "integral s (\<lambda>x. f x * c) = integral s f * c"
  2674 proof (cases "f integrable_on s \<or> c = 0")
  2675   case True then show ?thesis
  2676     by (force intro: has_integral_mult_left)
  2677 next
  2678   case False then have "~ (\<lambda>x. f x * c) integrable_on s"
  2679     using has_integral_mult_left [of "(\<lambda>x. f x * c)" _ s "inverse c"]
  2680     by (force simp add: mult.assoc)
  2681   with False show ?thesis by (simp add: not_integrable_integral)
  2682 qed
  2683 
  2684 corollary integral_mult_right [simp]:
  2685   fixes c:: "'a::{real_normed_field}"
  2686   shows "integral s (\<lambda>x. c * f x) = c * integral s f"
  2687 by (simp add: mult.commute [of c])
  2688 
  2689 corollary integral_divide [simp]:
  2690   fixes z :: "'a::real_normed_field"
  2691   shows "integral S (\<lambda>x. f x / z) = integral S (\<lambda>x. f x) / z"
  2692 using integral_mult_left [of S f "inverse z"]
  2693   by (simp add: divide_inverse_commute)
  2694 
  2695 lemma has_integral_mult_right:
  2696   fixes c :: "'a :: real_normed_algebra"
  2697   shows "(f has_integral y) i \<Longrightarrow> ((\<lambda>x. c * f x) has_integral (c * y)) i"
  2698   using has_integral_linear[OF _ bounded_linear_mult_right] by (simp add: comp_def)
  2699 
  2700 lemma has_integral_cmul: "(f has_integral k) s \<Longrightarrow> ((\<lambda>x. c *\<^sub>R f x) has_integral (c *\<^sub>R k)) s"
  2701   unfolding o_def[symmetric]
  2702   by (metis has_integral_linear bounded_linear_scaleR_right)
  2703 
  2704 lemma has_integral_cmult_real:
  2705   fixes c :: real
  2706   assumes "c \<noteq> 0 \<Longrightarrow> (f has_integral x) A"
  2707   shows "((\<lambda>x. c * f x) has_integral c * x) A"
  2708 proof (cases "c = 0")
  2709   case True
  2710   then show ?thesis by simp
  2711 next
  2712   case False
  2713   from has_integral_cmul[OF assms[OF this], of c] show ?thesis
  2714     unfolding real_scaleR_def .
  2715 qed
  2716 
  2717 lemma has_integral_neg: "(f has_integral k) s \<Longrightarrow> ((\<lambda>x. -(f x)) has_integral -k) s"
  2718   by (drule_tac c="-1" in has_integral_cmul) auto
  2719 
  2720 lemma has_integral_add:
  2721   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  2722   assumes "(f has_integral k) s"
  2723     and "(g has_integral l) s"
  2724   shows "((\<lambda>x. f x + g x) has_integral (k + l)) s"
  2725 proof -
  2726   have lem: "((\<lambda>x. f x + g x) has_integral (k + l)) (cbox a b)"
  2727     if f_k: "(f has_integral k) (cbox a b)"
  2728     and g_l: "(g has_integral l) (cbox a b)"
  2729     for f :: "'n \<Rightarrow> 'a" and g a b k l
  2730     unfolding has_integral
  2731   proof clarify
  2732     fix e :: real
  2733     assume e: "e > 0"
  2734     then have *: "e / 2 > 0"
  2735       by auto
  2736     obtain d1 where d1:
  2737       "gauge d1"
  2738       "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> d1 fine p \<Longrightarrow>
  2739         norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k) < e / 2"
  2740       using has_integralD[OF f_k *] by blast
  2741     obtain d2 where d2:
  2742       "gauge d2"
  2743       "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> d2 fine p \<Longrightarrow>
  2744         norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - l) < e / 2"
  2745       using has_integralD[OF g_l *] by blast
  2746     show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  2747               norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) < e)"
  2748     proof (rule exI [where x="\<lambda>x. (d1 x) \<inter> (d2 x)"], clarsimp simp add: gauge_inter[OF d1(1) d2(1)])
  2749       fix p
  2750       assume as: "p tagged_division_of (cbox a b)" "(\<lambda>x. d1 x \<inter> d2 x) fine p"
  2751       have *: "(\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) =
  2752         (\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p. content k *\<^sub>R g x)"
  2753         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]
  2754         by (rule setsum.cong) auto
  2755       from as have fine: "d1 fine p" "d2 fine p"
  2756         unfolding fine_inter by auto
  2757       have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) =
  2758             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))"
  2759         unfolding * by (auto simp add: algebra_simps)
  2760       also have "\<dots> < e/2 + e/2"
  2761         apply (rule le_less_trans[OF norm_triangle_ineq])
  2762         using as d1 d2 fine
  2763         apply (blast intro: add_strict_mono)
  2764         done
  2765       finally show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) < e"
  2766         by auto
  2767     qed
  2768   qed
  2769   {
  2770     presume "\<not> (\<exists>a b. s = cbox a b) \<Longrightarrow> ?thesis"
  2771     then show ?thesis
  2772       using assms lem by force
  2773   }
  2774   assume as: "\<not> (\<exists>a b. s = cbox a b)"
  2775   then show ?thesis
  2776   proof (subst has_integral_alt, clarsimp, goal_cases)
  2777     case (1 e)
  2778     then have *: "e / 2 > 0"
  2779       by auto
  2780     from has_integral_altD[OF assms(1) as *]
  2781     obtain B1 where B1:
  2782         "0 < B1"
  2783         "\<And>a b. ball 0 B1 \<subseteq> cbox a b \<Longrightarrow>
  2784           \<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"
  2785       by blast
  2786     from has_integral_altD[OF assms(2) as *]
  2787     obtain B2 where B2:
  2788         "0 < B2"
  2789         "\<And>a b. ball 0 B2 \<subseteq> (cbox a b) \<Longrightarrow>
  2790           \<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"
  2791       by blast
  2792     show ?case
  2793     proof (rule_tac x="max B1 B2" in exI, clarsimp simp add: max.strict_coboundedI1 B1)
  2794       fix a b
  2795       assume "ball 0 (max B1 B2) \<subseteq> cbox a (b::'n)"
  2796       then have *: "ball 0 B1 \<subseteq> cbox a (b::'n)" "ball 0 B2 \<subseteq> cbox a (b::'n)"
  2797         by auto
  2798       obtain w where w:
  2799         "((\<lambda>x. if x \<in> s then f x else 0) has_integral w) (cbox a b)"
  2800         "norm (w - k) < e / 2"
  2801         using B1(2)[OF *(1)] by blast
  2802       obtain z where z:
  2803         "((\<lambda>x. if x \<in> s then g x else 0) has_integral z) (cbox a b)"
  2804         "norm (z - l) < e / 2"
  2805         using B2(2)[OF *(2)] by blast
  2806       have *: "\<And>x. (if x \<in> s then f x + g x else 0) =
  2807         (if x \<in> s then f x else 0) + (if x \<in> s then g x else 0)"
  2808         by auto
  2809       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"
  2810         apply (rule_tac x="w + z" in exI)
  2811         apply (simp add: lem[OF w(1) z(1), unfolded *[symmetric]])
  2812         using norm_triangle_ineq[of "w - k" "z - l"] w(2) z(2)
  2813         apply (auto simp add: field_simps)
  2814         done
  2815     qed
  2816   qed
  2817 qed
  2818 
  2819 lemma has_integral_sub:
  2820   "(f has_integral k) s \<Longrightarrow> (g has_integral l) s \<Longrightarrow>
  2821     ((\<lambda>x. f x - g x) has_integral (k - l)) s"
  2822   using has_integral_add[OF _ has_integral_neg, of f k s g l]
  2823   by (auto simp: algebra_simps)
  2824 
  2825 lemma integral_0 [simp]:
  2826   "integral s (\<lambda>x::'n::euclidean_space. 0::'m::real_normed_vector) = 0"
  2827   by (rule integral_unique has_integral_0)+
  2828 
  2829 lemma integral_add: "f integrable_on s \<Longrightarrow> g integrable_on s \<Longrightarrow>
  2830     integral s (\<lambda>x. f x + g x) = integral s f + integral s g"
  2831   by (rule integral_unique) (metis integrable_integral has_integral_add)
  2832 
  2833 lemma integral_cmul [simp]: "integral s (\<lambda>x. c *\<^sub>R f x) = c *\<^sub>R integral s f"
  2834 proof (cases "f integrable_on s \<or> c = 0")
  2835   case True with has_integral_cmul show ?thesis by force
  2836 next
  2837   case False then have "~ (\<lambda>x. c *\<^sub>R f x) integrable_on s"
  2838     using has_integral_cmul [of "(\<lambda>x. c *\<^sub>R f x)" _ s "inverse c"]
  2839     by force
  2840   with False show ?thesis by (simp add: not_integrable_integral)
  2841 qed
  2842 
  2843 lemma integral_neg [simp]: "integral s (\<lambda>x. - f x) = - integral s f"
  2844 proof (cases "f integrable_on s")
  2845   case True then show ?thesis
  2846     by (simp add: has_integral_neg integrable_integral integral_unique)
  2847 next
  2848   case False then have "~ (\<lambda>x. - f x) integrable_on s"
  2849     using has_integral_neg [of "(\<lambda>x. - f x)" _ s ]
  2850     by force
  2851   with False show ?thesis by (simp add: not_integrable_integral)
  2852 qed
  2853 
  2854 lemma integral_diff: "f integrable_on s \<Longrightarrow> g integrable_on s \<Longrightarrow>
  2855     integral s (\<lambda>x. f x - g x) = integral s f - integral s g"
  2856   by (rule integral_unique) (metis integrable_integral has_integral_sub)
  2857 
  2858 lemma integrable_0: "(\<lambda>x. 0) integrable_on s"
  2859   unfolding integrable_on_def using has_integral_0 by auto
  2860 
  2861 lemma integrable_add: "f integrable_on s \<Longrightarrow> g integrable_on s \<Longrightarrow> (\<lambda>x. f x + g x) integrable_on s"
  2862   unfolding integrable_on_def by(auto intro: has_integral_add)
  2863 
  2864 lemma integrable_cmul: "f integrable_on s \<Longrightarrow> (\<lambda>x. c *\<^sub>R f(x)) integrable_on s"
  2865   unfolding integrable_on_def by(auto intro: has_integral_cmul)
  2866 
  2867 lemma integrable_on_cmult_iff:
  2868   fixes c :: real
  2869   assumes "c \<noteq> 0"
  2870   shows "(\<lambda>x. c * f x) integrable_on s \<longleftrightarrow> f integrable_on s"
  2871   using integrable_cmul[of "\<lambda>x. c * f x" s "1 / c"] integrable_cmul[of f s c] \<open>c \<noteq> 0\<close>
  2872   by auto
  2873 
  2874 lemma integrable_on_cmult_left:
  2875   assumes "f integrable_on s"
  2876   shows "(\<lambda>x. of_real c * f x) integrable_on s"
  2877     using integrable_cmul[of f s "of_real c"] assms
  2878     by (simp add: scaleR_conv_of_real)
  2879 
  2880 lemma integrable_neg: "f integrable_on s \<Longrightarrow> (\<lambda>x. -f(x)) integrable_on s"
  2881   unfolding integrable_on_def by(auto intro: has_integral_neg)
  2882 
  2883 lemma integrable_diff:
  2884   "f integrable_on s \<Longrightarrow> g integrable_on s \<Longrightarrow> (\<lambda>x. f x - g x) integrable_on s"
  2885   unfolding integrable_on_def by(auto intro: has_integral_sub)
  2886 
  2887 lemma integrable_linear:
  2888   "f integrable_on s \<Longrightarrow> bounded_linear h \<Longrightarrow> (h \<circ> f) integrable_on s"
  2889   unfolding integrable_on_def by(auto intro: has_integral_linear)
  2890 
  2891 lemma integral_linear:
  2892   "f integrable_on s \<Longrightarrow> bounded_linear h \<Longrightarrow> integral s (h \<circ> f) = h (integral s f)"
  2893   apply (rule has_integral_unique [where i=s and f = "h \<circ> f"])
  2894   apply (simp_all add: integrable_integral integrable_linear has_integral_linear )
  2895   done
  2896 
  2897 lemma integral_component_eq[simp]:
  2898   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  2899   assumes "f integrable_on s"
  2900   shows "integral s (\<lambda>x. f x \<bullet> k) = integral s f \<bullet> k"
  2901   unfolding integral_linear[OF assms(1) bounded_linear_inner_left,unfolded o_def] ..
  2902 
  2903 lemma has_integral_setsum:
  2904   assumes "finite t"
  2905     and "\<forall>a\<in>t. ((f a) has_integral (i a)) s"
  2906   shows "((\<lambda>x. setsum (\<lambda>a. f a x) t) has_integral (setsum i t)) s"
  2907   using assms(1) subset_refl[of t]
  2908 proof (induct rule: finite_subset_induct)
  2909   case empty
  2910   then show ?case by auto
  2911 next
  2912   case (insert x F)
  2913   with assms show ?case
  2914     by (simp add: has_integral_add)
  2915 qed
  2916 
  2917 lemma integral_setsum:
  2918   "\<lbrakk>finite t;  \<forall>a\<in>t. (f a) integrable_on s\<rbrakk> \<Longrightarrow>
  2919    integral s (\<lambda>x. setsum (\<lambda>a. f a x) t) = setsum (\<lambda>a. integral s (f a)) t"
  2920   by (auto intro: has_integral_setsum integrable_integral)
  2921 
  2922 lemma integrable_setsum:
  2923   "\<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"
  2924   unfolding integrable_on_def
  2925   apply (drule bchoice)
  2926   using has_integral_setsum[of t]
  2927   apply auto
  2928   done
  2929 
  2930 lemma has_integral_eq:
  2931   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
  2932     and "(f has_integral k) s"
  2933   shows "(g has_integral k) s"
  2934   using has_integral_sub[OF assms(2), of "\<lambda>x. f x - g x" 0]
  2935   using has_integral_is_0[of s "\<lambda>x. f x - g x"]
  2936   using assms(1)
  2937   by auto
  2938 
  2939 lemma integrable_eq: "(\<And>x. x \<in> s \<Longrightarrow> f x = g x) \<Longrightarrow> f integrable_on s \<Longrightarrow> g integrable_on s"
  2940   unfolding integrable_on_def
  2941   using has_integral_eq[of s f g] has_integral_eq by blast
  2942 
  2943 lemma has_integral_cong:
  2944   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
  2945   shows "(f has_integral i) s = (g has_integral i) s"
  2946   using has_integral_eq[of s f g] has_integral_eq[of s g f] assms
  2947   by auto
  2948 
  2949 lemma integral_cong:
  2950   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
  2951   shows "integral s f = integral s g"
  2952   unfolding integral_def
  2953 by (metis (full_types, hide_lams) assms has_integral_cong integrable_eq)
  2954 
  2955 lemma integrable_on_cmult_left_iff [simp]:
  2956   assumes "c \<noteq> 0"
  2957   shows "(\<lambda>x. of_real c * f x) integrable_on s \<longleftrightarrow> f integrable_on s"
  2958         (is "?lhs = ?rhs")
  2959 proof
  2960   assume ?lhs
  2961   then have "(\<lambda>x. of_real (1 / c) * (of_real c * f x)) integrable_on s"
  2962     using integrable_cmul[of "\<lambda>x. of_real c * f x" s "1 / of_real c"]
  2963     by (simp add: scaleR_conv_of_real)
  2964   then have "(\<lambda>x. (of_real (1 / c) * of_real c * f x)) integrable_on s"
  2965     by (simp add: algebra_simps)
  2966   with \<open>c \<noteq> 0\<close> show ?rhs
  2967     by (metis (no_types, lifting) integrable_eq mult.left_neutral nonzero_divide_eq_eq of_real_1 of_real_mult)
  2968 qed (blast intro: integrable_on_cmult_left)
  2969 
  2970 lemma integrable_on_cmult_right:
  2971   fixes f :: "_ \<Rightarrow> 'b :: {comm_ring,real_algebra_1,real_normed_vector}"
  2972   assumes "f integrable_on s"
  2973   shows "(\<lambda>x. f x * of_real c) integrable_on s"
  2974 using integrable_on_cmult_left [OF assms] by (simp add: mult.commute)
  2975 
  2976 lemma integrable_on_cmult_right_iff [simp]:
  2977   fixes f :: "_ \<Rightarrow> 'b :: {comm_ring,real_algebra_1,real_normed_vector}"
  2978   assumes "c \<noteq> 0"
  2979   shows "(\<lambda>x. f x * of_real c) integrable_on s \<longleftrightarrow> f integrable_on s"
  2980 using integrable_on_cmult_left_iff [OF assms] by (simp add: mult.commute)
  2981 
  2982 lemma integrable_on_cdivide:
  2983   fixes f :: "_ \<Rightarrow> 'b :: real_normed_field"
  2984   assumes "f integrable_on s"
  2985   shows "(\<lambda>x. f x / of_real c) integrable_on s"
  2986 by (simp add: integrable_on_cmult_right divide_inverse assms of_real_inverse [symmetric] del: of_real_inverse)
  2987 
  2988 lemma integrable_on_cdivide_iff [simp]:
  2989   fixes f :: "_ \<Rightarrow> 'b :: real_normed_field"
  2990   assumes "c \<noteq> 0"
  2991   shows "(\<lambda>x. f x / of_real c) integrable_on s \<longleftrightarrow> f integrable_on s"
  2992 by (simp add: divide_inverse assms of_real_inverse [symmetric] del: of_real_inverse)
  2993 
  2994 lemma has_integral_null [intro]:
  2995   assumes "content(cbox a b) = 0"
  2996   shows "(f has_integral 0) (cbox a b)"
  2997 proof -
  2998   have "gauge (\<lambda>x. ball x 1)"
  2999     by auto
  3000   moreover
  3001   {
  3002     fix e :: real
  3003     fix p
  3004     assume e: "e > 0"
  3005     assume p: "p tagged_division_of (cbox a b)"
  3006     have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) = 0"
  3007       unfolding norm_eq_zero diff_0_right
  3008       using setsum_content_null[OF assms(1) p, of f] .
  3009     then have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) < e"
  3010       using e by auto
  3011   }
  3012   ultimately show ?thesis
  3013     by (auto simp: has_integral)
  3014 qed
  3015 
  3016 lemma has_integral_null_real [intro]:
  3017   assumes "content {a .. b::real} = 0"
  3018   shows "(f has_integral 0) {a .. b}"
  3019   by (metis assms box_real(2) has_integral_null)
  3020 
  3021 lemma has_integral_null_eq[simp]: "content (cbox a b) = 0 \<Longrightarrow> (f has_integral i) (cbox a b) \<longleftrightarrow> i = 0"
  3022   by (auto simp add: has_integral_null dest!: integral_unique)
  3023 
  3024 lemma integral_null [simp]: "content (cbox a b) = 0 \<Longrightarrow> integral (cbox a b) f = 0"
  3025   by (metis has_integral_null integral_unique)
  3026 
  3027 lemma integrable_on_null [intro]: "content (cbox a b) = 0 \<Longrightarrow> f integrable_on (cbox a b)"
  3028   by (simp add: has_integral_integrable)
  3029 
  3030 lemma has_integral_empty[intro]: "(f has_integral 0) {}"
  3031   by (simp add: has_integral_is_0)
  3032 
  3033 lemma has_integral_empty_eq[simp]: "(f has_integral i) {} \<longleftrightarrow> i = 0"
  3034   by (auto simp add: has_integral_empty has_integral_unique)
  3035 
  3036 lemma integrable_on_empty[intro]: "f integrable_on {}"
  3037   unfolding integrable_on_def by auto
  3038 
  3039 lemma integral_empty[simp]: "integral {} f = 0"
  3040   by (rule integral_unique) (rule has_integral_empty)
  3041 
  3042 lemma has_integral_refl[intro]:
  3043   fixes a :: "'a::euclidean_space"
  3044   shows "(f has_integral 0) (cbox a a)"
  3045     and "(f has_integral 0) {a}"
  3046 proof -
  3047   have *: "{a} = cbox a a"
  3048     apply (rule set_eqI)
  3049     unfolding mem_box singleton_iff euclidean_eq_iff[where 'a='a]
  3050     apply safe
  3051     prefer 3
  3052     apply (erule_tac x=b in ballE)
  3053     apply (auto simp add: field_simps)
  3054     done
  3055   show "(f has_integral 0) (cbox a a)" "(f has_integral 0) {a}"
  3056     unfolding *
  3057     apply (rule_tac[!] has_integral_null)
  3058     unfolding content_eq_0_interior
  3059     unfolding interior_cbox
  3060     using box_sing
  3061     apply auto
  3062     done
  3063 qed
  3064 
  3065 lemma integrable_on_refl[intro]: "f integrable_on cbox a a"
  3066   unfolding integrable_on_def by auto
  3067 
  3068 lemma integral_refl [simp]: "integral (cbox a a) f = 0"
  3069   by (rule integral_unique) auto
  3070 
  3071 lemma integral_singleton [simp]: "integral {a} f = 0"
  3072   by auto
  3073 
  3074 lemma integral_blinfun_apply:
  3075   assumes "f integrable_on s"
  3076   shows "integral s (\<lambda>x. blinfun_apply h (f x)) = blinfun_apply h (integral s f)"
  3077   by (subst integral_linear[symmetric, OF assms blinfun.bounded_linear_right]) (simp add: o_def)
  3078 
  3079 lemma blinfun_apply_integral:
  3080   assumes "f integrable_on s"
  3081   shows "blinfun_apply (integral s f) x = integral s (\<lambda>y. blinfun_apply (f y) x)"
  3082   by (metis (no_types, lifting) assms blinfun.prod_left.rep_eq integral_blinfun_apply integral_cong)
  3083 
  3084 lemma has_integral_componentwise_iff:
  3085   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3086   shows "(f has_integral y) A \<longleftrightarrow> (\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
  3087 proof safe
  3088   fix b :: 'b assume "(f has_integral y) A"
  3089   from has_integral_linear[OF this(1) bounded_linear_inner_left, of b]
  3090     show "((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A" by (simp add: o_def)
  3091 next
  3092   assume "(\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
  3093   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"
  3094     by (intro ballI has_integral_linear) (simp_all add: bounded_linear_scaleR_left)
  3095   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"
  3096     by (intro has_integral_setsum) (simp_all add: o_def)
  3097   thus "(f has_integral y) A" by (simp add: euclidean_representation)
  3098 qed
  3099 
  3100 lemma has_integral_componentwise:
  3101   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3102   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"
  3103   by (subst has_integral_componentwise_iff) blast
  3104 
  3105 lemma integrable_componentwise_iff:
  3106   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3107   shows "f integrable_on A \<longleftrightarrow> (\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)"
  3108 proof
  3109   assume "f integrable_on A"
  3110   then obtain y where "(f has_integral y) A" by (auto simp: integrable_on_def)
  3111   hence "(\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
  3112     by (subst (asm) has_integral_componentwise_iff)
  3113   thus "(\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)" by (auto simp: integrable_on_def)
  3114 next
  3115   assume "(\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)"
  3116   then obtain y where "\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral y b) A"
  3117     unfolding integrable_on_def by (subst (asm) bchoice_iff) blast
  3118   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"
  3119     by (intro ballI has_integral_linear) (simp_all add: bounded_linear_scaleR_left)
  3120   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"
  3121     by (intro has_integral_setsum) (simp_all add: o_def)
  3122   thus "f integrable_on A" by (auto simp: integrable_on_def o_def euclidean_representation)
  3123 qed
  3124 
  3125 lemma integrable_componentwise:
  3126   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3127   shows "(\<And>b. b \<in> Basis \<Longrightarrow> (\<lambda>x. f x \<bullet> b) integrable_on A) \<Longrightarrow> f integrable_on A"
  3128   by (subst integrable_componentwise_iff) blast
  3129 
  3130 lemma integral_componentwise:
  3131   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  3132   assumes "f integrable_on A"
  3133   shows "integral A f = (\<Sum>b\<in>Basis. integral A (\<lambda>x. (f x \<bullet> b) *\<^sub>R b))"
  3134 proof -
  3135   from assms have integrable: "\<forall>b\<in>Basis. (\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. (f x \<bullet> b)) integrable_on A"
  3136     by (subst (asm) integrable_componentwise_iff, intro integrable_linear ballI)
  3137        (simp_all add: bounded_linear_scaleR_left)
  3138   have "integral A f = integral A (\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b)"
  3139     by (simp add: euclidean_representation)
  3140   also from integrable have "\<dots> = (\<Sum>a\<in>Basis. integral A (\<lambda>x. (f x \<bullet> a) *\<^sub>R a))"
  3141     by (subst integral_setsum) (simp_all add: o_def)
  3142   finally show ?thesis .
  3143 qed
  3144 
  3145 lemma integrable_component:
  3146   "f integrable_on A \<Longrightarrow> (\<lambda>x. f x \<bullet> (y :: 'b :: euclidean_space)) integrable_on A"
  3147   by (drule integrable_linear[OF _ bounded_linear_inner_left[of y]]) (simp add: o_def)
  3148 
  3149 
  3150 
  3151 subsection \<open>Cauchy-type criterion for integrability.\<close>
  3152 
  3153 (* XXXXXXX *)
  3154 lemma integrable_cauchy:
  3155   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::{real_normed_vector,complete_space}"
  3156   shows "f integrable_on cbox a b \<longleftrightarrow>
  3157     (\<forall>e>0.\<exists>d. gauge d \<and>
  3158       (\<forall>p1 p2. p1 tagged_division_of (cbox a b) \<and> d fine p1 \<and>
  3159         p2 tagged_division_of (cbox a b) \<and> d fine p2 \<longrightarrow>
  3160         norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p1 -
  3161         setsum (\<lambda>(x,k). content k *\<^sub>R f x) p2) < e))"
  3162   (is "?l = (\<forall>e>0. \<exists>d. ?P e d)")
  3163 proof
  3164   assume ?l
  3165   then guess y unfolding integrable_on_def has_integral .. note y=this
  3166   show "\<forall>e>0. \<exists>d. ?P e d"
  3167   proof (clarify, goal_cases)
  3168     case (1 e)
  3169     then have "e/2 > 0" by auto
  3170     then guess d
  3171       apply -
  3172       apply (drule y[rule_format])
  3173       apply (elim exE conjE)
  3174       done
  3175     note d=this[rule_format]
  3176     show ?case
  3177     proof (rule_tac x=d in exI, clarsimp simp: d)
  3178       fix p1 p2
  3179       assume as: "p1 tagged_division_of (cbox a b)" "d fine p1"
  3180                  "p2 tagged_division_of (cbox a b)" "d fine p2"
  3181       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"
  3182         apply (rule dist_triangle_half_l[where y=y,unfolded dist_norm])
  3183         using d(2)[OF conjI[OF as(1-2)]] d(2)[OF conjI[OF as(3-4)]] .
  3184     qed
  3185   qed
  3186 next
  3187   assume "\<forall>e>0. \<exists>d. ?P e d"
  3188   then have "\<forall>n::nat. \<exists>d. ?P (inverse(of_nat (n + 1))) d"
  3189     by auto
  3190   from choice[OF this] guess d .. note d=conjunctD2[OF this[rule_format],rule_format]
  3191   have "\<And>n. gauge (\<lambda>x. \<Inter>{d i x |i. i \<in> {0..n}})"
  3192     apply (rule gauge_inters)
  3193     using d(1)
  3194     apply auto
  3195     done
  3196   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"
  3197     by (meson fine_division_exists)
  3198   from choice[OF this] guess p .. note p = conjunctD2[OF this[rule_format]]
  3199   have dp: "\<And>i n. i\<le>n \<Longrightarrow> d i fine p n"
  3200     using p(2) unfolding fine_inters by auto
  3201   have "Cauchy (\<lambda>n. setsum (\<lambda>(x,k). content k *\<^sub>R (f x)) (p n))"
  3202   proof (rule CauchyI, goal_cases)
  3203     case (1 e)
  3204     then guess N unfolding real_arch_inverse[of e] .. note N=this
  3205     show ?case
  3206       apply (rule_tac x=N in exI)
  3207     proof clarify
  3208       fix m n
  3209       assume mn: "N \<le> m" "N \<le> n"
  3210       have *: "N = (N - 1) + 1" using N by auto
  3211       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"
  3212         apply (rule less_trans[OF _ N[THEN conjunct2,THEN conjunct2]])
  3213         apply(subst *)
  3214         using dp p(1) mn d(2) by auto
  3215     qed
  3216   qed
  3217   then guess y unfolding convergent_eq_cauchy[symmetric] .. note y=this[THEN LIMSEQ_D]
  3218   show ?l
  3219     unfolding integrable_on_def has_integral
  3220   proof (rule_tac x=y in exI, clarify)
  3221     fix e :: real
  3222     assume "e>0"
  3223     then have *:"e/2 > 0" by auto
  3224     then guess N1 unfolding real_arch_inverse[of "e/2"] .. note N1=this
  3225     then have N1': "N1 = N1 - 1 + 1"
  3226       by auto
  3227     guess N2 using y[OF *] .. note N2=this
  3228     have "gauge (d (N1 + N2))"
  3229       using d by auto
  3230     moreover
  3231     {
  3232       fix q
  3233       assume as: "q tagged_division_of (cbox a b)" "d (N1 + N2) fine q"
  3234       have *: "inverse (of_nat (N1 + N2 + 1)) < e / 2"
  3235         apply (rule less_trans)
  3236         using N1
  3237         apply auto
  3238         done
  3239       have "norm ((\<Sum>(x, k)\<in>q. content k *\<^sub>R f x) - y) < e"
  3240         apply (rule norm_triangle_half_r)
  3241         apply (rule less_trans[OF _ *])
  3242         apply (subst N1', rule d(2)[of "p (N1+N2)"])
  3243         using N1' as(1) as(2) dp
  3244         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>)
  3245         using N2 le_add2 by blast
  3246     }
  3247     ultimately show "\<exists>d. gauge d \<and>
  3248       (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  3249         norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - y) < e)"
  3250       by (rule_tac x="d (N1 + N2)" in exI) auto
  3251   qed
  3252 qed
  3253 
  3254 
  3255 subsection \<open>Additivity of integral on abutting intervals.\<close>
  3256 
  3257 lemma tagged_division_split_left_inj:
  3258   fixes x1 :: "'a::euclidean_space"
  3259   assumes d: "d tagged_division_of i"
  3260     and k12: "(x1, k1) \<in> d"
  3261              "(x2, k2) \<in> d"
  3262              "k1 \<noteq> k2"
  3263              "k1 \<inter> {x. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  3264              "k \<in> Basis"
  3265   shows "content (k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  3266 proof -
  3267   have *: "\<And>a b c. (a,b) \<in> c \<Longrightarrow> b \<in> snd ` c"
  3268     by force
  3269   show ?thesis
  3270     using k12
  3271     by (fastforce intro!:  division_split_left_inj[OF division_of_tagged_division[OF d]] *)
  3272 qed
  3273 
  3274 lemma tagged_division_split_right_inj:
  3275   fixes x1 :: "'a::euclidean_space"
  3276   assumes d: "d tagged_division_of i"
  3277     and k12: "(x1, k1) \<in> d"
  3278              "(x2, k2) \<in> d"
  3279              "k1 \<noteq> k2"
  3280              "k1 \<inter> {x. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}"
  3281              "k \<in> Basis"
  3282   shows "content (k1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
  3283 proof -
  3284   have *: "\<And>a b c. (a,b) \<in> c \<Longrightarrow> b \<in> snd ` c"
  3285     by force
  3286   show ?thesis
  3287     using k12
  3288     by (fastforce intro!:  division_split_right_inj[OF division_of_tagged_division[OF d]] *)
  3289 qed
  3290 
  3291 lemma has_integral_split:
  3292   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3293   assumes fi: "(f has_integral i) (cbox a b \<inter> {x. x\<bullet>k \<le> c})"
  3294       and fj: "(f has_integral j) (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  3295       and k: "k \<in> Basis"
  3296   shows "(f has_integral (i + j)) (cbox a b)"
  3297 proof (unfold has_integral, rule, rule, goal_cases)
  3298   case (1 e)
  3299   then have e: "e/2 > 0"
  3300     by auto
  3301     obtain d1
  3302     where d1: "gauge d1"
  3303       and d1norm:
  3304         "\<And>p. \<lbrakk>p tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c};
  3305                d1 fine p\<rbrakk> \<Longrightarrow> norm ((\<Sum>(x, k) \<in> p. content k *\<^sub>R f x) - i) < e / 2"
  3306        apply (rule has_integralD[OF fi[unfolded interval_split[OF k]] e])
  3307        apply (simp add: interval_split[symmetric] k)
  3308        done
  3309     obtain d2
  3310     where d2: "gauge d2"
  3311       and d2norm:
  3312         "\<And>p. \<lbrakk>p tagged_division_of cbox a b \<inter> {x. c \<le> x \<bullet> k};
  3313                d2 fine p\<rbrakk> \<Longrightarrow> norm ((\<Sum>(x, k) \<in> p. content k *\<^sub>R f x) - j) < e / 2"
  3314        apply (rule has_integralD[OF fj[unfolded interval_split[OF k]] e])
  3315        apply (simp add: interval_split[symmetric] k)
  3316        done
  3317   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"
  3318   have "gauge ?d"
  3319     using d1 d2 unfolding gauge_def by auto
  3320   then show ?case
  3321   proof (rule_tac x="?d" in exI, safe)
  3322     fix p
  3323     assume "p tagged_division_of (cbox a b)" "?d fine p"
  3324     note p = this tagged_division_ofD[OF this(1)]
  3325     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"
  3326     proof -
  3327       fix x kk
  3328       assume as: "(x, kk) \<in> p" and kk: "kk \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}"
  3329       show "x\<bullet>k \<le> c"
  3330       proof (rule ccontr)
  3331         assume **: "\<not> ?thesis"
  3332         from this[unfolded not_le]
  3333         have "kk \<subseteq> ball x \<bar>x \<bullet> k - c\<bar>"
  3334           using p(2)[unfolded fine_def, rule_format,OF as] by auto
  3335         with kk obtain y where y: "y \<in> ball x \<bar>x \<bullet> k - c\<bar>" "y\<bullet>k \<le> c"
  3336           by blast
  3337         then have "\<bar>x \<bullet> k - y \<bullet> k\<bar> < \<bar>x \<bullet> k - c\<bar>"
  3338           using Basis_le_norm[OF k, of "x - y"]
  3339           by (auto simp add: dist_norm inner_diff_left intro: le_less_trans)
  3340         with y show False
  3341           using ** by (auto simp add: field_simps)
  3342       qed
  3343     qed
  3344     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"
  3345     proof -
  3346       fix x kk
  3347       assume as: "(x, kk) \<in> p" and kk: "kk \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}"
  3348       show "x\<bullet>k \<ge> c"
  3349       proof (rule ccontr)
  3350         assume **: "\<not> ?thesis"
  3351         from this[unfolded not_le] have "kk \<subseteq> ball x \<bar>x \<bullet> k - c\<bar>"
  3352           using p(2)[unfolded fine_def,rule_format,OF as,unfolded split_conv] by auto
  3353         with kk obtain y where y: "y \<in> ball x \<bar>x \<bullet> k - c\<bar>" "y\<bullet>k \<ge> c"
  3354           by blast
  3355         then have "\<bar>x \<bullet> k - y \<bullet> k\<bar> < \<bar>x \<bullet> k - c\<bar>"
  3356           using Basis_le_norm[OF k, of "x - y"]
  3357           by (auto simp add: dist_norm inner_diff_left intro: le_less_trans)
  3358         with y show False
  3359           using ** by (auto simp add: field_simps)
  3360       qed
  3361     qed
  3362 
  3363     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>
  3364                          (\<forall>x k. P x k \<longrightarrow> Q x (f k))"
  3365       by auto
  3366     have fin_finite: "finite {(x,f k) | x k. (x,k) \<in> s \<and> P x k}" if "finite s" for f s P
  3367     proof -
  3368       from that have "finite ((\<lambda>(x, k). (x, f k)) ` s)"
  3369         by auto
  3370       then show ?thesis
  3371         by (rule rev_finite_subset) auto
  3372     qed
  3373     { fix g :: "'a set \<Rightarrow> 'a set"
  3374       fix i :: "'a \<times> 'a set"
  3375       assume "i \<in> (\<lambda>(x, k). (x, g k)) ` p - {(x, g k) |x k. (x, k) \<in> p \<and> g k \<noteq> {}}"
  3376       then obtain x k where xk:
  3377               "i = (x, g k)"  "(x, k) \<in> p"
  3378               "(x, g k) \<notin> {(x, g k) |x k. (x, k) \<in> p \<and> g k \<noteq> {}}"
  3379           by auto
  3380       have "content (g k) = 0"
  3381         using xk using content_empty by auto
  3382       then have "(\<lambda>(x, k). content k *\<^sub>R f x) i = 0"
  3383         unfolding xk split_conv by auto
  3384     } note [simp] = this
  3385     have lem3: "\<And>g :: 'a set \<Rightarrow> 'a set. finite p \<Longrightarrow>
  3386                   setsum (\<lambda>(x, k). content k *\<^sub>R f x) {(x,g k) |x k. (x,k) \<in> p \<and> g k \<noteq> {}} =
  3387                   setsum (\<lambda>(x, k). content k *\<^sub>R f x) ((\<lambda>(x, k). (x, g k)) ` p)"
  3388       by (rule setsum.mono_neutral_left) auto
  3389     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> {}}"
  3390     have d1_fine: "d1 fine ?M1"
  3391       by (force intro: fineI dest: fineD[OF p(2)] simp add: split: if_split_asm)
  3392     have "norm ((\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) - i) < e/2"
  3393     proof (rule d1norm [OF tagged_division_ofI d1_fine])
  3394       show "finite ?M1"
  3395         by (rule fin_finite p(3))+
  3396       show "\<Union>{k. \<exists>x. (x, k) \<in> ?M1} = cbox a b \<inter> {x. x\<bullet>k \<le> c}"
  3397         unfolding p(8)[symmetric] by auto
  3398       fix x l
  3399       assume xl: "(x, l) \<in> ?M1"
  3400       then guess x' l' unfolding mem_Collect_eq unfolding prod.inject by (elim exE conjE) note xl'=this
  3401       show "x \<in> l" "l \<subseteq> cbox a b \<inter> {x. x \<bullet> k \<le> c}"
  3402         unfolding xl'
  3403         using p(4-6)[OF xl'(3)] using xl'(4)
  3404         using xk_le_c[OF xl'(3-4)] by auto
  3405       show "\<exists>a b. l = cbox a b"
  3406         unfolding xl'
  3407         using p(6)[OF xl'(3)]
  3408         by (fastforce simp add: interval_split[OF k,where c=c])
  3409       fix y r
  3410       let ?goal = "interior l \<inter> interior r = {}"
  3411       assume yr: "(y, r) \<in> ?M1"
  3412       then guess y' r' unfolding mem_Collect_eq unfolding prod.inject by (elim exE conjE) note yr'=this
  3413       assume as: "(x, l) \<noteq> (y, r)"
  3414       show "interior l \<inter> interior r = {}"
  3415       proof (cases "l' = r' \<longrightarrow> x' = y'")
  3416         case False
  3417         then show ?thesis
  3418           using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto
  3419       next
  3420         case True
  3421         then have "l' \<noteq> r'"
  3422           using as unfolding xl' yr' by auto
  3423         then show ?thesis
  3424           using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto
  3425       qed
  3426     qed
  3427     moreover
  3428     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> {}}"
  3429     have d2_fine: "d2 fine ?M2"
  3430       by (force intro: fineI dest: fineD[OF p(2)] simp add: split: if_split_asm)
  3431     have "norm ((\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - j) < e/2"
  3432     proof (rule d2norm [OF tagged_division_ofI d2_fine])
  3433       show "finite ?M2"
  3434         by (rule fin_finite p(3))+
  3435       show "\<Union>{k. \<exists>x. (x, k) \<in> ?M2} = cbox a b \<inter> {x. x\<bullet>k \<ge> c}"
  3436         unfolding p(8)[symmetric] by auto
  3437       fix x l
  3438       assume xl: "(x, l) \<in> ?M2"
  3439       then guess x' l' unfolding mem_Collect_eq unfolding prod.inject by (elim exE conjE) note xl'=this
  3440       show "x \<in> l" "l \<subseteq> cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
  3441         unfolding xl'
  3442         using p(4-6)[OF xl'(3)] xl'(4) xk_ge_c[OF xl'(3-4)]
  3443         by auto
  3444       show "\<exists>a b. l = cbox a b"
  3445         unfolding xl'
  3446         using p(6)[OF xl'(3)]
  3447         by (fastforce simp add: interval_split[OF k, where c=c])
  3448       fix y r
  3449       let ?goal = "interior l \<inter> interior r = {}"
  3450       assume yr: "(y, r) \<in> ?M2"
  3451       then guess y' r' unfolding mem_Collect_eq unfolding prod.inject by (elim exE conjE) note yr'=this
  3452       assume as: "(x, l) \<noteq> (y, r)"
  3453       show "interior l \<inter> interior r = {}"
  3454       proof (cases "l' = r' \<longrightarrow> x' = y'")
  3455         case False
  3456         then show ?thesis
  3457           using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto
  3458       next
  3459         case True
  3460         then have "l' \<noteq> r'"
  3461           using as unfolding xl' yr' by auto
  3462         then show ?thesis
  3463           using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto
  3464       qed
  3465     qed
  3466     ultimately
  3467     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"
  3468       using norm_add_less by blast
  3469     also {
  3470       have eq0: "\<And>x y. x = (0::real) \<Longrightarrow> x *\<^sub>R (y::'b) = 0"
  3471         using scaleR_zero_left by auto
  3472       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)"
  3473         by auto
  3474       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) =
  3475         (\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - (i + j)"
  3476         by auto
  3477       also have "\<dots> = (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) +
  3478         (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) - (i + j)"
  3479         unfolding lem3[OF p(3)]
  3480         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)]
  3481               simp: cont_eq)+
  3482       also note setsum.distrib[symmetric]
  3483       also have "\<And>x. x \<in> p \<Longrightarrow>
  3484                     (\<lambda>(x,ka). content (ka \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) x +
  3485                     (\<lambda>(x,ka). content (ka \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) x =
  3486                     (\<lambda>(x,ka). content ka *\<^sub>R f x) x"
  3487       proof clarify
  3488         fix a b
  3489         assume "(a, b) \<in> p"
  3490         from p(6)[OF this] guess u v by (elim exE) note uv=this
  3491         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 =
  3492           content b *\<^sub>R f a"
  3493           unfolding scaleR_left_distrib[symmetric]
  3494           unfolding uv content_split[OF k,of u v c]
  3495           by auto
  3496       qed
  3497       note setsum.cong [OF _ this]
  3498       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 +
  3499         ((\<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) =
  3500         (\<Sum>(x, ka)\<in>p. content ka *\<^sub>R f x) - (i + j)"
  3501         by auto
  3502     }
  3503     finally show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - (i + j)) < e"
  3504       by auto
  3505   qed
  3506 qed
  3507 
  3508 
  3509 subsection \<open>A sort of converse, integrability on subintervals.\<close>
  3510 
  3511 lemma tagged_division_union_interval:
  3512   fixes a :: "'a::euclidean_space"
  3513   assumes "p1 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<le> (c::real)})"
  3514     and "p2 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
  3515     and k: "k \<in> Basis"
  3516   shows "(p1 \<union> p2) tagged_division_of (cbox a b)"
  3517 proof -
  3518   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})"
  3519     by auto
  3520   show ?thesis
  3521     apply (subst *)
  3522     apply (rule tagged_division_union[OF assms(1-2)])
  3523     unfolding interval_split[OF k] interior_cbox
  3524     using k
  3525     apply (auto simp add: box_def elim!: ballE[where x=k])
  3526     done
  3527 qed
  3528 
  3529 lemma tagged_division_union_interval_real:
  3530   fixes a :: real
  3531   assumes "p1 tagged_division_of ({a .. b} \<inter> {x. x\<bullet>k \<le> (c::real)})"
  3532     and "p2 tagged_division_of ({a .. b} \<inter> {x. x\<bullet>k \<ge> c})"
  3533     and k: "k \<in> Basis"
  3534   shows "(p1 \<union> p2) tagged_division_of {a .. b}"
  3535   using assms
  3536   unfolding box_real[symmetric]
  3537   by (rule tagged_division_union_interval)
  3538 
  3539 lemma has_integral_separate_sides:
  3540   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3541   assumes "(f has_integral i) (cbox a b)"
  3542     and "e > 0"
  3543     and k: "k \<in> Basis"
  3544   obtains d where "gauge d"
  3545     "\<forall>p1 p2. p1 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<and> d fine p1 \<and>
  3546         p2 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) \<and> d fine p2 \<longrightarrow>
  3547         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"
  3548 proof -
  3549   guess d using has_integralD[OF assms(1-2)] . note d=this
  3550   { fix p1 p2
  3551     assume "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p1"
  3552     note p1=tagged_division_ofD[OF this(1)] this
  3553     assume "p2 tagged_division_of (cbox a b) \<inter> {x. c \<le> x \<bullet> k}" "d fine p2"
  3554     note p2=tagged_division_ofD[OF this(1)] this
  3555     note tagged_division_union_interval[OF p1(7) p2(7)] note p12 = tagged_division_ofD[OF this] this
  3556     { fix a b
  3557       assume ab: "(a, b) \<in> p1 \<inter> p2"
  3558       have "(a, b) \<in> p1"
  3559         using ab by auto
  3560       with p1 obtain u v where uv: "b = cbox u v" by auto
  3561       have "b \<subseteq> {x. x\<bullet>k = c}"
  3562         using ab p1(3)[of a b] p2(3)[of a b] by fastforce
  3563       moreover
  3564       have "interior {x::'a. x \<bullet> k = c} = {}"
  3565       proof (rule ccontr)
  3566         assume "\<not> ?thesis"
  3567         then obtain x where x: "x \<in> interior {x::'a. x\<bullet>k = c}"
  3568           by auto
  3569         then guess e unfolding mem_interior .. note e=this
  3570         have x: "x\<bullet>k = c"
  3571           using x interior_subset by fastforce
  3572         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)"
  3573           using e k by (auto simp: inner_simps inner_not_same_Basis)
  3574         have "(\<Sum>i\<in>Basis. \<bar>(x - (x + (e / 2 ) *\<^sub>R k)) \<bullet> i\<bar>) =
  3575               (\<Sum>i\<in>Basis. (if i = k then e / 2 else 0))"
  3576           using "*" by (blast intro: setsum.cong)
  3577         also have "\<dots> < e"
  3578           apply (subst setsum.delta)
  3579           using e
  3580           apply auto
  3581           done
  3582         finally have "x + (e/2) *\<^sub>R k \<in> ball x e"
  3583           unfolding mem_ball dist_norm by(rule le_less_trans[OF norm_le_l1])
  3584         then have "x + (e/2) *\<^sub>R k \<in> {x. x\<bullet>k = c}"
  3585           using e by auto
  3586         then show False
  3587           unfolding mem_Collect_eq using e x k by (auto simp: inner_simps)
  3588       qed
  3589       ultimately have "content b = 0"
  3590         unfolding uv content_eq_0_interior
  3591         using interior_mono by blast
  3592       then have "content b *\<^sub>R f a = 0"
  3593         by auto
  3594     }
  3595     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) =
  3596                norm ((\<Sum>(x, k)\<in>p1 \<union> p2. content k *\<^sub>R f x) - i)"
  3597       by (subst setsum.union_inter_neutral) (auto simp: p1 p2)
  3598     also have "\<dots> < e"
  3599       by (rule k d(2) p12 fine_union p1 p2)+
  3600     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" .
  3601    }
  3602   then show ?thesis
  3603     by (auto intro: that[of d] d elim: )
  3604 qed
  3605 
  3606 lemma integrable_split[intro]:
  3607   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
  3608   assumes "f integrable_on cbox a b"
  3609     and k: "k \<in> Basis"
  3610   shows "f integrable_on (cbox a b \<inter> {x. x\<bullet>k \<le> c})" (is ?t1)
  3611     and "f integrable_on (cbox a b \<inter> {x. x\<bullet>k \<ge> c})" (is ?t2)
  3612 proof -
  3613   guess y using assms(1) unfolding integrable_on_def .. note y=this
  3614   define b' where "b' = (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) c else b\<bullet>i)*\<^sub>R i)"
  3615   define a' where "a' = (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) c else a\<bullet>i)*\<^sub>R i)"
  3616   show ?t1 ?t2
  3617     unfolding interval_split[OF k] integrable_cauchy
  3618     unfolding interval_split[symmetric,OF k]
  3619   proof (rule_tac[!] allI impI)+
  3620     fix e :: real
  3621     assume "e > 0"
  3622     then have "e/2>0"
  3623       by auto
  3624     from has_integral_separate_sides[OF y this k,of c] guess d . note d=this[rule_format]
  3625     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>
  3626       p2 tagged_division_of (cbox a b) \<inter> A \<and> d fine p2 \<longrightarrow>
  3627       norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e)"
  3628     show "?P {x. x \<bullet> k \<le> c}"
  3629     proof (rule_tac x=d in exI, clarsimp simp add: d)
  3630       fix p1 p2
  3631       assume as: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p1"
  3632                  "p2 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p2"
  3633       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"
  3634       proof (rule fine_division_exists[OF d(1), of a' b] )
  3635         fix p
  3636         assume "p tagged_division_of cbox a' b" "d fine p"
  3637         then show ?thesis
  3638           using as norm_triangle_half_l[OF d(2)[of p1 p] d(2)[of p2 p]]
  3639           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
  3640           by (auto simp add: algebra_simps)
  3641       qed
  3642     qed
  3643     show "?P {x. x \<bullet> k \<ge> c}"
  3644     proof (rule_tac x=d in exI, clarsimp simp add: d)
  3645       fix p1 p2
  3646       assume as: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<ge> c}" "d fine p1"
  3647                  "p2 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<ge> c}" "d fine p2"
  3648       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"
  3649       proof (rule fine_division_exists[OF d(1), of a b'] )
  3650         fix p
  3651         assume "p tagged_division_of cbox a b'" "d fine p"
  3652         then show ?thesis
  3653           using as norm_triangle_half_l[OF d(2)[of p p1] d(2)[of p p2]]
  3654           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
  3655           by (auto simp add: algebra_simps)
  3656       qed
  3657     qed
  3658   qed
  3659 qed
  3660 
  3661 lemma operative_integral:
  3662   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
  3663   shows "comm_monoid.operative (lift_option op +) (Some 0)
  3664     (\<lambda>i. if f integrable_on i then Some (integral i f) else None)"
  3665 proof -
  3666   interpret comm_monoid "lift_option plus" "Some (0::'b)"
  3667     by (rule comm_monoid_lift_option)
  3668       (rule add.comm_monoid_axioms)
  3669   show ?thesis
  3670   proof (unfold operative_def, safe)
  3671     fix a b c
  3672     fix k :: 'a
  3673     assume k: "k \<in> Basis"
  3674     show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) =
  3675           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)
  3676           (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)"
  3677     proof (cases "f integrable_on cbox a b")
  3678       case True
  3679       with k show ?thesis
  3680         apply (simp add: integrable_split)
  3681         apply (rule integral_unique [OF has_integral_split[OF _ _ k]])
  3682         apply (auto intro: integrable_integral)
  3683         done
  3684     next
  3685     case False
  3686       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})"
  3687       proof (rule ccontr)
  3688         assume "\<not> ?thesis"
  3689         then have "f integrable_on cbox a b"
  3690           unfolding integrable_on_def
  3691           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)
  3692           apply (rule has_integral_split[OF _ _ k])
  3693           apply (auto intro: integrable_integral)
  3694           done
  3695         then show False
  3696           using False by auto
  3697       qed
  3698       then show ?thesis
  3699         using False by auto
  3700     qed
  3701   next
  3702     fix a b :: 'a
  3703     assume "content (cbox a b) = 0"
  3704     then show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) = Some 0"
  3705       using has_integral_null_eq
  3706       by (auto simp: integrable_on_null)
  3707   qed
  3708 qed
  3709 
  3710 subsection \<open>Finally, the integral of a constant\<close>
  3711 
  3712 lemma has_integral_const [intro]:
  3713   fixes a b :: "'a::euclidean_space"
  3714   shows "((\<lambda>x. c) has_integral (content (cbox a b) *\<^sub>R c)) (cbox a b)"
  3715   apply (auto intro!: exI [where x="\<lambda>x. ball x 1"] simp: split_def has_integral)
  3716   apply (subst scaleR_left.setsum[symmetric, unfolded o_def])
  3717   apply (subst additive_content_tagged_division[unfolded split_def])
  3718   apply auto
  3719   done
  3720 
  3721 lemma has_integral_const_real [intro]:
  3722   fixes a b :: real
  3723   shows "((\<lambda>x. c) has_integral (content {a .. b} *\<^sub>R c)) {a .. b}"
  3724   by (metis box_real(2) has_integral_const)
  3725 
  3726 lemma integral_const [simp]:
  3727   fixes a b :: "'a::euclidean_space"
  3728   shows "integral (cbox a b) (\<lambda>x. c) = content (cbox a b) *\<^sub>R c"
  3729   by (rule integral_unique) (rule has_integral_const)
  3730 
  3731 lemma integral_const_real [simp]:
  3732   fixes a b :: real
  3733   shows "integral {a .. b} (\<lambda>x. c) = content {a .. b} *\<^sub>R c"
  3734   by (metis box_real(2) integral_const)
  3735 
  3736 
  3737 subsection \<open>Bounds on the norm of Riemann sums and the integral itself.\<close>
  3738 
  3739 lemma dsum_bound:
  3740   assumes "p division_of (cbox a b)"
  3741     and "norm c \<le> e"
  3742   shows "norm (setsum (\<lambda>l. content l *\<^sub>R c) p) \<le> e * content(cbox a b)"
  3743 proof -
  3744   have sumeq: "(\<Sum>i\<in>p. \<bar>content i\<bar>) = setsum content p"
  3745     apply (rule setsum.cong)
  3746     using assms
  3747     apply simp
  3748     apply (metis abs_of_nonneg assms(1) content_pos_le division_ofD(4))
  3749     done
  3750   have e: "0 \<le> e"
  3751     using assms(2) norm_ge_zero order_trans by blast
  3752   have "norm (setsum (\<lambda>l. content l *\<^sub>R c) p) \<le> (\<Sum>i\<in>p. norm (content i *\<^sub>R c))"
  3753     using norm_setsum by blast
  3754   also have "...  \<le> e * (\<Sum>i\<in>p. \<bar>content i\<bar>)"
  3755     by (simp add: setsum_distrib_left[symmetric] mult.commute assms(2) mult_right_mono setsum_nonneg)
  3756   also have "... \<le> e * content (cbox a b)"
  3757     apply (rule mult_left_mono [OF _ e])
  3758     apply (simp add: sumeq)
  3759     using additive_content_division assms(1) eq_iff apply blast
  3760     done
  3761   finally show ?thesis .
  3762 qed
  3763 
  3764 lemma rsum_bound:
  3765   assumes p: "p tagged_division_of (cbox a b)"
  3766       and "\<forall>x\<in>cbox a b. norm (f x) \<le> e"
  3767     shows "norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> e * content (cbox a b)"
  3768 proof (cases "cbox a b = {}")
  3769   case True show ?thesis
  3770     using p unfolding True tagged_division_of_trivial by auto
  3771 next
  3772   case False
  3773   then have e: "e \<ge> 0"
  3774     by (meson ex_in_conv assms(2) norm_ge_zero order_trans)
  3775   have setsum_le: "setsum (content \<circ> snd) p \<le> content (cbox a b)"
  3776     unfolding additive_content_tagged_division[OF p, symmetric] split_def
  3777     by (auto intro: eq_refl)
  3778   have con: "\<And>xk. xk \<in> p \<Longrightarrow> 0 \<le> content (snd xk)"
  3779     using tagged_division_ofD(4) [OF p] content_pos_le
  3780     by force
  3781   have norm: "\<And>xk. xk \<in> p \<Longrightarrow> norm (f (fst xk)) \<le> e"
  3782     unfolding fst_conv using tagged_division_ofD(2,3)[OF p] assms
  3783     by (metis prod.collapse subset_eq)
  3784   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))"
  3785     by (rule norm_setsum)
  3786   also have "...  \<le> e * content (cbox a b)"
  3787     unfolding split_def norm_scaleR
  3788     apply (rule order_trans[OF setsum_mono])
  3789     apply (rule mult_left_mono[OF _ abs_ge_zero, of _ e])
  3790     apply (metis norm)
  3791     unfolding setsum_distrib_right[symmetric]
  3792     using con setsum_le
  3793     apply (auto simp: mult.commute intro: mult_left_mono [OF _ e])
  3794     done
  3795   finally show ?thesis .
  3796 qed
  3797 
  3798 lemma rsum_diff_bound:
  3799   assumes "p tagged_division_of (cbox a b)"
  3800     and "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e"
  3801   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>
  3802          e * content (cbox a b)"
  3803   apply (rule order_trans[OF _ rsum_bound[OF assms]])
  3804   apply (simp add: split_def scaleR_diff_right setsum_subtractf eq_refl)
  3805   done
  3806 
  3807 lemma has_integral_bound:
  3808   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3809   assumes "0 \<le> B"
  3810       and "(f has_integral i) (cbox a b)"
  3811       and "\<forall>x\<in>cbox a b. norm (f x) \<le> B"
  3812     shows "norm i \<le> B * content (cbox a b)"
  3813 proof (rule ccontr)
  3814   assume "\<not> ?thesis"
  3815   then have *: "norm i - B * content (cbox a b) > 0"
  3816     by auto
  3817   from assms(2)[unfolded has_integral,rule_format,OF *]
  3818   guess d by (elim exE conjE) note d=this[rule_format]
  3819   from fine_division_exists[OF this(1), of a b] guess p . note p=this
  3820   have *: "\<And>s B. norm s \<le> B \<Longrightarrow> \<not> norm (s - i) < norm i - B"
  3821     unfolding not_less
  3822     by (metis norm_triangle_sub[of i] add.commute le_less_trans less_diff_eq linorder_not_le norm_minus_commute)
  3823   show False
  3824     using d(2)[OF conjI[OF p]] *[OF rsum_bound[OF p(1) assms(3)]] by auto
  3825 qed
  3826 
  3827 corollary has_integral_bound_real:
  3828   fixes f :: "real \<Rightarrow> 'b::real_normed_vector"
  3829   assumes "0 \<le> B"
  3830       and "(f has_integral i) {a .. b}"
  3831       and "\<forall>x\<in>{a .. b}. norm (f x) \<le> B"
  3832     shows "norm i \<le> B * content {a .. b}"
  3833   by (metis assms box_real(2) has_integral_bound)
  3834 
  3835 corollary integrable_bound:
  3836   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3837   assumes "0 \<le> B"
  3838       and "f integrable_on (cbox a b)"
  3839       and "\<And>x. x\<in>cbox a b \<Longrightarrow> norm (f x) \<le> B"
  3840     shows "norm (integral (cbox a b) f) \<le> B * content (cbox a b)"
  3841 by (metis integrable_integral has_integral_bound assms)
  3842 
  3843 
  3844 subsection \<open>Similar theorems about relationship among components.\<close>
  3845 
  3846 lemma rsum_component_le:
  3847   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3848   assumes "p tagged_division_of (cbox a b)"
  3849       and "\<forall>x\<in>cbox a b. (f x)\<bullet>i \<le> (g x)\<bullet>i"
  3850     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"
  3851 unfolding inner_setsum_left
  3852 proof (rule setsum_mono, clarify)
  3853   fix a b
  3854   assume ab: "(a, b) \<in> p"
  3855   note tagged = tagged_division_ofD(2-4)[OF assms(1) ab]
  3856   from this(3) guess u v by (elim exE) note b=this
  3857   show "(content b *\<^sub>R f a) \<bullet> i \<le> (content b *\<^sub>R g a) \<bullet> i"
  3858     unfolding b inner_simps real_scaleR_def
  3859     apply (rule mult_left_mono)
  3860     using assms(2) tagged
  3861     by (auto simp add: content_pos_le)
  3862 qed
  3863 
  3864 lemma has_integral_component_le:
  3865   fixes f g :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3866   assumes k: "k \<in> Basis"
  3867   assumes "(f has_integral i) s" "(g has_integral j) s"
  3868     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  3869   shows "i\<bullet>k \<le> j\<bullet>k"
  3870 proof -
  3871   have lem: "i\<bullet>k \<le> j\<bullet>k"
  3872     if f_i: "(f has_integral i) (cbox a b)"
  3873     and g_j: "(g has_integral j) (cbox a b)"
  3874     and le: "\<forall>x\<in>cbox a b. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  3875     for a b i and j :: 'b and f g :: "'a \<Rightarrow> 'b"
  3876   proof (rule ccontr)
  3877     assume "\<not> ?thesis"
  3878     then have *: "0 < (i\<bullet>k - j\<bullet>k) / 3"
  3879       by auto
  3880     guess d1 using f_i[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d1=this[rule_format]
  3881     guess d2 using g_j[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d2=this[rule_format]
  3882     obtain p where p: "p tagged_division_of cbox a b" "d1 fine p" "d2 fine p"
  3883        using fine_division_exists[OF gauge_inter[OF d1(1) d2(1)], of a b] unfolding fine_inter
  3884        by metis
  3885     note le_less_trans[OF Basis_le_norm[OF k]]
  3886     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"
  3887               "\<bar>((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - j) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
  3888       using  k norm_bound_Basis_lt d1 d2 p
  3889       by blast+
  3890     then show False
  3891       unfolding inner_simps
  3892       using rsum_component_le[OF p(1) le]
  3893       by (simp add: abs_real_def split: if_split_asm)
  3894   qed
  3895   show ?thesis
  3896   proof (cases "\<exists>a b. s = cbox a b")
  3897     case True
  3898     with lem assms show ?thesis
  3899       by auto
  3900   next
  3901     case False
  3902     show ?thesis
  3903     proof (rule ccontr)
  3904       assume "\<not> i\<bullet>k \<le> j\<bullet>k"
  3905       then have ij: "(i\<bullet>k - j\<bullet>k) / 3 > 0"
  3906         by auto
  3907       note has_integral_altD[OF _ False this]
  3908       from this[OF assms(2)] this[OF assms(3)] guess B1 B2 . note B=this[rule_format]
  3909       have "bounded (ball 0 B1 \<union> ball (0::'a) B2)"
  3910         unfolding bounded_Un by(rule conjI bounded_ball)+
  3911       from bounded_subset_cbox[OF this] guess a b by (elim exE)
  3912       note ab = conjunctD2[OF this[unfolded Un_subset_iff]]
  3913       guess w1 using B(2)[OF ab(1)] .. note w1=conjunctD2[OF this]
  3914       guess w2 using B(4)[OF ab(2)] .. note w2=conjunctD2[OF this]
  3915       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"
  3916         by (simp add: abs_real_def split: if_split_asm)
  3917       note le_less_trans[OF Basis_le_norm[OF k]]
  3918       note this[OF w1(2)] this[OF w2(2)]
  3919       moreover
  3920       have "w1\<bullet>k \<le> w2\<bullet>k"
  3921         by (rule lem[OF w1(1) w2(1)]) (simp add: assms(4))
  3922       ultimately show False
  3923         unfolding inner_simps by(rule *)
  3924     qed
  3925   qed
  3926 qed
  3927 
  3928 lemma integral_component_le:
  3929   fixes g f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3930   assumes "k \<in> Basis"
  3931     and "f integrable_on s" "g integrable_on s"
  3932     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  3933   shows "(integral s f)\<bullet>k \<le> (integral s g)\<bullet>k"
  3934   apply (rule has_integral_component_le)
  3935   using integrable_integral assms
  3936   apply auto
  3937   done
  3938 
  3939 lemma has_integral_component_nonneg:
  3940   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3941   assumes "k \<in> Basis"
  3942     and "(f has_integral i) s"
  3943     and "\<forall>x\<in>s. 0 \<le> (f x)\<bullet>k"
  3944   shows "0 \<le> i\<bullet>k"
  3945   using has_integral_component_le[OF assms(1) has_integral_0 assms(2)]
  3946   using assms(3-)
  3947   by auto
  3948 
  3949 lemma integral_component_nonneg:
  3950   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3951   assumes "k \<in> Basis"
  3952     and  "\<forall>x\<in>s. 0 \<le> (f x)\<bullet>k"
  3953   shows "0 \<le> (integral s f)\<bullet>k"
  3954 proof (cases "f integrable_on s")
  3955   case True show ?thesis
  3956     apply (rule has_integral_component_nonneg)
  3957     using assms True
  3958     apply auto
  3959     done
  3960 next
  3961   case False then show ?thesis by (simp add: not_integrable_integral)
  3962 qed
  3963 
  3964 lemma has_integral_component_neg:
  3965   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3966   assumes "k \<in> Basis"
  3967     and "(f has_integral i) s"
  3968     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> 0"
  3969   shows "i\<bullet>k \<le> 0"
  3970   using has_integral_component_le[OF assms(1,2) has_integral_0] assms(2-)
  3971   by auto
  3972 
  3973 lemma has_integral_component_lbound:
  3974   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3975   assumes "(f has_integral i) (cbox a b)"
  3976     and "\<forall>x\<in>cbox a b. B \<le> f(x)\<bullet>k"
  3977     and "k \<in> Basis"
  3978   shows "B * content (cbox a b) \<le> i\<bullet>k"
  3979   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-)
  3980   by (auto simp add: field_simps)
  3981 
  3982 lemma has_integral_component_ubound:
  3983   fixes f::"'a::euclidean_space => 'b::euclidean_space"
  3984   assumes "(f has_integral i) (cbox a b)"
  3985     and "\<forall>x\<in>cbox a b. f x\<bullet>k \<le> B"
  3986     and "k \<in> Basis"
  3987   shows "i\<bullet>k \<le> B * content (cbox a b)"
  3988   using has_integral_component_le[OF assms(3,1) has_integral_const, of "\<Sum>i\<in>Basis. B *\<^sub>R i"] assms(2-)
  3989   by (auto simp add: field_simps)
  3990 
  3991 lemma integral_component_lbound:
  3992   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3993   assumes "f integrable_on cbox a b"
  3994     and "\<forall>x\<in>cbox a b. B \<le> f(x)\<bullet>k"
  3995     and "k \<in> Basis"
  3996   shows "B * content (cbox a b) \<le> (integral(cbox a b) f)\<bullet>k"
  3997   apply (rule has_integral_component_lbound)
  3998   using assms
  3999   unfolding has_integral_integral
  4000   apply auto
  4001   done
  4002 
  4003 lemma integral_component_lbound_real:
  4004   assumes "f integrable_on {a ::real .. b}"
  4005     and "\<forall>x\<in>{a .. b}. B \<le> f(x)\<bullet>k"
  4006     and "k \<in> Basis"
  4007   shows "B * content {a .. b} \<le> (integral {a .. b} f)\<bullet>k"
  4008   using assms
  4009   by (metis box_real(2) integral_component_lbound)
  4010 
  4011 lemma integral_component_ubound:
  4012   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4013   assumes "f integrable_on cbox a b"
  4014     and "\<forall>x\<in>cbox a b. f x\<bullet>k \<le> B"
  4015     and "k \<in> Basis"
  4016   shows "(integral (cbox a b) f)\<bullet>k \<le> B * content (cbox a b)"
  4017   apply (rule has_integral_component_ubound)
  4018   using assms
  4019   unfolding has_integral_integral
  4020   apply auto
  4021   done
  4022 
  4023 lemma integral_component_ubound_real:
  4024   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
  4025   assumes "f integrable_on {a .. b}"
  4026     and "\<forall>x\<in>{a .. b}. f x\<bullet>k \<le> B"
  4027     and "k \<in> Basis"
  4028   shows "(integral {a .. b} f)\<bullet>k \<le> B * content {a .. b}"
  4029   using assms
  4030   by (metis box_real(2) integral_component_ubound)
  4031 
  4032 subsection \<open>Uniform limit of integrable functions is integrable.\<close>
  4033 
  4034 lemma real_arch_invD:
  4035   "0 < (e::real) \<Longrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
  4036   by (subst(asm) real_arch_inverse)
  4037 
  4038 lemma integrable_uniform_limit:
  4039   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
  4040   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"
  4041   shows "f integrable_on cbox a b"
  4042 proof (cases "content (cbox a b) > 0")
  4043   case False then show ?thesis
  4044       using has_integral_null
  4045       by (simp add: content_lt_nz integrable_on_def)
  4046 next
  4047   case True
  4048   have *: "\<And>P. \<forall>e>(0::real). P e \<Longrightarrow> \<forall>n::nat. P (inverse (real n + 1))"
  4049     by auto
  4050   from choice[OF *[OF assms]] guess g .. note g=conjunctD2[OF this[rule_format],rule_format]
  4051   from choice[OF allI[OF g(2)[unfolded integrable_on_def], of "\<lambda>x. x"]]
  4052   obtain i where i: "\<And>x. (g x has_integral i x) (cbox a b)"
  4053       by auto
  4054   have "Cauchy i"
  4055     unfolding Cauchy_def
  4056   proof clarify
  4057     fix e :: real
  4058     assume "e>0"
  4059     then have "e / 4 / content (cbox a b) > 0"
  4060       using True by (auto simp add: field_simps)
  4061     then obtain M :: nat
  4062          where M: "M \<noteq> 0" "0 < inverse (real_of_nat M)" "inverse (of_nat M) < e / 4 / content (cbox a b)"
  4063       by (subst (asm) real_arch_inverse) auto
  4064     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (i m) (i n) < e"
  4065     proof (rule exI [where x=M], clarify)
  4066       fix m n
  4067       assume m: "M \<le> m" and n: "M \<le> n"
  4068       have "e/4>0" using \<open>e>0\<close> by auto
  4069       note * = i[unfolded has_integral,rule_format,OF this]
  4070       from *[of m] guess gm by (elim conjE exE) note gm=this[rule_format]
  4071       from *[of n] guess gn by (elim conjE exE) note gn=this[rule_format]
  4072       from fine_division_exists[OF gauge_inter[OF gm(1) gn(1)], of a b]
  4073       obtain p where p: "p tagged_division_of cbox a b" "(\<lambda>x. gm x \<inter> gn x) fine p"
  4074         by auto
  4075       { fix s1 s2 i1 and i2::'b
  4076         assume no: "norm(s2 - s1) \<le> e/2" "norm (s1 - i1) < e/4" "norm (s2 - i2) < e/4"
  4077         have "norm (i1 - i2) \<le> norm (i1 - s1) + norm (s1 - s2) + norm (s2 - i2)"
  4078           using norm_triangle_ineq[of "i1 - s1" "s1 - i2"]
  4079           using norm_triangle_ineq[of "s1 - s2" "s2 - i2"]
  4080           by (auto simp add: algebra_simps)
  4081         also have "\<dots> < e"
  4082           using no
  4083           unfolding norm_minus_commute
  4084           by (auto simp add: algebra_simps)
  4085         finally have "norm (i1 - i2) < e" .
  4086       } note triangle3 = this
  4087       have finep: "gm fine p" "gn fine p"
  4088         using fine_inter p  by auto
  4089       { fix x
  4090         assume x: "x \<in> cbox a b"
  4091         have "norm (f x - g n x) + norm (f x - g m x) \<le> inverse (real n + 1) + inverse (real m + 1)"
  4092           using g(1)[OF x, of n] g(1)[OF x, of m] by auto
  4093         also have "\<dots> \<le> inverse (real M) + inverse (real M)"
  4094           apply (rule add_mono)
  4095           using M(2) m n by auto
  4096         also have "\<dots> = 2 / real M"
  4097           unfolding divide_inverse by auto
  4098         finally have "norm (g n x - g m x) \<le> 2 / real M"
  4099           using norm_triangle_le[of "g n x - f x" "f x - g m x" "2 / real M"]
  4100           by (auto simp add: algebra_simps simp add: norm_minus_commute)
  4101       } note norm_le = this
  4102       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"
  4103         apply (rule order_trans [OF rsum_diff_bound[OF p(1), where e="2 / real M"]])
  4104         apply (blast intro: norm_le)
  4105         using M True
  4106         by (auto simp add: field_simps)
  4107       then show "dist (i m) (i n) < e"
  4108         unfolding dist_norm
  4109         using gm gn p finep
  4110         by (auto intro!: triangle3)
  4111     qed
  4112   qed
  4113   then obtain s where s: "i \<longlonglongrightarrow> s"
  4114     using convergent_eq_cauchy[symmetric] by blast
  4115   show ?thesis
  4116     unfolding integrable_on_def has_integral
  4117   proof (rule_tac x=s in exI, clarify)
  4118     fix e::real
  4119     assume e: "0 < e"
  4120     then have *: "e/3 > 0" by auto
  4121     then obtain N1 where N1: "\<forall>n\<ge>N1. norm (i n - s) < e / 3"
  4122       using LIMSEQ_D [OF s] by metis
  4123     from e True have "e / 3 / content (cbox a b) > 0"
  4124       by (auto simp add: field_simps)
  4125     from real_arch_invD[OF this] guess N2 by (elim exE conjE) note N2=this
  4126     from i[of "N1 + N2",unfolded has_integral,rule_format,OF *] guess g' .. note g'=conjunctD2[OF this,rule_format]
  4127     { fix sf sg i
  4128       assume no: "norm (sf - sg) \<le> e / 3"
  4129                  "norm(i - s) < e / 3"
  4130                  "norm (sg - i) < e / 3"
  4131       have "norm (sf - s) \<le> norm (sf - sg) + norm (sg - i) + norm (i - s)"
  4132         using norm_triangle_ineq[of "sf - sg" "sg - s"]
  4133         using norm_triangle_ineq[of "sg -  i" " i - s"]
  4134         by (auto simp add: algebra_simps)
  4135       also have "\<dots> < e"
  4136         using no
  4137         unfolding norm_minus_commute
  4138         by (auto simp add: algebra_simps)
  4139       finally have "norm (sf - s) < e" .
  4140     } note lem = this
  4141     { fix p
  4142       assume p: "p tagged_division_of (cbox a b) \<and> g' fine p"
  4143       then have norm_less: "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g (N1 + N2) x) - i (N1 + N2)) < e / 3"
  4144         using g' by blast
  4145       have "content (cbox a b) < e / 3 * (of_nat N2)"
  4146         using N2 unfolding inverse_eq_divide using True by (auto simp add: field_simps)
  4147       moreover have "e / 3 * of_nat N2 \<le> e / 3 * (of_nat (N1 + N2) + 1)"
  4148         using \<open>e>0\<close> by auto
  4149       ultimately have "content (cbox a b) < e / 3 * (of_nat (N1 + N2) + 1)"
  4150         by linarith
  4151       then have le_e3: "inverse (real (N1 + N2) + 1) * content (cbox a b) \<le> e / 3"
  4152         unfolding inverse_eq_divide
  4153         by (auto simp add: field_simps)
  4154       have ne3: "norm (i (N1 + N2) - s) < e / 3"
  4155         using N1 by auto
  4156       have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - s) < e"
  4157         apply (rule lem[OF order_trans [OF _ le_e3] ne3 norm_less])
  4158         apply (rule rsum_diff_bound[OF p[THEN conjunct1]])
  4159         apply (blast intro: g)
  4160         done }
  4161     then show "\<exists>d. gauge d \<and>
  4162              (\<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)"
  4163       by (blast intro: g')
  4164   qed
  4165 qed
  4166 
  4167 lemmas integrable_uniform_limit_real = integrable_uniform_limit [where 'a=real, simplified]
  4168 
  4169 
  4170 subsection \<open>Negligible sets.\<close>
  4171 
  4172 definition "negligible (s:: 'a::euclidean_space set) \<longleftrightarrow>
  4173   (\<forall>a b. ((indicator s :: 'a\<Rightarrow>real) has_integral 0) (cbox a b))"
  4174 
  4175 
  4176 subsection \<open>Negligibility of hyperplane.\<close>
  4177 
  4178 lemma interval_doublesplit:
  4179   fixes a :: "'a::euclidean_space"
  4180   assumes "k \<in> Basis"
  4181   shows "cbox a b \<inter> {x . \<bar>x\<bullet>k - c\<bar> \<le> (e::real)} =
  4182     cbox (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) (c - e) else a\<bullet>i) *\<^sub>R i)
  4183      (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) (c + e) else b\<bullet>i) *\<^sub>R i)"
  4184 proof -
  4185   have *: "\<And>x c e::real. \<bar>x - c\<bar> \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
  4186     by auto
  4187   have **: "\<And>s P Q. s \<inter> {x. P x \<and> Q x} = (s \<inter> {x. Q x}) \<inter> {x. P x}"
  4188     by blast
  4189   show ?thesis
  4190     unfolding * ** interval_split[OF assms] by (rule refl)
  4191 qed
  4192 
  4193 lemma division_doublesplit:
  4194   fixes a :: "'a::euclidean_space"
  4195   assumes "p division_of (cbox a b)"
  4196     and k: "k \<in> Basis"
  4197   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> {}}
  4198          division_of  (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> e})"
  4199 proof -
  4200   have *: "\<And>x c. \<bar>x - c\<bar> \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
  4201     by auto
  4202   have **: "\<And>p q p' q'. p division_of q \<Longrightarrow> p = p' \<Longrightarrow> q = q' \<Longrightarrow> p' division_of q'"
  4203     by auto
  4204   note division_split(1)[OF assms, where c="c+e",unfolded interval_split[OF k]]
  4205   note division_split(2)[OF this, where c="c-e" and k=k,OF k]
  4206   then show ?thesis
  4207     apply (rule **)
  4208     subgoal
  4209       apply (simp add: abs_diff_le_iff field_simps Collect_conj_eq setcompr_eq_image[symmetric])
  4210       apply (rule equalityI)
  4211       apply blast
  4212       apply clarsimp
  4213       apply (rule_tac x="l \<inter> {x. c + e \<ge> x \<bullet> k}" in exI)
  4214       apply auto
  4215       done
  4216     by (simp add: interval_split k interval_doublesplit)
  4217 qed
  4218 
  4219 lemma content_doublesplit:
  4220   fixes a :: "'a::euclidean_space"
  4221   assumes "0 < e"
  4222     and k: "k \<in> Basis"
  4223   obtains d where "0 < d" and "content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d}) < e"
  4224 proof cases
  4225   assume *: "a \<bullet> k \<le> c \<and> c \<le> b \<bullet> k \<and> (\<forall>j\<in>Basis. a \<bullet> j \<le> b \<bullet> j)"
  4226   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
  4227   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
  4228 
  4229   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)"
  4230     by (auto simp: b'_def a'_def intro!: tendsto_min tendsto_max tendsto_eq_intros)
  4231   also have "(\<Prod>j\<in>Basis. (b' 0 - a' 0) \<bullet> j) = 0"
  4232     using k *
  4233     by (intro setprod_zero bexI[OF _ k])
  4234        (auto simp: b'_def a'_def inner_diff inner_setsum_left inner_not_same_Basis intro!: setsum.cong)
  4235   also have "((\<lambda>d. \<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) \<longlongrightarrow> 0) (at_right 0) =
  4236     ((\<lambda>d. content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d})) \<longlongrightarrow> 0) (at_right 0)"
  4237   proof (intro tendsto_cong eventually_at_rightI)
  4238     fix d :: real assume d: "d \<in> {0<..<1}"
  4239     have "cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d} = cbox (a' d) (b' d)" for d
  4240       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)
  4241     moreover have "j \<in> Basis \<Longrightarrow> a' d \<bullet> j \<le> b' d \<bullet> j" for j
  4242       using * d k by (auto simp: a'_def b'_def)
  4243     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})"
  4244       by simp
  4245   qed simp
  4246   finally have "((\<lambda>d. content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) \<longlongrightarrow> 0) (at_right 0)" .
  4247   from order_tendstoD(2)[OF this \<open>0<e\<close>]
  4248   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"
  4249     by (subst (asm) eventually_at_right[of _ 1]) auto
  4250   show ?thesis
  4251     by (rule that[of "d'/2"], insert \<open>0<d'\<close> d'[of "d'/2"], auto)
  4252 next
  4253   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))"
  4254   then have "(\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j) \<or> (c < a \<bullet> k \<or> b \<bullet> k < c)"
  4255     by (auto simp: not_le)
  4256   show thesis
  4257   proof cases
  4258     assume "\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j"
  4259     then have [simp]: "cbox a b = {}"
  4260       using box_ne_empty(1)[of a b] by auto
  4261     show ?thesis
  4262       by (rule that[of 1]) (simp_all add: \<open>0<e\<close>)
  4263   next
  4264     assume "\<not> (\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j)"
  4265     with * have "c < a \<bullet> k \<or> b \<bullet> k < c"
  4266       by auto
  4267     then show thesis
  4268     proof
  4269       assume c: "c < a \<bullet> k"
  4270       moreover have "x \<in> cbox a b \<Longrightarrow> c \<le> x \<bullet> k" for x
  4271         using k c by (auto simp: cbox_def)
  4272       ultimately have "cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> (a \<bullet> k - c) / 2} = {}"
  4273         using k by (auto simp: cbox_def)
  4274       with \<open>0<e\<close> c that[of "(a \<bullet> k - c) / 2"] show ?thesis
  4275         by auto
  4276     next
  4277       assume c: "b \<bullet> k < c"
  4278       moreover have "x \<in> cbox a b \<Longrightarrow> x \<bullet> k \<le> c" for x
  4279         using k c by (auto simp: cbox_def)
  4280       ultimately have "cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> (c - b \<bullet> k) / 2} = {}"
  4281         using k by (auto simp: cbox_def)
  4282       with \<open>0<e\<close> c that[of "(c - b \<bullet> k) / 2"] show ?thesis
  4283         by auto
  4284     qed
  4285   qed
  4286 qed
  4287 
  4288 
  4289 lemma negligible_standard_hyperplane[intro]:
  4290   fixes k :: "'a::euclidean_space"
  4291   assumes k: "k \<in> Basis"
  4292   shows "negligible {x. x\<bullet>k = c}"
  4293   unfolding negligible_def has_integral
  4294 proof (clarify, goal_cases)
  4295   case (1 a b e)
  4296   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"
  4297     by (rule content_doublesplit)
  4298   let ?i = "indicator {x::'a. x\<bullet>k = c} :: 'a\<Rightarrow>real"
  4299   show ?case
  4300     apply (rule_tac x="\<lambda>x. ball x d" in exI)
  4301     apply rule
  4302     apply (rule gauge_ball)
  4303     apply (rule d)
  4304   proof (rule, rule)
  4305     fix p
  4306     assume p: "p tagged_division_of (cbox a b) \<and> (\<lambda>x. ball x d) fine p"
  4307     have *: "(\<Sum>(x, ka)\<in>p. content ka *\<^sub>R ?i x) =
  4308       (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d}) *\<^sub>R ?i x)"
  4309       apply (rule setsum.cong)
  4310       apply (rule refl)
  4311       unfolding split_paired_all real_scaleR_def mult_cancel_right split_conv
  4312       apply cases
  4313       apply (rule disjI1)
  4314       apply assumption
  4315       apply (rule disjI2)
  4316     proof -
  4317       fix x l
  4318       assume as: "(x, l) \<in> p" "?i x \<noteq> 0"
  4319       then have xk: "x\<bullet>k = c"
  4320         unfolding indicator_def
  4321         apply -
  4322         apply (rule ccontr)
  4323         apply auto
  4324         done
  4325       show "content l = content (l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})"
  4326         apply (rule arg_cong[where f=content])
  4327         apply (rule set_eqI)
  4328         apply rule
  4329         apply rule
  4330         unfolding mem_Collect_eq
  4331       proof -
  4332         fix y
  4333         assume y: "y \<in> l"
  4334         note p[THEN conjunct2,unfolded fine_def,rule_format,OF as(1),unfolded split_conv]
  4335         note this[unfolded subset_eq mem_ball dist_norm,rule_format,OF y]
  4336         note le_less_trans[OF Basis_le_norm[OF k] this]
  4337         then show "\<bar>y \<bullet> k - c\<bar> \<le> d"
  4338           unfolding inner_simps xk by auto
  4339       qed auto
  4340     qed
  4341     note p'= tagged_division_ofD[OF p[THEN conjunct1]] and p''=division_of_tagged_division[OF p[THEN conjunct1]]
  4342     show "norm ((\<Sum>(x, ka)\<in>p. content ka *\<^sub>R ?i x) - 0) < e"
  4343       unfolding diff_0_right *
  4344       unfolding real_scaleR_def real_norm_def
  4345       apply (subst abs_of_nonneg)
  4346       apply (rule setsum_nonneg)
  4347       apply rule
  4348       unfolding split_paired_all split_conv
  4349       apply (rule mult_nonneg_nonneg)
  4350       apply (drule p'(4))
  4351       apply (erule exE)+
  4352       apply(rule_tac b=b in back_subst)
  4353       prefer 2
  4354       apply (subst(asm) eq_commute)
  4355       apply assumption
  4356       apply (subst interval_doublesplit[OF k])
  4357       apply (rule content_pos_le)
  4358       apply (rule indicator_pos_le)
  4359     proof -
  4360       have "(\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * ?i x) \<le>
  4361         (\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}))"
  4362         apply (rule setsum_mono)
  4363         unfolding split_paired_all split_conv
  4364         apply (rule mult_right_le_one_le)
  4365         apply (drule p'(4))
  4366         apply (auto simp add:interval_doublesplit[OF k])
  4367         done
  4368       also have "\<dots> < e"
  4369       proof (subst setsum.over_tagged_division_lemma[OF p[THEN conjunct1]], goal_cases)
  4370         case prems: (1 u v)
  4371         have "content (cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<le> content (cbox u v)"
  4372           unfolding interval_doublesplit[OF k]
  4373           apply (rule content_subset)
  4374           unfolding interval_doublesplit[symmetric,OF k]
  4375           apply auto
  4376           done
  4377         then show ?case
  4378           unfolding prems interval_doublesplit[OF k]
  4379           by (blast intro: antisym)
  4380       next
  4381         have "(\<Sum>l\<in>snd ` p. content (l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) =
  4382           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> {}})"
  4383         proof (subst (2) setsum.reindex_nontrivial)
  4384           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> {}}"
  4385             "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}"
  4386           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> {}"
  4387             by (auto)
  4388           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) = {}"
  4389             by auto
  4390           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)"
  4391             by (auto intro: interior_mono)
  4392           ultimately have "interior (x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = {}"
  4393             by (auto simp: eq)
  4394           then show "content (x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = 0"
  4395             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)
  4396         qed (insert p'(1), auto intro!: setsum.mono_neutral_right)
  4397         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)"
  4398           by simp
  4399         also have "\<dots> \<le> 1 * content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})"
  4400           using division_doublesplit[OF p'' k, unfolded interval_doublesplit[OF k]]
  4401           unfolding interval_doublesplit[OF k] by (intro dsum_bound) auto
  4402         also have "\<dots> < e"
  4403           using d(2) by simp
  4404         finally show "(\<Sum>ka\<in>snd ` p. content (ka \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) < e" .
  4405       qed
  4406       finally show "(\<Sum>(x, ka)\<in>p. content (ka \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * ?i x) < e" .
  4407     qed
  4408   qed
  4409 qed
  4410 
  4411 
  4412 subsection \<open>A technical lemma about "refinement" of division.\<close>
  4413 
  4414 lemma tagged_division_finer:
  4415   fixes p :: "('a::euclidean_space \<times> ('a::euclidean_space set)) set"
  4416   assumes "p tagged_division_of (cbox a b)"
  4417     and "gauge d"
  4418   obtains q where "q tagged_division_of (cbox a b)"
  4419     and "d fine q"
  4420     and "\<forall>(x,k) \<in> p. k \<subseteq> d(x) \<longrightarrow> (x,k) \<in> q"
  4421 proof -
  4422   let ?P = "\<lambda>p. p tagged_partial_division_of (cbox a b) \<longrightarrow> gauge d \<longrightarrow>
  4423     (\<exists>q. q tagged_division_of (\<Union>{k. \<exists>x. (x,k) \<in> p}) \<and> d fine q \<and>
  4424       (\<forall>(x,k) \<in> p. k \<subseteq> d(x) \<longrightarrow> (x,k) \<in> q))"
  4425   {
  4426     have *: "finite p" "p tagged_partial_division_of (cbox a b)"
  4427       using assms(1)
  4428       unfolding tagged_division_of_def
  4429       by auto
  4430     presume "\<And>p. finite p \<Longrightarrow> ?P p"
  4431     from this[rule_format,OF * assms(2)] guess q .. note q=this
  4432     then show ?thesis
  4433       apply -
  4434       apply (rule that[of q])
  4435       unfolding tagged_division_ofD[OF assms(1)]
  4436       apply auto
  4437       done
  4438   }
  4439   fix p :: "('a::euclidean_space \<times> ('a::euclidean_space set)) set"
  4440   assume as: "finite p"
  4441   show "?P p"
  4442     apply rule
  4443     apply rule
  4444     using as
  4445   proof (induct p)
  4446     case empty
  4447     show ?case
  4448       apply (rule_tac x="{}" in exI)
  4449       unfolding fine_def
  4450       apply auto
  4451       done
  4452   next
  4453     case (insert xk p)
  4454     guess x k using surj_pair[of xk] by (elim exE) note xk=this
  4455     note tagged_partial_division_subset[OF insert(4) subset_insertI]
  4456     from insert(3)[OF this insert(5)] guess q1 .. note q1 = conjunctD3[OF this]
  4457     have *: "\<Union>{l. \<exists>y. (y,l) \<in> insert xk p} = k \<union> \<Union>{l. \<exists>y. (y,l) \<in> p}"
  4458       unfolding xk by auto
  4459     note p = tagged_partial_division_ofD[OF insert(4)]
  4460     from p(4)[unfolded xk, OF insertI1] guess u v by (elim exE) note uv=this
  4461 
  4462     have "finite {k. \<exists>x. (x, k) \<in> p}"
  4463       apply (rule finite_subset[of _ "snd ` p"])
  4464       using p
  4465       apply safe
  4466       apply (metis image_iff snd_conv)
  4467       apply auto
  4468       done
  4469     then have int: "interior (cbox u v) \<inter> interior (\<Union>{k. \<exists>x. (x, k) \<in> p}) = {}"
  4470       apply (rule inter_interior_unions_intervals)
  4471       apply (rule open_interior)
  4472       apply (rule_tac[!] ballI)
  4473       unfolding mem_Collect_eq
  4474       apply (erule_tac[!] exE)
  4475       apply (drule p(4)[OF insertI2])
  4476       apply assumption
  4477       apply (rule p(5))
  4478       unfolding uv xk
  4479       apply (rule insertI1)
  4480       apply (rule insertI2)
  4481       apply assumption
  4482       using insert(2)
  4483       unfolding uv xk
  4484       apply auto
  4485       done
  4486     show ?case
  4487     proof (cases "cbox u v \<subseteq> d x")
  4488       case True
  4489       then show ?thesis
  4490         apply (rule_tac x="{(x,cbox u v)} \<union> q1" in exI)
  4491         apply rule
  4492         unfolding * uv
  4493         apply (rule tagged_division_union)
  4494         apply (rule tagged_division_of_self)
  4495         apply (rule p[unfolded xk uv] insertI1)+
  4496         apply (rule q1)
  4497         apply (rule int)
  4498         apply rule
  4499         apply (rule fine_union)
  4500         apply (subst fine_def)
  4501         defer
  4502         apply (rule q1)
  4503         unfolding Ball_def split_paired_All split_conv
  4504         apply rule
  4505         apply rule
  4506         apply rule
  4507         apply rule
  4508         apply (erule insertE)
  4509         apply (simp add: uv xk)
  4510         apply (rule UnI2)
  4511         apply (drule q1(3)[rule_format])
  4512         unfolding xk uv
  4513         apply auto
  4514         done
  4515     next
  4516       case False
  4517       from fine_division_exists[OF assms(2), of u v] guess q2 . note q2=this
  4518       show ?thesis
  4519         apply (rule_tac x="q2 \<union> q1" in exI)
  4520         apply rule
  4521         unfolding * uv
  4522         apply (rule tagged_division_union q2 q1 int fine_union)+
  4523         unfolding Ball_def split_paired_All split_conv
  4524         apply rule
  4525         apply (rule fine_union)
  4526         apply (rule q1 q2)+
  4527         apply rule
  4528         apply rule
  4529         apply rule
  4530         apply rule
  4531         apply (erule insertE)
  4532         apply (rule UnI2)
  4533         apply (simp add: False uv xk)
  4534         apply (drule q1(3)[rule_format])
  4535         using False
  4536         unfolding xk uv
  4537         apply auto
  4538         done
  4539     qed
  4540   qed
  4541 qed
  4542 
  4543 
  4544 subsection \<open>Hence the main theorem about negligible sets.\<close>
  4545 
  4546 lemma finite_product_dependent:
  4547   assumes "finite s"
  4548     and "\<And>x. x \<in> s \<Longrightarrow> finite (t x)"
  4549   shows "finite {(i, j) |i j. i \<in> s \<and> j \<in> t i}"
  4550   using assms
  4551 proof induct
  4552   case (insert x s)
  4553   have *: "{(i, j) |i j. i \<in> insert x s \<and> j \<in> t i} =
  4554     (\<lambda>y. (x,y)) ` (t x) \<union> {(i, j) |i j. i \<in> s \<and> j \<in> t i}" by auto
  4555   show ?case
  4556     unfolding *
  4557     apply (rule finite_UnI)
  4558     using insert
  4559     apply auto
  4560     done
  4561 qed auto
  4562 
  4563 lemma sum_sum_product:
  4564   assumes "finite s"
  4565     and "\<forall>i\<in>s. finite (t i)"
  4566   shows "setsum (\<lambda>i. setsum (x i) (t i)::real) s =
  4567     setsum (\<lambda>(i,j). x i j) {(i,j) | i j. i \<in> s \<and> j \<in> t i}"
  4568   using assms
  4569 proof induct
  4570   case (insert a s)
  4571   have *: "{(i, j) |i j. i \<in> insert a s \<and> j \<in> t i} =
  4572     (\<lambda>y. (a,y)) ` (t a) \<union> {(i, j) |i j. i \<in> s \<and> j \<in> t i}" by auto
  4573   show ?case
  4574     unfolding *
  4575     apply (subst setsum.union_disjoint)
  4576     unfolding setsum.insert[OF insert(1-2)]
  4577     prefer 4
  4578     apply (subst insert(3))
  4579     unfolding add_right_cancel
  4580   proof -
  4581     show "setsum (x a) (t a) = (\<Sum>(xa, y)\<in> Pair a ` t a. x xa y)"
  4582       apply (subst setsum.reindex)
  4583       unfolding inj_on_def
  4584       apply auto
  4585       done
  4586     show "finite {(i, j) |i j. i \<in> s \<and> j \<in> t i}"
  4587       apply (rule finite_product_dependent)
  4588       using insert
  4589       apply auto
  4590       done
  4591   qed (insert insert, auto)
  4592 qed auto
  4593 
  4594 lemma has_integral_negligible:
  4595   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  4596   assumes "negligible s"
  4597     and "\<forall>x\<in>(t - s). f x = 0"
  4598   shows "(f has_integral 0) t"
  4599 proof -
  4600   presume P: "\<And>f::'b::euclidean_space \<Rightarrow> 'a.
  4601     \<And>a b. \<forall>x. x \<notin> s \<longrightarrow> f x = 0 \<Longrightarrow> (f has_integral 0) (cbox a b)"
  4602   let ?f = "(\<lambda>x. if x \<in> t then f x else 0)"
  4603   show ?thesis
  4604     apply (rule_tac f="?f" in has_integral_eq)
  4605     unfolding if_P
  4606     apply (rule refl)
  4607     apply (subst has_integral_alt)
  4608     apply cases
  4609     apply (subst if_P, assumption)
  4610     unfolding if_not_P
  4611   proof -
  4612     assume "\<exists>a b. t = cbox a b"
  4613     then guess a b apply - by (erule exE)+ note t = this
  4614     show "(?f has_integral 0) t"
  4615       unfolding t
  4616       apply (rule P)
  4617       using assms(2)
  4618       unfolding t
  4619       apply auto
  4620       done
  4621   next
  4622     show "\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
  4623       (\<exists>z. ((\<lambda>x. if x \<in> t then ?f x else 0) has_integral z) (cbox a b) \<and> norm (z - 0) < e)"
  4624       apply safe
  4625       apply (rule_tac x=1 in exI)
  4626       apply rule
  4627       apply (rule zero_less_one)
  4628       apply safe
  4629       apply (rule_tac x=0 in exI)
  4630       apply rule
  4631       apply (rule P)
  4632       using assms(2)
  4633       apply auto
  4634       done
  4635   qed
  4636 next
  4637   fix f :: "'b \<Rightarrow> 'a"
  4638   fix a b :: 'b
  4639   assume assm: "\<forall>x. x \<notin> s \<longrightarrow> f x = 0"
  4640   show "(f has_integral 0) (cbox a b)"
  4641     unfolding has_integral
  4642   proof (safe, goal_cases)
  4643     case prems: (1 e)
  4644     then have "\<And>n. e / 2 / ((real n+1) * (2 ^ n)) > 0"
  4645       apply -
  4646       apply (rule divide_pos_pos)
  4647       defer
  4648       apply (rule mult_pos_pos)
  4649       apply (auto simp add:field_simps)
  4650       done
  4651     note assms(1)[unfolded negligible_def has_integral,rule_format,OF this,of a b]
  4652     note allI[OF this,of "\<lambda>x. x"]
  4653     from choice[OF this] guess d .. note d=conjunctD2[OF this[rule_format]]
  4654     show ?case
  4655       apply (rule_tac x="\<lambda>x. d (nat \<lfloor>norm (f x)\<rfloor>) x" in exI)
  4656     proof safe
  4657       show "gauge (\<lambda>x. d (nat \<lfloor>norm (f x)\<rfloor>) x)"
  4658         using d(1) unfolding gauge_def by auto
  4659       fix p
  4660       assume as: "p tagged_division_of (cbox a b)" "(\<lambda>x. d (nat \<lfloor>norm (f x)\<rfloor>) x) fine p"
  4661       let ?goal = "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) < e"
  4662       {
  4663         presume "p \<noteq> {} \<Longrightarrow> ?goal"
  4664         then show ?goal
  4665           apply (cases "p = {}")
  4666           using prems
  4667           apply auto
  4668           done
  4669       }
  4670       assume as': "p \<noteq> {}"
  4671       from real_arch_simple[of "Max((\<lambda>(x,k). norm(f x)) ` p)"] guess N ..
  4672       then have N: "\<forall>x\<in>(\<lambda>(x, k). norm (f x)) ` p. x \<le> real N"
  4673         by (meson Max_ge as(1) dual_order.trans finite_imageI tagged_division_of_finite)
  4674       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)"
  4675         by (auto intro: tagged_division_finer[OF as(1) d(1)])
  4676       from choice[OF this] guess q .. note q=conjunctD3[OF this[rule_format]]
  4677       have *: "\<And>i. (\<Sum>(x, k)\<in>q i. content k *\<^sub>R indicator s x) \<ge> (0::real)"
  4678         apply (rule setsum_nonneg)
  4679         apply safe
  4680         unfolding real_scaleR_def
  4681         apply (drule tagged_division_ofD(4)[OF q(1)])
  4682         apply (auto intro: mult_nonneg_nonneg)
  4683         done
  4684       have **: "finite s \<Longrightarrow> finite t \<Longrightarrow> (\<forall>(x,y) \<in> t. (0::real) \<le> g(x,y)) \<Longrightarrow>
  4685         (\<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
  4686         apply (rule setsum_le_included[of s t g snd f])
  4687         prefer 4
  4688         apply safe
  4689         apply (erule_tac x=x in ballE)
  4690         apply (erule exE)
  4691         apply (rule_tac x="(xa,x)" in bexI)
  4692         apply auto
  4693         done
  4694       have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) \<le> setsum (\<lambda>i. (real i + 1) *
  4695         norm (setsum (\<lambda>(x,k). content k *\<^sub>R indicator s x :: real) (q i))) {..N+1}"
  4696         unfolding real_norm_def setsum_distrib_left abs_of_nonneg[OF *] diff_0_right
  4697         apply (rule order_trans)
  4698         apply (rule norm_setsum)
  4699         apply (subst sum_sum_product)
  4700         prefer 3
  4701       proof (rule **, safe)
  4702         show "finite {(i, j) |i j. i \<in> {..N + 1} \<and> j \<in> q i}"
  4703           apply (rule finite_product_dependent)
  4704           using q
  4705           apply auto
  4706           done
  4707         fix i a b
  4708         assume as'': "(a, b) \<in> q i"
  4709         show "0 \<le> (real i + 1) * (content b *\<^sub>R indicator s a)"
  4710           unfolding real_scaleR_def
  4711           using tagged_division_ofD(4)[OF q(1) as'']
  4712           by (auto intro!: mult_nonneg_nonneg)
  4713       next
  4714         fix i :: nat
  4715         show "finite (q i)"
  4716           using q by auto
  4717       next
  4718         fix x k
  4719         assume xk: "(x, k) \<in> p"
  4720         define n where "n = nat \<lfloor>norm (f x)\<rfloor>"
  4721         have *: "norm (f x) \<in> (\<lambda>(x, k). norm (f x)) ` p"
  4722           using xk by auto
  4723         have nfx: "real n \<le> norm (f x)" "norm (f x) \<le> real n + 1"
  4724           unfolding n_def by auto
  4725         then have "n \<in> {0..N + 1}"
  4726           using N[rule_format,OF *] by auto
  4727         moreover
  4728         note as(2)[unfolded fine_def,rule_format,OF xk,unfolded split_conv]
  4729         note q(3)[rule_format,OF xk,unfolded split_conv,rule_format,OF this]
  4730         note this[unfolded n_def[symmetric]]
  4731         moreover
  4732         have "norm (content k *\<^sub>R f x) \<le> (real n + 1) * (content k * indicator s x)"
  4733         proof (cases "x \<in> s")
  4734           case False
  4735           then show ?thesis
  4736             using assm by auto
  4737         next
  4738           case True
  4739           have *: "content k \<ge> 0"
  4740             using tagged_division_ofD(4)[OF as(1) xk] by auto
  4741           moreover
  4742           have "content k * norm (f x) \<le> content k * (real n + 1)"
  4743             apply (rule mult_mono)
  4744             using nfx *
  4745             apply auto
  4746             done
  4747           ultimately
  4748           show ?thesis
  4749             unfolding abs_mult
  4750             using nfx True
  4751             by (auto simp add: field_simps)
  4752         qed
  4753         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>
  4754           (real y + 1) * (content k *\<^sub>R indicator s x)"
  4755           apply (rule_tac x=n in exI)
  4756           apply safe
  4757           apply (rule_tac x=n in exI)
  4758           apply (rule_tac x="(x,k)" in exI)
  4759           apply safe
  4760           apply auto
  4761           done
  4762       qed (insert as, auto)
  4763       also have "\<dots> \<le> setsum (\<lambda>i. e / 2 / 2 ^ i) {..N+1}"
  4764       proof (rule setsum_mono, goal_cases)
  4765         case (1 i)
  4766         then show ?case
  4767           apply (subst mult.commute, subst pos_le_divide_eq[symmetric])
  4768           using d(2)[rule_format, of "q i" i]
  4769           using q[rule_format]
  4770           apply (auto simp add: field_simps)
  4771           done
  4772       qed
  4773       also have "\<dots> < e * inverse 2 * 2"
  4774         unfolding divide_inverse setsum_distrib_left[symmetric]
  4775         apply (rule mult_strict_left_mono)
  4776         unfolding power_inverse [symmetric] lessThan_Suc_atMost[symmetric]
  4777         apply (subst geometric_sum)
  4778         using prems
  4779         apply auto
  4780         done
  4781       finally show "?goal" by auto
  4782     qed
  4783   qed
  4784 qed
  4785 
  4786 lemma has_integral_spike:
  4787   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  4788   assumes "negligible s"
  4789     and "(\<forall>x\<in>(t - s). g x = f x)"
  4790     and "(f has_integral y) t"
  4791   shows "(g has_integral y) t"
  4792 proof -
  4793   {
  4794     fix a b :: 'b
  4795     fix f g :: "'b \<Rightarrow> 'a"
  4796     fix y :: 'a
  4797     assume as: "\<forall>x \<in> cbox a b - s. g x = f x" "(f has_integral y) (cbox a b)"
  4798     have "((\<lambda>x. f x + (g x - f x)) has_integral (y + 0)) (cbox a b)"
  4799       apply (rule has_integral_add[OF as(2)])
  4800       apply (rule has_integral_negligible[OF assms(1)])
  4801       using as
  4802       apply auto
  4803       done
  4804     then have "(g has_integral y) (cbox a b)"
  4805       by auto
  4806   } note * = this
  4807   show ?thesis
  4808     apply (subst has_integral_alt)
  4809     using assms(2-)
  4810     apply -
  4811     apply (rule cond_cases)
  4812     apply safe
  4813     apply (rule *)
  4814     apply assumption+
  4815     apply (subst(asm) has_integral_alt)
  4816     unfolding if_not_P
  4817     apply (erule_tac x=e in allE)
  4818     apply safe
  4819     apply (rule_tac x=B in exI)
  4820     apply safe
  4821     apply (erule_tac x=a in allE)
  4822     apply (erule_tac x=b in allE)
  4823     apply safe
  4824     apply (rule_tac x=z in exI)
  4825     apply safe
  4826     apply (rule *[where fa2="\<lambda>x. if x\<in>t then f x else 0"])
  4827     apply auto
  4828     done
  4829 qed
  4830 
  4831 lemma has_integral_spike_eq:
  4832   assumes "negligible s"
  4833     and "\<forall>x\<in>(t - s). g x = f x"
  4834   shows "((f has_integral y) t \<longleftrightarrow> (g has_integral y) t)"
  4835   apply rule
  4836   apply (rule_tac[!] has_integral_spike[OF assms(1)])
  4837   using assms(2)
  4838   apply auto
  4839   done
  4840 
  4841 lemma integrable_spike:
  4842   assumes "negligible s"
  4843     and "\<forall>x\<in>(t - s). g x = f x"
  4844     and "f integrable_on t"
  4845   shows "g integrable_on  t"
  4846   using assms
  4847   unfolding integrable_on_def
  4848   apply -
  4849   apply (erule exE)
  4850   apply rule
  4851   apply (rule has_integral_spike)
  4852   apply fastforce+
  4853   done
  4854 
  4855 lemma integral_spike:
  4856   assumes "negligible s"
  4857     and "\<forall>x\<in>(t - s). g x = f x"
  4858   shows "integral t f = integral t g"
  4859   using has_integral_spike_eq[OF assms] by (simp add: integral_def integrable_on_def)
  4860 
  4861 
  4862 subsection \<open>Some other trivialities about negligible sets.\<close>
  4863 
  4864 lemma negligible_subset[intro]:
  4865   assumes "negligible s"
  4866     and "t \<subseteq> s"
  4867   shows "negligible t"
  4868   unfolding negligible_def
  4869 proof (safe, goal_cases)
  4870   case (1 a b)
  4871   show ?case
  4872     using assms(1)[unfolded negligible_def,rule_format,of a b]
  4873     apply -
  4874     apply (rule has_integral_spike[OF assms(1)])
  4875     defer
  4876     apply assumption
  4877     using assms(2)
  4878     unfolding indicator_def
  4879     apply auto
  4880     done
  4881 qed
  4882 
  4883 lemma negligible_diff[intro?]:
  4884   assumes "negligible s"
  4885   shows "negligible (s - t)"
  4886   using assms by auto
  4887 
  4888 lemma negligible_Int:
  4889   assumes "negligible s \<or> negligible t"
  4890   shows "negligible (s \<inter> t)"
  4891   using assms by auto
  4892 
  4893 lemma negligible_Un:
  4894   assumes "negligible s"
  4895     and "negligible t"
  4896   shows "negligible (s \<union> t)"
  4897   unfolding negligible_def
  4898 proof (safe, goal_cases)
  4899   case (1 a b)
  4900   note assm = assms[unfolded negligible_def,rule_format,of a b]
  4901   then show ?case
  4902     apply (subst has_integral_spike_eq[OF assms(2)])
  4903     defer
  4904     apply assumption
  4905     unfolding indicator_def
  4906     apply auto
  4907     done
  4908 qed
  4909 
  4910 lemma negligible_Un_eq[simp]: "negligible (s \<union> t) \<longleftrightarrow> negligible s \<and> negligible t"
  4911   using negligible_Un by auto
  4912 
  4913 lemma negligible_sing[intro]: "negligible {a::'a::euclidean_space}"
  4914   using negligible_standard_hyperplane[OF SOME_Basis, of "a \<bullet> (SOME i. i \<in> Basis)"] by auto
  4915 
  4916 lemma negligible_insert[simp]: "negligible (insert a s) \<longleftrightarrow> negligible s"
  4917   apply (subst insert_is_Un)
  4918   unfolding negligible_Un_eq
  4919   apply auto
  4920   done
  4921 
  4922 lemma negligible_empty[iff]: "negligible {}"
  4923   by auto
  4924 
  4925 lemma negligible_finite[intro]:
  4926   assumes "finite s"
  4927   shows "negligible s"
  4928   using assms by (induct s) auto
  4929 
  4930 lemma negligible_Union[intro]:
  4931   assumes "finite s"
  4932     and "\<forall>t\<in>s. negligible t"
  4933   shows "negligible(\<Union>s)"
  4934   using assms by induct auto
  4935 
  4936 lemma negligible:
  4937   "negligible s \<longleftrightarrow> (\<forall>t::('a::euclidean_space) set. ((indicator s::'a\<Rightarrow>real) has_integral 0) t)"
  4938   apply safe
  4939   defer
  4940   apply (subst negligible_def)
  4941 proof -
  4942   fix t :: "'a set"
  4943   assume as: "negligible s"
  4944   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)"
  4945     by auto
  4946   show "((indicator s::'a\<Rightarrow>real) has_integral 0) t"
  4947     apply (subst has_integral_alt)
  4948     apply cases
  4949     apply (subst if_P,assumption)
  4950     unfolding if_not_P
  4951     apply safe
  4952     apply (rule as[unfolded negligible_def,rule_format])
  4953     apply (rule_tac x=1 in exI)
  4954     apply safe
  4955     apply (rule zero_less_one)
  4956     apply (rule_tac x=0 in exI)
  4957     using negligible_subset[OF as,of "s \<inter> t"]
  4958     unfolding negligible_def indicator_def [abs_def]
  4959     unfolding *
  4960     apply auto
  4961     done
  4962 qed auto
  4963 
  4964 
  4965 subsection \<open>Finite case of the spike theorem is quite commonly needed.\<close>
  4966 
  4967 lemma has_integral_spike_finite:
  4968   assumes "finite s"
  4969     and "\<forall>x\<in>t-s. g x = f x"
  4970     and "(f has_integral y) t"
  4971   shows "(g has_integral y) t"
  4972   apply (rule has_integral_spike)
  4973   using assms
  4974   apply auto
  4975   done
  4976 
  4977 lemma has_integral_spike_finite_eq:
  4978   assumes "finite s"
  4979     and "\<forall>x\<in>t-s. g x = f x"
  4980   shows "((f has_integral y) t \<longleftrightarrow> (g has_integral y) t)"
  4981   apply rule
  4982   apply (rule_tac[!] has_integral_spike_finite)
  4983   using assms
  4984   apply auto
  4985   done
  4986 
  4987 lemma integrable_spike_finite:
  4988   assumes "finite s"
  4989     and "\<forall>x\<in>t-s. g x = f x"
  4990     and "f integrable_on t"
  4991   shows "g integrable_on  t"
  4992   using assms
  4993   unfolding integrable_on_def
  4994   apply safe
  4995   apply (rule_tac x=y in exI)
  4996   apply (rule has_integral_spike_finite)
  4997   apply auto
  4998   done
  4999 
  5000 
  5001 subsection \<open>In particular, the boundary of an interval is negligible.\<close>
  5002 
  5003 lemma negligible_frontier_interval: "negligible(cbox (a::'a::euclidean_space) b - box a b)"
  5004 proof -
  5005   let ?A = "\<Union>((\<lambda>k. {x. x\<bullet>k = a\<bullet>k} \<union> {x::'a. x\<bullet>k = b\<bullet>k}) ` Basis)"
  5006   have "cbox a b - box a b \<subseteq> ?A"
  5007     apply rule unfolding Diff_iff mem_box
  5008     apply simp
  5009     apply(erule conjE bexE)+
  5010     apply(rule_tac x=i in bexI)
  5011     apply auto
  5012     done
  5013   then show ?thesis
  5014     apply -
  5015     apply (rule negligible_subset[of ?A])
  5016     apply (rule negligible_Union[OF finite_imageI])
  5017     apply auto
  5018     done
  5019 qed
  5020 
  5021 lemma has_integral_spike_interior:
  5022   assumes "\<forall>x\<in>box a b. g x = f x"
  5023     and "(f has_integral y) (cbox a b)"
  5024   shows "(g has_integral y) (cbox a b)"
  5025   apply (rule has_integral_spike[OF negligible_frontier_interval _ assms(2)])
  5026   using assms(1)
  5027   apply auto
  5028   done
  5029 
  5030 lemma has_integral_spike_interior_eq:
  5031   assumes "\<forall>x\<in>box a b. g x = f x"
  5032   shows "(f has_integral y) (cbox a b) \<longleftrightarrow> (g has_integral y) (cbox a b)"
  5033   apply rule
  5034   apply (rule_tac[!] has_integral_spike_interior)
  5035   using assms
  5036   apply auto
  5037   done
  5038 
  5039 lemma integrable_spike_interior:
  5040   assumes "\<forall>x\<in>box a b. g x = f x"
  5041     and "f integrable_on cbox a b"
  5042   shows "g integrable_on cbox a b"
  5043   using assms
  5044   unfolding integrable_on_def
  5045   using has_integral_spike_interior[OF assms(1)]
  5046   by auto
  5047 
  5048 
  5049 subsection \<open>Integrability of continuous functions.\<close>
  5050 
  5051 lemma operative_approximable:
  5052   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5053   assumes "0 \<le> e"
  5054   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)"
  5055   unfolding comm_monoid.operative_def[OF comm_monoid_and]
  5056 proof safe
  5057   fix a b :: 'b
  5058   show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
  5059     if "content (cbox a b) = 0"
  5060     apply (rule_tac x=f in exI)
  5061     using assms that
  5062     apply (auto intro!: integrable_on_null)
  5063     done
  5064   {
  5065     fix c g
  5066     fix k :: 'b
  5067     assume as: "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e" "g integrable_on cbox a b"
  5068     assume k: "k \<in> Basis"
  5069     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}"
  5070       "\<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}"
  5071       apply (rule_tac[!] x=g in exI)
  5072       using as(1) integrable_split[OF as(2) k]
  5073       apply auto
  5074       done
  5075   }
  5076   fix c k g1 g2
  5077   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}"
  5078     "\<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}"
  5079   assume k: "k \<in> Basis"
  5080   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"
  5081   show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
  5082     apply (rule_tac x="?g" in exI)
  5083     apply safe
  5084   proof goal_cases
  5085     case (1 x)
  5086     then show ?case
  5087       apply -
  5088       apply (cases "x\<bullet>k=c")
  5089       apply (case_tac "x\<bullet>k < c")
  5090       using as assms
  5091       apply auto
  5092       done
  5093   next
  5094     case 2
  5095     presume "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
  5096       and "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
  5097     then guess h1 h2 unfolding integrable_on_def by auto
  5098     from has_integral_split[OF this k] show ?case
  5099       unfolding integrable_on_def by auto
  5100   next
  5101     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}"
  5102       apply(rule_tac[!] integrable_spike[OF negligible_standard_hyperplane[of k c]])
  5103       using k as(2,4)
  5104       apply auto
  5105       done
  5106   qed
  5107 qed
  5108 
  5109 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))"
  5110 proof -
  5111   interpret bool: comm_monoid_set "op \<and>" True
  5112     proof qed auto
  5113   show ?thesis
  5114     by (induction s rule: infinite_finite_induct) auto
  5115 qed
  5116 
  5117 lemma approximable_on_division:
  5118   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5119   assumes "0 \<le> e"
  5120     and "d division_of (cbox a b)"
  5121     and "\<forall>i\<in>d. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
  5122   obtains g where "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e" "g integrable_on cbox a b"
  5123 proof -
  5124   note * = comm_monoid_set.operative_division[OF comm_monoid_set_and operative_approximable[OF assms(1)] assms(2)]
  5125   from assms(3) this[unfolded comm_monoid_set_F_and, of f] division_of_finite[OF assms(2)]
  5126   guess g by auto
  5127   then show thesis
  5128     apply -
  5129     apply (rule that[of g])
  5130     apply auto
  5131     done
  5132 qed
  5133 
  5134 lemma integrable_continuous:
  5135   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5136   assumes "continuous_on (cbox a b) f"
  5137   shows "f integrable_on cbox a b"
  5138 proof (rule integrable_uniform_limit, safe)
  5139   fix e :: real
  5140   assume e: "e > 0"
  5141   from compact_uniformly_continuous[OF assms compact_cbox,unfolded uniformly_continuous_on_def,rule_format,OF e] guess d ..
  5142   note d=conjunctD2[OF this,rule_format]
  5143   from fine_division_exists[OF gauge_ball[OF d(1)], of a b] guess p . note p=this
  5144   note p' = tagged_division_ofD[OF p(1)]
  5145   have *: "\<forall>i\<in>snd ` p. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
  5146   proof (safe, unfold snd_conv)
  5147     fix x l
  5148     assume as: "(x, l) \<in> p"
  5149     from p'(4)[OF this] guess a b by (elim exE) note l=this
  5150     show "\<exists>g. (\<forall>x\<in>l. norm (f x - g x) \<le> e) \<and> g integrable_on l"
  5151       apply (rule_tac x="\<lambda>y. f x" in exI)
  5152     proof safe
  5153       show "(\<lambda>y. f x) integrable_on l"
  5154         unfolding integrable_on_def l
  5155         apply rule
  5156         apply (rule has_integral_const)
  5157         done
  5158       fix y
  5159       assume y: "y \<in> l"
  5160       note fineD[OF p(2) as,unfolded subset_eq,rule_format,OF this]
  5161       note d(2)[OF _ _ this[unfolded mem_ball]]
  5162       then show "norm (f y - f x) \<le> e"
  5163         using y p'(2-3)[OF as] unfolding dist_norm l norm_minus_commute by fastforce
  5164     qed
  5165   qed
  5166   from e have "e \<ge> 0"
  5167     by auto
  5168   from approximable_on_division[OF this division_of_tagged_division[OF p(1)] *] guess g .
  5169   then show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
  5170     by auto
  5171 qed
  5172 
  5173 lemma integrable_continuous_real:
  5174   fixes f :: "real \<Rightarrow> 'a::banach"
  5175   assumes "continuous_on {a .. b} f"
  5176   shows "f integrable_on {a .. b}"
  5177   by (metis assms box_real(2) integrable_continuous)
  5178 
  5179 subsection \<open>Specialization of additivity to one dimension.\<close>
  5180 
  5181 subsection \<open>Special case of additivity we need for the FTC.\<close>
  5182 
  5183 lemma additive_tagged_division_1:
  5184   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
  5185   assumes "a \<le> b"
  5186     and "p tagged_division_of {a..b}"
  5187   shows "setsum (\<lambda>(x,k). f(Sup k) - f(Inf k)) p = f b - f a"
  5188 proof -
  5189   let ?f = "(\<lambda>k::(real) set. if k = {} then 0 else f(interval_upperbound k) - f(interval_lowerbound k))"
  5190   have ***: "\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i"
  5191     using assms by auto
  5192   have *: "add.operative ?f"
  5193     unfolding add.operative_1_lt box_eq_empty
  5194     by auto
  5195   have **: "cbox a b \<noteq> {}"
  5196     using assms(1) by auto
  5197   note setsum.operative_tagged_division[OF * assms(2)[simplified box_real[symmetric]]]
  5198   note * = this[unfolded if_not_P[OF **] interval_bounds[OF ***],symmetric]
  5199   show ?thesis
  5200     unfolding *
  5201     apply (rule setsum.cong)
  5202     unfolding split_paired_all split_conv
  5203     using assms(2)
  5204     apply auto
  5205     done
  5206 qed
  5207 
  5208 
  5209 subsection \<open>A useful lemma allowing us to factor out the content size.\<close>
  5210 
  5211 lemma has_integral_factor_content:
  5212   "(f has_integral i) (cbox a b) \<longleftrightarrow>
  5213     (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  5214       norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content (cbox a b)))"
  5215 proof (cases "content (cbox a b) = 0")
  5216   case True
  5217   show ?thesis
  5218     unfolding has_integral_null_eq[OF True]
  5219     apply safe
  5220     apply (rule, rule, rule gauge_trivial, safe)
  5221     unfolding setsum_content_null[OF True] True
  5222     defer
  5223     apply (erule_tac x=1 in allE)
  5224     apply safe
  5225     defer
  5226     apply (rule fine_division_exists[of _ a b])
  5227     apply assumption
  5228     apply (erule_tac x=p in allE)
  5229     unfolding setsum_content_null[OF True]
  5230     apply auto
  5231     done
  5232 next
  5233   case False
  5234   note F = this[unfolded content_lt_nz[symmetric]]
  5235   let ?P = "\<lambda>e opp. \<exists>d. gauge d \<and>
  5236     (\<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)"
  5237   show ?thesis
  5238     apply (subst has_integral)
  5239   proof safe
  5240     fix e :: real
  5241     assume e: "e > 0"
  5242     {
  5243       assume "\<forall>e>0. ?P e op <"
  5244       then show "?P (e * content (cbox a b)) op \<le>"
  5245         apply (erule_tac x="e * content (cbox a b)" in allE)
  5246         apply (erule impE)
  5247         defer
  5248         apply (erule exE,rule_tac x=d in exI)
  5249         using F e
  5250         apply (auto simp add:field_simps)
  5251         done
  5252     }
  5253     {
  5254       assume "\<forall>e>0. ?P (e * content (cbox a b)) op \<le>"
  5255       then show "?P e op <"
  5256         apply (erule_tac x="e / 2 / content (cbox a b)" in allE)
  5257         apply (erule impE)
  5258         defer
  5259         apply (erule exE,rule_tac x=d in exI)
  5260         using F e
  5261         apply (auto simp add: field_simps)
  5262         done
  5263     }
  5264   qed
  5265 qed
  5266 
  5267 lemma has_integral_factor_content_real:
  5268   "(f has_integral i) {a .. b::real} \<longleftrightarrow>
  5269     (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a .. b}  \<and> d fine p \<longrightarrow>
  5270       norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content {a .. b} ))"
  5271   unfolding box_real[symmetric]
  5272   by (rule has_integral_factor_content)
  5273 
  5274 
  5275 subsection \<open>Fundamental theorem of calculus.\<close>
  5276 
  5277 lemma interval_bounds_real:
  5278   fixes q b :: real
  5279   assumes "a \<le> b"
  5280   shows "Sup {a..b} = b"
  5281     and "Inf {a..b} = a"
  5282   using assms by auto
  5283 
  5284 lemma fundamental_theorem_of_calculus:
  5285   fixes f :: "real \<Rightarrow> 'a::banach"
  5286   assumes "a \<le> b"
  5287     and "\<forall>x\<in>{a .. b}. (f has_vector_derivative f' x) (at x within {a .. b})"
  5288   shows "(f' has_integral (f b - f a)) {a .. b}"
  5289   unfolding has_integral_factor_content box_real[symmetric]
  5290 proof safe
  5291   fix e :: real
  5292   assume e: "e > 0"
  5293   note assm = assms(2)[unfolded has_vector_derivative_def has_derivative_within_alt]
  5294   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"
  5295     using e by blast
  5296   note this[OF assm,unfolded gauge_existence_lemma]
  5297   from choice[OF this,unfolded Ball_def[symmetric]] guess d ..
  5298   note d=conjunctD2[OF this[rule_format],rule_format]
  5299   show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
  5300     norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content (cbox a b))"
  5301     apply (rule_tac x="\<lambda>x. ball x (d x)" in exI)
  5302     apply safe
  5303     apply (rule gauge_ball_dependent)
  5304     apply rule
  5305     apply (rule d(1))
  5306   proof -
  5307     fix p
  5308     assume as: "p tagged_division_of cbox a b" "(\<lambda>x. ball x (d x)) fine p"
  5309     show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content (cbox a b)"
  5310       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]
  5311       unfolding additive_tagged_division_1[OF assms(1) as(1)[simplified box_real],of "\<lambda>x. x",symmetric]
  5312       unfolding setsum_distrib_left
  5313       defer
  5314       unfolding setsum_subtractf[symmetric]
  5315     proof (rule setsum_norm_le,safe)
  5316       fix x k
  5317       assume "(x, k) \<in> p"
  5318       note xk = tagged_division_ofD(2-4)[OF as(1) this]
  5319       from this(3) guess u v by (elim exE) note k=this
  5320       have *: "u \<le> v"
  5321         using xk unfolding k by auto
  5322       have ball: "\<forall>xa\<in>k. xa \<in> ball x (d x)"
  5323         using as(2)[unfolded fine_def,rule_format,OF \<open>(x,k)\<in>p\<close>,unfolded split_conv subset_eq] .
  5324       have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) \<le>
  5325         norm (f u - f x - (u - x) *\<^sub>R f' x) + norm (f v - f x - (v - x) *\<^sub>R f' x)"
  5326         apply (rule order_trans[OF _ norm_triangle_ineq4])
  5327         apply (rule eq_refl)
  5328         apply (rule arg_cong[where f=norm])
  5329         unfolding scaleR_diff_left
  5330         apply (auto simp add:algebra_simps)
  5331         done
  5332       also have "\<dots> \<le> e * norm (u - x) + e * norm (v - x)"
  5333         apply (rule add_mono)
  5334         apply (rule d(2)[of "x" "u",unfolded o_def])
  5335         prefer 4
  5336         apply (rule d(2)[of "x" "v",unfolded o_def])
  5337         using ball[rule_format,of u] ball[rule_format,of v]
  5338         using xk(1-2)
  5339         unfolding k subset_eq
  5340         apply (auto simp add:dist_real_def)
  5341         done
  5342       also have "\<dots> \<le> e * (Sup k - Inf k)"
  5343         unfolding k interval_bounds_real[OF *]
  5344         using xk(1)
  5345         unfolding k
  5346         by (auto simp add: dist_real_def field_simps)
  5347       finally show "norm (content k *\<^sub>R f' x - (f (Sup k) - f (Inf k))) \<le>
  5348         e * (Sup k - Inf k)"
  5349         unfolding box_real k interval_bounds_real[OF *] content_real[OF *]
  5350           interval_upperbound_real interval_lowerbound_real
  5351           .
  5352     qed
  5353   qed
  5354 qed
  5355 
  5356 lemma ident_has_integral:
  5357   fixes a::real
  5358   assumes "a \<le> b"
  5359   shows "((\<lambda>x. x) has_integral (b\<^sup>2 - a\<^sup>2) / 2) {a..b}"
  5360 proof -
  5361   have "((\<lambda>x. x) has_integral inverse 2 * b\<^sup>2 - inverse 2 * a\<^sup>2) {a..b}"
  5362     apply (rule fundamental_theorem_of_calculus [OF assms], clarify)
  5363     unfolding power2_eq_square
  5364     by (rule derivative_eq_intros | simp)+
  5365   then show ?thesis
  5366     by (simp add: field_simps)
  5367 qed
  5368 
  5369 lemma integral_ident [simp]:
  5370   fixes a::real
  5371   assumes "a \<le> b"
  5372   shows "integral {a..b} (\<lambda>x. x) = (if a \<le> b then (b\<^sup>2 - a\<^sup>2) / 2 else 0)"
  5373 using ident_has_integral integral_unique by fastforce
  5374 
  5375 lemma ident_integrable_on:
  5376   fixes a::real
  5377   shows "(\<lambda>x. x) integrable_on {a..b}"
  5378 by (metis atLeastatMost_empty_iff integrable_on_def has_integral_empty ident_has_integral)
  5379 
  5380 
  5381 subsection \<open>Taylor series expansion\<close>
  5382 
  5383 lemma (in bounded_bilinear) setsum_prod_derivatives_has_vector_derivative:
  5384   assumes "p>0"
  5385   and f0: "Df 0 = f"
  5386   and Df: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5387     (Df m has_vector_derivative Df (Suc m) t) (at t within {a .. b})"
  5388   and g0: "Dg 0 = g"
  5389   and Dg: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5390     (Dg m has_vector_derivative Dg (Suc m) t) (at t within {a .. b})"
  5391   and ivl: "a \<le> t" "t \<le> b"
  5392   shows "((\<lambda>t. \<Sum>i<p. (-1)^i *\<^sub>R prod (Df i t) (Dg (p - Suc i) t))
  5393     has_vector_derivative
  5394       prod (f t) (Dg p t) - (-1)^p *\<^sub>R prod (Df p t) (g t))
  5395     (at t within {a .. b})"
  5396   using assms
  5397 proof cases
  5398   assume p: "p \<noteq> 1"
  5399   define p' where "p' = p - 2"
  5400   from assms p have p': "{..<p} = {..Suc p'}" "p = Suc (Suc p')"
  5401     by (auto simp: p'_def)
  5402   have *: "\<And>i. i \<le> p' \<Longrightarrow> Suc (Suc p' - i) = (Suc (Suc p') - i)"
  5403     by auto
  5404   let ?f = "\<lambda>i. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg ((p - i)) t))"
  5405   have "(\<Sum>i<p. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg (Suc (p - Suc i)) t) +
  5406     prod (Df (Suc i) t) (Dg (p - Suc i) t))) =
  5407     (\<Sum>i\<le>(Suc p'). ?f i - ?f (Suc i))"
  5408     by (auto simp: algebra_simps p'(2) numeral_2_eq_2 * lessThan_Suc_atMost)
  5409   also note setsum_telescope
  5410   finally
  5411   have "(\<Sum>i<p. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg (Suc (p - Suc i)) t) +
  5412     prod (Df (Suc i) t) (Dg (p - Suc i) t)))
  5413     = prod (f t) (Dg p t) - (- 1) ^ p *\<^sub>R prod (Df p t) (g t)"
  5414     unfolding p'[symmetric]
  5415     by (simp add: assms)
  5416   thus ?thesis
  5417     using assms
  5418     by (auto intro!: derivative_eq_intros has_vector_derivative)
  5419 qed (auto intro!: derivative_eq_intros has_vector_derivative)
  5420 
  5421 lemma
  5422   fixes f::"real\<Rightarrow>'a::banach"
  5423   assumes "p>0"
  5424   and f0: "Df 0 = f"
  5425   and Df: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5426     (Df m has_vector_derivative Df (Suc m) t) (at t within {a .. b})"
  5427   and ivl: "a \<le> b"
  5428   defines "i \<equiv> \<lambda>x. ((b - x) ^ (p - 1) / fact (p - 1)) *\<^sub>R Df p x"
  5429   shows taylor_has_integral:
  5430     "(i has_integral f b - (\<Sum>i<p. ((b - a) ^ i / fact i) *\<^sub>R Df i a)) {a..b}"
  5431   and taylor_integral:
  5432     "f b = (\<Sum>i<p. ((b - a) ^ i / fact i) *\<^sub>R Df i a) + integral {a..b} i"
  5433   and taylor_integrable:
  5434     "i integrable_on {a .. b}"
  5435 proof goal_cases
  5436   case 1
  5437   interpret bounded_bilinear "scaleR::real\<Rightarrow>'a\<Rightarrow>'a"
  5438     by (rule bounded_bilinear_scaleR)
  5439   define g where "g s = (b - s)^(p - 1)/fact (p - 1)" for s
  5440   define Dg where [abs_def]:
  5441     "Dg n s = (if n < p then (-1)^n * (b - s)^(p - 1 - n) / fact (p - 1 - n) else 0)" for n s
  5442   have g0: "Dg 0 = g"
  5443     using \<open>p > 0\<close>
  5444     by (auto simp add: Dg_def divide_simps g_def split: if_split_asm)
  5445   {
  5446     fix m
  5447     assume "p > Suc m"
  5448     hence "p - Suc m = Suc (p - Suc (Suc m))"
  5449       by auto
  5450     hence "real (p - Suc m) * fact (p - Suc (Suc m)) = fact (p - Suc m)"
  5451       by auto
  5452   } note fact_eq = this
  5453   have Dg: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5454     (Dg m has_vector_derivative Dg (Suc m) t) (at t within {a .. b})"
  5455     unfolding Dg_def
  5456     by (auto intro!: derivative_eq_intros simp: has_vector_derivative_def fact_eq divide_simps)
  5457   let ?sum = "\<lambda>t. \<Sum>i<p. (- 1) ^ i *\<^sub>R Dg i t *\<^sub>R Df (p - Suc i) t"
  5458   from setsum_prod_derivatives_has_vector_derivative[of _ Dg _ _ _ Df,
  5459       OF \<open>p > 0\<close> g0 Dg f0 Df]
  5460   have deriv: "\<And>t. a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
  5461     (?sum has_vector_derivative
  5462       g t *\<^sub>R Df p t - (- 1) ^ p *\<^sub>R Dg p t *\<^sub>R f t) (at t within {a..b})"
  5463     by auto
  5464   from fundamental_theorem_of_calculus[rule_format, OF \<open>a \<le> b\<close> deriv]
  5465   have "(i has_integral ?sum b - ?sum a) {a .. b}"
  5466     using atLeastatMost_empty'[simp del]
  5467     by (simp add: i_def g_def Dg_def)
  5468   also
  5469   have one: "(- 1) ^ p' * (- 1) ^ p' = (1::real)"
  5470     and "{..<p} \<inter> {i. p = Suc i} = {p - 1}"
  5471     for p'
  5472     using \<open>p > 0\<close>
  5473     by (auto simp: power_mult_distrib[symmetric])
  5474   then have "?sum b = f b"
  5475     using Suc_pred'[OF \<open>p > 0\<close>]
  5476     by (simp add: diff_eq_eq Dg_def power_0_left le_Suc_eq if_distrib
  5477         cond_application_beta setsum.If_cases f0)
  5478   also
  5479   have "{..<p} = (\<lambda>x. p - x - 1) ` {..<p}"
  5480   proof safe
  5481     fix x
  5482     assume "x < p"
  5483     thus "x \<in> (\<lambda>x. p - x - 1) ` {..<p}"
  5484       by (auto intro!: image_eqI[where x = "p - x - 1"])
  5485   qed simp
  5486   from _ this
  5487   have "?sum a = (\<Sum>i<p. ((b - a) ^ i / fact i) *\<^sub>R Df i a)"
  5488     by (rule setsum.reindex_cong) (auto simp add: inj_on_def Dg_def one)
  5489   finally show c: ?case .
  5490   case 2 show ?case using c integral_unique by force
  5491   case 3 show ?case using c by force
  5492 qed
  5493 
  5494 
  5495 subsection \<open>Attempt a systematic general set of "offset" results for components.\<close>
  5496 
  5497 lemma gauge_modify:
  5498   assumes "(\<forall>s. open s \<longrightarrow> open {x. f(x) \<in> s})" "gauge d"
  5499   shows "gauge (\<lambda>x. {y. f y \<in> d (f x)})"
  5500   using assms
  5501   unfolding gauge_def
  5502   apply safe
  5503   defer
  5504   apply (erule_tac x="f x" in allE)
  5505   apply (erule_tac x="d (f x)" in allE)
  5506   apply auto
  5507   done
  5508 
  5509 
  5510 subsection \<open>Only need trivial subintervals if the interval itself is trivial.\<close>
  5511 
  5512 lemma division_of_nontrivial:
  5513   fixes s :: "'a::euclidean_space set set"
  5514   assumes "s division_of (cbox a b)"
  5515     and "content (cbox a b) \<noteq> 0"
  5516   shows "{k. k \<in> s \<and> content k \<noteq> 0} division_of (cbox a b)"
  5517   using assms(1)
  5518   apply -
  5519 proof (induct "card s" arbitrary: s rule: nat_less_induct)
  5520   fix s::"'a set set"
  5521   assume assm: "s division_of (cbox a b)"
  5522     "\<forall>m<card s. \<forall>x. m = card x \<longrightarrow>
  5523       x division_of (cbox a b) \<longrightarrow> {k \<in> x. content k \<noteq> 0} division_of (cbox a b)"
  5524   note s = division_ofD[OF assm(1)]
  5525   let ?thesis = "{k \<in> s. content k \<noteq> 0} division_of (cbox a b)"
  5526   {
  5527     presume *: "{k \<in> s. content k \<noteq> 0} \<noteq> s \<Longrightarrow> ?thesis"
  5528     show ?thesis
  5529       apply cases
  5530       defer
  5531       apply (rule *)
  5532       apply assumption
  5533       using assm(1)
  5534       apply auto
  5535       done
  5536   }
  5537   assume noteq: "{k \<in> s. content k \<noteq> 0} \<noteq> s"
  5538   then obtain k where k: "k \<in> s" "content k = 0"
  5539     by auto
  5540   from s(4)[OF k(1)] guess c d by (elim exE) note k=k this
  5541   from k have "card s > 0"
  5542     unfolding card_gt_0_iff using assm(1) by auto
  5543   then have card: "card (s - {k}) < card s"
  5544     using assm(1) k(1)
  5545     apply (subst card_Diff_singleton_if)
  5546     apply auto
  5547     done
  5548   have *: "closed (\<Union>(s - {k}))"
  5549     apply (rule closed_Union)
  5550     defer
  5551     apply rule
  5552     apply (drule DiffD1,drule s(4))
  5553     using assm(1)
  5554     apply auto
  5555     done
  5556   have "k \<subseteq> \<Union>(s - {k})"
  5557     apply safe
  5558     apply (rule *[unfolded closed_limpt,rule_format])
  5559     unfolding islimpt_approachable
  5560   proof safe
  5561     fix x
  5562     fix e :: real
  5563     assume as: "x \<in> k" "e > 0"
  5564     from k(2)[unfolded k content_eq_0] guess i ..
  5565     then have i:"c\<bullet>i = d\<bullet>i" "i\<in>Basis"
  5566       using s(3)[OF k(1),unfolded k] unfolding box_ne_empty by auto
  5567     then have xi: "x\<bullet>i = d\<bullet>i"
  5568       using as unfolding k mem_box by (metis antisym)
  5569     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 +
  5570       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)"
  5571     show "\<exists>x'\<in>\<Union>(s - {k}). x' \<noteq> x \<and> dist x' x < e"
  5572       apply (rule_tac x=y in bexI)
  5573     proof
  5574       have "d \<in> cbox c d"
  5575         using s(3)[OF k(1)]
  5576         unfolding k box_eq_empty mem_box
  5577         by (fastforce simp add: not_less)
  5578       then have "d \<in> cbox a b"
  5579         using s(2)[OF k(1)]
  5580         unfolding k
  5581         by auto
  5582       note di = this[unfolded mem_box,THEN bspec[where x=i]]
  5583       then have xyi: "y\<bullet>i \<noteq> x\<bullet>i"
  5584         unfolding y_def i xi
  5585         using as(2) assms(2)[unfolded content_eq_0] i(2)
  5586         by (auto elim!: ballE[of _ _ i])
  5587       then show "y \<noteq> x"
  5588         unfolding euclidean_eq_iff[where 'a='a] using i by auto
  5589       have *: "Basis = insert i (Basis - {i})"
  5590         using i by auto
  5591       have "norm (y - x) < e + setsum (\<lambda>i. 0) Basis"
  5592         apply (rule le_less_trans[OF norm_le_l1])
  5593         apply (subst *)
  5594         apply (subst setsum.insert)
  5595         prefer 3
  5596         apply (rule add_less_le_mono)
  5597       proof -
  5598         show "\<bar>(y - x) \<bullet> i\<bar> < e"
  5599           using di as(2) y_def i xi by (auto simp: inner_simps)
  5600         show "(\<Sum>i\<in>Basis - {i}. \<bar>(y - x) \<bullet> i\<bar>) \<le> (\<Sum>i\<in>Basis. 0)"
  5601           unfolding y_def by (auto simp: inner_simps)
  5602       qed auto
  5603       then show "dist y x < e"
  5604         unfolding dist_norm by auto
  5605       have "y \<notin> k"
  5606         unfolding k mem_box
  5607         apply rule
  5608         apply (erule_tac x=i in ballE)
  5609         using xyi k i xi
  5610         apply auto
  5611         done
  5612       moreover
  5613       have "y \<in> \<Union>s"
  5614         using set_rev_mp[OF as(1) s(2)[OF k(1)]] as(2) di i
  5615         unfolding s mem_box y_def
  5616         by (auto simp: field_simps elim!: ballE[of _ _ i])
  5617       ultimately
  5618       show "y \<in> \<Union>(s - {k})" by auto
  5619     qed
  5620   qed
  5621   then have "\<Union>(s - {k}) = cbox a b"
  5622     unfolding s(6)[symmetric] by auto
  5623   then have  "{ka \<in> s - {k}. content ka \<noteq> 0} division_of (cbox a b)"
  5624     apply -
  5625     apply (rule assm(2)[rule_format,OF card refl])
  5626     apply (rule division_ofI)
  5627     defer
  5628     apply (rule_tac[1-4] s)
  5629     using assm(1)
  5630     apply auto
  5631     done
  5632   moreover
  5633   have "{ka \<in> s - {k}. content ka \<noteq> 0} = {k \<in> s. content k \<noteq> 0}"
  5634     using k by auto
  5635   ultimately show ?thesis by auto
  5636 qed
  5637 
  5638 
  5639 subsection \<open>Integrability on subintervals.\<close>
  5640 
  5641 lemma operative_integrable:
  5642   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5643   shows "comm_monoid.operative op \<and> True (\<lambda>i. f integrable_on i)"
  5644   unfolding comm_monoid.operative_def[OF comm_monoid_and]
  5645   apply safe
  5646   apply (subst integrable_on_def)
  5647   unfolding has_integral_null_eq
  5648   apply (rule, rule refl)
  5649   apply (rule, assumption, assumption)+
  5650   unfolding integrable_on_def
  5651   by (auto intro!: has_integral_split)
  5652 
  5653 lemma integrable_subinterval:
  5654   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5655   assumes "f integrable_on cbox a b"
  5656     and "cbox c d \<subseteq> cbox a b"
  5657   shows "f integrable_on cbox c d"
  5658   apply (cases "cbox c d = {}")
  5659   defer
  5660   apply (rule partial_division_extend_1[OF assms(2)],assumption)
  5661   using comm_monoid_set.operative_division[OF comm_monoid_set_and operative_integrable,symmetric,of _ _ _ f] assms(1)
  5662   apply (auto simp: comm_monoid_set_F_and)
  5663   done
  5664 
  5665 lemma integrable_subinterval_real:
  5666   fixes f :: "real \<Rightarrow> 'a::banach"
  5667   assumes "f integrable_on {a .. b}"
  5668     and "{c .. d} \<subseteq> {a .. b}"
  5669   shows "f integrable_on {c .. d}"
  5670   by (metis assms(1) assms(2) box_real(2) integrable_subinterval)
  5671 
  5672 
  5673 subsection \<open>Combining adjacent intervals in 1 dimension.\<close>
  5674 
  5675 lemma has_integral_combine:
  5676   fixes a b c :: real
  5677   assumes "a \<le> c"
  5678     and "c \<le> b"
  5679     and "(f has_integral i) {a .. c}"
  5680     and "(f has_integral (j::'a::banach)) {c .. b}"
  5681   shows "(f has_integral (i + j)) {a .. b}"
  5682 proof -
  5683   interpret comm_monoid "lift_option plus" "Some (0::'a)"
  5684     by (rule comm_monoid_lift_option)
  5685       (rule add.comm_monoid_axioms)
  5686   note operative_integral [of f, unfolded operative_1_le]
  5687   note conjunctD2 [OF this, rule_format]
  5688   note * = this(2) [OF conjI [OF assms(1-2)],
  5689     unfolded if_P [OF assms(3)]]
  5690   then have "f integrable_on cbox a b"
  5691     apply -
  5692     apply (rule ccontr)
  5693     apply (subst(asm) if_P)
  5694     defer
  5695     apply (subst(asm) if_P)
  5696     using assms(3-)
  5697     apply auto
  5698     done
  5699   with *
  5700   show ?thesis
  5701     apply -
  5702     apply (subst(asm) if_P)
  5703     defer
  5704     apply (subst(asm) if_P)
  5705     defer
  5706     apply (subst(asm) if_P)
  5707     using assms(3-)
  5708     apply (auto simp add: integrable_on_def integral_unique)
  5709     done
  5710 qed
  5711 
  5712 lemma integral_combine:
  5713   fixes f :: "real \<Rightarrow> 'a::banach"
  5714   assumes "a \<le> c"
  5715     and "c \<le> b"
  5716     and "f integrable_on {a .. b}"
  5717   shows "integral {a .. c} f + integral {c .. b} f = integral {a .. b} f"
  5718   apply (rule integral_unique[symmetric])
  5719   apply (rule has_integral_combine[OF assms(1-2)])
  5720   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)
  5721   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)
  5722 
  5723 lemma integrable_combine:
  5724   fixes f :: "real \<Rightarrow> 'a::banach"
  5725   assumes "a \<le> c"
  5726     and "c \<le> b"
  5727     and "f integrable_on {a .. c}"
  5728     and "f integrable_on {c .. b}"
  5729   shows "f integrable_on {a .. b}"
  5730   using assms
  5731   unfolding integrable_on_def
  5732   by (fastforce intro!:has_integral_combine)
  5733 
  5734 
  5735 subsection \<open>Reduce integrability to "local" integrability.\<close>
  5736 
  5737 lemma integrable_on_little_subintervals:
  5738   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
  5739   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>
  5740     f integrable_on cbox u v"
  5741   shows "f integrable_on cbox a b"
  5742 proof -
  5743   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>
  5744     f integrable_on cbox u v)"
  5745     using assms by auto
  5746   note this[unfolded gauge_existence_lemma]
  5747   from choice[OF this] guess d .. note d=this[rule_format]
  5748   guess p
  5749     apply (rule fine_division_exists[OF gauge_ball_dependent,of d a b])
  5750     using d
  5751     by auto
  5752   note p=this(1-2)
  5753   note division_of_tagged_division[OF this(1)]
  5754   note * = comm_monoid_set.operative_division[OF comm_monoid_set_and operative_integrable, OF this, symmetric, of f]
  5755   show ?thesis
  5756     unfolding * comm_monoid_set_F_and
  5757     apply safe
  5758     unfolding snd_conv
  5759   proof -
  5760     fix x k
  5761     assume "(x, k) \<in> p"
  5762     note tagged_division_ofD(2-4)[OF p(1) this] fineD[OF p(2) this]
  5763     then show "f integrable_on k"
  5764       apply safe
  5765       apply (rule d[THEN conjunct2,rule_format,of x])
  5766       apply (auto intro: order.trans)
  5767       done
  5768   qed
  5769 qed
  5770 
  5771 
  5772 subsection \<open>Second FTC or existence of antiderivative.\<close>
  5773 
  5774 lemma integrable_const[intro]: "(\<lambda>x. c) integrable_on cbox a b"
  5775   unfolding integrable_on_def
  5776   apply rule
  5777   apply (rule has_integral_const)
  5778   done
  5779 
  5780 lemma integral_has_vector_derivative_continuous_at:
  5781   fixes f :: "real \<Rightarrow> 'a::banach"
  5782   assumes f: "f integrable_on {a..b}"
  5783       and x: "x \<in> {a..b}"
  5784       and fx: "continuous (at x within {a..b}) f"
  5785   shows "((\<lambda>u. integral {a..u} f) has_vector_derivative f x) (at x within {a..b})"
  5786 proof -
  5787   let ?I = "\<lambda>a b. integral {a..b} f"
  5788   { fix e::real
  5789     assume "e > 0"
  5790     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"
  5791       using \<open>e>0\<close> fx by (auto simp: continuous_within_eps_delta dist_norm less_imp_le)
  5792     have "norm (integral {a..y} f - integral {a..x} f - (y - x) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
  5793            if y: "y \<in> {a..b}" and yx: "\<bar>y - x\<bar> < d" for y
  5794     proof (cases "y < x")
  5795       case False
  5796       have "f integrable_on {a..y}"
  5797         using f y by (simp add: integrable_subinterval_real)
  5798       then have Idiff: "?I a y - ?I a x = ?I x y"
  5799         using False x by (simp add: algebra_simps integral_combine)
  5800       have fux_int: "((\<lambda>u. f u - f x) has_integral integral {x..y} f - (y - x) *\<^sub>R f x) {x..y}"
  5801         apply (rule has_integral_sub)
  5802         using x y apply (force intro: integrable_integral [OF integrable_subinterval_real [OF f]])
  5803         using has_integral_const_real [of "f x" x y] False
  5804         apply (simp add: )
  5805         done
  5806       show ?thesis
  5807         using False
  5808         apply (simp add: abs_eq_content del: content_real_if measure_lborel_Icc)
  5809         apply (rule has_integral_bound_real[where f="(\<lambda>u. f u - f x)"])
  5810         using yx False d x y \<open>e>0\<close> apply (auto simp add: Idiff fux_int)
  5811         done
  5812     next
  5813       case True
  5814       have "f integrable_on {a..x}"
  5815         using f x by (simp add: integrable_subinterval_real)
  5816       then have Idiff: "?I a x - ?I a y = ?I y x"
  5817         using True x y by (simp add: algebra_simps integral_combine)
  5818       have fux_int: "((\<lambda>u. f u - f x) has_integral integral {y..x} f - (x - y) *\<^sub>R f x) {y..x}"
  5819         apply (rule has_integral_sub)
  5820         using x y apply (force intro: integrable_integral [OF integrable_subinterval_real [OF f]])
  5821         using has_integral_const_real [of "f x" y x] True
  5822         apply (simp add: )
  5823         done
  5824       have "norm (integral {a..x} f - integral {a..y} f - (x - y) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
  5825         using True
  5826         apply (simp add: abs_eq_content del: content_real_if measure_lborel_Icc)
  5827         apply (rule has_integral_bound_real[where f="(\<lambda>u. f u - f x)"])
  5828         using yx True d x y \<open>e>0\<close> apply (auto simp add: Idiff fux_int)
  5829         done
  5830       then show ?thesis
  5831         by (simp add: algebra_simps norm_minus_commute)
  5832     qed
  5833     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>"
  5834       using \<open>d>0\<close> by blast
  5835   }
  5836   then show ?thesis
  5837     by (simp add: has_vector_derivative_def has_derivative_within_alt bounded_linear_scaleR_left)
  5838 qed
  5839 
  5840 lemma integral_has_vector_derivative:
  5841   fixes f :: "real \<Rightarrow> 'a::banach"
  5842   assumes "continuous_on {a .. b} f"
  5843     and "x \<in> {a .. b}"
  5844   shows "((\<lambda>u. integral {a .. u} f) has_vector_derivative f(x)) (at x within {a .. b})"
  5845 apply (rule integral_has_vector_derivative_continuous_at [OF integrable_continuous_real])
  5846 using assms
  5847 apply (auto simp: continuous_on_eq_continuous_within)
  5848 done
  5849 
  5850 lemma antiderivative_continuous:
  5851   fixes q b :: real
  5852   assumes "continuous_on {a .. b} f"
  5853   obtains g where "\<forall>x\<in>{a .. b}. (g has_vector_derivative (f x::_::banach)) (at x within {a .. b})"
  5854   apply (rule that)
  5855   apply rule
  5856   using integral_has_vector_derivative[OF assms]
  5857   apply auto
  5858   done
  5859 
  5860 
  5861 subsection \<open>Combined fundamental theorem of calculus.\<close>
  5862 
  5863 lemma antiderivative_integral_continuous:
  5864   fixes f :: "real \<Rightarrow> 'a::banach"
  5865   assumes "continuous_on {a .. b} f"
  5866   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}"
  5867 proof -
  5868   from antiderivative_continuous[OF assms] guess g . note g=this
  5869   show ?thesis
  5870     apply (rule that[of g])
  5871     apply safe
  5872   proof goal_cases
  5873     case prems: (1 u v)
  5874     have "\<forall>x\<in>cbox u v. (g has_vector_derivative f x) (at x within cbox u v)"
  5875       apply rule
  5876       apply (rule has_vector_derivative_within_subset)
  5877       apply (rule g[rule_format])
  5878       using prems(1,2)
  5879       apply auto
  5880       done
  5881     then show ?case
  5882       using fundamental_theorem_of_calculus[OF prems(3), of g f] by auto
  5883   qed
  5884 qed
  5885 
  5886 
  5887 subsection \<open>General "twiddling" for interval-to-interval function image.\<close>
  5888 
  5889 lemma has_integral_twiddle:
  5890   assumes "0 < r"
  5891     and "\<forall>x. h(g x) = x"
  5892     and "\<forall>x. g(h x) = x"
  5893     and contg: "\<And>x. continuous (at x) g"
  5894     and "\<forall>u v. \<exists>w z. g ` cbox u v = cbox w z"
  5895     and "\<forall>u v. \<exists>w z. h ` cbox u v = cbox w z"
  5896     and "\<forall>u v. content(g ` cbox u v) = r * content (cbox u v)"
  5897     and "(f has_integral i) (cbox a b)"
  5898   shows "((\<lambda>x. f(g x)) has_integral (1 / r) *\<^sub>R i) (h ` cbox a b)"
  5899 proof -
  5900   show ?thesis when *: "cbox a b \<noteq> {} \<Longrightarrow> ?thesis"
  5901     apply cases
  5902     defer
  5903     apply (rule *)
  5904     apply assumption
  5905   proof goal_cases
  5906     case prems: 1
  5907     then show ?thesis
  5908       unfolding prems assms(8)[unfolded prems has_integral_empty_eq] by auto
  5909   qed
  5910   assume "cbox a b \<noteq> {}"
  5911   from assms(6)[rule_format,of a b] guess w z by (elim exE) note wz=this
  5912   have inj: "inj g" "inj h"
  5913     unfolding inj_on_def
  5914     apply safe
  5915     apply(rule_tac[!] ccontr)
  5916     using assms(2)
  5917     apply(erule_tac x=x in allE)
  5918     using assms(2)
  5919     apply(erule_tac x=y in allE)
  5920     defer
  5921     using assms(3)
  5922     apply (erule_tac x=x in allE)
  5923     using assms(3)
  5924     apply(erule_tac x=y in allE)
  5925     apply auto
  5926     done
  5927   show ?thesis
  5928     unfolding has_integral_def has_integral_compact_interval_def
  5929     apply (subst if_P)
  5930     apply rule
  5931     apply rule
  5932     apply (rule wz)
  5933   proof safe
  5934     fix e :: real
  5935     assume e: "e > 0"
  5936     with assms(1) have "e * r > 0" by simp
  5937     from assms(