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