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