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