diff --git a/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy b/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
--- a/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
+++ b/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
@@ -1,7539 +1,7549 @@
 (*  Author:     John Harrison
     Author:     Robert Himmelmann, TU Muenchen (Translation from HOL light)
                 Huge cleanup by LCP
 *)
 
 section \<open>Henstock-Kurzweil Gauge Integration in Many Dimensions\<close>
 
 theory Henstock_Kurzweil_Integration
 imports
   Lebesgue_Measure Tagged_Division
 begin
 
 lemma norm_diff2: "\<lbrakk>y = y1 + y2; x = x1 + x2; e = e1 + e2; norm(y1 - x1) \<le> e1; norm(y2 - x2) \<le> e2\<rbrakk>
   \<Longrightarrow> norm(y-x) \<le> e"
   by (smt (verit, ccfv_SIG) norm_diff_triangle_ineq)
 
 lemma setcomp_dot1: "{z. P (z \<bullet> (i,0))} = {(x,y). P(x \<bullet> i)}"
   by auto
 
 lemma setcomp_dot2: "{z. P (z \<bullet> (0,i))} = {(x,y). P(y \<bullet> i)}"
   by auto
 
 lemma Sigma_Int_Paircomp1: "(Sigma A B) \<inter> {(x, y). P x} = Sigma (A \<inter> {x. P x}) B"
   by blast
 
 lemma Sigma_Int_Paircomp2: "(Sigma A B) \<inter> {(x, y). P y} = Sigma A (\<lambda>z. B z \<inter> {y. P y})"
   by blast
 (* END MOVE *)
 
 subsection \<open>Content (length, area, volume...) of an interval\<close>
 
 abbreviation content :: "'a::euclidean_space set \<Rightarrow> real"
   where "content s \<equiv> measure lborel s"
 
 lemma content_cbox_cases:
   "content (cbox a b) = (if \<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i then prod (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis else 0)"
   by (simp add: measure_lborel_cbox_eq inner_diff)
 
 lemma content_cbox: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow> content (cbox a b) = (\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   unfolding content_cbox_cases by simp
 
 lemma content_cbox': "cbox a b \<noteq> {} \<Longrightarrow> content (cbox a b) = (\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   by (simp add: box_ne_empty inner_diff)
 
 lemma content_cbox_if: "content (cbox a b) = (if cbox a b = {} then 0 else \<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   by (simp add: content_cbox')
 
 lemma content_cbox_cart:
    "cbox a b \<noteq> {} \<Longrightarrow> content(cbox a b) = prod (\<lambda>i. b$i - a$i) UNIV"
   by (simp add: content_cbox_if Basis_vec_def cart_eq_inner_axis axis_eq_axis prod.UNION_disjoint)
 
 lemma content_cbox_if_cart:
    "content(cbox a b) = (if cbox a b = {} then 0 else prod (\<lambda>i. b$i - a$i) UNIV)"
   by (simp add: content_cbox_cart)
 
 lemma content_division_of:
   assumes "K \<in> \<D>" "\<D> division_of S"
   shows "content K = (\<Prod>i \<in> Basis. interval_upperbound K \<bullet> i - interval_lowerbound K \<bullet> i)"
 proof -
   obtain a b where "K = cbox a b"
     using cbox_division_memE assms by metis
   then show ?thesis
     using assms by (force simp: division_of_def content_cbox')
 qed
 
 lemma content_real: "a \<le> b \<Longrightarrow> content {a..b} = b - a"
   by simp
 
 lemma abs_eq_content: "\<bar>y - x\<bar> = (if x\<le>y then content {x..y} else content {y..x})"
   by (auto simp: content_real)
 
 lemma content_singleton: "content {a} = 0"
   by simp
 
 lemma content_unit[iff]: "content (cbox 0 (One::'a::euclidean_space)) = 1"
   by simp
 
 lemma content_pos_le [iff]: "0 \<le> content X"
   by simp
 
 corollary\<^marker>\<open>tag unimportant\<close> content_nonneg [simp]: "\<not> content (cbox a b) < 0"
   using not_le by blast
 
 lemma content_pos_lt: "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i \<Longrightarrow> 0 < content (cbox a b)"
   by (auto simp: less_imp_le inner_diff box_eq_empty intro!: prod_pos)
 
 lemma content_eq_0: "content (cbox a b) = 0 \<longleftrightarrow> (\<exists>i\<in>Basis. b\<bullet>i \<le> a\<bullet>i)"
   by (auto simp: content_cbox_cases not_le intro: less_imp_le antisym eq_refl)
 
 lemma content_eq_0_interior: "content (cbox a b) = 0 \<longleftrightarrow> interior(cbox a b) = {}"
   unfolding content_eq_0 interior_cbox box_eq_empty by auto
 
 lemma content_pos_lt_eq: "0 < content (cbox a (b::'a::euclidean_space)) \<longleftrightarrow> (\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i)"
   by (auto simp add: content_cbox_cases less_le prod_nonneg)
 
 lemma content_empty [simp]: "content {} = 0"
   by simp
 
 lemma content_real_if [simp]: "content {a..b} = (if a \<le> b then b - a else 0)"
   by (simp add: content_real)
 
 lemma content_subset: "cbox a b \<subseteq> cbox c d \<Longrightarrow> content (cbox a b) \<le> content (cbox c d)"
   unfolding measure_def
   by (intro enn2real_mono emeasure_mono) (auto simp: emeasure_lborel_cbox_eq)
 
 lemma content_lt_nz: "0 < content (cbox a b) \<longleftrightarrow> content (cbox a b) \<noteq> 0"
   by (fact zero_less_measure_iff)
 
 lemma content_Pair: "content (cbox (a,c) (b,d)) = content (cbox a b) * content (cbox c d)"
   unfolding measure_lborel_cbox_eq Basis_prod_def
   apply (subst prod.union_disjoint)
   apply (auto simp: bex_Un ball_Un)
   apply (subst (1 2) prod.reindex_nontrivial)
   apply auto
   done
 
 lemma content_cbox_pair_eq0_D:
    "content (cbox (a,c) (b,d)) = 0 \<Longrightarrow> content (cbox a b) = 0 \<or> content (cbox c d) = 0"
   by (simp add: content_Pair)
 
 lemma content_cbox_plus:
   fixes x :: "'a::euclidean_space"
   shows "content(cbox x (x + h *\<^sub>R One)) = (if h \<ge> 0 then h ^ DIM('a) else 0)"
   by (simp add: algebra_simps content_cbox_if box_eq_empty)
 
 lemma content_0_subset: "content(cbox a b) = 0 \<Longrightarrow> s \<subseteq> cbox a b \<Longrightarrow> content s = 0"
   using emeasure_mono[of s "cbox a b" lborel]
   by (auto simp: measure_def enn2real_eq_0_iff emeasure_lborel_cbox_eq)
 
 lemma content_ball_pos:
   assumes "r > 0"
   shows   "content (ball c r) > 0"
 proof -
   from rational_boxes[OF assms, of c] obtain a b where ab: "c \<in> box a b" "box a b \<subseteq> ball c r"
     by auto
   then have "0 < content (box a b)"
     by (subst measure_lborel_box_eq) (auto intro!: prod_pos simp: algebra_simps box_def)
   have "emeasure lborel (box a b) \<le> emeasure lborel (ball c r)"
     using ab by (intro emeasure_mono) auto
   then show ?thesis
     using \<open>content (box a b) > 0\<close>
     by (smt (verit, best) Sigma_Algebra.measure_def emeasure_lborel_ball_finite enn2real_mono infinity_ennreal_def)
 qed
 
 lemma content_cball_pos:
   assumes "r > 0"
   shows   "content (cball c r) > 0"
 proof -
   from rational_boxes[OF assms, of c] obtain a b where ab: "c \<in> box a b" "box a b \<subseteq> ball c r"
     by auto
   then have "0 < content (box a b)"
     by (subst measure_lborel_box_eq) (auto intro!: prod_pos simp: algebra_simps box_def)
   have "emeasure lborel (box a b) \<le> emeasure lborel (cball c r)"
     using ab by (intro emeasure_mono) auto
   also have "emeasure lborel (box a b) = ennreal (content (box a b))"
     using emeasure_lborel_box_finite[of a b] by (intro emeasure_eq_ennreal_measure) auto
   also have "emeasure lborel (cball c r) = ennreal (content (cball c r))"
     using emeasure_lborel_cball_finite[of c r] by (intro emeasure_eq_ennreal_measure) auto
   finally show ?thesis
     using \<open>content (box a b) > 0\<close> by simp
 qed
 
 lemma content_split:
   fixes a :: "'a::euclidean_space"
   assumes "k \<in> Basis"
   shows "content (cbox a b) = content(cbox a b \<inter> {x. x\<bullet>k \<le> c}) + content(cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
   \<comment> \<open>Prove using measure theory\<close>
 proof (cases "\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i")
   case True
   have 1: "\<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))"
     by (simp add: if_distrib prod.delta_remove assms)
   note simps = interval_split[OF assms] content_cbox_cases
   have 2: "(\<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)"
     by (metis (no_types, lifting) assms finite_Basis mult.commute prod.remove)
   have "\<And>x. min (b \<bullet> k) c = max (a \<bullet> k) c \<Longrightarrow>
     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)"
     by  (auto simp add: field_simps)
   moreover
   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)) =
       (\<Prod>i\<in>Basis. (if i = k then min (b \<bullet> k) c else b \<bullet> i) - a \<bullet> i)"
     "(\<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)) =
       (\<Prod>i\<in>Basis. b \<bullet> i - (if i = k then max (a \<bullet> k) c else a \<bullet> i))"
     by (auto intro!: prod.cong)
   have "\<not> a \<bullet> k \<le> c \<Longrightarrow> \<not> c \<le> b \<bullet> k \<Longrightarrow> False"
     unfolding not_le using True assms by auto
   ultimately show ?thesis
     using assms unfolding simps ** 1[of "\<lambda>i x. b\<bullet>i - x"] 1[of "\<lambda>i x. x - a\<bullet>i"] 2
     by auto
 next
   case False
   then have "cbox a b = {}"
     unfolding box_eq_empty by (auto simp: not_le)
   then show ?thesis
     by (auto simp: not_le)
 qed
 
 lemma division_of_content_0:
   assumes "content (cbox a b) = 0" "d division_of (cbox a b)" "K \<in> d"
   shows "content K = 0"
   unfolding forall_in_division[OF assms(2)]
   by (meson assms content_0_subset division_of_def)
 
 lemma sum_content_null:
   assumes "content (cbox a b) = 0"
     and "p tagged_division_of (cbox a b)"
   shows "(\<Sum>(x,K)\<in>p. content K *\<^sub>R f x) = (0::'a::real_normed_vector)"
 proof (intro sum.neutral strip)
   fix y
   assume y: "y \<in> p"
   obtain x K where xk: "y = (x, K)"
     using surj_pair[of y] by blast
   then obtain c d where k: "K = cbox c d" "K \<subseteq> cbox a b"
     by (metis assms(2) tagged_division_ofD(3) tagged_division_ofD(4) y)
   have "(\<lambda>(x',K'). content K' *\<^sub>R f x') y = content K *\<^sub>R f x"
     unfolding xk by auto
   also have "\<dots> = 0"
     using assms(1) content_0_subset k(2) by auto
   finally show "(\<lambda>(x, k). content k *\<^sub>R f x) y = 0" .
 qed
 
 global_interpretation sum_content: operative plus 0 content
   rewrites "comm_monoid_set.F plus 0 = sum"
 proof -
   interpret operative plus 0 content
     by standard (auto simp add: content_split [symmetric] content_eq_0_interior)
   show "operative plus 0 content"
     by standard
   show "comm_monoid_set.F plus 0 = sum"
     by (simp add: sum_def)
 qed
 
 lemma additive_content_division: "d division_of (cbox a b) \<Longrightarrow> sum content d = content (cbox a b)"
   by (fact sum_content.division)
 
 lemma additive_content_tagged_division:
   "d tagged_division_of (cbox a b) \<Longrightarrow> sum (\<lambda>(x,l). content l) d = content (cbox a b)"
   by (fact sum_content.tagged_division)
 
 lemma subadditive_content_division:
   assumes "\<D> division_of S" "S \<subseteq> cbox a b"
   shows "sum content \<D> \<le> content(cbox a b)"
 proof -
   have "\<D> division_of \<Union>\<D>" "\<Union>\<D> \<subseteq> cbox a b"
     using assms by auto
   then obtain \<D>' where "\<D> \<subseteq> \<D>'" "\<D>' division_of cbox a b"
     using partial_division_extend_interval by metis
   then have "sum content \<D> \<le> sum content \<D>'"
     using sum_mono2 by blast
   also have "... \<le> content(cbox a b)"
     by (simp add: \<open>\<D>' division_of cbox a b\<close> additive_content_division less_eq_real_def)
   finally show ?thesis .
 qed
 
 lemma content_real_eq_0: "content {a..b::real} = 0 \<longleftrightarrow> a \<ge> b"
   by simp
 
 lemma property_empty_interval: "\<forall>a b. content (cbox a b) = 0 \<longrightarrow> P (cbox a b) \<Longrightarrow> P {}"
   using content_empty unfolding empty_as_interval by auto
 
 lemma interval_bounds_nz_content [simp]:
   assumes "content (cbox a b) \<noteq> 0"
   shows "interval_upperbound (cbox a b) = b"
     and "interval_lowerbound (cbox a b) = a"
   by (metis assms content_empty interval_bounds')+
 
 subsection \<open>Gauge integral\<close>
 
 text \<open>Case distinction to define it first on compact intervals first, then use a limit. This is only
 much later unified. In Fremlin: Measure Theory, Volume 4I this is generalized using residual sets.\<close>
 
 definition has_integral :: "('n::euclidean_space \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'b \<Rightarrow> 'n set \<Rightarrow> bool"
   (infixr "has'_integral" 46)
   where "(f has_integral I) s \<longleftrightarrow>
     (if \<exists>a b. s = cbox a b
       then ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R f x) \<longlongrightarrow> I) (division_filter s)
       else (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
         (\<exists>z. ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R (if x \<in> s then f x else 0)) \<longlongrightarrow> z) (division_filter (cbox a b)) \<and>
           norm (z - I) < e)))"
 
 lemma has_integral_cbox:
   "(f has_integral I) (cbox a b) \<longleftrightarrow> ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R f x) \<longlongrightarrow> I) (division_filter (cbox a b))"
   by (auto simp add: has_integral_def)
 
 lemma has_integral:
   "(f has_integral y) (cbox a b) \<longleftrightarrow>
     (\<forall>e>0. \<exists>\<gamma>. gauge \<gamma> \<and>
       (\<forall>\<D>. \<D> tagged_division_of (cbox a b) \<and> \<gamma> fine \<D> \<longrightarrow>
         norm (sum (\<lambda>(x,k). content(k) *\<^sub>R f x) \<D> - y) < e))"
   by (auto simp: dist_norm eventually_division_filter has_integral_def tendsto_iff)
 
 lemma has_integral_real:
   "(f has_integral y) {a..b::real} \<longleftrightarrow>
     (\<forall>e>0. \<exists>\<gamma>. gauge \<gamma> \<and>
       (\<forall>\<D>. \<D> tagged_division_of {a..b} \<and> \<gamma> fine \<D> \<longrightarrow>
         norm (sum (\<lambda>(x,k). content(k) *\<^sub>R f x) \<D> - y) < e))"
   unfolding box_real[symmetric] by (rule has_integral)
 
 lemma has_integralD[dest]:
   assumes "(f has_integral y) (cbox a b)"
     and "e > 0"
   obtains \<gamma>
     where "gauge \<gamma>"
       and "\<And>\<D>. \<D> tagged_division_of (cbox a b) \<Longrightarrow> \<gamma> fine \<D> \<Longrightarrow>
         norm ((\<Sum>(x,k)\<in>\<D>. content k *\<^sub>R f x) - y) < e"
   using assms unfolding has_integral by auto
 
 lemma has_integral_alt:
   "(f has_integral y) i \<longleftrightarrow>
     (if \<exists>a b. i = cbox a b
      then (f has_integral y) i
      else (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       (\<exists>z. ((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b) \<and> norm (z - y) < e)))"
   by (subst has_integral_def) (auto simp add: has_integral_cbox)
 
 lemma has_integral_altD:
   assumes "(f has_integral y) i"
     and "\<not> (\<exists>a b. i = cbox a b)"
     and "e>0"
   obtains B where "B > 0"
     and "\<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       (\<exists>z. ((\<lambda>x. if x \<in> i then f(x) else 0) has_integral z) (cbox a b) \<and> norm(z - y) < e)"
   using assms has_integral_alt[of f y i] by auto
 
 definition integrable_on (infixr "integrable'_on" 46)
   where "f integrable_on i \<longleftrightarrow> (\<exists>y. (f has_integral y) i)"
 
 definition "integral i f = (SOME y. (f has_integral y) i \<or> \<not> f integrable_on i \<and> y=0)"
 
 lemma integrable_integral[intro]: "f integrable_on i \<Longrightarrow> (f has_integral (integral i f)) i"
   unfolding integrable_on_def integral_def by (metis (mono_tags, lifting))
 
 lemma not_integrable_integral: "\<not> f integrable_on i \<Longrightarrow> integral i f = 0"
   unfolding integrable_on_def integral_def by blast
 
 lemma has_integral_integrable[dest]: "(f has_integral i) s \<Longrightarrow> f integrable_on s"
   unfolding integrable_on_def by auto
 
 lemma has_integral_integral: "f integrable_on s \<longleftrightarrow> (f has_integral (integral s f)) s"
   by auto
 
 subsection \<open>Basic theorems about integrals\<close>
 
 lemma has_integral_eq_rhs: "(f has_integral j) S \<Longrightarrow> i = j \<Longrightarrow> (f has_integral i) S"
   by (rule forw_subst)
 
 lemma has_integral_unique_cbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   shows "(f has_integral k1) (cbox a b) \<Longrightarrow> (f has_integral k2) (cbox a b) \<Longrightarrow> k1 = k2"
   by (meson division_filter_not_empty has_integral_cbox tendsto_unique)
 
 lemma has_integral_unique:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "(f has_integral k1) i" "(f has_integral k2) i"
   shows "k1 = k2"
 proof (rule ccontr)
   let ?e = "norm (k1 - k2)/2"
   let ?F = "(\<lambda>x. if x \<in> i then f x else 0)"
   assume "k1 \<noteq> k2"
   then have e: "?e > 0"
     by auto
   have nonbox: "\<not> (\<exists>a b. i = cbox a b)"
     using \<open>k1 \<noteq> k2\<close> assms has_integral_unique_cbox by blast
   obtain B1 where B1:
       "0 < B1"
       "\<And>a b. ball 0 B1 \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?F has_integral z) (cbox a b) \<and> norm (z - k1) < norm (k1 - k2)/2"
     by (rule has_integral_altD[OF assms(1) nonbox,OF e]) blast
   obtain B2 where B2:
       "0 < B2"
       "\<And>a b. ball 0 B2 \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?F has_integral z) (cbox a b) \<and> norm (z - k2) < norm (k1 - k2)/2"
     by (rule has_integral_altD[OF assms(2) nonbox,OF e]) blast
   obtain a b :: 'n where ab: "ball 0 B1 \<subseteq> cbox a b" "ball 0 B2 \<subseteq> cbox a b"
     by (metis Un_subset_iff bounded_Un bounded_ball bounded_subset_cbox_symmetric)
   obtain w where w: "(?F has_integral w) (cbox a b)" "norm (w - k1) < norm (k1 - k2)/2"
     using B1(2)[OF ab(1)] by blast
   obtain z where z: "(?F has_integral z) (cbox a b)" "norm (z - k2) < norm (k1 - k2)/2"
     using B2(2)[OF ab(2)] by blast
   have "z = w"
     using has_integral_unique_cbox[OF w(1) z(1)] by auto
   then have "norm (k1 - k2) \<le> norm (z - k2) + norm (w - k1)"
     using norm_triangle_ineq4 [of "k1 - w" "k2 - z"]
     by (auto simp add: norm_minus_commute)
   also have "\<dots> < norm (k1 - k2)/2 + norm (k1 - k2)/2"
     by (metis add_strict_mono z(2) w(2))
   finally show False by auto
 qed
 
 lemma integral_unique [intro]: "(f has_integral y) k \<Longrightarrow> integral k f = y"
   unfolding integral_def
   by (rule some_equality) (auto intro: has_integral_unique)
 
 lemma has_integral_iff: "(f has_integral i) S \<longleftrightarrow> (f integrable_on S \<and> integral S f = i)"
   by blast
 
 lemma eq_integralD: "integral k f = y \<Longrightarrow> (f has_integral y) k \<or> \<not> f integrable_on k \<and> y=0"
   unfolding integral_def integrable_on_def
   by (metis (mono_tags, lifting))
 
 lemma has_integral_const [intro]:
   fixes a b :: "'a::euclidean_space"
   shows "((\<lambda>x. c) has_integral (content (cbox a b) *\<^sub>R c)) (cbox a b)"
   using eventually_division_filter_tagged_division[of "cbox a b"]
      additive_content_tagged_division[of _ a b]
   by (auto simp: has_integral_cbox split_beta' scaleR_sum_left[symmetric]
            elim!: eventually_mono intro!: tendsto_cong[THEN iffD1, OF _ tendsto_const])
 
 lemma has_integral_const_real [intro]:
   fixes a b :: real
   shows "((\<lambda>x. c) has_integral (content {a..b} *\<^sub>R c)) {a..b}"
   by (metis box_real(2) has_integral_const)
 
 lemma has_integral_integrable_integral: "(f has_integral i) s \<longleftrightarrow> f integrable_on s \<and> integral s f = i"
   by blast
 
 lemma integral_const [simp]:
   fixes a b :: "'a::euclidean_space"
   shows "integral (cbox a b) (\<lambda>x. c) = content (cbox a b) *\<^sub>R c"
   by blast
 
 lemma integral_const_real [simp]:
   fixes a b :: real
   shows "integral {a..b} (\<lambda>x. c) = content {a..b} *\<^sub>R c"
   by blast
 
 lemma has_integral_is_0_cbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "\<And>x. x \<in> cbox a b \<Longrightarrow> f x = 0"
   shows "(f has_integral 0) (cbox a b)"
     unfolding has_integral_cbox
     using eventually_division_filter_tagged_division[of "cbox a b"] assms
     by (subst tendsto_cong[where g="\<lambda>_. 0"])
        (auto elim!: eventually_mono intro!: sum.neutral simp: tag_in_interval)
 
 lemma has_integral_is_0:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x = 0"
   shows "(f has_integral 0) S"
 proof (cases "(\<exists>a b. S = cbox a b)")
   case True with assms has_integral_is_0_cbox show ?thesis
     by blast
 next
   case False
   have *: "(\<lambda>x. if x \<in> S then f x else 0) = (\<lambda>x. 0)"
     by (auto simp add: assms)
   show ?thesis
     using has_integral_is_0_cbox False
     by (subst has_integral_alt) (force simp add: *)
 qed
 
 lemma has_integral_0[simp]: "((\<lambda>x::'n::euclidean_space. 0) has_integral 0) S"
   by (rule has_integral_is_0) auto
 
 lemma has_integral_0_eq[simp]: "((\<lambda>x. 0) has_integral i) S \<longleftrightarrow> i = 0"
   using has_integral_unique[OF has_integral_0] by auto
 
 lemma has_integral_linear_cbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes f: "(f has_integral y) (cbox a b)"
     and h: "bounded_linear h"
   shows "((h \<circ> f) has_integral (h y)) (cbox a b)"
 proof -
   interpret bounded_linear h using h .
   show ?thesis
     unfolding has_integral_cbox using tendsto [OF f [unfolded has_integral_cbox]]
     by (simp add: sum scaleR split_beta')
 qed
 
 lemma has_integral_linear:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes f: "(f has_integral y) S"
     and h: "bounded_linear h"
   shows "((h \<circ> f) has_integral (h y)) S"
 proof (cases "(\<exists>a b. S = cbox a b)")
   case True with f h has_integral_linear_cbox show ?thesis 
     by blast
 next
   case False
   interpret bounded_linear h using h .
   from pos_bounded obtain B where B: "0 < B" "\<And>x. norm (h x) \<le> norm x * B"
     by blast
   let ?S = "\<lambda>f x. if x \<in> S then f x else 0"
   show ?thesis
   proof (subst has_integral_alt, clarsimp simp: False)
     fix e :: real
     assume e: "e > 0"
     have *: "0 < e/B" using e B(1) by simp
     obtain M where M:
       "M > 0"
       "\<And>a b. ball 0 M \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?S f has_integral z) (cbox a b) \<and> norm (z - y) < e/B"
       using has_integral_altD[OF f False *] by blast
     show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       (\<exists>z. (?S(h \<circ> f) has_integral z) (cbox a b) \<and> norm (z - h y) < e)"
     proof (rule exI, intro allI conjI impI)
       show "M > 0" using M by metis
     next
       fix a b::'n
       assume sb: "ball 0 M \<subseteq> cbox a b"
       obtain z where z: "(?S f has_integral z) (cbox a b)" "norm (z - y) < e/B"
         using M(2)[OF sb] by blast
       have *: "?S(h \<circ> f) = h \<circ> ?S f"
         using zero by auto
       show "\<exists>z. (?S(h \<circ> f) has_integral z) (cbox a b) \<and> norm (z - h y) < e"
       proof (intro exI conjI)
         show "(?S(h \<circ> f) has_integral h z) (cbox a b)"
           by (simp add: * has_integral_linear_cbox[OF z(1) h])
         show "norm (h z - h y) < e"
           by (metis B diff le_less_trans pos_less_divide_eq z(2))
       qed
     qed
   qed
 qed
 
 lemma has_integral_scaleR_left:
   "(f has_integral y) S \<Longrightarrow> ((\<lambda>x. f x *\<^sub>R c) has_integral (y *\<^sub>R c)) S"
   using has_integral_linear[OF _ bounded_linear_scaleR_left] by (simp add: comp_def)
 
 lemma integrable_on_scaleR_left:
   assumes "f integrable_on A"
   shows "(\<lambda>x. f x *\<^sub>R y) integrable_on A"
   using assms has_integral_scaleR_left unfolding integrable_on_def by blast
 
 lemma has_integral_mult_left:
   fixes c :: "_ :: real_normed_algebra"
   shows "(f has_integral y) S \<Longrightarrow> ((\<lambda>x. f x * c) has_integral (y * c)) S"
   using has_integral_linear[OF _ bounded_linear_mult_left] by (simp add: comp_def)
 
 lemma integrable_on_mult_left:
   fixes c :: "'a :: real_normed_algebra"
   assumes "f integrable_on A"
   shows   "(\<lambda>x. f x * c) integrable_on A"
   using assms has_integral_mult_left by blast
 
 lemma has_integral_divide:
   fixes c :: "_ :: real_normed_div_algebra"
   shows "(f has_integral y) S \<Longrightarrow> ((\<lambda>x. f x / c) has_integral (y / c)) S"
   unfolding divide_inverse by (simp add: has_integral_mult_left)
 
 lemma integrable_on_divide:
   fixes c :: "'a :: real_normed_div_algebra"
   assumes "f integrable_on A"
   shows   "(\<lambda>x. f x / c) integrable_on A"
   using assms has_integral_divide by blast
 
 text\<open>The case analysis eliminates the condition \<^term>\<open>f integrable_on S\<close> at the cost
      of the type class constraint \<open>division_ring\<close>\<close>
 corollary integral_mult_left [simp]:
   fixes c:: "'a::{real_normed_algebra,division_ring}"
   shows "integral S (\<lambda>x. f x * c) = integral S f * c"
 proof (cases "f integrable_on S \<or> c = 0")
   case True then show ?thesis
     by (force intro: has_integral_mult_left)
 next
   case False then have "\<not> (\<lambda>x. f x * c) integrable_on S"
     using has_integral_mult_left [of "(\<lambda>x. f x * c)" _ S "inverse c"]
     by (auto simp add: mult.assoc)
   with False show ?thesis by (simp add: not_integrable_integral)
 qed
 
 corollary integral_mult_right [simp]:
   fixes c:: "'a::{real_normed_field}"
   shows "integral S (\<lambda>x. c * f x) = c * integral S f"
 by (simp add: mult.commute [of c])
 
 corollary integral_divide [simp]:
   fixes z :: "'a::real_normed_field"
   shows "integral S (\<lambda>x. f x / z) = integral S (\<lambda>x. f x) / z"
 using integral_mult_left [of S f "inverse z"]
   by (simp add: divide_inverse_commute)
 
 lemma has_integral_mult_right:
   fixes c :: "'a :: real_normed_algebra"
   shows "(f has_integral y) A \<Longrightarrow> ((\<lambda>x. c * f x) has_integral (c * y)) A"
   using has_integral_linear[OF _ bounded_linear_mult_right] by (simp add: comp_def)
 
 lemma integrable_on_mult_right:
   fixes c :: "'a :: real_normed_algebra"
   assumes "f integrable_on A"
   shows   "(\<lambda>x. c * f x) integrable_on A"
   using assms has_integral_mult_right by blast
 
 lemma integrable_on_mult_right_iff [simp]:
   fixes c :: "'a :: real_normed_field"
   assumes "c \<noteq> 0"
   shows   "(\<lambda>x. c * f x) integrable_on A \<longleftrightarrow> f integrable_on A"
     using integrable_on_mult_right[of f A c]
           integrable_on_mult_right[of "\<lambda>x. c * f x" A "inverse c"] assms
     by (auto simp: field_simps)
 
 lemma integrable_on_mult_left_iff [simp]:
   fixes c :: "'a :: real_normed_field"
   assumes "c \<noteq> 0"
   shows   "(\<lambda>x. f x * c) integrable_on A \<longleftrightarrow> f integrable_on A"
   using integrable_on_mult_right_iff[OF assms, of f A] by (simp add: mult.commute)
 
 lemma integrable_on_div_iff [simp]:
   fixes c :: "'a :: real_normed_field"
   assumes "c \<noteq> 0"
   shows   "(\<lambda>x. f x / c) integrable_on A \<longleftrightarrow> f integrable_on A"
   using integrable_on_mult_right_iff[of "inverse c" f A] assms by (simp add: field_simps)
 
 lemma has_integral_cmul: "(f has_integral k) S \<Longrightarrow> ((\<lambda>x. c *\<^sub>R f x) has_integral (c *\<^sub>R k)) S"
   unfolding o_def[symmetric]
   by (metis has_integral_linear bounded_linear_scaleR_right)
 
 lemma has_integral_cmult_real:
   fixes c :: real
   assumes "c \<noteq> 0 \<Longrightarrow> (f has_integral x) A"
   shows "((\<lambda>x. c * f x) has_integral c * x) A"
   by (metis assms has_integral_is_0 has_integral_mult_right lambda_zero)
 
 lemma has_integral_neg: "(f has_integral k) S \<Longrightarrow> ((\<lambda>x. -(f x)) has_integral -k) S"
   by (drule_tac c="-1" in has_integral_cmul) auto
 
 lemma has_integral_neg_iff: "((\<lambda>x. - f x) has_integral k) S \<longleftrightarrow> (f has_integral - k) S"
   using has_integral_neg[of f "- k"] has_integral_neg[of "\<lambda>x. - f x" k] by auto
 
 lemma has_integral_add_cbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "(f has_integral k) (cbox a b)" "(g has_integral l) (cbox a b)"
   shows "((\<lambda>x. f x + g x) has_integral (k + l)) (cbox a b)"
   using assms
     unfolding has_integral_cbox
     by (simp add: split_beta' scaleR_add_right sum.distrib[abs_def] tendsto_add)
 
 lemma has_integral_add:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes f: "(f has_integral k) S" and g: "(g has_integral l) S"
   shows "((\<lambda>x. f x + g x) has_integral (k + l)) S"
 proof (cases "\<exists>a b. S = cbox a b")
   case True with has_integral_add_cbox assms show ?thesis
     by blast 
 next
   let ?S = "\<lambda>f x. if x \<in> S then f x else 0"
   case False
   then show ?thesis
   proof (subst has_integral_alt, clarsimp, goal_cases)
     case (1 e)
     then have e2: "e/2 > 0"
       by auto
     obtain Bf where "0 < Bf"
       and Bf: "\<And>a b. ball 0 Bf \<subseteq> cbox a b \<Longrightarrow>
                      \<exists>z. (?S f has_integral z) (cbox a b) \<and> norm (z - k) < e/2"
       using has_integral_altD[OF f False e2] by blast
     obtain Bg where "0 < Bg"
       and Bg: "\<And>a b. ball 0 Bg \<subseteq> (cbox a b) \<Longrightarrow>
                      \<exists>z. (?S g has_integral z) (cbox a b) \<and> norm (z - l) < e/2"
       using has_integral_altD[OF g False e2] by blast
     show ?case
     proof (rule_tac x="max Bf Bg" in exI, clarsimp simp add: max.strict_coboundedI1 \<open>0 < Bf\<close>)
       fix a b
       assume "ball 0 (max Bf Bg) \<subseteq> cbox a (b::'n)"
       then have fs: "ball 0 Bf \<subseteq> cbox a (b::'n)" and gs: "ball 0 Bg \<subseteq> cbox a (b::'n)"
         by auto
       obtain w where w: "(?S f has_integral w) (cbox a b)" "norm (w - k) < e/2"
         using Bf[OF fs] by blast
       obtain z where z: "(?S g has_integral z) (cbox a b)" "norm (z - l) < e/2"
         using Bg[OF gs] by blast
       have *: "\<And>x. (if x \<in> S then f x + g x else 0) = (?S f x) + (?S g x)"
         by auto
       show "\<exists>z. (?S(\<lambda>x. f x + g x) has_integral z) (cbox a b) \<and> norm (z - (k + l)) < e"
       proof (intro exI conjI)
         show "(?S(\<lambda>x. f x + g x) has_integral (w + z)) (cbox a b)"
           by (simp add: has_integral_add_cbox[OF w(1) z(1), unfolded *[symmetric]])
         show "norm (w + z - (k + l)) < e"
           by (metis dist_norm dist_triangle_add_half w(2) z(2))
       qed
     qed
   qed
 qed
 
 lemma has_integral_diff:
   "(f has_integral k) S \<Longrightarrow> (g has_integral l) S \<Longrightarrow>
     ((\<lambda>x. f x - g x) has_integral (k - l)) S"
   using has_integral_add[OF _ has_integral_neg, of f k S g l]
   by (auto simp: algebra_simps)
 
 lemma integral_0 [simp]:
   "integral S (\<lambda>x::'n::euclidean_space. 0::'m::real_normed_vector) = 0"
   by auto
 
 lemma integral_add: "f integrable_on S \<Longrightarrow> g integrable_on S \<Longrightarrow>
     integral S (\<lambda>x. f x + g x) = integral S f + integral S g"
   by (rule integral_unique) (metis integrable_integral has_integral_add)
 
 lemma integral_cmul [simp]: "integral S (\<lambda>x. c *\<^sub>R f x) = c *\<^sub>R integral S f"
 proof (cases "f integrable_on S \<or> c = 0")
   case True with has_integral_cmul integrable_integral show ?thesis
     by fastforce
 next
   case False then have "\<not> (\<lambda>x. c *\<^sub>R f x) integrable_on S"
     using has_integral_cmul [of "(\<lambda>x. c *\<^sub>R f x)" _ S "inverse c"] by auto
   with False show ?thesis by (simp add: not_integrable_integral)
 qed
 
 lemma integral_mult:
   fixes K::real
   shows "f integrable_on X \<Longrightarrow> K * integral X f = integral X (\<lambda>x. K * f x)"
   by simp
 
 lemma integral_neg [simp]: "integral S (\<lambda>x. - f x) = - integral S f"
   by (metis eq_integralD equation_minus_iff has_integral_iff has_integral_neg_iff neg_equal_0_iff_equal)
 
 lemma integral_diff: "f integrable_on S \<Longrightarrow> g integrable_on S \<Longrightarrow>
     integral S (\<lambda>x. f x - g x) = integral S f - integral S g"
   by (rule integral_unique) (metis integrable_integral has_integral_diff)
 
 lemma integrable_0: "(\<lambda>x. 0) integrable_on S"
   unfolding integrable_on_def using has_integral_0 by auto
 
 lemma integrable_add: "f integrable_on S \<Longrightarrow> g integrable_on S \<Longrightarrow> (\<lambda>x. f x + g x) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_add)
 
 lemma integrable_cmul: "f integrable_on S \<Longrightarrow> (\<lambda>x. c *\<^sub>R f(x)) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_cmul)
 
 lemma integrable_on_scaleR_iff [simp]:
   fixes c :: real
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. c *\<^sub>R f x) integrable_on S \<longleftrightarrow> f integrable_on S"
   using integrable_cmul[of "\<lambda>x. c *\<^sub>R f x" S "1 / c"] integrable_cmul[of f S c] \<open>c \<noteq> 0\<close>
   by auto
 
 lemma integrable_on_cmult_iff [simp]:
   fixes c :: real
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. c * f x) integrable_on S \<longleftrightarrow> f integrable_on S"
   using integrable_on_scaleR_iff [of c f] assms by simp
 
 lemma integrable_on_cmult_left:
   assumes "f integrable_on S"
   shows "(\<lambda>x. of_real c * f x) integrable_on S"
     using integrable_cmul[of f S "of_real c"] assms
     by (simp add: scaleR_conv_of_real)
 
 lemma integrable_neg: "f integrable_on S \<Longrightarrow> (\<lambda>x. -f(x)) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_neg)
 
 lemma integrable_neg_iff: "(\<lambda>x. -f(x)) integrable_on S \<longleftrightarrow> f integrable_on S"
   using integrable_neg by fastforce
 
 lemma integrable_diff:
   "f integrable_on S \<Longrightarrow> g integrable_on S \<Longrightarrow> (\<lambda>x. f x - g x) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_diff)
 
 lemma integrable_linear:
   "f integrable_on S \<Longrightarrow> bounded_linear h \<Longrightarrow> (h \<circ> f) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_linear)
 
 lemma integral_linear:
   "f integrable_on S \<Longrightarrow> bounded_linear h \<Longrightarrow> integral S (h \<circ> f) = h (integral S f)"
   by (meson has_integral_iff has_integral_linear)
 
 lemma integrable_on_cnj_iff:
   "(\<lambda>x. cnj (f x)) integrable_on A \<longleftrightarrow> f integrable_on A"
   using integrable_linear[OF _ bounded_linear_cnj, of f A]
         integrable_linear[OF _ bounded_linear_cnj, of "cnj \<circ> f" A]
   by (auto simp: o_def)
 
 lemma integral_cnj: "cnj (integral A f) = integral A (\<lambda>x. cnj (f x))"
   by (cases "f integrable_on A")
      (simp_all add: integral_linear[OF _ bounded_linear_cnj, symmetric]
                     o_def integrable_on_cnj_iff not_integrable_integral)
 
+lemma has_integral_cnj: "(cnj \<circ> f has_integral (cnj I)) A  = (f has_integral I) A"
+  unfolding has_integral_iff comp_def
+  by (metis integral_cnj complex_cnj_cancel_iff integrable_on_cnj_iff)
+
 lemma integral_component_eq[simp]:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes "f integrable_on S"
   shows "integral S (\<lambda>x. f x \<bullet> k) = integral S f \<bullet> k"
   unfolding integral_linear[OF assms(1) bounded_linear_inner_left,unfolded o_def] ..
 
 lemma has_integral_sum:
   assumes "finite T"
     and "\<And>a. a \<in> T \<Longrightarrow> ((f a) has_integral (i a)) S"
   shows "((\<lambda>x. sum (\<lambda>a. f a x) T) has_integral (sum i T)) S"
   using \<open>finite T\<close> subset_refl[of T]
   by (induct rule: finite_subset_induct) (use assms in \<open>auto simp: has_integral_add\<close>)
 
 lemma integral_sum:
   "\<lbrakk>finite I;  \<And>a. a \<in> I \<Longrightarrow> f a integrable_on S\<rbrakk> \<Longrightarrow>
    integral S (\<lambda>x. \<Sum>a\<in>I. f a x) = (\<Sum>a\<in>I. integral S (f a))"
   by (simp add: has_integral_sum integrable_integral integral_unique)
 
 lemma integrable_sum:
   "\<lbrakk>finite I;  \<And>a. a \<in> I \<Longrightarrow> f a integrable_on S\<rbrakk> \<Longrightarrow> (\<lambda>x. \<Sum>a\<in>I. f a x) integrable_on S"
   unfolding integrable_on_def using has_integral_sum[of I] by metis
 
 lemma has_integral_eq:
   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
     and f: "(f has_integral k) s"
   shows "(g has_integral k) s"
   using has_integral_diff[OF f, of "\<lambda>x. f x - g x" 0]
   using has_integral_is_0[of s "\<lambda>x. f x - g x"]
   using assms
   by auto
 
 lemma integrable_eq: "\<lbrakk>f integrable_on s; \<And>x. x \<in> s \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> g integrable_on s"
   unfolding integrable_on_def
   using has_integral_eq[of s f g] has_integral_eq by blast
 
 lemma has_integral_cong:
   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
   shows "(f has_integral i) s = (g has_integral i) s"
   by (metis assms has_integral_eq)
 
 lemma integrable_cong:
   assumes "\<And>x. x \<in> A \<Longrightarrow> f x = g x"
   shows   "f integrable_on A \<longleftrightarrow> g integrable_on A"
   using has_integral_cong [OF assms] by fast
 
 lemma integral_cong:
   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
   shows "integral s f = integral s g"
   unfolding integral_def
 by (metis (full_types, opaque_lifting) assms has_integral_cong integrable_eq)
 
 lemma integrable_on_cmult_left_iff [simp]:
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. of_real c * f x) integrable_on s \<longleftrightarrow> f integrable_on s"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "(\<lambda>x. of_real (1 / c) * (of_real c * f x)) integrable_on s"
     using integrable_cmul[of "\<lambda>x. of_real c * f x" s "1 / of_real c"]
     by (simp add: scaleR_conv_of_real)
   then have "(\<lambda>x. (of_real (1 / c) * of_real c * f x)) integrable_on s"
     by (simp add: algebra_simps)
   with \<open>c \<noteq> 0\<close> show ?rhs
     by (metis (no_types, lifting) integrable_eq mult.left_neutral nonzero_divide_eq_eq of_real_1 of_real_mult)
 qed (blast intro: integrable_on_cmult_left)
 
 lemma integrable_on_cmult_right:
   fixes f :: "_ \<Rightarrow> 'b :: {comm_ring,real_algebra_1,real_normed_vector}"
   assumes "f integrable_on s"
   shows "(\<lambda>x. f x * of_real c) integrable_on s"
   using integrable_on_cmult_left [OF assms] by (simp add: mult.commute)
 
 lemma integrable_on_cmult_right_iff [simp]:
   fixes f :: "_ \<Rightarrow> 'b :: {comm_ring,real_algebra_1,real_normed_vector}"
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. f x * of_real c) integrable_on s \<longleftrightarrow> f integrable_on s"
   using integrable_on_cmult_left_iff [OF assms] by (simp add: mult.commute)
 
 lemma integrable_on_cdivide_iff [simp]:
   fixes f :: "_ \<Rightarrow> 'b :: real_normed_field"
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. f x / of_real c) integrable_on s \<longleftrightarrow> f integrable_on s"
   by (simp add: divide_inverse assms flip: of_real_inverse)
 
 lemma has_integral_null [intro]: "content(cbox a b) = 0 \<Longrightarrow> (f has_integral 0) (cbox a b)"
   unfolding has_integral_cbox
   using eventually_division_filter_tagged_division[of "cbox a b"]
   by (subst tendsto_cong[where g="\<lambda>_. 0"]) (auto elim: eventually_mono intro: sum_content_null)
 
 lemma has_integral_null_real [intro]: "content {a..b::real} = 0 \<Longrightarrow> (f has_integral 0) {a..b}"
   by (metis box_real(2) has_integral_null)
 
 lemma has_integral_null_eq[simp]: "content (cbox a b) = 0 \<Longrightarrow> (f has_integral i) (cbox a b) \<longleftrightarrow> i = 0"
   by (auto simp add: has_integral_null dest!: integral_unique)
 
 lemma integral_null [simp]: "content (cbox a b) = 0 \<Longrightarrow> integral (cbox a b) f = 0"
   by (metis has_integral_null integral_unique)
 
 lemma integrable_on_null [intro]: "content (cbox a b) = 0 \<Longrightarrow> f integrable_on (cbox a b)"
   by (simp add: has_integral_integrable)
 
 lemma has_integral_empty[intro]: "(f has_integral 0) {}"
   by (meson ex_in_conv has_integral_is_0)
 
 lemma has_integral_empty_eq[simp]: "(f has_integral i) {} \<longleftrightarrow> i = 0"
   by (auto simp add: has_integral_empty has_integral_unique)
 
 lemma integrable_on_empty[intro]: "f integrable_on {}"
   unfolding integrable_on_def by auto
 
 lemma integral_empty[simp]: "integral {} f = 0"
   by blast
 
 lemma has_integral_refl[intro]:
   fixes a :: "'a::euclidean_space"
   shows "(f has_integral 0) (cbox a a)"
     and "(f has_integral 0) {a}"
 proof -
   show "(f has_integral 0) (cbox a a)"
      by (rule has_integral_null) simp
   then show "(f has_integral 0) {a}"
     by simp
 qed
 
 lemma integrable_on_refl[intro]: "f integrable_on cbox a a"
   unfolding integrable_on_def by auto
 
 lemma integral_refl [simp]: "integral (cbox a a) f = 0"
   by auto
 
 lemma integral_singleton [simp]: "integral {a} f = 0"
   by auto
 
 lemma integral_blinfun_apply:
   assumes "f integrable_on s"
   shows "integral s (\<lambda>x. blinfun_apply h (f x)) = blinfun_apply h (integral s f)"
   by (subst integral_linear[symmetric, OF assms blinfun.bounded_linear_right]) (simp add: o_def)
 
 lemma blinfun_apply_integral:
   assumes "f integrable_on s"
   shows "blinfun_apply (integral s f) x = integral s (\<lambda>y. blinfun_apply (f y) x)"
   by (metis (no_types, lifting) assms blinfun.prod_left.rep_eq integral_blinfun_apply integral_cong)
 
 lemma has_integral_componentwise_iff:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   shows "(f has_integral y) A \<longleftrightarrow> (\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
 proof safe
   fix b :: 'b assume "(f has_integral y) A"
   from has_integral_linear[OF this(1) bounded_linear_inner_left, of b]
     show "((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A" by (simp add: o_def)
 next
   assume "(\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
   hence "\<forall>b\<in>Basis. (((\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. f x \<bullet> b)) has_integral ((y \<bullet> b) *\<^sub>R b)) A"
     by (intro ballI has_integral_linear) (simp_all add: bounded_linear_scaleR_left)
   hence "((\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b) has_integral (\<Sum>b\<in>Basis. (y \<bullet> b) *\<^sub>R b)) A"
     by (intro has_integral_sum) (simp_all add: o_def)
   thus "(f has_integral y) A" by (simp add: euclidean_representation)
 qed
 
 lemma has_integral_componentwise:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   shows "(\<And>b. b \<in> Basis \<Longrightarrow> ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A) \<Longrightarrow> (f has_integral y) A"
   by (subst has_integral_componentwise_iff) blast
 
 lemma integrable_componentwise_iff:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   shows "f integrable_on A \<longleftrightarrow> (\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)"
 proof
   assume "f integrable_on A"
   then obtain y where "(f has_integral y) A" by (auto simp: integrable_on_def)
   hence "(\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
     by (subst (asm) has_integral_componentwise_iff)
   thus "(\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)" by (auto simp: integrable_on_def)
 next
   assume "(\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)"
   then obtain y where "\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral y b) A"
     unfolding integrable_on_def by (subst (asm) bchoice_iff) blast
   hence "\<forall>b\<in>Basis. (((\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. f x \<bullet> b)) has_integral (y b *\<^sub>R b)) A"
     by (intro ballI has_integral_linear) (simp_all add: bounded_linear_scaleR_left)
   hence "((\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b) has_integral (\<Sum>b\<in>Basis. y b *\<^sub>R b)) A"
     by (intro has_integral_sum) (simp_all add: o_def)
   thus "f integrable_on A" by (auto simp: integrable_on_def o_def euclidean_representation)
 qed
 
 lemma integrable_componentwise:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   shows "(\<And>b. b \<in> Basis \<Longrightarrow> (\<lambda>x. f x \<bullet> b) integrable_on A) \<Longrightarrow> f integrable_on A"
   by (subst integrable_componentwise_iff) blast
 
 lemma integral_componentwise:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   assumes "f integrable_on A"
   shows "integral A f = (\<Sum>b\<in>Basis. integral A (\<lambda>x. (f x \<bullet> b) *\<^sub>R b))"
 proof -
   from assms have integrable: "\<forall>b\<in>Basis. (\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. (f x \<bullet> b)) integrable_on A"
     by (subst (asm) integrable_componentwise_iff, intro integrable_linear ballI)
        (simp_all add: bounded_linear_scaleR_left)
   have "integral A f = integral A (\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b)"
     by (simp add: euclidean_representation)
   also from integrable have "\<dots> = (\<Sum>a\<in>Basis. integral A (\<lambda>x. (f x \<bullet> a) *\<^sub>R a))"
     by (subst integral_sum) (simp_all add: o_def)
   finally show ?thesis .
 qed
 
 lemma integrable_component:
   "f integrable_on A \<Longrightarrow> (\<lambda>x. f x \<bullet> (y :: 'b :: euclidean_space)) integrable_on A"
   by (drule integrable_linear[OF _ bounded_linear_inner_left[of y]]) (simp add: o_def)
 
 
 subsection \<open>Cauchy-type criterion for integrability\<close>
 
 proposition integrable_Cauchy:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::{real_normed_vector,complete_space}"
   shows "f integrable_on cbox a b \<longleftrightarrow>
         (\<forall>e>0. \<exists>\<gamma>. gauge \<gamma> \<and>
           (\<forall>\<D>1 \<D>2. \<D>1 tagged_division_of (cbox a b) \<and> \<gamma> fine \<D>1 \<and>
             \<D>2 tagged_division_of (cbox a b) \<and> \<gamma> fine \<D>2 \<longrightarrow>
             norm ((\<Sum>(x,K)\<in>\<D>1. content K *\<^sub>R f x) - (\<Sum>(x,K)\<in>\<D>2. content K *\<^sub>R f x)) < e))"
   (is "?l = (\<forall>e>0. \<exists>\<gamma>. ?P e \<gamma>)")
 proof (intro iffI allI impI)
   assume ?l
   then obtain y
     where y: "\<And>e. e > 0 \<Longrightarrow>
         \<exists>\<gamma>. gauge \<gamma> \<and>
             (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                  norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - y) < e)"
     by (auto simp: integrable_on_def has_integral)
   show "\<exists>\<gamma>. ?P e \<gamma>" if "e > 0" for e
   proof -
     have "e/2 > 0" using that by auto
     with y obtain \<gamma> where "gauge \<gamma>"
       and \<gamma>: "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<Longrightarrow>
                   norm ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f x) - y) < e/2"
       by meson
     show ?thesis
     apply (rule_tac x=\<gamma> in exI, clarsimp simp: \<open>gauge \<gamma>\<close>)
         by (blast intro!: \<gamma> dist_triangle_half_l[where y=y,unfolded dist_norm])
     qed
 next
   assume "\<forall>e>0. \<exists>\<gamma>. ?P e \<gamma>"
   then have "\<forall>n::nat. \<exists>\<gamma>. ?P (1 / (n + 1)) \<gamma>"
     by auto
   then obtain \<gamma> :: "nat \<Rightarrow> 'n \<Rightarrow> 'n set" where \<gamma>:
     "\<And>m. gauge (\<gamma> m)"
     "\<And>m \<D>1 \<D>2. \<lbrakk>\<D>1 tagged_division_of cbox a b;
               \<gamma> m fine \<D>1; \<D>2 tagged_division_of cbox a b; \<gamma> m fine \<D>2\<rbrakk>
               \<Longrightarrow> norm ((\<Sum>(x,K) \<in> \<D>1. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> \<D>2. content K *\<^sub>R f x))
                   < 1 / (m + 1)"
     by metis
   have "gauge (\<lambda>x. \<Inter>{\<gamma> i x |i. i \<in> {0..n}})" for n
     using \<gamma> by (intro gauge_Inter) auto
   then have "\<forall>n. \<exists>p. p tagged_division_of (cbox a b) \<and> (\<lambda>x. \<Inter>{\<gamma> i x |i. i \<in> {0..n}}) fine p"
     by (meson fine_division_exists)
   then obtain p where p: "\<And>z. p z tagged_division_of cbox a b"
                          "\<And>z. (\<lambda>x. \<Inter>{\<gamma> i x |i. i \<in> {0..z}}) fine p z"
     by meson
   have dp: "\<And>i n. i\<le>n \<Longrightarrow> \<gamma> i fine p n"
     using p unfolding fine_Inter
     using atLeastAtMost_iff by blast
   have "Cauchy (\<lambda>n. sum (\<lambda>(x,K). content K *\<^sub>R (f x)) (p n))"
   proof (rule CauchyI)
     fix e::real
     assume "0 < e"
     then obtain N where "N \<noteq> 0" and N: "inverse (real N) < e"
       using real_arch_inverse[of e] by blast
     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. 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"
     proof (intro exI allI impI)
       fix m n
       assume mn: "N \<le> m" "N \<le> n"
       have "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)) < 1 / (real N + 1)"
         by (simp add: p(1) dp mn \<gamma>)
       also have "... < e"
         using  N \<open>N \<noteq> 0\<close> \<open>0 < e\<close> by (auto simp: field_simps)
       finally 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" .
     qed
   qed
   then obtain y where y: "\<exists>no. \<forall>n\<ge>no. norm ((\<Sum>(x,K) \<in> p n. content K *\<^sub>R f x) - y) < r" if "r > 0" for r
     by (auto simp: convergent_eq_Cauchy[symmetric] dest: LIMSEQ_D)
   show ?l
     unfolding integrable_on_def has_integral
   proof (rule_tac x=y in exI, clarify)
     fix e :: real
     assume "e>0"
     then have e2: "e/2 > 0" by auto
     then obtain N1::nat where N1: "N1 \<noteq> 0" "inverse (real N1) < e/2"
       using real_arch_inverse by blast
     obtain N2::nat where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> norm ((\<Sum>(x,K) \<in> p n. content K *\<^sub>R f x) - y) < e/2"
       using y[OF e2] by metis
     show "\<exists>\<gamma>. gauge \<gamma> \<and>
               (\<forall>\<D>. \<D> tagged_division_of (cbox a b) \<and> \<gamma> fine \<D> \<longrightarrow>
                 norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - y) < e)"
     proof (intro exI conjI allI impI)
       show "gauge (\<gamma> (N1+N2))"
         using \<gamma> by auto
       show "norm ((\<Sum>(x,K) \<in> q. content K *\<^sub>R f x) - y) < e"
            if "q tagged_division_of cbox a b \<and> \<gamma> (N1+N2) fine q" for q
       proof (rule norm_triangle_half_r)
         have "norm ((\<Sum>(x,K) \<in> p (N1+N2). content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> q. content K *\<^sub>R f x))
                < 1 / (real (N1+N2) + 1)"
           by (rule \<gamma>; simp add: dp p that)
         also have "... < e/2"
           using N1 \<open>0 < e\<close> by (auto simp: field_simps intro: less_le_trans)
         finally show "norm ((\<Sum>(x,K) \<in> p (N1+N2). content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> q. content K *\<^sub>R f x)) < e/2" .
         show "norm ((\<Sum>(x,K) \<in> p (N1+N2). content K *\<^sub>R f x) - y) < e/2"
           using N2 le_add_same_cancel2 by blast
       qed
     qed
   qed
 qed
 
 
 subsection \<open>Additivity of integral on abutting intervals\<close>
 
 lemma tagged_division_split_left_inj_content:
   assumes \<D>: "\<D> tagged_division_of S"
     and "(x1, K1) \<in> \<D>" "(x2, K2) \<in> \<D>" "K1 \<noteq> K2" "K1 \<inter> {x. x\<bullet>k \<le> c} = K2 \<inter> {x. x\<bullet>k \<le> c}" "k \<in> Basis"
   shows "content (K1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
 proof -
   from tagged_division_ofD(4)[OF \<D> \<open>(x1, K1) \<in> \<D>\<close>] obtain a b where K1: "K1 = cbox a b"
     by auto
   then have "interior (K1 \<inter> {x. x \<bullet> k \<le> c}) = {}"
     by (metis tagged_division_split_left_inj assms)
   then show ?thesis
     unfolding K1 interval_split[OF \<open>k \<in> Basis\<close>] by (auto simp: content_eq_0_interior)
 qed
 
 lemma tagged_division_split_right_inj_content:
   assumes \<D>: "\<D> tagged_division_of S"
     and "(x1, K1) \<in> \<D>" "(x2, K2) \<in> \<D>" "K1 \<noteq> K2" "K1 \<inter> {x. x\<bullet>k \<ge> c} = K2 \<inter> {x. x\<bullet>k \<ge> c}" "k \<in> Basis"
   shows "content (K1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
 proof -
   from tagged_division_ofD(4)[OF \<D> \<open>(x1, K1) \<in> \<D>\<close>] obtain a b where K1: "K1 = cbox a b"
     by auto
   then have "interior (K1 \<inter> {x. c \<le> x \<bullet> k}) = {}"
     by (metis tagged_division_split_right_inj assms)
   then show ?thesis
     unfolding K1 interval_split[OF \<open>k \<in> Basis\<close>]
     by (auto simp: content_eq_0_interior)
 qed
 
 
 proposition has_integral_split:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes fi: "(f has_integral i) (cbox a b \<inter> {x. x\<bullet>k \<le> c})"
       and fj: "(f has_integral j) (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
       and k: "k \<in> Basis"
 shows "(f has_integral (i + j)) (cbox a b)"
   unfolding has_integral
 proof clarify
   fix e::real
   assume "0 < e"
   then have e: "e/2 > 0"
     by auto
     obtain \<gamma>1 where \<gamma>1: "gauge \<gamma>1"
       and \<gamma>1norm:
         "\<And>\<D>. \<lbrakk>\<D> tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c}; \<gamma>1 fine \<D>\<rbrakk>
              \<Longrightarrow> norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - i) < e/2"
        apply (rule has_integralD[OF fi[unfolded interval_split[OF k]] e])
        apply (simp add: interval_split[symmetric] k)
       done
     obtain \<gamma>2 where \<gamma>2: "gauge \<gamma>2"
       and \<gamma>2norm:
         "\<And>\<D>. \<lbrakk>\<D> tagged_division_of cbox a b \<inter> {x. c \<le> x \<bullet> k}; \<gamma>2 fine \<D>\<rbrakk>
              \<Longrightarrow> norm ((\<Sum>(x, k) \<in> \<D>. content k *\<^sub>R f x) - j) < e/2"
        apply (rule has_integralD[OF fj[unfolded interval_split[OF k]] e])
        apply (simp add: interval_split[symmetric] k)
        done
   let ?\<gamma> = "\<lambda>x. if x\<bullet>k = c then (\<gamma>1 x \<inter> \<gamma>2 x) else ball x \<bar>x\<bullet>k - c\<bar> \<inter> \<gamma>1 x \<inter> \<gamma>2 x"
   have "gauge ?\<gamma>"
     using \<gamma>1 \<gamma>2 unfolding gauge_def by auto
   then show "\<exists>\<gamma>. gauge \<gamma> \<and>
                  (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                       norm ((\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R f x) - (i + j)) < e)"
   proof (rule_tac x="?\<gamma>" in exI, safe)
     fix p
     assume p: "p tagged_division_of (cbox a b)" and "?\<gamma> fine p"
     have ab_eqp: "cbox a b = \<Union>{K. \<exists>x. (x, K) \<in> p}"
       using p by blast
     have xk_le_c: "x\<bullet>k \<le> c" if as: "(x,K) \<in> p" and K: "K \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}" for x K
     proof (rule ccontr)
       assume **: "\<not> x \<bullet> k \<le> c"
       then have "K \<subseteq> ball x \<bar>x \<bullet> k - c\<bar>"
         using \<open>?\<gamma> fine p\<close> as by (fastforce simp: not_le algebra_simps)
       with K obtain y where y: "y \<in> ball x \<bar>x \<bullet> k - c\<bar>" "y\<bullet>k \<le> c"
         by blast
       then have "\<bar>x \<bullet> k - y \<bullet> k\<bar> < \<bar>x \<bullet> k - c\<bar>"
         using Basis_le_norm[OF k, of "x - y"]
         by (auto simp add: dist_norm inner_diff_left intro: le_less_trans)
       with y show False
         using ** by (auto simp add: field_simps)
     qed
     have xk_ge_c: "x\<bullet>k \<ge> c" if as: "(x,K) \<in> p" and K: "K \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}" for x K
     proof (rule ccontr)
       assume **: "\<not> x \<bullet> k \<ge> c"
       then have "K \<subseteq> ball x \<bar>x \<bullet> k - c\<bar>"
         using \<open>?\<gamma> fine p\<close> as by (fastforce simp: not_le algebra_simps)
       with K obtain y where y: "y \<in> ball x \<bar>x \<bullet> k - c\<bar>" "y\<bullet>k \<ge> c"
         by blast
       then have "\<bar>x \<bullet> k - y \<bullet> k\<bar> < \<bar>x \<bullet> k - c\<bar>"
         using Basis_le_norm[OF k, of "x - y"]
         by (auto simp add: dist_norm inner_diff_left intro: le_less_trans)
       with y show False
         using ** by (auto simp add: field_simps)
     qed
     have fin_finite: "finite {(x,f K) | x K. (x,K) \<in> s \<and> P x K}"
       if "finite s" for s and f :: "'a set \<Rightarrow> 'a set" and P :: "'a \<Rightarrow> 'a set \<Rightarrow> bool"
     proof -
       from that have "finite ((\<lambda>(x,K). (x, f K)) ` s)"
         by auto
       then show ?thesis
         by (rule rev_finite_subset) auto
     qed
     { fix \<G> :: "'a set \<Rightarrow> 'a set"
       fix i :: "'a \<times> 'a set"
       assume "i \<in> (\<lambda>(x, k). (x, \<G> k)) ` p - {(x, \<G> k) |x k. (x, k) \<in> p \<and> \<G> k \<noteq> {}}"
       then obtain x K where xk: "i = (x, \<G> K)"  "(x,K) \<in> p"
                                  "(x, \<G> K) \<notin> {(x, \<G> K) |x K. (x,K) \<in> p \<and> \<G> K \<noteq> {}}"
         by auto
       have "content (\<G> K) = 0"
         using xk using content_empty by auto
       then have "(\<lambda>(x,K). content K *\<^sub>R f x) i = 0"
         unfolding xk split_conv by auto
     } note [simp] = this
     have "finite p"
       using p by blast
     let ?M1 = "{(x, K \<inter> {x. x\<bullet>k \<le> c}) |x K. (x,K) \<in> p \<and> K \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
     have \<gamma>1_fine: "\<gamma>1 fine ?M1"
       using \<open>?\<gamma> fine p\<close> by (fastforce simp: fine_def split: if_split_asm)
     have "norm ((\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) - i) < e/2"
     proof (rule \<gamma>1norm [OF tagged_division_ofI \<gamma>1_fine])
       show "finite ?M1"
         by (rule fin_finite) (use p in blast)
       show "\<Union>{k. \<exists>x. (x, k) \<in> ?M1} = cbox a b \<inter> {x. x\<bullet>k \<le> c}"
         by (auto simp: ab_eqp)
 
       fix x L
       assume xL: "(x, L) \<in> ?M1"
       then obtain x' L' where xL': "x = x'" "L = L' \<inter> {x. x \<bullet> k \<le> c}"
                                    "(x', L') \<in> p" "L' \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
         by blast
       then obtain a' b' where ab': "L' = cbox a' b'"
         using p by blast
       show "x \<in> L" "L \<subseteq> cbox a b \<inter> {x. x \<bullet> k \<le> c}"
         using p xk_le_c xL' by auto
       show "\<exists>a b. L = cbox a b"
         using p xL' ab' by (auto simp add: interval_split[OF k,where c=c])
 
       fix y R
       assume yR: "(y, R) \<in> ?M1"
       then obtain y' R' where yR': "y = y'" "R = R' \<inter> {x. x \<bullet> k \<le> c}"
                                    "(y', R') \<in> p" "R' \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
         by blast
       assume as: "(x, L) \<noteq> (y, R)"
       show "interior L \<inter> interior R = {}"
       proof (cases "L' = R' \<longrightarrow> x' = y'")
         case False
         have "interior R' = {}"
           by (metis (no_types) False Pair_inject inf.idem tagged_division_ofD(5) [OF p] xL'(3) yR'(3))
         then show ?thesis
           using yR' by simp
       next
         case True
         then have "L' \<noteq> R'"
           using as unfolding xL' yR' by auto
         have "interior L' \<inter> interior R' = {}"
           by (metis (no_types) Pair_inject \<open>L' \<noteq> R'\<close> p tagged_division_ofD(5) xL'(3) yR'(3))
         then show ?thesis
           using xL'(2) yR'(2) by auto
       qed
     qed
     moreover
     let ?M2 = "{(x,K \<inter> {x. x\<bullet>k \<ge> c}) |x K. (x,K) \<in> p \<and> K \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
     have \<gamma>2_fine: "\<gamma>2 fine ?M2"
       using \<open>?\<gamma> fine p\<close> by (fastforce simp: fine_def split: if_split_asm)
     have "norm ((\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - j) < e/2"
     proof (rule \<gamma>2norm [OF tagged_division_ofI \<gamma>2_fine])
       show "finite ?M2"
         by (rule fin_finite) (use p in blast)
       show "\<Union>{k. \<exists>x. (x, k) \<in> ?M2} = cbox a b \<inter> {x. x\<bullet>k \<ge> c}"
         by (auto simp: ab_eqp)
 
       fix x L
       assume xL: "(x, L) \<in> ?M2"
       then obtain x' L' where xL': "x = x'" "L = L' \<inter> {x. x \<bullet> k \<ge> c}"
                                    "(x', L') \<in> p" "L' \<inter> {x. x \<bullet> k \<ge> c} \<noteq> {}"
         by blast
       then obtain a' b' where ab': "L' = cbox a' b'"
         using p by blast
       show "x \<in> L" "L \<subseteq> cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
         using p xk_ge_c xL' by auto
       show "\<exists>a b. L = cbox a b"
         using p xL' ab' by (auto simp add: interval_split[OF k,where c=c])
 
       fix y R
       assume yR: "(y, R) \<in> ?M2"
       then obtain y' R' where yR': "y = y'" "R = R' \<inter> {x. x \<bullet> k \<ge> c}"
                                    "(y', R') \<in> p" "R' \<inter> {x. x \<bullet> k \<ge> c} \<noteq> {}"
         by blast
       assume as: "(x, L) \<noteq> (y, R)"
       show "interior L \<inter> interior R = {}"
       proof (cases "L' = R' \<longrightarrow> x' = y'")
         case False
         have "interior R' = {}"
           by (metis (no_types) False Pair_inject inf.idem tagged_division_ofD(5) [OF p] xL'(3) yR'(3))
         then show ?thesis
           using yR' by simp
       next
         case True
         then have "L' \<noteq> R'"
           using as unfolding xL' yR' by auto
         have "interior L' \<inter> interior R' = {}"
           by (metis (no_types) Pair_inject \<open>L' \<noteq> R'\<close> p tagged_division_ofD(5) xL'(3) yR'(3))
         then show ?thesis
           using xL'(2) yR'(2) by auto
       qed
     qed
     ultimately
     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"
       using norm_add_less by blast
     moreover 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) =
                    (\<Sum>(x, ka)\<in>p. content ka *\<^sub>R f x) - (i + j)"
     proof -
       have eq0: "\<And>x y. x = (0::real) \<Longrightarrow> x *\<^sub>R (y::'b) = 0"
          by auto
       have cont_eq: "\<And>g. (\<lambda>(x,l). content l *\<^sub>R f x) \<circ> (\<lambda>(x,l). (x,g l)) = (\<lambda>(x,l). content (g l) *\<^sub>R f x)"
         by auto
       have *: "\<And>\<G> :: 'a set \<Rightarrow> 'a set.
                   (\<Sum>(x,K)\<in>{(x, \<G> K) |x K. (x,K) \<in> p \<and> \<G> K \<noteq> {}}. content K *\<^sub>R f x) =
                   (\<Sum>(x,K)\<in>(\<lambda>(x,K). (x, \<G> K)) ` p. content K *\<^sub>R f x)"
         by (rule sum.mono_neutral_left) (auto simp: \<open>finite p\<close>)
       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) =
         (\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - (i + j)"
         by auto
       moreover have "\<dots> = (\<Sum>(x,K) \<in> p. content (K \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) +
         (\<Sum>(x,K) \<in> p. content (K \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) - (i + j)"
         unfolding *
         apply (subst (1 2) sum.reindex_nontrivial)
            apply (auto intro!: k p eq0 tagged_division_split_left_inj_content tagged_division_split_right_inj_content
                        simp: cont_eq \<open>finite p\<close>)
         done
       moreover have "\<And>x. x \<in> p \<Longrightarrow> (\<lambda>(a,B). content (B \<inter> {a. a \<bullet> k \<le> c}) *\<^sub>R f a) x +
                                 (\<lambda>(a,B). content (B \<inter> {a. c \<le> a \<bullet> k}) *\<^sub>R f a) x =
                                 (\<lambda>(a,B). content B *\<^sub>R f a) x"
       proof clarify
         fix a B
         assume "(a, B) \<in> p"
         with p obtain u v where uv: "B = cbox u v" by blast
         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 = content B *\<^sub>R f a"
           by (auto simp: scaleR_left_distrib uv content_split[OF k,of u v c])
       qed
       ultimately show ?thesis
         by (auto simp: sum.distrib[symmetric])
       qed
     ultimately show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - (i + j)) < e"
       by auto
   qed
 qed
 
 
 subsection \<open>A sort of converse, integrability on subintervals\<close>
 
 lemma has_integral_separate_sides:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes f: "(f has_integral i) (cbox a b)"
     and "e > 0"
     and k: "k \<in> Basis"
   obtains d where "gauge d"
     "\<forall>p1 p2. p1 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<and> d fine p1 \<and>
         p2 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) \<and> d fine p2 \<longrightarrow>
         norm ((sum (\<lambda>(x,k). content k *\<^sub>R f x) p1 + sum (\<lambda>(x,k). content k *\<^sub>R f x) p2) - i) < e"
 proof -
   obtain \<gamma> where d: "gauge \<gamma>"
       "\<And>p. \<lbrakk>p tagged_division_of cbox a b; \<gamma> fine p\<rbrakk>
             \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) < e"
     using has_integralD[OF f \<open>e > 0\<close>] by metis
   { fix p1 p2
     assume tdiv1: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" and "\<gamma> fine p1"
     note p1=tagged_division_ofD[OF this(1)] 
     assume tdiv2: "p2 tagged_division_of (cbox a b) \<inter> {x. c \<le> x \<bullet> k}" and "\<gamma> fine p2"
     note p2=tagged_division_ofD[OF this(1)] 
     note tagged_division_Un_interval[OF tdiv1 tdiv2] 
     note p12 = tagged_division_ofD[OF this] this
     { fix a b
       assume ab: "(a, b) \<in> p1 \<inter> p2"
       have "(a, b) \<in> p1"
         using ab by auto
       obtain u v where uv: "b = cbox u v"
         using \<open>(a, b) \<in> p1\<close> p1(4) by moura
       have "b \<subseteq> {x. x\<bullet>k = c}"
         using ab p1(3)[of a b] p2(3)[of a b] by fastforce
       moreover
       have "interior {x::'a. x \<bullet> k = c} = {}"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         then obtain x where x: "x \<in> interior {x::'a. x\<bullet>k = c}"
           by auto
         then obtain \<epsilon> where "0 < \<epsilon>" and \<epsilon>: "ball x \<epsilon> \<subseteq> {x. x \<bullet> k = c}"
           using mem_interior by metis
         have x: "x\<bullet>k = c"
           using x interior_subset by fastforce
         have *: "\<And>i. i \<in> Basis \<Longrightarrow> \<bar>(x - (x + (\<epsilon>/2) *\<^sub>R k)) \<bullet> i\<bar> = (if i = k then \<epsilon>/2 else 0)"
           using \<open>0 < \<epsilon>\<close> k by (auto simp: inner_simps inner_not_same_Basis)
         have "(\<Sum>i\<in>Basis. \<bar>(x - (x + (\<epsilon>/2 ) *\<^sub>R k)) \<bullet> i\<bar>) =
               (\<Sum>i\<in>Basis. (if i = k then \<epsilon>/2 else 0))"
           using "*" by (blast intro: sum.cong)
         also have "\<dots> < \<epsilon>"
           by (subst sum.delta) (use \<open>0 < \<epsilon>\<close> in auto)
         finally have "x + (\<epsilon>/2) *\<^sub>R k \<in> ball x \<epsilon>"
           unfolding mem_ball dist_norm by(rule le_less_trans[OF norm_le_l1])
         then have "x + (\<epsilon>/2) *\<^sub>R k \<in> {x. x\<bullet>k = c}"
           using \<epsilon> by auto
         then show False
           using \<open>0 < \<epsilon>\<close> x k by (auto simp: inner_simps)
       qed
       ultimately have "content b = 0"
         unfolding uv content_eq_0_interior
         using interior_mono by blast
       then have "content b *\<^sub>R f a = 0"
         by auto
     }
     then have "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) =
                norm ((\<Sum>(x, k)\<in>p1 \<union> p2. content k *\<^sub>R f x) - i)"
       by (subst sum.union_inter_neutral) (auto simp: p1 p2)
     also have "\<dots> < e"
       using d(2) p12 by (simp add: fine_Un k \<open>\<gamma> fine p1\<close> \<open>\<gamma> fine p2\<close>)
     finally have "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) < e" .
    }
   then show ?thesis
     using d(1) that by auto
 qed
 
 lemma integrable_split [intro]:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
   assumes f: "f integrable_on cbox a b"
       and k: "k \<in> Basis"
     shows "f integrable_on (cbox a b \<inter> {x. x\<bullet>k \<le> c})"   (is ?thesis1)
     and   "f integrable_on (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"   (is ?thesis2)
 proof -
   obtain y where y: "(f has_integral y) (cbox a b)"
     using f by blast
   define a' where "a' = (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) c else a\<bullet>i)*\<^sub>R i)"
   define b' where "b' = (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) c else b\<bullet>i)*\<^sub>R i)"
   have "\<exists>d. gauge d \<and>
             (\<forall>p1 p2. p1 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c} \<and> d fine p1 \<and>
                      p2 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c} \<and> d fine p2 \<longrightarrow>
                      norm ((\<Sum>(x,K) \<in> p1. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p2. content K *\<^sub>R f x)) < e)"
     if "e > 0" for e
   proof -
     have "e/2 > 0" using that by auto
   with has_integral_separate_sides[OF y this k, of c]
   obtain d
     where "gauge d"
          and d: "\<And>p1 p2. \<lbrakk>p1 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c}; d fine p1;
                           p2 tagged_division_of cbox a b \<inter> {x. c \<le> x \<bullet> k}; d fine p2\<rbrakk>
                   \<Longrightarrow> norm ((\<Sum>(x,K)\<in>p1. content K *\<^sub>R f x) + (\<Sum>(x,K)\<in>p2. content K *\<^sub>R f x) - y) < e/2"
     by metis
   show ?thesis
     proof (rule_tac x=d in exI, clarsimp simp add: \<open>gauge d\<close>)
       fix p1 p2
       assume as: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p1"
                  "p2 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p2"
       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"
       proof (rule fine_division_exists[OF \<open>gauge d\<close>, of a' b])
         fix p
         assume "p tagged_division_of cbox a' b" "d fine p"
         then show ?thesis
           using as norm_triangle_half_l[OF d[of p1 p] d[of p2 p]]
           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
           by (auto simp add: algebra_simps)
       qed
     qed
   qed
   with f show ?thesis1
     by (simp add: interval_split[OF k] integrable_Cauchy)
   have "\<exists>d. gauge d \<and>
             (\<forall>p1 p2. p1 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<ge> c} \<and> d fine p1 \<and>
                      p2 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<ge> c} \<and> d fine p2 \<longrightarrow>
                      norm ((\<Sum>(x,K) \<in> p1. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p2. content K *\<^sub>R f x)) < e)"
     if "e > 0" for e
   proof -
     have "e/2 > 0" using that by auto
   with has_integral_separate_sides[OF y this k, of c]
   obtain d
     where "gauge d"
          and d: "\<And>p1 p2. \<lbrakk>p1 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c}; d fine p1;
                           p2 tagged_division_of cbox a b \<inter> {x. c \<le> x \<bullet> k}; d fine p2\<rbrakk>
                   \<Longrightarrow> norm ((\<Sum>(x,K)\<in>p1. content K *\<^sub>R f x) + (\<Sum>(x,K)\<in>p2. content K *\<^sub>R f x) - y) < e/2"
     by metis
   show ?thesis
     proof (rule_tac x=d in exI, clarsimp simp add: \<open>gauge d\<close>)
       fix p1 p2
       assume as: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<ge> c}" "d fine p1"
                  "p2 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<ge> c}" "d fine p2"
       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"
       proof (rule fine_division_exists[OF \<open>gauge d\<close>, of a b'])
         fix p
         assume "p tagged_division_of cbox a b'" "d fine p"
         then show ?thesis
           using as norm_triangle_half_l[OF d[of p p1] d[of p p2]]
           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
           by (auto simp add: algebra_simps)
       qed
     qed
   qed
   with f show ?thesis2
     by (simp add: interval_split[OF k] integrable_Cauchy)
 qed
 
 lemma operative_integralI:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   shows "operative (lift_option (+)) (Some 0)
     (\<lambda>i. if f integrable_on i then Some (integral i f) else None)"
 proof -
   interpret comm_monoid "lift_option plus" "Some (0::'b)"
     by (rule comm_monoid_lift_option)
       (rule add.comm_monoid_axioms)
   show ?thesis
   proof
     fix a b c
     fix k :: 'a
     assume k: "k \<in> Basis"
     show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) =
           lift_option (+) (if f integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c} then Some (integral (cbox a b \<inter> {x. x \<bullet> k \<le> c}) f) else None)
           (if f integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k} then Some (integral (cbox a b \<inter> {x. c \<le> x \<bullet> k}) f) else None)"
     proof (cases "f integrable_on cbox a b")
       case True
       with k show ?thesis
         by (auto simp: integrable_split intro: integral_unique [OF has_integral_split[OF _ _ k]])
     next
     case False
       have "\<not> (f integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}) \<or> \<not> ( f integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k})"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         then have "f integrable_on cbox a b"
           unfolding integrable_on_def
           apply (rule_tac x="integral (cbox a b \<inter> {x. x \<bullet> k \<le> c}) f + integral (cbox a b \<inter> {x. x \<bullet> k \<ge> c}) f" in exI)
           apply (auto intro: has_integral_split[OF _ _ k])
           done
         then show False
           using False by auto
       qed
       then show ?thesis
         using False by auto
     qed
   next
     fix a b :: 'a
     assume "box a b = {}"
     then show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) = Some 0"
       using has_integral_null_eq
       by (auto simp: integrable_on_null content_eq_0_interior)
   qed
 qed
 
 subsection \<open>Bounds on the norm of Riemann sums and the integral itself\<close>
 
 lemma dsum_bound:
   assumes p: "p division_of (cbox a b)"
     and "norm c \<le> e"
   shows "norm (sum (\<lambda>l. content l *\<^sub>R c) p) \<le> e * content(cbox a b)"
 proof -
   have sumeq: "(\<Sum>i\<in>p. \<bar>content i\<bar>) = sum content p"
     by simp
   have e: "0 \<le> e"
     using assms(2) norm_ge_zero order_trans by blast
   have "norm (sum (\<lambda>l. content l *\<^sub>R c) p) \<le> (\<Sum>i\<in>p. norm (content i *\<^sub>R c))"
     using norm_sum by blast
   also have "...  \<le> e * (\<Sum>i\<in>p. \<bar>content i\<bar>)"
     by (simp add: sum_distrib_left[symmetric] mult.commute assms(2) mult_right_mono sum_nonneg)
   also have "... \<le> e * content (cbox a b)"
     by (metis additive_content_division p eq_iff sumeq)
   finally show ?thesis .
 qed
 
 lemma rsum_bound:
   assumes p: "p tagged_division_of (cbox a b)"
       and "\<forall>x\<in>cbox a b. norm (f x) \<le> e"
     shows "norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> e * content (cbox a b)"
 proof (cases "cbox a b = {}")
   case True show ?thesis
     using p unfolding True tagged_division_of_trivial by auto
 next
   case False
   then have e: "e \<ge> 0"
     by (meson ex_in_conv assms(2) norm_ge_zero order_trans)
   have sum_le: "sum (content \<circ> snd) p \<le> content (cbox a b)"
     unfolding additive_content_tagged_division[OF p, symmetric] split_def
     by (auto intro: eq_refl)
   have con: "\<And>xk. xk \<in> p \<Longrightarrow> 0 \<le> content (snd xk)"
     using tagged_division_ofD(4) [OF p] content_pos_le
     by force
   have "norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> (\<Sum>i\<in>p. norm (case i of (x, k) \<Rightarrow> content k *\<^sub>R f x))"
     by (rule norm_sum)
   also have "...  \<le> e * content (cbox a b)"
   proof -
     have "\<And>xk. xk \<in> p \<Longrightarrow> norm (f (fst xk)) \<le> e"
       using assms(2) p tag_in_interval by force
     moreover have "(\<Sum>i\<in>p. \<bar>content (snd i)\<bar> * e) \<le> e * content (cbox a b)"
       unfolding sum_distrib_right[symmetric]
       using con sum_le by (auto simp: mult.commute intro: mult_left_mono [OF _ e])
     ultimately show ?thesis
       unfolding split_def norm_scaleR
       by (metis (no_types, lifting) mult_left_mono[OF _ abs_ge_zero]   order_trans[OF sum_mono])
   qed
   finally show ?thesis .
 qed
 
 lemma rsum_diff_bound:
   assumes "p tagged_division_of (cbox a b)"
     and "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e"
   shows "norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p - sum (\<lambda>(x,k). content k *\<^sub>R g x) p) \<le>
          e * content (cbox a b)"
   using order_trans[OF _ rsum_bound[OF assms]]
   by (simp add: split_def scaleR_diff_right sum_subtractf eq_refl)
 
 lemma has_integral_bound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "0 \<le> B"
       and f: "(f has_integral i) (cbox a b)"
       and "\<And>x. x\<in>cbox a b \<Longrightarrow> norm (f x) \<le> B"
     shows "norm i \<le> B * content (cbox a b)"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have "norm i - B * content (cbox a b) > 0"
     by auto
   with f[unfolded has_integral]
   obtain \<gamma> where "gauge \<gamma>" and \<gamma>:
     "\<And>p. \<lbrakk>p tagged_division_of cbox a b; \<gamma> fine p\<rbrakk>
           \<Longrightarrow> norm ((\<Sum>(x, K)\<in>p. content K *\<^sub>R f x) - i) < norm i - B * content (cbox a b)"
     by metis
   then obtain p where p: "p tagged_division_of cbox a b" and "\<gamma> fine p"
     using fine_division_exists by blast
   have "\<And>s B. norm s \<le> B \<Longrightarrow> \<not> norm (s - i) < norm i - B"
     unfolding not_less
     by (metis diff_left_mono dist_commute dist_norm norm_triangle_ineq2 order_trans)
   then show False
     using \<gamma> [OF p \<open>\<gamma> fine p\<close>] rsum_bound[OF p] assms by metis
 qed
 
 corollary integrable_bound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "0 \<le> B"
     and "f integrable_on (cbox a b)"
     and "\<And>x. x\<in>cbox a b \<Longrightarrow> norm (f x) \<le> B"
   shows "norm (integral (cbox a b) f) \<le> B * content (cbox a b)"
   by (metis integrable_integral has_integral_bound assms)
 
 
 subsection \<open>Similar theorems about relationship among components\<close>
 
 lemma rsum_component_le:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes p: "p tagged_division_of (cbox a b)"
       and "\<And>x. x \<in> cbox a b \<Longrightarrow> (f x)\<bullet>i \<le> (g x)\<bullet>i"
     shows "(\<Sum>(x, K)\<in>p. content K *\<^sub>R f x) \<bullet> i \<le> (\<Sum>(x, K)\<in>p. content K *\<^sub>R g x) \<bullet> i"
 unfolding inner_sum_left
 proof (rule sum_mono, clarify)
   fix x K
   assume ab: "(x, K) \<in> p"
   with p obtain u v where K: "K = cbox u v"
     by blast
   then show "(content K *\<^sub>R f x) \<bullet> i \<le> (content K *\<^sub>R g x) \<bullet> i"
     by (metis ab assms inner_scaleR_left measure_nonneg mult_left_mono tag_in_interval)
 qed
 
 lemma has_integral_component_le:
   fixes f g :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes k: "k \<in> Basis"
   assumes "(f has_integral i) S" "(g has_integral j) S"
     and f_le_g: "\<And>x. x \<in> S \<Longrightarrow> (f x)\<bullet>k \<le> (g x)\<bullet>k"
   shows "i\<bullet>k \<le> j\<bullet>k"
 proof -
   have ik_le_jk: "i\<bullet>k \<le> j\<bullet>k"
     if f_i: "(f has_integral i) (cbox a b)"
     and g_j: "(g has_integral j) (cbox a b)"
     and le: "\<forall>x\<in>cbox a b. (f x)\<bullet>k \<le> (g x)\<bullet>k"
     for a b i and j :: 'b and f g :: "'a \<Rightarrow> 'b"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     then have *: "0 < (i\<bullet>k - j\<bullet>k) / 3"
       by auto
     obtain \<gamma>1 where "gauge \<gamma>1" 
       and \<gamma>1: "\<And>p. \<lbrakk>p tagged_division_of cbox a b; \<gamma>1 fine p\<rbrakk>
                 \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) < (i \<bullet> k - j \<bullet> k) / 3"
       using f_i[unfolded has_integral,rule_format,OF *] by fastforce 
     obtain \<gamma>2 where "gauge \<gamma>2" 
       and \<gamma>2: "\<And>p. \<lbrakk>p tagged_division_of cbox a b; \<gamma>2 fine p\<rbrakk>
                 \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - j) < (i \<bullet> k - j \<bullet> k) / 3"
       using g_j[unfolded has_integral,rule_format,OF *] by fastforce 
     obtain p where p: "p tagged_division_of cbox a b" and "\<gamma>1 fine p" "\<gamma>2 fine p"
        using fine_division_exists[OF gauge_Int[OF \<open>gauge \<gamma>1\<close> \<open>gauge \<gamma>2\<close>], of a b] unfolding fine_Int
        by metis
     then have "\<bar>((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
          "\<bar>((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - j) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
       using le_less_trans[OF Basis_le_norm[OF k]] k \<gamma>1 \<gamma>2 by metis+ 
     then show False
       unfolding inner_simps
       using rsum_component_le[OF p] le
       by (fastforce simp add: abs_real_def split: if_split_asm)
   qed
   show ?thesis
   proof (cases "\<exists>a b. S = cbox a b")
     case True
     with ik_le_jk assms show ?thesis
       by auto
   next
     case False
     show ?thesis
     proof (rule ccontr)
       assume "\<not> i\<bullet>k \<le> j\<bullet>k"
       then have ij: "(i\<bullet>k - j\<bullet>k) / 3 > 0"
         by auto
       obtain B1 where "0 < B1" 
            and B1: "\<And>a b. ball 0 B1 \<subseteq> cbox a b \<Longrightarrow>
                     \<exists>z. ((\<lambda>x. if x \<in> S then f x else 0) has_integral z) (cbox a b) \<and>
                         norm (z - i) < (i \<bullet> k - j \<bullet> k) / 3"
         using has_integral_altD[OF _ False ij] assms by blast
       obtain B2 where "0 < B2" 
            and B2: "\<And>a b. ball 0 B2 \<subseteq> cbox a b \<Longrightarrow>
                     \<exists>z. ((\<lambda>x. if x \<in> S then g x else 0) has_integral z) (cbox a b) \<and>
                         norm (z - j) < (i \<bullet> k - j \<bullet> k) / 3"
         using has_integral_altD[OF _ False ij] assms by blast
       have "bounded (ball 0 B1 \<union> ball (0::'a) B2)"
         unfolding bounded_Un by(rule conjI bounded_ball)+
       from bounded_subset_cbox_symmetric[OF this] 
       obtain a b::'a where ab: "ball 0 B1 \<subseteq> cbox a b" "ball 0 B2 \<subseteq> cbox a b"
         by (meson Un_subset_iff)
       then obtain w1 w2 where int_w1: "((\<lambda>x. if x \<in> S then f x else 0) has_integral w1) (cbox a b)"
                         and norm_w1:  "norm (w1 - i) < (i \<bullet> k - j \<bullet> k) / 3"
                         and int_w2: "((\<lambda>x. if x \<in> S then g x else 0) has_integral w2) (cbox a b)"
                         and norm_w2: "norm (w2 - j) < (i \<bullet> k - j \<bullet> k) / 3"
         using B1 B2 by blast
       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"
         by (simp add: abs_real_def split: if_split_asm)
       have "\<bar>(w1 - i) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
            "\<bar>(w2 - j) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
         using Basis_le_norm k le_less_trans norm_w1 norm_w2 by blast+
       moreover
       have "w1\<bullet>k \<le> w2\<bullet>k"
         using ik_le_jk int_w1 int_w2 f_le_g by auto
       ultimately show False
         unfolding inner_simps by(rule *)
     qed
   qed
 qed
 
 lemma integral_component_le:
   fixes g f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "k \<in> Basis"
     and "f integrable_on S" "g integrable_on S"
     and "\<And>x. x \<in> S \<Longrightarrow> (f x)\<bullet>k \<le> (g x)\<bullet>k"
   shows "(integral S f)\<bullet>k \<le> (integral S g)\<bullet>k"
   using has_integral_component_le assms by blast
 
 lemma has_integral_component_nonneg:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "k \<in> Basis"
     and "(f has_integral i) S"
     and "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> (f x)\<bullet>k"
   shows "0 \<le> i\<bullet>k"
   by (metis (no_types, lifting) assms euclidean_all_zero_iff has_integral_0 has_integral_component_le)
 
 lemma integral_component_nonneg:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "k \<in> Basis"
     and  "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> (f x)\<bullet>k"
   shows "0 \<le> (integral S f)\<bullet>k"
   by (smt (verit, ccfv_threshold) assms eq_integralD euclidean_all_zero_iff has_integral_component_nonneg)
 
 lemma has_integral_component_neg:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "k \<in> Basis"
     and "(f has_integral i) S"
     and "\<And>x. x \<in> S \<Longrightarrow> (f x)\<bullet>k \<le> 0"
   shows "i\<bullet>k \<le> 0"
   by (metis (no_types, lifting) assms has_integral_0 has_integral_component_le inner_zero_left)
 
 lemma has_integral_component_lbound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "(f has_integral i) (cbox a b)"
     and "\<forall>x\<in>cbox a b. B \<le> f(x)\<bullet>k"
     and "k \<in> Basis"
   shows "B * content (cbox a b) \<le> i\<bullet>k"
   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-)
   by (auto simp add: field_simps)
 
 lemma has_integral_component_ubound:
   fixes f::"'a::euclidean_space => 'b::euclidean_space"
   assumes "(f has_integral i) (cbox a b)"
     and "\<forall>x\<in>cbox a b. f x\<bullet>k \<le> B"
     and "k \<in> Basis"
   shows "i\<bullet>k \<le> B * content (cbox a b)"
   using has_integral_component_le[OF assms(3,1) has_integral_const, of "\<Sum>i\<in>Basis. B *\<^sub>R i"] assms(2-)
   by (auto simp add: field_simps)
 
 lemma integral_component_lbound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "f integrable_on cbox a b"
     and "\<forall>x\<in>cbox a b. B \<le> f(x)\<bullet>k"
     and "k \<in> Basis"
   shows "B * content (cbox a b) \<le> (integral(cbox a b) f)\<bullet>k"
   using assms has_integral_component_lbound by blast
 
 lemma integral_component_lbound_real:
   assumes "f integrable_on {a ::real..b}"
     and "\<forall>x\<in>{a..b}. B \<le> f(x)\<bullet>k"
     and "k \<in> Basis"
   shows "B * content {a..b} \<le> (integral {a..b} f)\<bullet>k"
   using assms by (metis box_real(2) integral_component_lbound)
 
 lemma integral_component_ubound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "f integrable_on cbox a b"
     and "\<forall>x\<in>cbox a b. f x\<bullet>k \<le> B"
     and "k \<in> Basis"
   shows "(integral (cbox a b) f)\<bullet>k \<le> B * content (cbox a b)"
   using assms has_integral_component_ubound by blast
 
 lemma integral_component_ubound_real:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "f integrable_on {a..b}"
     and "\<forall>x\<in>{a..b}. f x\<bullet>k \<le> B"
     and "k \<in> Basis"
   shows "(integral {a..b} f)\<bullet>k \<le> B * content {a..b}"
   using assms by (metis box_real(2) integral_component_ubound)
 
 subsection \<open>Uniform limit of integrable functions is integrable\<close>
 
 lemma real_arch_invD:
   "0 < (e::real) \<Longrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
   by (subst(asm) real_arch_inverse)
 
 
 lemma integrable_uniform_limit:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "\<And>e. e > 0 \<Longrightarrow> \<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
   shows "f integrable_on cbox a b"
 proof (cases "content (cbox a b) > 0")
   case False then show ?thesis
     using has_integral_null by (simp add: content_lt_nz integrable_on_def)
 next
   case True
   have "1 / (real n + 1) > 0" for n
     by auto
   then have "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> 1 / (real n + 1)) \<and> g integrable_on cbox a b" for n
     using assms by blast
   then obtain g where g_near_f: "\<And>n x. x \<in> cbox a b \<Longrightarrow> norm (f x - g n x) \<le> 1 / (real n + 1)"
                   and int_g: "\<And>n. g n integrable_on cbox a b"
     by metis
   then obtain h where h: "\<And>n. (g n has_integral h n) (cbox a b)"
     unfolding integrable_on_def by metis
   have "Cauchy h"
     unfolding Cauchy_def
   proof clarify
     fix e :: real
     assume "e>0"
     then have "e/4 / content (cbox a b) > 0"
       using True by (auto simp: field_simps)
     then obtain M where "M \<noteq> 0" and M: "1 / (real M) < e/4 / content (cbox a b)"
       by (metis inverse_eq_divide real_arch_inverse)
     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (h m) (h n) < e"
     proof (intro exI strip)
       fix m n
       assume m: "M \<le> m" and n: "M \<le> n"
       have "e/4>0" using \<open>e>0\<close> by auto
       then obtain gm gn where "gauge gm" "gauge gn"
               and gm: "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> gm fine \<D> 
                             \<Longrightarrow> norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g m x) - h m) < e/4"
               and gn: "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> gn fine \<D> \<Longrightarrow>
                       norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g n x) - h n) < e/4"
         using h[unfolded has_integral] by meson
       then obtain \<D> where \<D>: "\<D> tagged_division_of cbox a b" "(\<lambda>x. gm x \<inter> gn x) fine \<D>"
         by (metis (full_types) fine_division_exists gauge_Int)
       have triangle3: "norm (i1 - i2) < e"
         if no: "norm(s2 - s1) \<le> e/2" "norm (s1 - i1) < e/4" "norm (s2 - i2) < e/4" for s1 s2 i1 and i2::'b
       proof -
         have "norm (i1 - i2) \<le> norm (i1 - s1) + norm (s1 - s2) + norm (s2 - i2)"
           using norm_triangle_ineq[of "i1 - s1" "s1 - i2"]
           using norm_triangle_ineq[of "s1 - s2" "s2 - i2"]
           by (auto simp: algebra_simps)
         also have "\<dots> < e"
           using no by (auto simp: algebra_simps norm_minus_commute)
         finally show ?thesis .
       qed
       have finep: "gm fine \<D>" "gn fine \<D>"
         using fine_Int \<D>  by auto
       have norm_le: "norm (g n x - g m x) \<le> 2 / real M" if x: "x \<in> cbox a b" for x
       proof -
         have "norm (f x - g n x) + norm (f x - g m x) \<le> 1 / (real n + 1) + 1 / (real m + 1)"          
           using g_near_f[OF x, of n] g_near_f[OF x, of m] by simp
         also have "\<dots> \<le> 1 / (real M) + 1 / (real M)"
           using \<open>M \<noteq> 0\<close> m n by (intro add_mono; force simp: field_split_simps)
         also have "\<dots> = 2 / real M"
           by auto
         finally show "norm (g n x - g m x) \<le> 2 / real M"
           using norm_triangle_le[of "g n x - f x" "f x - g m x" "2 / real M"]
           by (auto simp: algebra_simps simp add: norm_minus_commute)
       qed
       have "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g n x) - (\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g m x)) \<le> 2 / real M * content (cbox a b)"
         by (blast intro: norm_le rsum_diff_bound[OF \<D>(1), where e="2 / real M"])
       also have "... \<le> e/2"
         using M True
         by (auto simp: field_simps)
       finally have le_e2: "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g n x) - (\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g m x)) \<le> e/2" .
       then show "dist (h m) (h n) < e"
         unfolding dist_norm using gm gn \<D> finep by (auto intro!: triangle3)
     qed
   qed
   then obtain s where s: "h \<longlonglongrightarrow> s"
     using convergent_eq_Cauchy[symmetric] by blast
   show ?thesis
     unfolding integrable_on_def has_integral
   proof (rule_tac x=s in exI, clarify)
     fix e::real
     assume e: "0 < e"
     then have "e/3 > 0" by auto
     then obtain N1 where N1: "\<forall>n\<ge>N1. norm (h n - s) < e/3"
       using LIMSEQ_D [OF s] by metis
     from e True have "e/3 / content (cbox a b) > 0"
       by (auto simp: field_simps)
     then obtain N2 :: nat
          where "N2 \<noteq> 0" and N2: "1 / (real N2) < e/3 / content (cbox a b)"
       by (metis inverse_eq_divide real_arch_inverse)
     obtain g' where "gauge g'"
             and g': "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> g' fine \<D> \<Longrightarrow>
                     norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g (N1 + N2) x) - h (N1 + N2)) < e/3"
       by (metis h has_integral \<open>e/3 > 0\<close>)
     have *: "norm (sf - s) < e" 
         if no: "norm (sf - sg) \<le> e/3" "norm(h - s) < e/3" "norm (sg - h) < e/3" for sf sg h
     proof -
       have "norm (sf - s) \<le> norm (sf - sg) + norm (sg - h) + norm (h - s)"
         using norm_triangle_ineq[of "sf - sg" "sg - s"]
         using norm_triangle_ineq[of "sg -  h" " h - s"]
         by (auto simp: algebra_simps)
       also have "\<dots> < e"
         using no by (auto simp: algebra_simps norm_minus_commute)
       finally show ?thesis .
     qed
     { fix \<D>
       assume ptag: "\<D> tagged_division_of (cbox a b)" and "g' fine \<D>"
       then have norm_less: "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g (N1 + N2) x) - h (N1 + N2)) < e/3"
         using g' by blast
       have "content (cbox a b) < e/3 * (of_nat N2)"
         using \<open>N2 \<noteq> 0\<close> N2 using True by (auto simp: field_split_simps)
       moreover have "e/3 * of_nat N2 \<le> e/3 * (of_nat (N1 + N2) + 1)"
         using \<open>e>0\<close> by auto
       ultimately have "content (cbox a b) < e/3 * (of_nat (N1 + N2) + 1)"
         by linarith
       then have le_e3: "1 / (real (N1 + N2) + 1) * content (cbox a b) \<le> e/3"
         unfolding inverse_eq_divide
         by (auto simp: field_simps)
       have ne3: "norm (h (N1 + N2) - s) < e/3"
         using N1 by auto
       have "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g (N1 + N2) x))
             \<le> 1 / (real (N1 + N2) + 1) * content (cbox a b)"
         by (blast intro: g_near_f rsum_diff_bound[OF ptag])
       then have "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - s) < e"
         by (rule *[OF order_trans [OF _ le_e3] ne3 norm_less])
     }
     then show "\<exists>d. gauge d \<and>
              (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> d fine \<D> \<longrightarrow> norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - s) < e)"
       by (blast intro: g' \<open>gauge g'\<close>)
   qed
 qed
 
 lemmas integrable_uniform_limit_real = integrable_uniform_limit [where 'a=real, simplified]
 
 
 subsection \<open>Negligible sets\<close>
 
 definition "negligible (s:: 'a::euclidean_space set) \<longleftrightarrow>
   (\<forall>a b. ((indicator s :: 'a\<Rightarrow>real) has_integral 0) (cbox a b))"
 
 
 subsubsection \<open>Negligibility of hyperplane\<close>
 
 lemma content_doublesplit:
   fixes a :: "'a::euclidean_space"
   assumes "0 < e"
     and k: "k \<in> Basis"
   obtains d where "0 < d" and "content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d}) < e"
 proof cases
   assume *: "a \<bullet> k \<le> c \<and> c \<le> b \<bullet> k \<and> (\<forall>j\<in>Basis. a \<bullet> j \<le> b \<bullet> j)"
   define a' where "a' d = (\<Sum>j\<in>Basis. (if j = k then max (a\<bullet>j) (c - d) else a\<bullet>j) *\<^sub>R j)" for d
   define b' where "b' d = (\<Sum>j\<in>Basis. (if j = k then min (b\<bullet>j) (c + d) else b\<bullet>j) *\<^sub>R j)" for d
 
   have "((\<lambda>d. \<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) \<longlongrightarrow> (\<Prod>j\<in>Basis. (b' 0 - a' 0) \<bullet> j)) (at_right 0)"
     by (auto simp: b'_def a'_def intro!: tendsto_min tendsto_max tendsto_eq_intros)
   also have "(\<Prod>j\<in>Basis. (b' 0 - a' 0) \<bullet> j) = 0"
     using k *
     by (intro prod_zero bexI[OF _ k])
        (auto simp: b'_def a'_def inner_diff inner_sum_left inner_not_same_Basis intro!: sum.cong)
   also have "((\<lambda>d. \<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) \<longlongrightarrow> 0) (at_right 0) =
     ((\<lambda>d. content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d})) \<longlongrightarrow> 0) (at_right 0)"
   proof (intro tendsto_cong eventually_at_rightI)
     fix d :: real assume d: "d \<in> {0<..<1}"
     have "cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d} = cbox (a' d) (b' d)" for d
       using * d k by (auto simp add: cbox_def set_eq_iff Int_def ball_conj_distrib abs_diff_le_iff a'_def b'_def)
     moreover have "j \<in> Basis \<Longrightarrow> a' d \<bullet> j \<le> b' d \<bullet> j" for j
       using * d k by (auto simp: a'_def b'_def)
     ultimately show "(\<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) = content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d})"
       by simp
   qed simp
   finally have "((\<lambda>d. content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) \<longlongrightarrow> 0) (at_right 0)" .
   from order_tendstoD(2)[OF this \<open>0<e\<close>]
   obtain d' where "0 < d'" and d': "\<And>y. y > 0 \<Longrightarrow> y < d' \<Longrightarrow> content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> y}) < e"
     by (subst (asm) eventually_at_right[of _ 1]) auto
   show ?thesis
     by (rule that[of "d'/2"], insert \<open>0<d'\<close> d'[of "d'/2"], auto)
 next
   assume *: "\<not> (a \<bullet> k \<le> c \<and> c \<le> b \<bullet> k \<and> (\<forall>j\<in>Basis. a \<bullet> j \<le> b \<bullet> j))"
   then have "(\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j) \<or> (c < a \<bullet> k \<or> b \<bullet> k < c)"
     by (auto simp: not_le)
   show thesis
   proof cases
     assume "\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j"
     then have [simp]: "cbox a b = {}"
       using box_ne_empty(1)[of a b] by auto
     show ?thesis
       by (rule that[of 1]) (simp_all add: \<open>0<e\<close>)
   next
     assume "\<not> (\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j)"
     with * have "c < a \<bullet> k \<or> b \<bullet> k < c"
       by auto
     then show thesis
     proof
       assume c: "c < a \<bullet> k"
       moreover have "x \<in> cbox a b \<Longrightarrow> c \<le> x \<bullet> k" for x
         using k c by (auto simp: cbox_def)
       ultimately have "cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> (a \<bullet> k - c)/2} = {}"
         using k by (auto simp: cbox_def)
       with \<open>0<e\<close> c that[of "(a \<bullet> k - c)/2"] show ?thesis
         by auto
     next
       assume c: "b \<bullet> k < c"
       moreover have "x \<in> cbox a b \<Longrightarrow> x \<bullet> k \<le> c" for x
         using k c by (auto simp: cbox_def)
       ultimately have "cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> (c - b \<bullet> k)/2} = {}"
         using k by (auto simp: cbox_def)
       with \<open>0<e\<close> c that[of "(c - b \<bullet> k)/2"] show ?thesis
         by auto
     qed
   qed
 qed
 
 
 proposition negligible_standard_hyperplane[intro]:
   fixes k :: "'a::euclidean_space"
   assumes k: "k \<in> Basis"
   shows "negligible {x. x\<bullet>k = c}"
   unfolding negligible_def has_integral
 proof clarsimp
   fix a b and e::real assume "e > 0"
   with k obtain d where "0 < d" and d: "content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) < e"
     by (metis content_doublesplit)
   let ?i = "indicator {x::'a. x\<bullet>k = c} :: 'a\<Rightarrow>real"
   show "\<exists>\<gamma>. gauge \<gamma> \<and>
            (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                  \<bar>\<Sum>(x,K) \<in> \<D>. content K * ?i x\<bar> < e)"
   proof (intro exI, safe)
     show "gauge (\<lambda>x. ball x d)"
       using \<open>0 < d\<close> by blast
   next
     fix \<D>
     assume p: "\<D> tagged_division_of (cbox a b)" "(\<lambda>x. ball x d) fine \<D>"
     have "content L = content (L \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})" 
       if "(x, L) \<in> \<D>" "?i x \<noteq> 0" for x L
     proof -
       have xk: "x\<bullet>k = c"
         using that by (simp add: indicator_def split: if_split_asm)
       have "L \<subseteq> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}"
       proof 
         fix y
         assume y: "y \<in> L"
         have "L \<subseteq> ball x d"
           using p(2) that(1) by auto
         then have "norm (x - y) < d"
           by (simp add: dist_norm subset_iff y)
         then have "\<bar>(x - y) \<bullet> k\<bar> < d"
           using k norm_bound_Basis_lt by blast
         then show "y \<in> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}"
           unfolding inner_simps xk by auto
       qed 
       then show "content L = content (L \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})"
         by (metis inf.orderE)
     qed
     then have *: "(\<Sum>(x,K)\<in>\<D>. content K * ?i x) = (\<Sum>(x,K)\<in>\<D>. content (K \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d}) *\<^sub>R ?i x)"
       by (force simp add: split_paired_all intro!: sum.cong [OF refl])
     note p'= tagged_division_ofD[OF p(1)] and p''=division_of_tagged_division[OF p(1)]
     have "(\<Sum>(x,K)\<in>\<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * indicator {x. x \<bullet> k = c} x) < e"
     proof -
       have "(\<Sum>(x,K)\<in>\<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * ?i x) \<le> (\<Sum>(x,K)\<in>\<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}))"
         by (force simp add: indicator_def intro!: sum_mono)
       also have "\<dots> < e"
       proof (subst sum.over_tagged_division_lemma[OF p(1)])
         fix u v::'a
         assume "box u v = {}"
         then have *: "content (cbox u v) = 0"
           unfolding content_eq_0_interior by simp
         have "cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<subseteq> cbox u v"
           by auto
         then have "content (cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<le> content (cbox u v)"
           unfolding interval_doublesplit[OF k] by (rule content_subset)
         then show "content (cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = 0"
           unfolding * interval_doublesplit[OF k]
           by (blast intro: antisym)
       next
         have "(\<Sum>l\<in>snd ` \<D>. content (l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) =
           sum content ((\<lambda>l. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})`{l\<in>snd ` \<D>. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}})"
         proof (subst (2) sum.reindex_nontrivial)
           fix x y assume "x \<in> {l \<in> snd ` \<D>. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}" "y \<in> {l \<in> snd ` \<D>. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}"
             "x \<noteq> y" and eq: "x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} = y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}"
           then obtain x' y' where "(x', x) \<in> \<D>" "x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}" "(y', y) \<in> \<D>" "y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}"
             by (auto)
           from p'(5)[OF \<open>(x', x) \<in> \<D>\<close> \<open>(y', y) \<in> \<D>\<close>] \<open>x \<noteq> y\<close> have "interior (x \<inter> y) = {}"
             by auto
           moreover have "interior ((x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<inter> (y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) \<subseteq> interior (x \<inter> y)"
             by (auto intro: interior_mono)
           ultimately have "interior (x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = {}"
             by (auto simp: eq)
           then show "content (x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = 0"
             using p'(4)[OF \<open>(x', x) \<in> \<D>\<close>] by (auto simp: interval_doublesplit[OF k] content_eq_0_interior simp del: interior_Int)
         qed (insert p'(1), auto intro!: sum.mono_neutral_right)
         also have "\<dots> \<le> norm (\<Sum>l\<in>(\<lambda>l. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})`{l\<in>snd ` \<D>. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}. content l *\<^sub>R 1::real)"
           by simp
         also have "\<dots> \<le> 1 * content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})"
           using division_doublesplit[OF p'' k, unfolded interval_doublesplit[OF k]]
           unfolding interval_doublesplit[OF k] by (intro dsum_bound) auto
         also have "\<dots> < e"
           using d by simp
         finally show "(\<Sum>K\<in>snd ` \<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) < e" .
       qed
       finally show "(\<Sum>(x, K)\<in>\<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * ?i x) < e" .
     qed
     then show "\<bar>\<Sum>(x, K)\<in>\<D>. content K * ?i x\<bar> < e"
       unfolding *  by (simp add: sum_nonneg split: prod.split)
   qed
 qed
 
 corollary negligible_standard_hyperplane_cart:
   fixes k :: "'a::finite"
   shows "negligible {x. x$k = (0::real)}"
   by (simp add: cart_eq_inner_axis negligible_standard_hyperplane)
 
 
 subsubsection \<open>Hence the main theorem about negligible sets\<close>
 
 
 lemma has_integral_negligible_cbox:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes negs: "negligible S"
     and 0: "\<And>x. x \<notin> S \<Longrightarrow> f x = 0"
   shows "(f has_integral 0) (cbox a b)"
   unfolding has_integral
 proof clarify
   fix e::real
   assume "e > 0"
   then have nn_gt0: "e/2 / ((real n+1) * (2 ^ n)) > 0" for n
     by simp
   then have "\<exists>\<gamma>. gauge \<gamma> \<and>
                  (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                       \<bar>\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R indicator S x\<bar>
                       < e/2 / ((real n + 1) * 2 ^ n))" for n
     using negs [unfolded negligible_def has_integral] by auto
   then obtain \<gamma> where 
     gd: "\<And>n. gauge (\<gamma> n)"
     and \<gamma>: "\<And>n \<D>. \<lbrakk>\<D> tagged_division_of cbox a b; \<gamma> n fine \<D>\<rbrakk>
                   \<Longrightarrow> \<bar>\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R indicator S x\<bar> < e/2 / ((real n + 1) * 2 ^ n)"
     by metis
   show "\<exists>\<gamma>. gauge \<gamma> \<and>
              (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                   norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - 0) < e)"
   proof (intro exI, safe)
     show "gauge (\<lambda>x. \<gamma> (nat \<lfloor>norm (f x)\<rfloor>) x)"
       using gd by (auto simp: gauge_def)
 
     show "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - 0) < e"
       if "\<D> tagged_division_of (cbox a b)" "(\<lambda>x. \<gamma> (nat \<lfloor>norm (f x)\<rfloor>) x) fine \<D>" for \<D>
     proof (cases "\<D> = {}")
       case True with \<open>0 < e\<close> show ?thesis by simp
     next
       case False
       obtain N where "Max ((\<lambda>(x, K). norm (f x)) ` \<D>) \<le> real N"
         using real_arch_simple by blast
       then have N: "\<And>x. x \<in> (\<lambda>(x, K). norm (f x)) ` \<D> \<Longrightarrow> x \<le> real N"
         by (meson Max_ge that(1) dual_order.trans finite_imageI tagged_division_of_finite)
       have "\<forall>i. \<exists>q. q tagged_division_of (cbox a b) \<and> (\<gamma> i) fine q \<and> (\<forall>(x,K) \<in> \<D>. K \<subseteq> (\<gamma> i) x \<longrightarrow> (x, K) \<in> q)"
         by (auto intro: tagged_division_finer[OF that(1) gd])
       from choice[OF this] 
       obtain q where q: "\<And>n. q n tagged_division_of cbox a b"
                         "\<And>n. \<gamma> n fine q n"
                         "\<And>n x K. \<lbrakk>(x, K) \<in> \<D>; K \<subseteq> \<gamma> n x\<rbrakk> \<Longrightarrow> (x, K) \<in> q n"
         by fastforce
       have "finite \<D>"
         using that(1) by blast
       then have sum_le_inc: "\<lbrakk>finite T; \<And>x y. (x,y) \<in> T \<Longrightarrow> (0::real) \<le> g(x,y);
                       \<And>y. y\<in>\<D> \<Longrightarrow> \<exists>x. (x,y) \<in> T \<and> f(y) \<le> g(x,y)\<rbrakk> \<Longrightarrow> sum f \<D> \<le> sum g T" for f g T
         by (rule sum_le_included[of \<D> T g snd f]; force)
       have "norm (\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) \<le> (\<Sum>(x,K) \<in> \<D>. norm (content K *\<^sub>R f x))"
         unfolding split_def by (rule norm_sum)
       also have "... \<le> (\<Sum>(i, j) \<in> Sigma {..N + 1} q.
                           (real i + 1) * (case j of (x, K) \<Rightarrow> content K *\<^sub>R indicator S x))"
       proof (rule sum_le_inc, safe)
         show "finite (Sigma {..N+1} q)"
           by (meson finite_SigmaI finite_atMost tagged_division_of_finite q(1)) 
       next
         fix x K
         assume xk: "(x, K) \<in> \<D>"
         define n where "n = nat \<lfloor>norm (f x)\<rfloor>"
         have *: "norm (f x) \<in> (\<lambda>(x, K). norm (f x)) ` \<D>"
           using xk by auto
         have nfx: "real n \<le> norm (f x)" "norm (f x) \<le> real n + 1"
           unfolding n_def by auto
         then have "n \<in> {0..N + 1}"
           using N[OF *] by auto
         moreover have "K \<subseteq> \<gamma> (nat \<lfloor>norm (f x)\<rfloor>) x"
           using that(2) xk by auto
         moreover then have "(x, K) \<in> q (nat \<lfloor>norm (f x)\<rfloor>)"
           by (simp add: q(3) xk)
         moreover then have "(x, K) \<in> q n"
           using n_def by blast
         moreover
         have "norm (content K *\<^sub>R f x) \<le> (real n + 1) * (content K * indicator S x)"
         proof (cases "x \<in> S")
           case False
           then show ?thesis by (simp add: 0)
         next
           case True
           have *: "content K \<ge> 0"
             using tagged_division_ofD(4)[OF that(1) xk] by auto
           moreover have "content K * norm (f x) \<le> content K * (real n + 1)"
             by (simp add: mult_left_mono nfx(2))
           ultimately show ?thesis
             using nfx True by (auto simp: field_simps)
         qed
         ultimately show "\<exists>y. (y, x, K) \<in> (Sigma {..N + 1} q) \<and> norm (content K *\<^sub>R f x) \<le>
           (real y + 1) * (content K *\<^sub>R indicator S x)"
           by force
       qed auto
       also have "... = (\<Sum>i\<le>N + 1. \<Sum>j\<in>q i. (real i + 1) * (case j of (x, K) \<Rightarrow> content K *\<^sub>R indicator S x))"
         using q(1) by (intro sum_Sigma_product [symmetric]) auto
       also have "... \<le> (\<Sum>i\<le>N + 1. (real i + 1) * \<bar>\<Sum>(x,K) \<in> q i. content K *\<^sub>R indicator S x\<bar>)"
         by (rule sum_mono) (simp add: sum_distrib_left [symmetric])
       also have "... \<le> (\<Sum>i\<le>N + 1. e/2/2 ^ i)"
       proof (rule sum_mono)
         show "(real i + 1) * \<bar>\<Sum>(x,K) \<in> q i. content K *\<^sub>R indicator S x\<bar> \<le> e/2/2 ^ i"
           if "i \<in> {..N + 1}" for i
           using \<gamma>[of "q i" i] q by (simp add: divide_simps mult.left_commute)
       qed
       also have "... = e/2 * (\<Sum>i\<le>N + 1. (1/2) ^ i)"
         unfolding sum_distrib_left by (metis divide_inverse inverse_eq_divide power_one_over)
       also have "\<dots> < e/2 * 2"
       proof (rule mult_strict_left_mono)
         have "sum (power (1/2)) {..N + 1} = sum (power (1/2::real)) {..<N + 2}"
           using lessThan_Suc_atMost by auto
         also have "... < 2"
           by (auto simp: geometric_sum)
         finally show "sum (power (1/2::real)) {..N + 1} < 2" .
       qed (use \<open>0 < e\<close> in auto)
       finally  show ?thesis by auto
     qed
   qed
 qed
 
 
 proposition has_integral_negligible:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes negs: "negligible S"
     and "\<And>x. x \<in> (T - S) \<Longrightarrow> f x = 0"
   shows "(f has_integral 0) T"
 proof (cases "\<exists>a b. T = cbox a b")
   case True
   then have "((\<lambda>x. if x \<in> T then f x else 0) has_integral 0) T"
     using assms by (auto intro!: has_integral_negligible_cbox)
   then show ?thesis
     by (rule has_integral_eq [rotated]) auto
 next
   case False
   let ?f = "(\<lambda>x. if x \<in> T then f x else 0)"
   have "((\<lambda>x. if x \<in> T then f x else 0) has_integral 0) T"
     apply (auto simp: False has_integral_alt [of ?f])
     apply (rule_tac x=1 in exI, auto)
     apply (rule_tac x=0 in exI, simp add: has_integral_negligible_cbox [OF negs] assms)
     done
   then show ?thesis
     by (rule_tac f="?f" in has_integral_eq) auto
 qed
 
 lemma
   assumes "negligible S"
   shows integrable_negligible: "f integrable_on S" and integral_negligible: "integral S f = 0"
   using has_integral_negligible [OF assms]
   by (auto simp: has_integral_iff)
 
 lemma has_integral_spike:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "negligible S"
     and gf: "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
     and fint: "(f has_integral y) T"
   shows "(g has_integral y) T"
 proof -
   have *: "(g has_integral y) (cbox a b)"
        if "(f has_integral y) (cbox a b)" "\<forall>x \<in> cbox a b - S. g x = f x" for a b f and g:: "'b \<Rightarrow> 'a" and y
   proof -
     have "((\<lambda>x. f x + (g x - f x)) has_integral (y + 0)) (cbox a b)"
       using that by (intro has_integral_add has_integral_negligible) (auto intro!: \<open>negligible S\<close>)
     then show ?thesis
       by auto
   qed
   have \<section>: "\<And>a b z. \<lbrakk>\<And>x. x \<in> T \<and> x \<notin> S \<Longrightarrow> g x = f x;
                      ((\<lambda>x. if x \<in> T then f x else 0) has_integral z) (cbox a b)\<rbrakk>
                     \<Longrightarrow> ((\<lambda>x. if x \<in> T then g x else 0) has_integral z) (cbox a b)"
       by (auto dest!: *[where f="\<lambda>x. if x\<in>T then f x else 0" and g="\<lambda>x. if x \<in> T then g x else 0"])
   show ?thesis
     using fint gf
     apply (subst has_integral_alt)
     apply (subst (asm) has_integral_alt)
     apply (auto split: if_split_asm)
      apply (blast dest: *)
     using \<section> by meson
 qed
 
 lemma has_integral_spike_eq:
   assumes "negligible S" and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
   shows "(f has_integral y) T \<longleftrightarrow> (g has_integral y) T"
   by (metis assms has_integral_spike)
 
 lemma integrable_spike:
   assumes "f integrable_on T" "negligible S" "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
     shows "g integrable_on T"
   using assms unfolding integrable_on_def by (blast intro: has_integral_spike)
 
 lemma integral_spike:
   assumes "negligible S"
     and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
   shows "integral T f = integral T g"
   using has_integral_spike_eq[OF assms]
     by (auto simp: integral_def integrable_on_def)
 
 
 subsection \<open>Some other trivialities about negligible sets\<close>
 
 lemma negligible_subset:
   assumes "negligible s" "t \<subseteq> s"
   shows "negligible t"
   unfolding negligible_def
     by (metis (no_types) Diff_iff assms contra_subsetD has_integral_negligible indicator_simps(2))
 
 lemma negligible_diff[intro?]:
   assumes "negligible s"
   shows "negligible (s - t)"
   using assms by (meson Diff_subset negligible_subset)
 
 lemma negligible_Int:
   assumes "negligible s \<or> negligible t"
   shows "negligible (s \<inter> t)"
   using assms negligible_subset by force
 
 lemma negligible_Un:
   assumes "negligible S" and T: "negligible T"
   shows "negligible (S \<union> T)"
 proof -
   have "(indicat_real (S \<union> T) has_integral 0) (cbox a b)"
     if S0: "(indicat_real S has_integral 0) (cbox a b)" 
       and  "(indicat_real T has_integral 0) (cbox a b)" for a b
   proof (subst has_integral_spike_eq[OF T])
     show "indicat_real S x = indicat_real (S \<union> T) x" if "x \<in> cbox a b - T" for x
       using that by (simp add: indicator_def)
     show "(indicat_real S has_integral 0) (cbox a b)"
       by (simp add: S0)
   qed
   with assms show ?thesis
     unfolding negligible_def by blast
 qed
 
 lemma negligible_Un_eq[simp]: "negligible (s \<union> t) \<longleftrightarrow> negligible s \<and> negligible t"
   using negligible_Un negligible_subset by blast
 
 lemma negligible_sing[intro]: "negligible {a::'a::euclidean_space}"
   using negligible_standard_hyperplane[OF SOME_Basis, of "a \<bullet> (SOME i. i \<in> Basis)"] negligible_subset by blast
 
 lemma negligible_insert[simp]: "negligible (insert a s) \<longleftrightarrow> negligible s"
   by (metis insert_is_Un negligible_Un_eq negligible_sing)
 
 lemma negligible_empty[iff]: "negligible {}"
   using negligible_insert by blast
 
 text\<open>Useful in this form for backchaining\<close>
 lemma empty_imp_negligible: "S = {} \<Longrightarrow> negligible S"
   by simp
 
 lemma negligible_finite[intro]:
   assumes "finite s"
   shows "negligible s"
   using assms by (induct s) auto
 
 lemma negligible_Union[intro]:
   assumes "finite \<T>"
     and "\<And>t. t \<in> \<T> \<Longrightarrow> negligible t"
   shows "negligible(\<Union>\<T>)"
   using assms by induct auto
 
 lemma negligible: "negligible S \<longleftrightarrow> (\<forall>T. (indicat_real S has_integral 0) T)"
 proof (intro iffI allI)
   fix T
   assume "negligible S"
   then show "(indicator S has_integral 0) T"
     by (meson Diff_iff has_integral_negligible indicator_simps(2))
 qed (simp add: negligible_def)
 
 subsection \<open>Finite case of the spike theorem is quite commonly needed\<close>
 
 lemma has_integral_spike_finite:
   assumes "finite S"
     and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
     and "(f has_integral y) T"
   shows "(g has_integral y) T"
   using assms has_integral_spike negligible_finite by blast
 
 lemma has_integral_spike_finite_eq:
   assumes "finite S"
     and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
   shows "((f has_integral y) T \<longleftrightarrow> (g has_integral y) T)"
   by (metis assms has_integral_spike_finite)
 
 lemma integrable_spike_finite:
   assumes "finite S"
     and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
     and "f integrable_on T"
   shows "g integrable_on T"
   using assms has_integral_spike_finite by blast
 
+lemma integrable_spike_finite_eq:
+  assumes "finite S"
+    and "\<And>x. x \<in> T - S \<Longrightarrow> f x = g x"
+  shows "f integrable_on T \<longleftrightarrow> g integrable_on T"
+  by (metis assms integrable_spike_finite)
+
 lemma has_integral_bound_spike_finite:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "0 \<le> B" "finite S"
       and f: "(f has_integral i) (cbox a b)"
       and leB: "\<And>x. x \<in> cbox a b - S \<Longrightarrow> norm (f x) \<le> B"
     shows "norm i \<le> B * content (cbox a b)"
 proof -
   define g where "g \<equiv> (\<lambda>x. if x \<in> S then 0 else f x)"
   then have "\<And>x. x \<in> cbox a b - S \<Longrightarrow> norm (g x) \<le> B"
     using leB by simp
   moreover have "(g has_integral i) (cbox a b)"
     using has_integral_spike_finite [OF \<open>finite S\<close> _ f]
     by (simp add: g_def)
   ultimately show ?thesis
     by (simp add: \<open>0 \<le> B\<close> g_def has_integral_bound)
 qed
 
 corollary has_integral_bound_real:
   fixes f :: "real \<Rightarrow> 'b::real_normed_vector"
   assumes "0 \<le> B" "finite S"
       and "(f has_integral i) {a..b}"
       and "\<And>x. x \<in> {a..b} - S \<Longrightarrow> norm (f x) \<le> B"
     shows "norm i \<le> B * content {a..b}"
   by (metis assms box_real(2) has_integral_bound_spike_finite)
 
 
 subsection \<open>In particular, the boundary of an interval is negligible\<close>
 
 lemma negligible_frontier_interval: "negligible(cbox (a::'a::euclidean_space) b - box a b)"
 proof -
   let ?A = "\<Union>((\<lambda>k. {x. x\<bullet>k = a\<bullet>k} \<union> {x::'a. x\<bullet>k = b\<bullet>k}) ` Basis)"
   have "negligible ?A"
     by (force simp add: negligible_Union[OF finite_imageI])
   moreover have "cbox a b - box a b \<subseteq> ?A"
     by (force simp add: mem_box)
   ultimately show ?thesis
     by (rule negligible_subset)
 qed
 
 lemma has_integral_spike_interior:
   assumes f: "(f has_integral y) (cbox a b)" and gf: "\<And>x. x \<in> box a b \<Longrightarrow> g x = f x"
   shows "(g has_integral y) (cbox a b)"
   by (meson Diff_iff gf has_integral_spike[OF negligible_frontier_interval _ f])
   
 lemma has_integral_spike_interior_eq:
   assumes "\<And>x. x \<in> box a b \<Longrightarrow> g x = f x"
   shows "(f has_integral y) (cbox a b) \<longleftrightarrow> (g has_integral y) (cbox a b)"
   by (metis assms has_integral_spike_interior)
 
 lemma integrable_spike_interior:
   assumes "\<And>x. x \<in> box a b \<Longrightarrow> g x = f x"
     and "f integrable_on cbox a b"
   shows "g integrable_on cbox a b"
   using assms has_integral_spike_interior_eq by blast
 
 
 subsection \<open>Integrability of continuous functions\<close>
 
 lemma operative_approximableI:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "0 \<le> e"
   shows "operative conj True (\<lambda>i. \<exists>g. (\<forall>x\<in>i. norm (f x - g (x::'b)) \<le> e) \<and> g integrable_on i)"
 proof -
   interpret comm_monoid conj True
     by standard auto
   show ?thesis
   proof (standard, safe)
     fix a b :: 'b
     show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
       if "box a b = {}" for a b
       using assms that
       by (metis content_eq_0_interior integrable_on_null interior_cbox norm_zero right_minus_eq)
     {
       fix c g and k :: 'b
       assume fg: "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e" and g: "g integrable_on cbox a b"
       assume k: "k \<in> Basis"
       show "\<exists>g. (\<forall>x\<in>cbox a b \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
            "\<exists>g. (\<forall>x\<in>cbox a b \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k}"
         using fg g k by auto
     }
     show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
       if fg1: "\<forall>x\<in>cbox a b \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g1 x) \<le> e" 
         and g1: "g1 integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
         and fg2: "\<forall>x\<in>cbox a b \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g2 x) \<le> e" 
         and g2: "g2 integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k}" 
         and k: "k \<in> Basis"
       for c k g1 g2
     proof -
       let ?g = "\<lambda>x. if x\<bullet>k = c then f x else if x\<bullet>k \<le> c then g1 x else g2 x"
       show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
       proof (intro exI conjI ballI)
         show "norm (f x - ?g x) \<le> e" if "x \<in> cbox a b" for x
           by (auto simp: that assms fg1 fg2)
         show "?g integrable_on cbox a b"
         proof -
           have "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}" "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
             by(rule integrable_spike[OF _ negligible_standard_hyperplane[of k c]], use k g1 g2 in auto)+
           with has_integral_split[OF _ _ k] show ?thesis
             unfolding integrable_on_def by blast
         qed
       qed
     qed
   qed
 qed
 
 lemma comm_monoid_set_F_and: "comm_monoid_set.F (\<and>) True f s \<longleftrightarrow> (finite s \<longrightarrow> (\<forall>x\<in>s. f x))"
 proof -
   interpret bool: comm_monoid_set \<open>(\<and>)\<close> True ..
   show ?thesis
     by (induction s rule: infinite_finite_induct) auto
 qed
 
 lemma approximable_on_division:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "0 \<le> e"
     and d: "d division_of (cbox a b)"
     and f: "\<forall>i\<in>d. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
   obtains g where "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e" "g integrable_on cbox a b"
 proof -
   interpret operative conj True "\<lambda>i. \<exists>g. (\<forall>x\<in>i. norm (f x - g (x::'b)) \<le> e) \<and> g integrable_on i"
     using \<open>0 \<le> e\<close> by (rule operative_approximableI)
   from f local.division [OF d] that show thesis
     by auto
 qed
 
 lemma integrable_continuous:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "continuous_on (cbox a b) f"
   shows "f integrable_on cbox a b"
 proof (rule integrable_uniform_limit)
   fix e :: real
   assume e: "e > 0"
   then obtain d where "0 < d" and d: "\<And>x x'. \<lbrakk>x \<in> cbox a b; x' \<in> cbox a b; dist x' x < d\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e"
     using compact_uniformly_continuous[OF assms compact_cbox] unfolding uniformly_continuous_on_def by metis
   obtain p where ptag: "p tagged_division_of cbox a b" and finep: "(\<lambda>x. ball x d) fine p"
     using fine_division_exists[OF gauge_ball[OF \<open>0 < d\<close>], of a b] .
   have *: "\<forall>i\<in>snd ` p. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
   proof (safe, unfold snd_conv)
     fix x l
     assume as: "(x, l) \<in> p"
     obtain a b where l: "l = cbox a b"
       using as ptag by blast
     then have x: "x \<in> cbox a b"
       using as ptag by auto
     show "\<exists>g. (\<forall>x\<in>l. norm (f x - g x) \<le> e) \<and> g integrable_on l"
     proof (intro exI conjI strip)
       show "(\<lambda>y. f x) integrable_on l"
         unfolding integrable_on_def l by blast
     next
       fix y
       assume y: "y \<in> l"
       then have "y \<in> ball x d"
         using as finep by fastforce
       then show "norm (f y - f x) \<le> e"
         using d x y as l
         by (metis dist_commute dist_norm less_imp_le mem_ball ptag subsetCE tagged_division_ofD(3))
     qed
   qed
   from e have "e \<ge> 0"
     by auto
   from approximable_on_division[OF this division_of_tagged_division[OF ptag] *]
   show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
     by metis
 qed
 
 lemma integrable_continuous_interval:
   fixes f :: "'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
   assumes "continuous_on {a..b} f"
   shows "f integrable_on {a..b}"
   by (metis assms integrable_continuous interval_cbox)
 
 lemmas integrable_continuous_real = integrable_continuous_interval[where 'b=real]
 
 lemma integrable_continuous_closed_segment:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "continuous_on (closed_segment a b) f"
   shows "f integrable_on (closed_segment a b)"
   by (metis assms closed_segment_eq_real_ivl integrable_continuous_interval)
 
 
 subsection \<open>Specialization of additivity to one dimension\<close>
 
 
 subsection \<open>A useful lemma allowing us to factor out the content size\<close>
 
 lemma has_integral_factor_content:
   "(f has_integral i) (cbox a b) \<longleftrightarrow>
     (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
       norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content (cbox a b)))"
 proof (cases "content (cbox a b) = 0")
   case True
   have "\<And>e p. p tagged_division_of cbox a b \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x)) \<le> e * content (cbox a b)"
     unfolding sum_content_null[OF True] True by force
   moreover have "i = 0" 
     if "\<And>e. e > 0 \<Longrightarrow> \<exists>d. gauge d \<and>
               (\<forall>p. p tagged_division_of cbox a b \<and>
                    d fine p \<longrightarrow>
                    norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) \<le> e * content (cbox a b))"
     using that [of 1]
     by (force simp add: True sum_content_null[OF True] intro: fine_division_exists[of _ a b])
   ultimately show ?thesis
     unfolding has_integral_null_eq[OF True]
     by (force simp add: )
 next
   case False
   then have F: "0 < content (cbox a b)"
     using zero_less_measure_iff by blast
   let ?P = "\<lambda>e opp. \<exists>d. gauge d \<and>
     (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow> opp (norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i)) e)"
   show ?thesis
   proof (subst has_integral, safe)
     fix e :: real
     assume e: "e > 0"
     show "?P (e * content (cbox a b)) (\<le>)" if \<section>[rule_format]: "\<forall>\<epsilon>>0. ?P \<epsilon> (<)"
       using \<section> [of "e * content (cbox a b)"]
       by (meson F e less_imp_le mult_pos_pos)
     show "?P e (<)" if \<section>[rule_format]:  "\<forall>\<epsilon>>0. ?P (\<epsilon> * content (cbox a b)) (\<le>)"
       using \<section> [of "e/2 / content (cbox a b)"]
         using F e by (force simp add: algebra_simps)
   qed
 qed
 
 lemma has_integral_factor_content_real:
   "(f has_integral i) {a..b::real} \<longleftrightarrow>
     (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a..b}  \<and> d fine p \<longrightarrow>
       norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content {a..b} ))"
   unfolding box_real[symmetric]
   by (rule has_integral_factor_content)
 
 
 subsection \<open>Fundamental theorem of calculus\<close>
 
 lemma interval_bounds_real:
   fixes q b :: real
   assumes "a \<le> b"
   shows "Sup {a..b} = b"
     and "Inf {a..b} = a"
   using assms by auto
 
 theorem fundamental_theorem_of_calculus:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "a \<le> b" 
       and vecd: "\<And>x. x \<in> {a..b} \<Longrightarrow> (f has_vector_derivative f' x) (at x within {a..b})"
   shows "(f' has_integral (f b - f a)) {a..b}"
   unfolding has_integral_factor_content box_real[symmetric]
 proof safe
   fix e :: real
   assume "e > 0"
   then have "\<forall>x. \<exists>d>0. x \<in> {a..b} \<longrightarrow>
          (\<forall>y\<in>{a..b}. norm (y-x) < d \<longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e * norm (y-x))"
     using vecd[unfolded has_vector_derivative_def has_derivative_within_alt] by blast
   then obtain d where d: "\<And>x. 0 < d x"
                  "\<And>x y. \<lbrakk>x \<in> {a..b}; y \<in> {a..b}; norm (y-x) < d x\<rbrakk>
                         \<Longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e * norm (y-x)"
     by metis  
   show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
     norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content (cbox a b))"
   proof (rule exI, safe)
     show "gauge (\<lambda>x. ball x (d x))"
       using d(1) gauge_ball_dependent by blast
   next
     fix p
     assume ptag: "p tagged_division_of cbox a b" and finep: "(\<lambda>x. ball x (d x)) fine p"
     have ba: "b - a = (\<Sum>(x,K)\<in>p. Sup K - Inf K)" "f b - f a = (\<Sum>(x,K)\<in>p. f(Sup K) - f(Inf K))"
       using additive_tagged_division_1[where f= "\<lambda>x. x"] additive_tagged_division_1[where f= f]
             \<open>a \<le> b\<close> ptag by auto
     have "norm (\<Sum>(x, K) \<in> p. (content K *\<^sub>R f' x) - (f (Sup K) - f (Inf K)))
           \<le> (\<Sum>n\<in>p. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))"
     proof (rule sum_norm_le,safe)
       fix x K
       assume "(x, K) \<in> p"
       then have "x \<in> K" and kab: "K \<subseteq> cbox a b"
         using ptag by blast+
       then obtain u v where k: "K = cbox u v" and "x \<in> K" and kab: "K \<subseteq> cbox a b"
         using ptag \<open>(x, K) \<in> p\<close> by auto 
       have "u \<le> v"
         using \<open>x \<in> K\<close> unfolding k by auto
       have ball: "\<forall>y\<in>K. y \<in> ball x (d x)"
         using finep \<open>(x, K) \<in> p\<close> by blast
       have "u \<in> K" "v \<in> K"
         by (simp_all add: \<open>u \<le> v\<close> k)
       have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) = norm (f u - f x - (u - x) *\<^sub>R f' x - (f v - f x - (v - x) *\<^sub>R f' x))"
         by (auto simp add: algebra_simps)
       also have "... \<le> norm (f u - f x - (u - x) *\<^sub>R f' x) + norm (f v - f x - (v - x) *\<^sub>R f' x)"
         by (rule norm_triangle_ineq4)
       finally have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) \<le>
         norm (f u - f x - (u - x) *\<^sub>R f' x) + norm (f v - f x - (v - x) *\<^sub>R f' x)" .
       also have "\<dots> \<le> e * norm (u - x) + e * norm (v - x)"
       proof (rule add_mono)
         show "norm (f u - f x - (u - x) *\<^sub>R f' x) \<le> e * norm (u - x)"
         proof (rule d)
           show "norm (u - x) < d x"
             using \<open>u \<in> K\<close> ball by (auto simp add: dist_real_def)
         qed (use \<open>x \<in> K\<close> \<open>u \<in> K\<close> kab in auto)
         show "norm (f v - f x - (v - x) *\<^sub>R f' x) \<le> e * norm (v - x)"
         proof (rule d)
           show "norm (v - x) < d x"
             using \<open>v \<in> K\<close> ball by (auto simp add: dist_real_def)
         qed (use \<open>x \<in> K\<close> \<open>v \<in> K\<close> kab in auto)
       qed
       also have "\<dots> \<le> e * (Sup K - Inf K)"
         using \<open>x \<in> K\<close> by (auto simp: k interval_bounds_real[OF \<open>u \<le> v\<close>] field_simps)
       finally show "norm (content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) \<le> e * (Sup K - Inf K)"
         using \<open>u \<le> v\<close> by (simp add: k)
     qed
     with \<open>a \<le> b\<close> show "norm ((\<Sum>(x, K)\<in>p. content K *\<^sub>R f' x) - (f b - f a)) \<le> e * content (cbox a b)"
       by (auto simp: ba split_def sum_subtractf [symmetric] sum_distrib_left)
   qed
 qed
 
 lemma has_complex_derivative_imp_has_vector_derivative:
   fixes f :: "complex \<Rightarrow> complex"
   assumes "(f has_field_derivative f') (at (of_real a) within (cbox (of_real x) (of_real y)))"
   shows "((f o of_real) has_vector_derivative f') (at a within {x..y})"
   using has_derivative_in_compose[of of_real of_real a "{x..y}" f "(*) f'"] assms
   by (simp add: scaleR_conv_of_real ac_simps has_vector_derivative_def has_field_derivative_def o_def cbox_complex_of_real)
 
 lemma ident_has_integral:
   fixes a::real
   assumes "a \<le> b"
   shows "((\<lambda>x. x) has_integral (b\<^sup>2 - a\<^sup>2)/2) {a..b}"
 proof -
   have "((\<lambda>x. x) has_integral inverse 2 * b\<^sup>2 - inverse 2 * a\<^sup>2) {a..b}"
     unfolding power2_eq_square
     by (rule fundamental_theorem_of_calculus [OF assms] derivative_eq_intros | simp)+
   then show ?thesis
     by (simp add: field_simps)
 qed
 
 lemma integral_ident [simp]:
   fixes a::real
   assumes "a \<le> b"
   shows "integral {a..b} (\<lambda>x. x) = (if a \<le> b then (b\<^sup>2 - a\<^sup>2)/2 else 0)"
   by (metis assms ident_has_integral integral_unique)
 
 lemma ident_integrable_on:
   fixes a::real
   shows "(\<lambda>x. x) integrable_on {a..b}"
   using continuous_on_id integrable_continuous_real by blast
 
 lemma integral_sin [simp]:
   fixes a::real
   assumes "a \<le> b" shows "integral {a..b} sin = cos a - cos b"
 proof -
   have "(sin has_integral (- cos b - - cos a)) {a..b}"
   proof (rule fundamental_theorem_of_calculus)
     show "((\<lambda>a. - cos a) has_vector_derivative sin x) (at x within {a..b})" for x
       unfolding has_real_derivative_iff_has_vector_derivative [symmetric]
       by (rule derivative_eq_intros | force)+
   qed (use assms in auto)
   then show ?thesis
     by (simp add: integral_unique)
 qed
 
 lemma integral_cos [simp]:
   fixes a::real
   assumes "a \<le> b" shows "integral {a..b} cos = sin b - sin a"
 proof -
   have "(cos has_integral (sin b - sin a)) {a..b}"
   proof (rule fundamental_theorem_of_calculus)
     show "(sin has_vector_derivative cos x) (at x within {a..b})" for x
       unfolding has_real_derivative_iff_has_vector_derivative [symmetric]
       by (rule derivative_eq_intros | force)+
   qed (use assms in auto)
   then show ?thesis
     by (simp add: integral_unique)
 qed
 
 lemma integral_exp [simp]:
   fixes a::real
   assumes "a \<le> b" shows "integral {a..b} exp = exp b - exp a"
   by (meson DERIV_exp assms fundamental_theorem_of_calculus has_real_derivative_iff_has_vector_derivative
        has_vector_derivative_at_within integral_unique)
 
 
 lemma has_integral_sin_nx: "((\<lambda>x. sin(real_of_int n * x)) has_integral 0) {-pi..pi}"
 proof (cases "n = 0")
   case False
   have "((\<lambda>x. sin (n * x)) has_integral (- cos (n * pi)/n - - cos (n * - pi)/n)) {-pi..pi}"
   proof (rule fundamental_theorem_of_calculus)
     show "((\<lambda>x. - cos (n * x) / n) has_vector_derivative sin (n * a)) (at a within {-pi..pi})"
       if "a \<in> {-pi..pi}" for a :: real
       using that False
       unfolding has_vector_derivative_def
       by (intro derivative_eq_intros | force)+
   qed auto
   then show ?thesis
     by simp
 qed auto
 
 lemma integral_sin_nx:
    "integral {-pi..pi} (\<lambda>x. sin(x * real_of_int n)) = 0"
   using has_integral_sin_nx [of n] by (force simp: mult.commute)
 
 lemma has_integral_cos_nx:
   "((\<lambda>x. cos(real_of_int n * x)) has_integral (if n = 0 then 2 * pi else 0)) {-pi..pi}"
 proof (cases "n = 0")
   case True
   then show ?thesis
     using has_integral_const_real [of "1::real" "-pi" pi] by auto
 next
   case False
   have "((\<lambda>x. cos (n * x)) has_integral (sin (n * pi)/n - sin (n * - pi)/n)) {-pi..pi}"
   proof (rule fundamental_theorem_of_calculus)
     show "((\<lambda>x. sin (n * x) / n) has_vector_derivative cos (n * x)) (at x within {-pi..pi})"
       if "x \<in> {-pi..pi}"
       for x :: real
       using that False
       unfolding has_vector_derivative_def
       by (intro derivative_eq_intros | force)+
   qed auto
   with False show ?thesis
     by (simp add: mult.commute)
 qed
 
 lemma integral_cos_nx:
    "integral {-pi..pi} (\<lambda>x. cos(x * real_of_int n)) = (if n = 0 then 2 * pi else 0)"
   using has_integral_cos_nx [of n] by (force simp: mult.commute)
 
 
 subsection \<open>Taylor series expansion\<close>
 
 lemma mvt_integral:
   fixes f::"'a::real_normed_vector\<Rightarrow>'b::banach"
   assumes f'[derivative_intros]:
     "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   assumes line_in: "\<And>t. t \<in> {0..1} \<Longrightarrow> x + t *\<^sub>R y \<in> S"
   shows "f (x + y) - f x = integral {0..1} (\<lambda>t. f' (x + t *\<^sub>R y) y)"
 proof -
   from assms have subset: "(\<lambda>xa. x + xa *\<^sub>R y) ` {0..1} \<subseteq> S" by auto
   note [derivative_intros] =
     has_derivative_subset[OF _ subset]
     has_derivative_in_compose[where f="(\<lambda>xa. x + xa *\<^sub>R y)" and g = f]
   note [continuous_intros] =
     continuous_on_compose2[where f="(\<lambda>xa. x + xa *\<^sub>R y)"]
     continuous_on_subset[OF _ subset]
   have "\<And>t. t \<in> {0..1} \<Longrightarrow>
     ((\<lambda>t. f (x + t *\<^sub>R y)) has_vector_derivative f' (x + t *\<^sub>R y) y)
     (at t within {0..1})"
     using assms
     by (auto simp: has_vector_derivative_def
         linear_cmul[OF has_derivative_linear[OF f'], symmetric]
       intro!: derivative_eq_intros)
   from fundamental_theorem_of_calculus[rule_format, OF _ this]
   show ?thesis
     by (auto intro!: integral_unique[symmetric])
 qed
 
 lemma (in bounded_bilinear) sum_prod_derivatives_has_vector_derivative:
   assumes "p>0"
   and f0: "Df 0 = f"
   and Df: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (Df m has_vector_derivative Df (Suc m) t) (at t within {a..b})"
   and g0: "Dg 0 = g"
   and Dg: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (Dg m has_vector_derivative Dg (Suc m) t) (at t within {a..b})"
   and ivl: "a \<le> t" "t \<le> b"
   shows "((\<lambda>t. \<Sum>i<p. (-1)^i *\<^sub>R prod (Df i t) (Dg (p - Suc i) t))
     has_vector_derivative
       prod (f t) (Dg p t) - (-1)^p *\<^sub>R prod (Df p t) (g t))
     (at t within {a..b})"
   using assms
 proof cases
   assume p: "p \<noteq> 1"
   define p' where "p' = p - 2"
   from assms p have p': "{..<p} = {..Suc p'}" "p = Suc (Suc p')"
     by (auto simp: p'_def)
   have *: "\<And>i. i \<le> p' \<Longrightarrow> Suc (Suc p' - i) = (Suc (Suc p') - i)"
     by auto
   let ?f = "\<lambda>i. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg ((p - i)) t))"
   have "(\<Sum>i<p. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg (Suc (p - Suc i)) t) +
     prod (Df (Suc i) t) (Dg (p - Suc i) t))) =
     (\<Sum>i\<le>(Suc p'). ?f i - ?f (Suc i))"
     by (auto simp: algebra_simps p'(2) numeral_2_eq_2 * lessThan_Suc_atMost)
   also note sum_telescope
   finally
   have "(\<Sum>i<p. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg (Suc (p - Suc i)) t) +
     prod (Df (Suc i) t) (Dg (p - Suc i) t)))
     = prod (f t) (Dg p t) - (- 1) ^ p *\<^sub>R prod (Df p t) (g t)"
     unfolding p'[symmetric]
     by (simp add: assms)
   thus ?thesis
     using assms
     by (auto intro!: derivative_eq_intros has_vector_derivative)
 qed (auto intro!: derivative_eq_intros has_vector_derivative)
 
 lemma
   fixes f::"real\<Rightarrow>'a::banach"
   assumes "p>0"
   and f0: "Df 0 = f"
   and Df: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (Df m has_vector_derivative Df (Suc m) t) (at t within {a..b})"
   and ivl: "a \<le> b"
   defines "i \<equiv> \<lambda>x. ((b - x) ^ (p - 1) / fact (p - 1)) *\<^sub>R Df p x"
   shows Taylor_has_integral:
     "(i has_integral f b - (\<Sum>i<p. ((b-a) ^ i / fact i) *\<^sub>R Df i a)) {a..b}"
   and Taylor_integral:
     "f b = (\<Sum>i<p. ((b-a) ^ i / fact i) *\<^sub>R Df i a) + integral {a..b} i"
   and Taylor_integrable:
     "i integrable_on {a..b}"
 proof goal_cases
   case 1
   interpret bounded_bilinear "scaleR::real\<Rightarrow>'a\<Rightarrow>'a"
     by (rule bounded_bilinear_scaleR)
   define g where "g s = (b - s)^(p - 1)/fact (p - 1)" for s
   define Dg where [abs_def]:
     "Dg n s = (if n < p then (-1)^n * (b - s)^(p - 1 - n) / fact (p - 1 - n) else 0)" for n s
   have g0: "Dg 0 = g"
     using \<open>p > 0\<close>
     by (auto simp add: Dg_def field_split_simps g_def split: if_split_asm)
   {
     fix m
     assume "p > Suc m"
     hence "p - Suc m = Suc (p - Suc (Suc m))"
       by auto
     hence "real (p - Suc m) * fact (p - Suc (Suc m)) = fact (p - Suc m)"
       by auto
   } note fact_eq = this
   have Dg: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (Dg m has_vector_derivative Dg (Suc m) t) (at t within {a..b})"
     unfolding Dg_def
     by (auto intro!: derivative_eq_intros simp: has_vector_derivative_def fact_eq field_split_simps)
   let ?sum = "\<lambda>t. \<Sum>i<p. (- 1) ^ i *\<^sub>R Dg i t *\<^sub>R Df (p - Suc i) t"
   from sum_prod_derivatives_has_vector_derivative[of _ Dg _ _ _ Df,
       OF \<open>p > 0\<close> g0 Dg f0 Df]
   have deriv: "\<And>t. a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (?sum has_vector_derivative
       g t *\<^sub>R Df p t - (- 1) ^ p *\<^sub>R Dg p t *\<^sub>R f t) (at t within {a..b})"
     by auto
   from fundamental_theorem_of_calculus[rule_format, OF \<open>a \<le> b\<close> deriv]
   have "(i has_integral ?sum b - ?sum a) {a..b}"
     using atLeastatMost_empty'[simp del]
     by (simp add: i_def g_def Dg_def)
   also
   have one: "(- 1) ^ p' * (- 1) ^ p' = (1::real)" "{..<p} \<inter> {i. p = Suc i} = {p - 1}" for p'
     using \<open>p > 0\<close> by (auto simp: power_mult_distrib)
   then have "?sum b = f b"
     using Suc_pred'[OF \<open>p > 0\<close>]
     by (simp add: diff_eq_eq Dg_def power_0_left le_Suc_eq if_distrib
         if_distribR sum.If_cases f0)
   also
   have "?sum a = (\<Sum>i<p. ((b-a) ^ i / fact i) *\<^sub>R Df i a)"
   proof (rule sum.reindex_cong)
     have "\<And>i. i < p \<Longrightarrow> \<exists>j<p. i = p - Suc j"
       by (metis Suc_diff_Suc \<open>p>0\<close> diff_Suc_less diff_diff_cancel less_or_eq_imp_le)
     then show "{..<p} = (\<lambda>x. p - x - 1) ` {..<p}"
       by force
   qed (auto simp add: inj_on_def Dg_def one)
   finally show c: ?case .
   case 2 show ?case using c integral_unique
     by (metis (lifting) add.commute diff_eq_eq integral_unique)
   case 3 show ?case using c by force
 qed
 
 
 subsection \<open>Only need trivial subintervals if the interval itself is trivial\<close>
 
 proposition division_of_nontrivial:
   fixes \<D> :: "'a::euclidean_space set set"
   assumes sdiv: "\<D> division_of (cbox a b)"
      and cont0: "content (cbox a b) \<noteq> 0"
   shows "{k. k \<in> \<D> \<and> content k \<noteq> 0} division_of (cbox a b)"
   using sdiv
 proof (induction "card \<D>" arbitrary: \<D> rule: less_induct)
   case less
   note \<D> = division_ofD[OF less.prems]
   {
     presume *: "{k \<in> \<D>. content k \<noteq> 0} \<noteq> \<D> \<Longrightarrow> ?case"
     then show ?case
       using less.prems by fastforce
   }
   assume noteq: "{k \<in> \<D>. content k \<noteq> 0} \<noteq> \<D>"
   then obtain K c d where "K \<in> \<D>" and contk: "content K = 0" and keq: "K = cbox c d"
     using \<D>(4) by blast 
   then have "card \<D> > 0"
     unfolding card_gt_0_iff using less by auto
   then have card: "card (\<D> - {K}) < card \<D>"
     using less \<open>K \<in> \<D>\<close> by (simp add: \<D>(1))
   have closed: "closed (\<Union>(\<D> - {K}))"
     using less.prems by auto
   have "x islimpt \<Union>(\<D> - {K})" if "x \<in> K" for x 
     unfolding islimpt_approachable
   proof (intro allI impI)
     fix e::real
     assume "e > 0"
     obtain i where i: "c\<bullet>i = d\<bullet>i" "i\<in>Basis"
       using contk \<D>(3) [OF \<open>K \<in> \<D>\<close>] unfolding box_ne_empty keq
       by (meson content_eq_0 dual_order.antisym)
     then have xi: "x\<bullet>i = d\<bullet>i"
       using \<open>x \<in> K\<close> unfolding keq mem_box by (metis antisym)
     define y where "y = (\<Sum>j\<in>Basis. (if j = i then if c\<bullet>i \<le> (a\<bullet>i + b\<bullet>i)/2 then c\<bullet>i +
       min e (b\<bullet>i - c\<bullet>i)/2 else c\<bullet>i - min e (c\<bullet>i - a\<bullet>i)/2 else x\<bullet>j) *\<^sub>R j)"
     show "\<exists>x'\<in>\<Union>(\<D> - {K}). x' \<noteq> x \<and> dist x' x < e"
     proof (intro bexI conjI)
       have "d \<in> cbox c d"
         using \<D>(3)[OF \<open>K \<in> \<D>\<close>] by (simp add: box_ne_empty(1) keq mem_box(2))
       then have "d \<in> cbox a b"
         using \<D>(2)[OF \<open>K \<in> \<D>\<close>] by (auto simp: keq)
       then have di: "a \<bullet> i \<le> d \<bullet> i \<and> d \<bullet> i \<le> b \<bullet> i"
         using \<open>i \<in> Basis\<close> mem_box(2) by blast
       then have xyi: "y\<bullet>i \<noteq> x\<bullet>i"
         unfolding y_def i xi using \<open>e > 0\<close> cont0 \<open>i \<in> Basis\<close>
         by (auto simp: content_eq_0 elim!: ballE[of _ _ i])
       then show "y \<noteq> x"
         unfolding euclidean_eq_iff[where 'a='a] using i by auto
       have "norm (y-x) \<le> (\<Sum>b\<in>Basis. \<bar>(y - x) \<bullet> b\<bar>)"
         by (rule norm_le_l1)
       also have "... = \<bar>(y - x) \<bullet> i\<bar> + (\<Sum>b \<in> Basis - {i}. \<bar>(y - x) \<bullet> b\<bar>)"
         by (meson finite_Basis i(2) sum.remove)
       also have "... <  e + sum (\<lambda>i. 0) Basis"
       proof (rule add_less_le_mono)
         show "\<bar>(y-x) \<bullet> i\<bar> < e"
           using di \<open>e > 0\<close> y_def i xi by (auto simp: inner_simps)
         show "(\<Sum>i\<in>Basis - {i}. \<bar>(y-x) \<bullet> i\<bar>) \<le> (\<Sum>i\<in>Basis. 0)"
           unfolding y_def by (auto simp: inner_simps)
       qed 
       finally have "norm (y-x) < e + sum (\<lambda>i. 0) Basis" .
       then show "dist y x < e"
         unfolding dist_norm by auto
       have "y \<notin> K"
         unfolding keq mem_box using i(1) i(2) xi xyi by fastforce
       moreover have "y \<in> \<Union>\<D>"
         using subsetD[OF \<D>(2)[OF \<open>K \<in> \<D>\<close>] \<open>x \<in> K\<close>] \<open>e > 0\<close> di i
         by (auto simp: \<D> mem_box y_def field_simps elim!: ballE[of _ _ i])
       ultimately show "y \<in> \<Union>(\<D> - {K})" by auto
     qed
   qed
   then have "K \<subseteq> \<Union>(\<D> - {K})"
     using closed closed_limpt by blast
   then have "\<Union>(\<D> - {K}) = cbox a b"
     unfolding \<D>(6)[symmetric] by auto
   then have "\<D> - {K} division_of cbox a b"
     by (metis Diff_subset less.prems division_of_subset \<D>(6))
   then have "{ka \<in> \<D> - {K}. content ka \<noteq> 0} division_of (cbox a b)"
     using card less.hyps by blast
   moreover have "{ka \<in> \<D> - {K}. content ka \<noteq> 0} = {K \<in> \<D>. content K \<noteq> 0}"
     using contk by auto
   ultimately show ?case by auto
 qed
 
 
 subsection \<open>Integrability on subintervals\<close>
 
 lemma operative_integrableI:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "0 \<le> e"
   shows "operative conj True (\<lambda>i. f integrable_on i)"
 proof -
   interpret comm_monoid conj True
   proof qed
   show ?thesis
   proof
     show "\<And>a b. box a b = {} \<Longrightarrow> (f integrable_on cbox a b) = True"
       by (simp add: content_eq_0_interior integrable_on_null)
     show "\<And>a b c k.
              k \<in> Basis \<Longrightarrow>
              (f integrable_on cbox a b) \<longleftrightarrow>
              (f integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c} \<and> f integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k})"
       unfolding integrable_on_def by (auto intro!: has_integral_split)
   qed
 qed
 
 lemma integrable_subinterval:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on cbox a b"
     and cd: "cbox c d \<subseteq> cbox a b"
   shows "f integrable_on cbox c d"
 proof -
   interpret operative conj True "\<lambda>i. f integrable_on i"
     using order_refl by (rule operative_integrableI)
   show ?thesis
     by (metis cd division division_of_finite empty f partial_division_extend_1 remove)
 qed
 
 lemma integrable_subinterval_real:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "f integrable_on {a..b}"
     and "{c..d} \<subseteq> {a..b}"
   shows "f integrable_on {c..d}"
   by (metis assms box_real(2) integrable_subinterval)
 
 subsection \<open>Combining adjacent intervals in 1 dimension\<close>
 
 lemma has_integral_combine:
   fixes a b c :: real and j :: "'a::banach"
   assumes "a \<le> c"
       and "c \<le> b"
       and ac: "(f has_integral i) {a..c}"
       and cb: "(f has_integral j) {c..b}"
   shows "(f has_integral (i + j)) {a..b}"
 proof -
   interpret operative_real "lift_option plus" "Some 0"
     "\<lambda>i. if f integrable_on i then Some (integral i f) else None"
     using operative_integralI by (rule operative_realI)
   from \<open>a \<le> c\<close> \<open>c \<le> b\<close> ac cb coalesce_less_eq
   have *: "lift_option (+)
              (if f integrable_on {a..c} then Some (integral {a..c} f) else None)
              (if f integrable_on {c..b} then Some (integral {c..b} f) else None) =
             (if f integrable_on {a..b} then Some (integral {a..b} f) else None)"
     by (auto simp: split: if_split_asm)
   then have "f integrable_on cbox a b"
     using ac cb by (auto split: if_split_asm)
   with * show ?thesis
     using ac cb by (auto simp add: integrable_on_def integral_unique split: if_split_asm)
 qed
 
 lemma integral_combine:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "a \<le> c"
     and "c \<le> b"
     and ab: "f integrable_on {a..b}"
   shows "integral {a..c} f + integral {c..b} f = integral {a..b} f"
 proof -
   have "(f has_integral integral {a..c} f) {a..c}"
     using ab \<open>c \<le> b\<close> integrable_subinterval_real by fastforce
   moreover
   have "(f has_integral integral {c..b} f) {c..b}"
     using ab \<open>a \<le> c\<close> integrable_subinterval_real by fastforce
   ultimately show ?thesis
     by (smt (verit, best) assms has_integral_combine integral_unique)
 qed
 
 lemma integrable_combine:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "a \<le> c"
     and "c \<le> b"
     and "f integrable_on {a..c}"
     and "f integrable_on {c..b}"
   shows "f integrable_on {a..b}"
   using assms has_integral_combine by blast
 
 lemma integral_minus_sets:
   fixes f::"real \<Rightarrow> 'a::banach"
   shows "c \<le> a \<Longrightarrow> c \<le> b \<Longrightarrow> f integrable_on {c .. max a b} \<Longrightarrow>
     integral {c .. a} f - integral {c .. b} f =
     (if a \<le> b then - integral {a .. b} f else integral {b .. a} f)"
   using integral_combine[of c a b f]  integral_combine[of c b a f]
   by (auto simp: algebra_simps max_def)
 
 lemma integral_minus_sets':
   fixes f::"real \<Rightarrow> 'a::banach"
   shows "c \<ge> a \<Longrightarrow> c \<ge> b \<Longrightarrow> f integrable_on {min a b .. c} \<Longrightarrow>
     integral {a .. c} f - integral {b .. c} f =
     (if a \<le> b then integral {a .. b} f else - integral {b .. a} f)"
   using integral_combine[of b a c f] integral_combine[of a b c f]
   by (auto simp: algebra_simps min_def)
 
 subsection \<open>Reduce integrability to "local" integrability\<close>
 
 lemma integrable_on_little_subintervals:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "\<forall>x\<in>cbox a b. \<exists>d>0. \<forall>u v. x \<in> cbox u v \<and> cbox u v \<subseteq> ball x d \<and> cbox u v \<subseteq> cbox a b \<longrightarrow>
     f integrable_on cbox u v"
   shows "f integrable_on cbox a b"
 proof -
   interpret operative conj True "\<lambda>i. f integrable_on i"
     using order_refl by (rule operative_integrableI)
   have "\<forall>x. \<exists>d>0. x\<in>cbox a b \<longrightarrow> (\<forall>u v. x \<in> cbox u v \<and> cbox u v \<subseteq> ball x d \<and> cbox u v \<subseteq> cbox a b \<longrightarrow>
     f integrable_on cbox u v)"
     using assms by (metis zero_less_one)
   then obtain d where d: "\<And>x. 0 < d x"
      "\<And>x u v. \<lbrakk>x \<in> cbox a b; x \<in> cbox u v; cbox u v \<subseteq> ball x (d x); cbox u v \<subseteq> cbox a b\<rbrakk> 
                \<Longrightarrow> f integrable_on cbox u v"
     by metis
   obtain p where p: "p tagged_division_of cbox a b" "(\<lambda>x. ball x (d x)) fine p"
     using fine_division_exists[OF gauge_ball_dependent,of d a b] d(1) by blast 
   then have sndp: "snd ` p division_of cbox a b"
     by (metis division_of_tagged_division)
   have "f integrable_on k" if "(x, k) \<in> p" for x k
     using tagged_division_ofD(2-4)[OF p(1) that] fineD[OF p(2) that] d[of x] by auto
   then show ?thesis
     unfolding division [symmetric, OF sndp] comm_monoid_set_F_and
     by auto
 qed
 
 
 subsection \<open>Second FTC or existence of antiderivative\<close>
 
 lemma integrable_const[intro]: "(\<lambda>x. c) integrable_on cbox a b"
   unfolding integrable_on_def by blast
 
 lemma integral_has_vector_derivative_continuous_at:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on {a..b}"
      and x: "x \<in> {a..b} - S"
      and "finite S"
      and fx: "continuous (at x within ({a..b} - S)) f"
  shows "((\<lambda>u. integral {a..u} f) has_vector_derivative f x) (at x within ({a..b} - S))"
 proof -
   let ?I = "\<lambda>a b. integral {a..b} f"
   { fix e::real
     assume "e > 0"
     obtain d where "d>0" and d: "\<And>x'. \<lbrakk>x' \<in> {a..b} - S; \<bar>x' - x\<bar> < d\<rbrakk> \<Longrightarrow> norm(f x' - f x) \<le> e"
       using \<open>e>0\<close> fx by (auto simp: continuous_within_eps_delta dist_norm less_imp_le)
     have "norm (integral {a..y} f - integral {a..x} f - (y-x) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>" (is "?lhs \<le> ?rhs")
            if y: "y \<in> {a..b} - S" and yx: "\<bar>y - x\<bar> < d" for y
     proof (cases "y < x")
       case False
       have "f integrable_on {a..y}"
         using f y by (simp add: integrable_subinterval_real)
       then have Idiff: "?I a y - ?I a x = ?I x y"
         using False x by (simp add: algebra_simps integral_combine)
       have fux_int: "((\<lambda>u. f u - f x) has_integral integral {x..y} f - (y-x) *\<^sub>R f x) {x..y}"
       proof (rule has_integral_diff)
         show "(f has_integral integral {x..y} f) {x..y}"
           using x y by (auto intro: integrable_integral [OF integrable_subinterval_real [OF f]])
         show "((\<lambda>u. f x) has_integral (y - x) *\<^sub>R f x) {x..y}"
           using has_integral_const_real [of "f x" x y] False by simp
       qed
       have "?lhs \<le> e * content {x..y}"
         using yx False d x y \<open>e>0\<close> assms 
         by (intro has_integral_bound_real[where f="(\<lambda>u. f u - f x)"]) (auto simp: Idiff fux_int)
       also have "... \<le> ?rhs"
         using False by auto
       finally show ?thesis .
     next
       case True
       have "f integrable_on {a..x}"
         using f x by (simp add: integrable_subinterval_real)
       then have Idiff: "?I a x - ?I a y = ?I y x"
         using True x y by (simp add: algebra_simps integral_combine)
       have fux_int: "((\<lambda>u. f u - f x) has_integral integral {y..x} f - (x - y) *\<^sub>R f x) {y..x}"
       proof (rule has_integral_diff)
         show "(f has_integral integral {y..x} f) {y..x}"
           using x y by (auto intro: integrable_integral [OF integrable_subinterval_real [OF f]])
         show "((\<lambda>u. f x) has_integral (x - y) *\<^sub>R f x) {y..x}"
           using has_integral_const_real [of "f x" y x] True by simp
       qed
       have "norm (integral {a..x} f - integral {a..y} f - (x - y) *\<^sub>R f x) \<le> e * content {y..x}"
         using yx True d x y \<open>e>0\<close> assms 
         by (intro has_integral_bound_real[where f="(\<lambda>u. f u - f x)"]) (auto simp: Idiff fux_int)
       also have "... \<le> e * \<bar>y - x\<bar>"
         using True by auto
       finally have "norm (integral {a..x} f - integral {a..y} f - (x - y) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>" .
       then show ?thesis
         by (simp add: algebra_simps norm_minus_commute)
     qed
     then have "\<exists>d>0. \<forall>y\<in>{a..b} - S. \<bar>y - x\<bar> < d \<longrightarrow> norm (integral {a..y} f - integral {a..x} f - (y-x) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
       using \<open>d>0\<close> by blast
   }
   then show ?thesis
     by (simp add: has_vector_derivative_def has_derivative_within_alt bounded_linear_scaleR_left)
 qed
 
 
 lemma integral_has_vector_derivative:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "continuous_on {a..b} f"
     and "x \<in> {a..b}"
   shows "((\<lambda>u. integral {a..u} f) has_vector_derivative f(x)) (at x within {a..b})"
   using assms integral_has_vector_derivative_continuous_at [OF integrable_continuous_real]
   by (fastforce simp: continuous_on_eq_continuous_within)
 
 lemma integral_has_real_derivative:
   assumes "continuous_on {a..b} g"
   assumes "t \<in> {a..b}"
   shows "((\<lambda>x. integral {a..x} g) has_real_derivative g t) (at t within {a..b})"
   using integral_has_vector_derivative[of a b g t] assms
   by (auto simp: has_real_derivative_iff_has_vector_derivative)
 
 lemma antiderivative_continuous:
   fixes q b :: real
   assumes "continuous_on {a..b} f"
   obtains g where "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_vector_derivative (f x::_::banach)) (at x within {a..b})"
   using integral_has_vector_derivative[OF assms] by auto
 
 subsection \<open>Combined fundamental theorem of calculus\<close>
 
 lemma antiderivative_integral_continuous:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "continuous_on {a..b} f"
   obtains g where "\<forall>u\<in>{a..b}. \<forall>v \<in> {a..b}. u \<le> v \<longrightarrow> (f has_integral (g v - g u)) {u..v}"
 proof -
   obtain g 
     where g: "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_vector_derivative f x) (at x within {a..b})" 
     using  antiderivative_continuous[OF assms] by metis
   have "(f has_integral g v - g u) {u..v}" if "u \<in> {a..b}" "v \<in> {a..b}" "u \<le> v" for u v
   proof -
     have "\<And>x. x \<in> cbox u v \<Longrightarrow> (g has_vector_derivative f x) (at x within cbox u v)"
       by (metis atLeastAtMost_iff atLeastatMost_subset_iff box_real(2) g
           has_vector_derivative_within_subset subsetCE that(1,2))
     then show ?thesis
       by (metis box_real(2) that(3) fundamental_theorem_of_calculus)
   qed
   then show ?thesis
     using that by blast
 qed
 
 
 subsection \<open>General "twiddling" for interval-to-interval function image\<close>
 
 lemma has_integral_twiddle:
   assumes "0 < r"
     and hg: "\<And>x. h(g x) = x"
     and gh: "\<And>x. g(h x) = x"
     and contg: "\<And>x. continuous (at x) g"
     and g: "\<And>u v. \<exists>w z. g ` cbox u v = cbox w z"
     and h: "\<And>u v. \<exists>w z. h ` cbox u v = cbox w z"
     and r: "\<And>u v. content(g ` cbox u v) = r * content (cbox u v)"
     and intfi: "(f has_integral i) (cbox a b)"
   shows "((\<lambda>x. f(g x)) has_integral (1 / r) *\<^sub>R i) (h ` cbox a b)"
 proof (cases "cbox a b = {}")
   case True
   then show ?thesis 
     using intfi by auto
 next
   case False
   obtain w z where wz: "h ` cbox a b = cbox w z"
     using h by blast
   have inj: "inj g" "inj h"
     using hg gh injI by metis+
   from h obtain ha hb where h_eq: "h ` cbox a b = cbox ha hb" by blast
   have "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of h ` cbox a b \<and> d fine p 
               \<longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e)"
     if "e > 0" for e
   proof -
     have "e * r > 0" using that \<open>0 < r\<close> by simp
     with intfi[unfolded has_integral]
     obtain d where "gauge d"
                and d: "\<And>p. p tagged_division_of cbox a b \<and> d fine p 
                         \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) < e * r" 
       by metis
     define d' where "d' x = g -` d (g x)" for x
     show ?thesis
     proof (rule_tac x=d' in exI, safe)
       show "gauge d'"
         using \<open>gauge d\<close> continuous_open_vimage[OF _ contg] by (auto simp: gauge_def d'_def)
     next
       fix p
       assume ptag: "p tagged_division_of h ` cbox a b" and finep: "d' fine p"
       note p = tagged_division_ofD[OF ptag]
       have gab: "g y \<in> cbox a b" if "y \<in> K" "(x, K) \<in> p" for x y K
         by (metis hg inj(2) inj_image_mem_iff p(3) subsetCE that that)
       have gimp: "(\<lambda>(x,K). (g x, g ` K)) ` p tagged_division_of (cbox a b) \<and> 
                   d fine (\<lambda>(x, k). (g x, g ` k)) ` p"
         unfolding tagged_division_of
       proof safe
         show "finite ((\<lambda>(x, k). (g x, g ` k)) ` p)"
           using ptag by auto
         show "d fine (\<lambda>(x, k). (g x, g ` k)) ` p"
           using finep unfolding fine_def d'_def by auto
       next
         fix x K
         assume xk: "(x, K) \<in> p"
         show "g x \<in> g ` K"
           using p(2)[OF xk] by auto
         show "\<exists>u v. g ` K = cbox u v"
           using p(4)[OF xk] using assms(5-6) by auto
         fix x' K' u
         assume xk': "(x', K') \<in> p" and u: "u \<in> interior (g ` K)" "u \<in> interior (g ` K')"
         have "interior K \<inter> interior K' \<noteq> {}"
         proof 
           assume "interior K \<inter> interior K' = {}"
           moreover have "u \<in> g ` (interior K \<inter> interior K')"
             using interior_image_subset[OF \<open>inj g\<close> contg] u
             unfolding image_Int[OF inj(1)] by blast
           ultimately show False by blast
         qed
         then have same: "(x, K) = (x', K')"
           using ptag xk' xk by blast
         then show "g x = g x'"
           by auto
         show "g u \<in> g ` K'"if "u \<in> K" for u
           using that same by auto
         show "g u \<in> g ` K"if "u \<in> K'" for u
           using that same by auto
       next
         fix x
         assume "x \<in> cbox a b"
         then have "h x \<in>  \<Union>{k. \<exists>x. (x, k) \<in> p}"
           using p(6) by auto
         then obtain X y where "h x \<in> X" "(y, X) \<in> p" by blast
         then show "x \<in> \<Union>{k. \<exists>x. (x, k) \<in> (\<lambda>(x, k). (g x, g ` k)) ` p}"
           by clarsimp (metis (no_types, lifting) gh image_eqI pair_imageI)
       qed (use gab in auto)
       have *: "inj_on (\<lambda>(x, k). (g x, g ` k)) p"
         using inj(1) unfolding inj_on_def by fastforce
       have "(\<Sum>(x,K)\<in>(\<lambda>(y,L). (g y, g ` L)) ` p. content K *\<^sub>R f x) 
           = (\<Sum>u\<in>p. case case u of (x,K) \<Rightarrow> (g x, g ` K) of (y,L) \<Rightarrow> content L *\<^sub>R f y)"
         by (metis (mono_tags, lifting) "*" sum.reindex_cong)
       also have "... = (\<Sum>(x,K)\<in>p. r *\<^sub>R content K *\<^sub>R f (g x))"
         using r by (auto intro!: * sum.cong simp: bij_betw_def dest!: p(4))
       finally
       have "(\<Sum>(x, K)\<in>(\<lambda>(x,K). (g x, g ` K)) ` p. content K *\<^sub>R f x) - i = r *\<^sub>R (\<Sum>(x,K)\<in>p. content K *\<^sub>R f (g x)) - i" 
         by (simp add: scaleR_right.sum split_def)
       also have "\<dots> = r *\<^sub>R ((\<Sum>(x,K)\<in>p. content K *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i)" 
         using \<open>0 < r\<close> by (auto simp: scaleR_diff_right)
       finally show "norm ((\<Sum>(x,K)\<in>p. content K *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e"
         using d[OF gimp] \<open>0 < r\<close> by auto
     qed
   qed
   then show ?thesis
     by (auto simp: h_eq has_integral)
 qed
 
 
 subsection \<open>Special case of a basic affine transformation\<close>
 
 lemma AE_lborel_inner_neq:
   assumes k: "k \<in> Basis"
   shows "AE x in lborel. x \<bullet> k \<noteq> c"
 proof -
   interpret finite_product_sigma_finite "\<lambda>_. lborel" Basis
     proof qed simp
     have "emeasure lborel {x\<in>space lborel. x \<bullet> k = c} 
         = emeasure (\<Pi>\<^sub>M j::'a\<in>Basis. lborel) (\<Pi>\<^sub>E j\<in>Basis. if j = k then {c} else UNIV)"
     using k
     by (auto simp add: lborel_eq[where 'a='a] emeasure_distr intro!: arg_cong2[where f=emeasure])
        (auto simp: space_PiM PiE_iff extensional_def split: if_split_asm)
   also have "\<dots> = (\<Prod>j\<in>Basis. emeasure lborel (if j = k then {c} else UNIV))"
     by (intro measure_times) auto
   also have "\<dots> = 0"
     by (intro prod_zero bexI[OF _ k]) auto
   finally show ?thesis
     by (subst AE_iff_measurable[OF _ refl]) auto
 qed
 
 lemma content_image_stretch_interval:
   fixes m :: "'a::euclidean_space \<Rightarrow> real"
   defines "s f x \<equiv> (\<Sum>k::'a\<in>Basis. (f k * (x\<bullet>k)) *\<^sub>R k)"
   shows "content (s m ` cbox a b) = \<bar>\<Prod>k\<in>Basis. m k\<bar> * content (cbox a b)"
 proof cases
   have s[measurable]: "s f \<in> borel \<rightarrow>\<^sub>M borel" for f
     by (auto simp: s_def[abs_def])
   assume m: "\<forall>k\<in>Basis. m k \<noteq> 0"
   then have s_comp_s: "s (\<lambda>k. 1 / m k) \<circ> s m = id" "s m \<circ> s (\<lambda>k. 1 / m k) = id"
     by (auto simp: s_def[abs_def] fun_eq_iff euclidean_representation)
   then have "inv (s (\<lambda>k. 1 / m k)) = s m" "bij (s (\<lambda>k. 1 / m k))"
     by (auto intro: inv_unique_comp o_bij)
   then have eq: "s m ` cbox a b = s (\<lambda>k. 1 / m k) -` cbox a b"
     using bij_vimage_eq_inv_image[OF \<open>bij (s (\<lambda>k. 1 / m k))\<close>, of "cbox a b"] by auto
   show ?thesis
     using m unfolding eq measure_def
     by (subst lborel_affine_euclidean[where c=m and t=0])
        (simp_all add: emeasure_density measurable_sets_borel[OF s] abs_prod nn_integral_cmult
                       s_def[symmetric] emeasure_distr vimage_comp s_comp_s enn2real_mult prod_nonneg)
 next
   assume "\<not> (\<forall>k\<in>Basis. m k \<noteq> 0)"
   then obtain k where k: "k \<in> Basis" "m k = 0" by auto
   then have [simp]: "(\<Prod>k\<in>Basis. m k) = 0"
     by (intro prod_zero) auto
   have "emeasure lborel {x\<in>space lborel. x \<in> s m ` cbox a b} = 0"
   proof (rule emeasure_eq_0_AE)
     show "AE x in lborel. x \<notin> s m ` cbox a b"
       using AE_lborel_inner_neq[OF \<open>k\<in>Basis\<close>]
     proof eventually_elim
       show "x \<bullet> k \<noteq> 0 \<Longrightarrow> x \<notin> s m ` cbox a b " for x
         using k by (auto simp: s_def[abs_def] cbox_def)
     qed
   qed
   then show ?thesis
     by (simp add: measure_def)
 qed
 
 lemma interval_image_affinity_interval:
   "\<exists>u v. (\<lambda>x. m *\<^sub>R (x::'a::euclidean_space) + c) ` cbox a b = cbox u v"
   unfolding image_affinity_cbox
   by auto
 
 lemma content_image_affinity_cbox:
   "content((\<lambda>x::'a::euclidean_space. m *\<^sub>R x + c) ` cbox a b) =
     \<bar>m\<bar> ^ DIM('a) * content (cbox a b)" (is "?l = ?r")
 proof (cases "cbox a b = {}")
   case True then show ?thesis by simp
 next
   case False
   show ?thesis
   proof (cases "m \<ge> 0")
     case True
     with \<open>cbox a b \<noteq> {}\<close> have "cbox (m *\<^sub>R a + c) (m *\<^sub>R b + c) \<noteq> {}"
       by (simp add: box_ne_empty inner_left_distrib mult_left_mono)
     moreover from True have *: "\<And>i. (m *\<^sub>R b + c) \<bullet> i - (m *\<^sub>R a + c) \<bullet> i = m *\<^sub>R (b-a) \<bullet> i"
       by (simp add: inner_simps field_simps)
     ultimately show ?thesis
       by (simp add: image_affinity_cbox True content_cbox' prod.distrib inner_diff_left)
   next
     case False
     with \<open>cbox a b \<noteq> {}\<close> have "cbox (m *\<^sub>R b + c) (m *\<^sub>R a + c) \<noteq> {}"
       by (simp add: box_ne_empty inner_left_distrib mult_left_mono)
     moreover from False have *: "\<And>i. (m *\<^sub>R a + c) \<bullet> i - (m *\<^sub>R b + c) \<bullet> i = (-m) *\<^sub>R (b-a) \<bullet> i"
       by (simp add: inner_simps field_simps)
     ultimately show ?thesis using False
       by (simp add: image_affinity_cbox content_cbox'
         prod.distrib[symmetric] inner_diff_left flip: prod_constant)
   qed
 qed
 
 lemma has_integral_affinity:
   fixes a :: "'a::euclidean_space"
   assumes "(f has_integral i) (cbox a b)"
       and "m \<noteq> 0"
   shows "((\<lambda>x. f(m *\<^sub>R x + c)) has_integral (1 / (\<bar>m\<bar> ^ DIM('a))) *\<^sub>R i) ((\<lambda>x. (1 / m) *\<^sub>R x + -((1 / m) *\<^sub>R c)) ` cbox a b)"
 proof (rule has_integral_twiddle)
   show "\<exists>w z. (\<lambda>x. (1 / m) *\<^sub>R x + - ((1 / m) *\<^sub>R c)) ` cbox u v = cbox w z" 
        "\<exists>w z. (\<lambda>x. m *\<^sub>R x + c) ` cbox u v = cbox w z" for u v
     using interval_image_affinity_interval by blast+
   show "content ((\<lambda>x. m *\<^sub>R x + c) ` cbox u v) = \<bar>m\<bar> ^ DIM('a) * content (cbox u v)" for u v
     using content_image_affinity_cbox by blast
 qed (use assms zero_less_power in \<open>auto simp: field_simps\<close>)
 
 lemma integrable_affinity:
   assumes "f integrable_on cbox a b"
     and "m \<noteq> 0"
   shows "(\<lambda>x. f(m *\<^sub>R x + c)) integrable_on ((\<lambda>x. (1 / m) *\<^sub>R x + -((1/m) *\<^sub>R c)) ` cbox a b)"
   using has_integral_affinity assms
   unfolding integrable_on_def by blast
 
 lemmas has_integral_affinity01 = has_integral_affinity [of _ _ 0 "1::real", simplified]
 
 lemma integrable_on_affinity:
   assumes "m \<noteq> 0" "f integrable_on (cbox a b)"
   shows   "(\<lambda>x. f (m *\<^sub>R x + c)) integrable_on ((\<lambda>x. (1 / m) *\<^sub>R x - ((1 / m) *\<^sub>R c)) ` cbox a b)"
 proof -
   from assms obtain I where "(f has_integral I) (cbox a b)"
     by (auto simp: integrable_on_def)
   from has_integral_affinity[OF this assms(1), of c] show ?thesis
     by (auto simp: integrable_on_def)
 qed
 
 lemma has_integral_cmul_iff:
   assumes "c \<noteq> 0"
   shows   "((\<lambda>x. c *\<^sub>R f x) has_integral (c *\<^sub>R I)) A \<longleftrightarrow> (f has_integral I) A"
   using assms has_integral_cmul[of f I A c]
         has_integral_cmul[of "\<lambda>x. c *\<^sub>R f x" "c *\<^sub>R I" A "inverse c"] 
   by (auto simp: field_simps)
 
 lemma has_integral_cmul_iff':
   assumes "c \<noteq> 0"
   shows   "((\<lambda>x. c *\<^sub>R f x) has_integral I) A \<longleftrightarrow> (f has_integral I /\<^sub>R c) A"
   using assms by (metis divideR_right has_integral_cmul_iff)
 
 lemma has_integral_affinity':
   fixes a :: "'a::euclidean_space"
   assumes "(f has_integral i) (cbox a b)" and "m > 0"
   shows "((\<lambda>x. f(m *\<^sub>R x + c)) has_integral (i /\<^sub>R m ^ DIM('a)))
            (cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m))"
 proof (cases "cbox a b = {}")
   case True
   hence "(cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)) = {}"
     using \<open>m > 0\<close> unfolding box_eq_empty by (auto simp: algebra_simps)
   with True and assms show ?thesis by simp
 next
   case False
   have "((\<lambda>x. f (m *\<^sub>R x + c)) has_integral (1 / \<bar>m\<bar> ^ DIM('a)) *\<^sub>R i)
           ((\<lambda>x. (1 / m) *\<^sub>R x + - ((1 / m) *\<^sub>R c)) ` cbox a b)"
     using assms by (intro has_integral_affinity) auto
   also have "((\<lambda>x. (1 / m) *\<^sub>R x + - ((1 / m) *\<^sub>R c)) ` cbox a b) =
                ((\<lambda>x.  - ((1 / m) *\<^sub>R c) + x) ` (\<lambda>x. (1 / m) *\<^sub>R x) ` cbox a b)"
     by (simp add: image_image algebra_simps)
   also have "(\<lambda>x. (1 / m) *\<^sub>R x) ` cbox a b = cbox ((1 / m) *\<^sub>R a) ((1 / m) *\<^sub>R b)" using \<open>m > 0\<close> False
     by (subst image_smult_cbox) simp_all
   also have "(\<lambda>x. - ((1 / m) *\<^sub>R c) + x) ` \<dots> = cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)"
     by (subst cbox_translation [symmetric]) (simp add: field_simps vector_add_divide_simps)
   finally show ?thesis using \<open>m > 0\<close> 
     by (simp add: field_simps)
 qed
 
 lemma has_integral_affinity_iff:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: real_normed_vector"
   assumes "m > 0"
   shows   "((\<lambda>x. f (m *\<^sub>R x + c)) has_integral (I /\<^sub>R m ^ DIM('a)))
                (cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)) \<longleftrightarrow>
            (f has_integral I) (cbox a b)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   from has_integral_affinity'[OF this, of "1 / m" "-c /\<^sub>R m"] and \<open>m > 0\<close>
   show ?rhs by (simp add: vector_add_divide_simps) (simp add: field_simps)
 next
   assume ?rhs
   from has_integral_affinity'[OF this, of m c] and \<open>m > 0\<close>
   show ?lhs by simp
 qed
 
 
 subsection \<open>Special case of stretching coordinate axes separately\<close>
 
 lemma has_integral_stretch:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "(f has_integral i) (cbox a b)"
     and "\<forall>k\<in>Basis. m k \<noteq> 0"
   shows "((\<lambda>x. f (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)) has_integral
          ((1/ \<bar>prod m Basis\<bar>) *\<^sub>R i)) ((\<lambda>x. (\<Sum>k\<in>Basis. (1 / m k * (x\<bullet>k))*\<^sub>R k)) ` cbox a b)"
   apply (rule has_integral_twiddle[where f=f])
   unfolding zero_less_abs_iff content_image_stretch_interval
   unfolding image_stretch_interval empty_as_interval euclidean_eq_iff[where 'a='a]
   using assms
   by auto
 
 lemma has_integral_stretch_real:
   fixes f :: "real \<Rightarrow> 'b::real_normed_vector"
   assumes "(f has_integral i) {a..b}" and "m \<noteq> 0"
   shows "((\<lambda>x. f (m * x)) has_integral (1 / \<bar>m\<bar>) *\<^sub>R i) ((\<lambda>x. x / m) ` {a..b})"
   using has_integral_stretch [of f i a b "\<lambda>b. m"] assms by simp
 
 lemma integrable_stretch:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "f integrable_on cbox a b"
     and "\<forall>k\<in>Basis. m k \<noteq> 0"
   shows "(\<lambda>x::'a. f (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)) integrable_on
     ((\<lambda>x. \<Sum>k\<in>Basis. (1 / m k * (x\<bullet>k))*\<^sub>R k) ` cbox a b)"
   using assms unfolding integrable_on_def
   by (force dest: has_integral_stretch)
 
 lemma vec_lambda_eq_sum:
      "(\<chi> k. f k (x $ k)) = (\<Sum>k\<in>Basis. (f (axis_index k) (x \<bullet> k)) *\<^sub>R k)" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<chi> k. f k (x \<bullet> axis k 1))"
     by (simp add: cart_eq_inner_axis)
   also have "... = (\<Sum>u\<in>UNIV. f u (x \<bullet> axis u 1) *\<^sub>R axis u 1)"
     by (simp add: vec_eq_iff axis_def if_distrib cong: if_cong)
   also have "... = ?rhs"
     by (simp add: Basis_vec_def UNION_singleton_eq_range sum.reindex axis_eq_axis inj_on_def)
   finally show ?thesis .
 qed
 
 lemma has_integral_stretch_cart:
   fixes m :: "'n::finite \<Rightarrow> real"
   assumes f: "(f has_integral i) (cbox a b)" and m: "\<And>k. m k \<noteq> 0"
   shows "((\<lambda>x. f(\<chi> k. m k * x$k)) has_integral i /\<^sub>R \<bar>prod m UNIV\<bar>)
             ((\<lambda>x. \<chi> k. x$k / m k) ` (cbox a b))"
 proof -
   have *: "\<forall>k:: real^'n \<in> Basis. m (axis_index k) \<noteq> 0"
     using axis_index by (simp add: m)
   have eqp: "(\<Prod>k:: real^'n \<in> Basis. m (axis_index k)) = prod m UNIV"
     by (simp add: Basis_vec_def UNION_singleton_eq_range prod.reindex axis_eq_axis inj_on_def)
   show ?thesis
     using has_integral_stretch [OF f *] vec_lambda_eq_sum [where f="\<lambda>i x. m i * x"] vec_lambda_eq_sum [where f="\<lambda>i x. x / m i"]
     by (simp add: field_simps eqp)
 qed
 
 lemma image_stretch_interval_cart:
   fixes m :: "'n::finite \<Rightarrow> real"
   shows "(\<lambda>x. \<chi> k. m k * x$k) ` cbox a b =
             (if cbox a b = {} then {}
             else cbox (\<chi> k. min (m k * a$k) (m k * b$k)) (\<chi> k. max (m k * a$k) (m k * b$k)))"
 proof -
   have *: "(\<Sum>k\<in>Basis. min (m (axis_index k) * (a \<bullet> k)) (m (axis_index k) * (b \<bullet> k)) *\<^sub>R k)
            = (\<chi> k. min (m k * a $ k) (m k * b $ k))"
           "(\<Sum>k\<in>Basis. max (m (axis_index k) * (a \<bullet> k)) (m (axis_index k) * (b \<bullet> k)) *\<^sub>R k)
            = (\<chi> k. max (m k * a $ k) (m k * b $ k))"
     apply (simp_all add: Basis_vec_def cart_eq_inner_axis UNION_singleton_eq_range sum.reindex axis_eq_axis inj_on_def)
     apply (simp_all add: vec_eq_iff axis_def if_distrib cong: if_cong)
     done
   show ?thesis
     by (simp add: vec_lambda_eq_sum [where f="\<lambda>i x. m i * x"] image_stretch_interval eq_cbox *)
 qed
 
 
 subsection \<open>even more special cases\<close>
 
 lemma uminus_interval_vector[simp]:
   fixes a b :: "'a::euclidean_space"
   shows "uminus ` cbox a b = cbox (-b) (-a)"
 proof -
   have "x \<in> uminus ` cbox a b" if "x \<in> cbox (- b) (- a)" for x
     by (smt (verit) add.inverse_inverse image_iff inner_minus_left mem_box(2) that)
   then show ?thesis
     by (auto simp: mem_box)
 qed
 
 lemma has_integral_reflect_lemma[intro]:
   assumes "(f has_integral i) (cbox a b)"
   shows "((\<lambda>x. f(-x)) has_integral i) (cbox (-b) (-a))"
   using has_integral_affinity[OF assms, of "-1" 0]
   by auto
 
 lemma has_integral_reflect_lemma_real[intro]:
   assumes "(f has_integral i) {a..b::real}"
   shows "((\<lambda>x. f(-x)) has_integral i) {-b .. -a}"
   by (metis has_integral_reflect_lemma interval_cbox assms)
 
 lemma has_integral_reflect[simp]:
   "((\<lambda>x. f (-x)) has_integral i) (cbox (-b) (-a)) \<longleftrightarrow> (f has_integral i) (cbox a b)"
   by (auto dest: has_integral_reflect_lemma)
 
 lemma has_integral_reflect_real[simp]:
   fixes a b::real
   shows "((\<lambda>x. f (-x)) has_integral i) {-b..-a} \<longleftrightarrow> (f has_integral i) {a..b}"
   by (metis has_integral_reflect interval_cbox)
 
 lemma integrable_reflect[simp]: "(\<lambda>x. f(-x)) integrable_on cbox (-b) (-a) \<longleftrightarrow> f integrable_on cbox a b"
   unfolding integrable_on_def by auto
 
 lemma integrable_reflect_real[simp]: "(\<lambda>x. f(-x)) integrable_on {-b .. -a} \<longleftrightarrow> f integrable_on {a..b::real}"
   unfolding box_real[symmetric]
   by (rule integrable_reflect)
 
 lemma integral_reflect[simp]: "integral (cbox (-b) (-a)) (\<lambda>x. f (-x)) = integral (cbox a b) f"
   unfolding integral_def by auto
 
 lemma integral_reflect_real[simp]: "integral {-b .. -a} (\<lambda>x. f (-x)) = integral {a..b::real} f"
   unfolding box_real[symmetric]
   by (rule integral_reflect)
 
 subsection \<open>Stronger form of FCT; quite a tedious proof\<close>
 
 lemma split_minus[simp]: "(\<lambda>(x, k). f x k) x - (\<lambda>(x, k). g x k) x = (\<lambda>(x, k). f x k - g x k) x"
   by (simp add: split_def)
 
 theorem fundamental_theorem_of_calculus_interior:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "a \<le> b"
     and contf: "continuous_on {a..b} f"
     and derf: "\<And>x. x \<in> {a <..< b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
   shows "(f' has_integral (f b - f a)) {a..b}"
 proof (cases "a = b")
   case True
   then have *: "cbox a b = {b}" "f b - f a = 0"
     by (auto simp add:  order_antisym)
   with True show ?thesis by auto
 next
   case False
   with \<open>a \<le> b\<close> have ab: "a < b" by arith
   show ?thesis
     unfolding has_integral_factor_content_real
   proof (intro allI impI)
     fix e :: real
     assume e: "e > 0"
     then have eba8: "(e * (b-a)) / 8 > 0"
       using ab by (auto simp add: field_simps)
     note derf_exp = derf[unfolded has_vector_derivative_def has_derivative_at_alt, THEN conjunct2, rule_format]
     have bounded: "\<And>x. x \<in> {a<..<b} \<Longrightarrow> bounded_linear (\<lambda>u. u *\<^sub>R f' x)"
       by (simp add: bounded_linear_scaleR_left)
     have "\<forall>x \<in> box a b. \<exists>d>0. \<forall>y. norm (y-x) < d \<longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e/2 * norm (y-x)"
       (is "\<forall>x \<in> box a b. ?Q x") \<comment>\<open>The explicit quantifier is required by the following step\<close>
     proof
       fix x assume "x \<in> box a b"
       with e show "?Q x"
         using derf_exp [of x "e/2"] by auto
     qed
     then obtain d where d: "\<And>x. 0 < d x"
       "\<And>x y. \<lbrakk>x \<in> box a b; norm (y-x) < d x\<rbrakk> \<Longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e/2 * norm (y-x)"
       unfolding bgauge_existence_lemma by metis
     have "bounded (f ` cbox a b)"
       using compact_cbox assms by (auto simp: compact_imp_bounded compact_continuous_image)
     then obtain B 
       where "0 < B" and B: "\<And>x. x \<in> f ` cbox a b \<Longrightarrow> norm x \<le> B"
       unfolding bounded_pos by metis
     obtain da where "0 < da"
       and da: "\<And>c. \<lbrakk>a \<le> c; {a..c} \<subseteq> {a..b}; {a..c} \<subseteq> ball a da\<rbrakk>
                           \<Longrightarrow> norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> (e * (b-a)) / 4"
     proof -
       have "continuous (at a within {a..b}) f"
         using contf continuous_on_eq_continuous_within by force
       with eba8 obtain k where "0 < k"
         and k: "\<And>x. \<lbrakk>x \<in> {a..b}; 0 < norm (x-a); norm (x-a) < k\<rbrakk> \<Longrightarrow> norm (f x - f a) < e * (b-a) / 8"
         unfolding continuous_within Lim_within dist_norm by metis
       obtain l where l: "0 < l" "norm (l *\<^sub>R f' a) \<le> e * (b-a) / 8" 
       proof (cases "f' a = 0")
         case True with ab e that show ?thesis by auto
       next
         case False
         show ?thesis
         proof
           show "norm ((e * (b - a) / 8 / norm (f' a)) *\<^sub>R f' a) \<le> e * (b - a) / 8"
                "0 < e * (b - a) / 8 / norm (f' a)"
             using False ab e by (auto simp add: field_simps)
         qed 
       qed
       have "norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> e * (b-a) / 4"
         if "a \<le> c" "{a..c} \<subseteq> {a..b}" and bmin: "{a..c} \<subseteq> ball a (min k l)" for c
       proof -
         have minkl: "\<bar>a - x\<bar> < min k l" if "x \<in> {a..c}" for x
           using bmin dist_real_def that by auto
         then have lel: "\<bar>c - a\<bar> \<le> \<bar>l\<bar>"
           using that by force
         have "norm ((c - a) *\<^sub>R f' a - (f c - f a)) \<le> norm ((c - a) *\<^sub>R f' a) + norm (f c - f a)"
           by (rule norm_triangle_ineq4)
         also have "\<dots> \<le> e * (b-a) / 8 + e * (b-a) / 8"
         proof (rule add_mono)
           have "norm ((c - a) *\<^sub>R f' a) \<le> norm (l *\<^sub>R f' a)"
             by (auto intro: mult_right_mono [OF lel])
           with l show "norm ((c - a) *\<^sub>R f' a) \<le> e * (b-a) / 8"
             by linarith 
         next
           have "norm (f c - f a) < e * (b-a) / 8"
           proof (cases "a = c")
             case True then show ?thesis
               using eba8 by auto
           next
             case False show ?thesis
               by (rule k) (use minkl \<open>a \<le> c\<close> that False in auto)
           qed
           then show "norm (f c - f a) \<le> e * (b-a) / 8" by simp
         qed
         finally show "norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> e * (b-a) / 4"
           unfolding content_real[OF \<open>a \<le> c\<close>] by auto
       qed
       then show ?thesis
         by (rule_tac da="min k l" in that) (auto simp: l \<open>0 < k\<close>)
     qed
     obtain db where "0 < db"
       and db: "\<And>c. \<lbrakk>c \<le> b; {c..b} \<subseteq> {a..b}; {c..b} \<subseteq> ball b db\<rbrakk>
                           \<Longrightarrow> norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> (e * (b-a)) / 4"
     proof -
       have "continuous (at b within {a..b}) f"
         using contf continuous_on_eq_continuous_within by force
       with eba8 obtain k
         where "0 < k"
           and k: "\<And>x. \<lbrakk>x \<in> {a..b}; 0 < norm(x-b); norm(x-b) < k\<rbrakk>
                      \<Longrightarrow> norm (f b - f x) < e * (b-a) / 8"
         unfolding continuous_within Lim_within dist_norm norm_minus_commute by metis
       obtain l where l: "0 < l" "norm (l *\<^sub>R f' b) \<le> (e * (b-a)) / 8"
       proof (cases "f' b = 0")
         case True thus ?thesis 
           using ab e that by auto
       next
         case False show ?thesis
         proof
           show "norm ((e * (b - a) / 8 / norm (f' b)) *\<^sub>R f' b) \<le> e * (b - a) / 8" 
                "0 < e * (b - a) / 8 / norm (f' b)"
             using False ab e by (auto simp add: field_simps)
         qed
       qed
       have "norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> e * (b-a) / 4" 
         if "c \<le> b" "{c..b} \<subseteq> {a..b}" and bmin: "{c..b} \<subseteq> ball b (min k l)" for c
       proof -
         have minkl: "\<bar>b - x\<bar> < min k l" if "x \<in> {c..b}" for x
           using bmin dist_real_def that by auto
         then have lel: "\<bar>b - c\<bar> \<le> \<bar>l\<bar>"
           using that by force
         have "norm ((b - c) *\<^sub>R f' b - (f b - f c)) \<le> norm ((b - c) *\<^sub>R f' b) + norm (f b - f c)"
           by (rule norm_triangle_ineq4)
         also have "\<dots> \<le> e * (b-a) / 8 + e * (b-a) / 8"
         proof (rule add_mono)
           have "norm ((b - c) *\<^sub>R f' b) \<le> norm (l *\<^sub>R f' b)"
             by (auto intro: mult_right_mono [OF lel])
           also have "... \<le> e * (b-a) / 8"
             by (rule l)
           finally show "norm ((b - c) *\<^sub>R f' b) \<le> e * (b-a) / 8" .
         next
           have "norm (f b - f c) < e * (b-a) / 8"
           proof (cases "b = c")
             case True with eba8 show ?thesis
               by auto
           next
             case False show ?thesis
               by (rule k) (use minkl \<open>c \<le> b\<close> that False in auto)
           qed
           then show "norm (f b - f c) \<le> e * (b-a) / 8" by simp
         qed
         finally show "norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> e * (b-a) / 4"
           unfolding content_real[OF \<open>c \<le> b\<close>] by auto
       qed
       then show ?thesis
         by (rule_tac db="min k l" in that) (auto simp: l \<open>0 < k\<close>)
     qed
     let ?d = "(\<lambda>x. ball x (if x=a then da else if x=b then db else d x))"
     show "\<exists>d. gauge d \<and> (\<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) - (f b - f a)) \<le> e * content {a..b})"
     proof (rule exI, safe)
       show "gauge ?d"
         using ab \<open>db > 0\<close> \<open>da > 0\<close> d(1) by (auto intro: gauge_ball_dependent)
     next
       fix p
       assume ptag: "p tagged_division_of {a..b}" and fine: "?d fine p"
       let ?A = "{t. fst t \<in> {a, b}}"
       note p = tagged_division_ofD[OF ptag]
       have pA: "p = (p \<inter> ?A) \<union> (p - ?A)" "finite (p \<inter> ?A)" "finite (p - ?A)" "(p \<inter> ?A) \<inter> (p - ?A) = {}"
         using ptag fine by auto
       have le_xz: "\<And>w x y z::real. y \<le> z/2 \<Longrightarrow> w - x \<le> z/2 \<Longrightarrow> w + y \<le> x + z"
         by arith
       have non: False if xk: "(x,K) \<in> p" and "x \<noteq> a" "x \<noteq> b"
         and less: "e * (Sup K - Inf K)/2 < norm (content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))"
       for x K
       proof -
         obtain u v where k: "K = cbox u v"
           using p(4) xk by blast
         then have "u \<le> v" and uv: "{u, v} \<subseteq> cbox u v"
           using p(2)[OF xk] by auto
         then have result: "e * (v - u)/2 < norm ((v - u) *\<^sub>R f' x - (f v - f u))"
           using less[unfolded k box_real interval_bounds_real content_real] by auto
         then have "x \<in> box a b"
           using p(2) p(3) \<open>x \<noteq> a\<close> \<open>x \<noteq> b\<close> xk by fastforce
         with d have *: "\<And>y. norm (y-x) < d x 
                 \<Longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e/2 * norm (y-x)"
           by metis
         have xd: "norm (u - x) < d x" "norm (v - x) < d x"
           using fineD[OF fine xk] \<open>x \<noteq> a\<close> \<open>x \<noteq> b\<close> uv 
           by (auto simp add: k subset_eq dist_commute dist_real_def)
         have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) =
               norm ((f u - f x - (u - x) *\<^sub>R f' x) - (f v - f x - (v - x) *\<^sub>R f' x))"
           by (rule arg_cong[where f=norm]) (auto simp: scaleR_left.diff)
         also have "\<dots> \<le> e/2 * norm (u - x) + e/2 * norm (v - x)"
           by (metis norm_triangle_le_diff add_mono * xd)
         also have "\<dots> \<le> e/2 * norm (v - u)"
           using p(2)[OF xk] by (auto simp add: field_simps k)
         also have "\<dots> < norm ((v - u) *\<^sub>R f' x - (f v - f u))"
           using result by (simp add: \<open>u \<le> v\<close>)
         finally have "e * (v - u)/2 < e * (v - u)/2"
           using uv by auto
         then show False by auto
       qed
       have "norm (\<Sum>(x, K)\<in>p - ?A. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))
           \<le> (\<Sum>(x, K)\<in>p - ?A. norm (content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))))"
         by (auto intro: sum_norm_le)
       also have "... \<le> (\<Sum>n\<in>p - ?A. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k)/2)"
         using non by (fastforce intro: sum_mono)
       finally have I: "norm (\<Sum>(x, k)\<in>p - ?A. content k *\<^sub>R f' x - (f (Sup k) - f (Inf k)))
                      \<le> (\<Sum>n\<in>p - ?A. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))/2"
         by (simp add: sum_divide_distrib)
       have II: "norm (\<Sum>(x, k)\<in>p \<inter> ?A. content k *\<^sub>R f' x - (f (Sup k) - f (Inf k))) -
              (\<Sum>n\<in>p \<inter> ?A. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))
              \<le> (\<Sum>n\<in>p - ?A. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))/2"
       proof -
         have ge0: "0 \<le> e * (Sup k - Inf k)" if xkp: "(x, k) \<in> p \<inter> ?A" for x k
         proof -
           obtain u v where uv: "k = cbox u v"
             by (meson Int_iff xkp p(4))
           with p that have "cbox u v \<noteq> {}"
             by blast
           then show "0 \<le> e * ((Sup k) - (Inf k))"
             unfolding uv using e by (auto simp add: field_simps)
         qed
         let ?B = "\<lambda>x. {t \<in> p. fst t = x \<and> content (snd t) \<noteq> 0}"
         let ?C = "{t \<in> p. fst t \<in> {a, b} \<and> content (snd t) \<noteq> 0}"
         have "norm (\<Sum>(x, k)\<in>p \<inter> {t. fst t \<in> {a, b}}. content k *\<^sub>R f' x - (f (Sup k) - f (Inf k))) \<le> e * (b-a)/2"
         proof -
           have *: "\<And>S f e. sum f S = sum f (p \<inter> ?C) \<Longrightarrow> norm (sum f (p \<inter> ?C)) \<le> e \<Longrightarrow> norm (sum f S) \<le> e"
             by auto
           have 1: "content K *\<^sub>R (f' x) - (f ((Sup K)) - f ((Inf K))) = 0"
             if "(x,K) \<in> p \<inter> {t. fst t \<in> {a, b}} - p \<inter> ?C" for x K
           proof -
             have xk: "(x,K) \<in> p" and k0: "content K = 0"
               using that by auto
             then obtain u v where uv: "K = cbox u v" "u = v"
               using xk k0 p by fastforce
             then show "content K *\<^sub>R (f' x) - (f ((Sup K)) - f ((Inf K))) = 0"
               using xk unfolding uv by auto
           qed
           have 2: "norm(\<Sum>(x,K)\<in>p \<inter> ?C. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))  \<le> e * (b-a)/2"
           proof -
             have norm_le: "norm (sum f S) \<le> e"
               if "\<And>x y. \<lbrakk>x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x = y" "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> e" "e > 0"
               for S f and e :: real
             proof (cases "S = {}")
               case True
               with that show ?thesis by auto
             next
               case False then obtain x where "x \<in> S"
                 by auto
               then have "S = {x}"
                 using that(1) by auto
               then show ?thesis
                 using \<open>x \<in> S\<close> that(2) by auto
             qed
             have *: "p \<inter> ?C = ?B a \<union> ?B b"
               by blast
             then have "norm (\<Sum>(x,K)\<in>p \<inter> ?C. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) =
                        norm (\<Sum>(x,K) \<in> ?B a \<union> ?B b. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))"
               by simp
             also have "... = norm ((\<Sum>(x,K) \<in> ?B a. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) + 
                                    (\<Sum>(x,K) \<in> ?B b. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))))"
               using p(1) ab e by (subst sum.union_disjoint) auto
             also have "... \<le> e * (b - a) / 4 + e * (b - a) / 4"
             proof (rule norm_triangle_le [OF add_mono])
               have pa: "\<exists>v. k = cbox a v \<and> a \<le> v" if "(a, k) \<in> p" for k
                 using p that by fastforce
               show "norm (\<Sum>(x,K) \<in> ?B a. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) \<le> e * (b - a) / 4"
               proof (intro norm_le; clarsimp)
                 fix K K'
                 assume K: "(a, K) \<in> p" "(a, K') \<in> p" and ne0: "content K \<noteq> 0" "content K' \<noteq> 0"
                 with pa obtain v v' where v: "K = cbox a v" "a \<le> v" and v': "K' = cbox a v'" "a \<le> v'"
                   by blast
                 let ?v = "min v v'"
                 have "box a ?v \<subseteq> K \<inter> K'"
                   unfolding v v' by (auto simp add: mem_box)
                 then have "interior (box a (min v v')) \<subseteq> interior K \<inter> interior K'"
                   using interior_Int interior_mono by blast
                 moreover have "(a + ?v)/2 \<in> box a ?v"
                   using ne0  unfolding v v' content_eq_0 not_le
                   by (auto simp add: mem_box)
                 ultimately have "(a + ?v)/2 \<in> interior K \<inter> interior K'"
                   unfolding interior_open[OF open_box] by auto
                 then show "K = K'"
                   using p(5)[OF K] by auto
               next
                 fix K 
                 assume K: "(a, K) \<in> p" and ne0: "content K \<noteq> 0"
                 show "norm (content c *\<^sub>R f' a - (f (Sup c) - f (Inf c))) * 4 \<le> e * (b-a)"
                   if "(a, c) \<in> p" and ne0: "content c \<noteq> 0" for c
                 proof -
                   obtain v where v: "c = cbox a v" and "a \<le> v"
                     using pa[OF \<open>(a, c) \<in> p\<close>] by metis 
                   then have "a \<in> {a..v}" "v \<le> b"
                     using p(3)[OF \<open>(a, c) \<in> p\<close>] by auto
                   moreover have "{a..v} \<subseteq> ball a da"
                     using fineD[OF \<open>?d fine p\<close> \<open>(a, c) \<in> p\<close>] by (simp add: v split: if_split_asm)
                   ultimately show ?thesis
                     unfolding v interval_bounds_real[OF \<open>a \<le> v\<close>] box_real
                     using da \<open>a \<le> v\<close> by auto
                 qed
               qed (use ab e in auto)
             next
               have pb: "\<exists>v. k = cbox v b \<and> b \<ge> v" if "(b, k) \<in> p" for k
                 using p that by fastforce
               show "norm (\<Sum>(x,K) \<in> ?B b. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) \<le> e * (b - a) / 4"
               proof (intro norm_le; clarsimp)
                 fix K K'
                 assume K: "(b, K) \<in> p" "(b, K') \<in> p" and ne0: "content K \<noteq> 0" "content K' \<noteq> 0"
                 with pb obtain v v' where v: "K = cbox v b" "v \<le> b" and v': "K' = cbox v' b" "v' \<le> b"
                   by blast
                 let ?v = "max v v'"
                 have "box ?v b \<subseteq> K \<inter> K'"
                   unfolding v v' by (auto simp: mem_box)
                 then have "interior (box (max v v') b) \<subseteq> interior K \<inter> interior K'"
                   using interior_Int interior_mono by blast
                 moreover have "((b + ?v)/2) \<in> box ?v b"
                   using ne0 unfolding v v' content_eq_0 not_le by (auto simp: mem_box)
                 ultimately have "((b + ?v)/2) \<in> interior K \<inter> interior K'"
                   unfolding interior_open[OF open_box] by auto
                 then show "K = K'"
                   using p(5)[OF K] by auto
               next
                 fix K 
                 assume K: "(b, K) \<in> p" and ne0: "content K \<noteq> 0"
                 show "norm (content c *\<^sub>R f' b - (f (Sup c) - f (Inf c))) * 4 \<le> e * (b-a)"
                   if "(b, c) \<in> p" and ne0: "content c \<noteq> 0" for c
                 proof -
                 obtain v where v: "c = cbox v b" and "v \<le> b"
                   using \<open>(b, c) \<in> p\<close> pb by blast
                 then have "v \<ge> a""b \<in> {v.. b}"  
                   using p(3)[OF \<open>(b, c) \<in> p\<close>] by auto
                 moreover have "{v..b} \<subseteq> ball b db"
                   using fineD[OF \<open>?d fine p\<close> \<open>(b, c) \<in> p\<close>] box_real(2) v False by force
                 ultimately show ?thesis
                   using db v by auto
                 qed
               qed (use ab e in auto)
             qed
             also have "... = e * (b-a)/2"
               by simp
             finally show "norm (\<Sum>(x,k)\<in>p \<inter> ?C.
                         content k *\<^sub>R f' x - (f (Sup k) - f (Inf k))) \<le> e * (b-a)/2" .
           qed
           show "norm (\<Sum>(x, k)\<in>p \<inter> ?A. content k *\<^sub>R f' x - (f ((Sup k)) - f ((Inf k)))) \<le> e * (b-a)/2"
             apply (rule * [OF sum.mono_neutral_right[OF pA(2)]])
             using 1 2 by (auto simp: split_paired_all)
         qed
         also have "... = (\<Sum>n\<in>p. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))/2"
           unfolding sum_distrib_left[symmetric]
           by (subst additive_tagged_division_1[OF \<open>a \<le> b\<close> ptag]) auto
         finally have norm_le: "norm (\<Sum>(x,K)\<in>p \<inter> {t. fst t \<in> {a, b}}. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))
                 \<le> (\<Sum>n\<in>p. e * (case n of (x, K) \<Rightarrow> Sup K - Inf K))/2" .
         have le2: "\<And>x s1 s2::real. 0 \<le> s1 \<Longrightarrow> x \<le> (s1 + s2)/2 \<Longrightarrow> x - s1 \<le> s2/2"
           by auto
         show ?thesis
           apply (rule le2 [OF sum_nonneg])
           using ge0 apply force
           by (metis (no_types, lifting) Diff_Diff_Int Diff_subset norm_le p(1) sum.subset_diff)
       qed
       note * = additive_tagged_division_1[OF assms(1) ptag, symmetric]
       have "norm (\<Sum>(x,K)\<in>p \<inter> ?A \<union> (p - ?A). content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))
                \<le> e * (\<Sum>(x,K)\<in>p \<inter> ?A \<union> (p - ?A). Sup K - Inf K)"
         unfolding sum_distrib_left
         unfolding sum.union_disjoint[OF pA(2-)]
         using le_xz norm_triangle_le I II by blast
       then
       show "norm ((\<Sum>(x,K)\<in>p. content K *\<^sub>R f' x) - (f b - f a)) \<le> e * content {a..b}"
         by (simp only: content_real[OF \<open>a \<le> b\<close>] *[of "\<lambda>x. x"] *[of f] sum_subtractf[symmetric] split_minus pA(1) [symmetric])
     qed
   qed
 qed
 
 
 subsection \<open>Stronger form with finite number of exceptional points\<close>
 
 lemma fundamental_theorem_of_calculus_interior_strong:
  fixes f :: "real \<Rightarrow> 'a::banach"
  assumes "finite S"
    and "a \<le> b" "\<And>x. x \<in> {a <..< b} - S \<Longrightarrow> (f has_vector_derivative f'(x)) (at x)"
    and "continuous_on {a .. b} f"
  shows "(f' has_integral (f b - f a)) {a .. b}"
   using assms
 proof (induction arbitrary: a b)
 case empty
   then show ?case
     using fundamental_theorem_of_calculus_interior by force
 next
 case (insert x S)
   show ?case
   proof (cases "x \<in> {a<..<b}")
     case False then show ?thesis
       using insert by blast
   next
     case True then have "a < x" "x < b"
       by auto
     have "(f' has_integral f x - f a) {a..x}" "(f' has_integral f b - f x) {x..b}"
       using \<open>continuous_on {a..b} f\<close> \<open>a < x\<close> \<open>x < b\<close> continuous_on_subset by (force simp: intro!: insert)+
     then have "(f' has_integral f x - f a + (f b - f x)) {a..b}"
       using \<open>a < x\<close> \<open>x < b\<close> has_integral_combine less_imp_le by blast
     then show ?thesis
       by simp
   qed
 qed
 
 corollary fundamental_theorem_of_calculus_strong:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "finite S"
     and "a \<le> b"
     and vec: "\<And>x. x \<in> {a..b} - S \<Longrightarrow> (f has_vector_derivative f'(x)) (at x)"
     and "continuous_on {a..b} f"
   shows "(f' has_integral (f b - f a)) {a..b}"
   by (rule fundamental_theorem_of_calculus_interior_strong [OF \<open>finite S\<close>]) (force simp: assms)+
 
 proposition indefinite_integral_continuous_left:
   fixes f:: "real \<Rightarrow> 'a::banach"
   assumes intf: "f integrable_on {a..b}" and "a < c" "c \<le> b" "e > 0"
   obtains d where "d > 0"
     and "\<forall>t. c - d < t \<and> t \<le> c \<longrightarrow> norm (integral {a..c} f - integral {a..t} f) < e"
 proof -
   obtain w where "w > 0" and w: "\<And>t. \<lbrakk>c - w < t; t < c\<rbrakk> \<Longrightarrow> norm (f c) * norm(c - t) < e/3"
   proof (cases "f c = 0")
     case False
     hence e3: "0 < e/3 / norm (f c)" using \<open>e>0\<close> by simp
     moreover have "norm (f c) * norm (c - t) < e/3" 
       if "t < c" and "c - e/3 / norm (f c) < t" for t
       unfolding real_norm_def
       by (smt (verit) False divide_right_mono nonzero_mult_div_cancel_left norm_eq_zero norm_ge_zero that)
     ultimately show ?thesis
       using that by auto
   qed (use \<open>e > 0\<close> in auto)
 
   let ?SUM = "\<lambda>p. (\<Sum>(x,K) \<in> p. content K *\<^sub>R f x)"
   have e3: "e/3 > 0"
     using \<open>e > 0\<close> by auto
   have "f integrable_on {a..c}"
     using \<open>a < c\<close> \<open>c \<le> b\<close> by (auto intro: integrable_subinterval_real[OF intf])
   then obtain d1 where "gauge d1" and d1:
     "\<And>p. \<lbrakk>p tagged_division_of {a..c}; d1 fine p\<rbrakk> \<Longrightarrow> norm (?SUM p - integral {a..c} f) < e/3"
     using integrable_integral has_integral_real e3 by metis
   define d where [abs_def]: "d x = ball x w \<inter> d1 x" for x
   have "gauge d"
     unfolding d_def using \<open>w > 0\<close> \<open>gauge d1\<close> by auto
   then obtain k where "0 < k" and k: "ball c k \<subseteq> d c"
     by (meson gauge_def open_contains_ball)
 
   let ?d = "min k (c - a)/2"
   show thesis
   proof (intro that[of ?d] allI impI, safe)
     show "?d > 0"
       using \<open>0 < k\<close> \<open>a < c\<close> by auto
   next
     fix t
     assume t: "c - ?d < t" "t \<le> c"
     show "norm (integral ({a..c}) f - integral ({a..t}) f) < e"
     proof (cases "t < c")
       case False with \<open>t \<le> c\<close> show ?thesis
         by (simp add: \<open>e > 0\<close>)
     next
       case True
       have "f integrable_on {a..t}"
         using \<open>t < c\<close> \<open>c \<le> b\<close> by (auto intro: integrable_subinterval_real[OF intf])
       then obtain d2 where d2: "gauge d2"
         "\<And>p. p tagged_division_of {a..t} \<and> d2 fine p \<Longrightarrow> norm (?SUM p - integral {a..t} f) < e/3"
         using integrable_integral has_integral_real e3 by metis
       define d3 where "d3 x = (if x \<le> t then d1 x \<inter> d2 x else d1 x)" for x
       have "gauge d3"
         using \<open>gauge d1\<close> \<open>gauge d2\<close> unfolding d3_def gauge_def by auto
       then obtain p where ptag: "p tagged_division_of {a..t}" and pfine: "d3 fine p"
         by (metis box_real(2) fine_division_exists)
       note p' = tagged_division_ofD[OF ptag]
       have pt: "(x,K)\<in>p \<Longrightarrow> x \<le> t" for x K
         by (meson atLeastAtMost_iff p'(2) p'(3) subsetCE)
       with pfine have "d2 fine p"
         unfolding fine_def d3_def by fastforce
       then have d2_fin: "norm (?SUM p - integral {a..t} f) < e/3"
         using d2(2) ptag by auto
       have eqs: "{a..c} \<inter> {x. x \<le> t} = {a..t}" "{a..c} \<inter> {x. x \<ge> t} = {t..c}"
         using t by (auto simp add: field_simps)
       have "p \<union> {(c, {t..c})} tagged_division_of {a..c}"
       proof (intro tagged_division_Un_interval_real)
         show "{(c, {t..c})} tagged_division_of {a..c} \<inter> {x. t \<le> x \<bullet> 1}"
           using \<open>t \<le> c\<close> by (auto simp: eqs tagged_division_of_self_real)
       qed (auto simp: eqs ptag)
       moreover
       have "d1 fine p \<union> {(c, {t..c})}"
         unfolding fine_def
       proof safe
         fix x K y
         assume "(x,K) \<in> p" and "y \<in> K" then show "y \<in> d1 x"
           by (metis Int_iff d3_def subsetD fineD pfine)
       next
         fix x assume "x \<in> {t..c}"
         then have "dist c x < k"
           using t(1) by (auto simp add: field_simps dist_real_def)
         with k show "x \<in> d1 c"
           unfolding d_def by auto
       qed  
       ultimately have d1_fin: "norm (?SUM(p \<union> {(c, {t..c})}) - integral {a..c} f) < e/3"
         using d1 by metis
       have SUMEQ: "?SUM(p \<union> {(c, {t..c})}) = (c - t) *\<^sub>R f c + ?SUM p"
       proof -
         have "?SUM(p \<union> {(c, {t..c})}) = (content{t..c} *\<^sub>R f c) + ?SUM p"
         proof (subst sum.union_disjoint)
           show "p \<inter> {(c, {t..c})} = {}"
             using \<open>t < c\<close> pt by force
         qed (use p'(1) in auto)
         also have "... = (c - t) *\<^sub>R f c + ?SUM p"
           using \<open>t \<le> c\<close> by auto
         finally show ?thesis .
       qed
       have "c - k < t"
         using \<open>k>0\<close> t(1) by (auto simp add: field_simps)
       moreover have "k \<le> w"
       proof (rule ccontr)
         assume "\<not> k \<le> w"
         then have "c + (k + w) / 2 \<notin> d c"
           by (auto simp add: field_simps not_le not_less dist_real_def d_def)
         then have "c + (k + w) / 2 \<notin> ball c k"
           using k by blast
         then show False
           using \<open>0 < w\<close> \<open>\<not> k \<le> w\<close> dist_real_def by auto
       qed
       ultimately have cwt: "c - w < t"
         by (auto simp add: field_simps)
       have eq: "integral {a..c} f - integral {a..t} f = -(((c - t) *\<^sub>R f c + ?SUM p) -
                 integral {a..c} f) + (?SUM p - integral {a..t} f) + (c - t) *\<^sub>R f c"
         by auto
       have "norm (integral {a..c} f - integral {a..t} f) < e/3 + e/3 + e/3"
         unfolding eq
       proof (intro norm_triangle_lt add_strict_mono)
         show "norm (- ((c - t) *\<^sub>R f c + ?SUM p - integral {a..c} f)) < e/3"
           by (metis SUMEQ d1_fin norm_minus_cancel)
         show "norm (?SUM p - integral {a..t} f) < e/3"
           using d2_fin by blast
         show "norm ((c - t) *\<^sub>R f c) < e/3"
           using w cwt \<open>t < c\<close> by simp (simp add: field_simps)
       qed
       then show ?thesis by simp
     qed
   qed
 qed
 
 lemma indefinite_integral_continuous_right:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "f integrable_on {a..b}"
     and "a \<le> c"
     and "c < b"
     and "e > 0"
   obtains d where "0 < d"
     and "\<forall>t. c \<le> t \<and> t < c + d \<longrightarrow> norm (integral {a..c} f - integral {a..t} f) < e"
 proof -
   have intm: "(\<lambda>x. f (- x)) integrable_on {-b .. -a}" "- b < - c" "- c \<le> - a"
     using assms by auto
   from indefinite_integral_continuous_left[OF intm \<open>e>0\<close>]
   obtain d where "0 < d"
     and d: "\<And>t. \<lbrakk>- c - d < t; t \<le> -c\<rbrakk> 
              \<Longrightarrow> norm (integral {- b..- c} (\<lambda>x. f (-x)) - integral {- b..t} (\<lambda>x. f (-x))) < e"
     by metis
   let ?d = "min d (b - c)" 
   show ?thesis
   proof (intro that[of "?d"] allI impI)
     show "0 < ?d"
       using \<open>0 < d\<close> \<open>c < b\<close> by auto
     fix t :: real
     assume t: "c \<le> t \<and> t < c + ?d"
     have *: "integral {a..c} f = integral {a..b} f - integral {c..b} f"
             "integral {a..t} f = integral {a..b} f - integral {t..b} f"
       using assms t by (auto simp: algebra_simps integral_combine)
     have "(- c) - d < (- t)" "- t \<le> - c"
       using t by auto 
     from d[OF this] show "norm (integral {a..c} f - integral {a..t} f) < e"
       by (auto simp add: algebra_simps norm_minus_commute *)
   qed
 qed
 
 lemma indefinite_integral_continuous_1:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "f integrable_on {a..b}"
   shows "continuous_on {a..b} (\<lambda>x. integral {a..x} f)"
 proof -
   have "\<exists>d>0. \<forall>x'\<in>{a..b}. dist x' x < d \<longrightarrow> dist (integral {a..x'} f) (integral {a..x} f) < e" 
        if x: "x \<in> {a..b}" and "e > 0" for x e :: real
   proof (cases "a = b")
     case True
     with that show ?thesis by force
   next
     case False
     with x have "a < b" by force
     with x consider "x = a" | "x = b" | "a < x" "x < b"
       by force
     then show ?thesis 
     proof cases
       case 1 then show ?thesis
         by (force simp: dist_norm algebra_simps intro: indefinite_integral_continuous_right [OF assms _ \<open>a < b\<close> \<open>e > 0\<close>])
     next
       case 2 then show ?thesis
         by (force simp: dist_norm norm_minus_commute algebra_simps intro: indefinite_integral_continuous_left [OF assms \<open>a < b\<close> _ \<open>e > 0\<close>])
     next
       case 3
       obtain d1 where "0 < d1" 
         and d1: "\<And>t. \<lbrakk>x - d1 < t; t \<le> x\<rbrakk> \<Longrightarrow> norm (integral {a..x} f - integral {a..t} f) < e"
         using 3 by (auto intro: indefinite_integral_continuous_left [OF assms \<open>a < x\<close> _ \<open>e > 0\<close>])
       obtain d2 where "0 < d2" 
         and d2: "\<And>t. \<lbrakk>x \<le> t; t < x + d2\<rbrakk> \<Longrightarrow> norm (integral {a..x} f - integral {a..t} f) < e"
         using 3 by (auto intro: indefinite_integral_continuous_right [OF assms _ \<open>x < b\<close> \<open>e > 0\<close>])
       show ?thesis
       proof (intro exI ballI conjI impI)
         show "0 < min d1 d2"
           using \<open>0 < d1\<close> \<open>0 < d2\<close> by simp
         show "dist (integral {a..y} f) (integral {a..x} f) < e"
           if "dist y x < min d1 d2" for y
           by (smt (verit) d1 d2 dist_norm dist_real_def norm_minus_commute that)
       qed
     qed
   qed
   then show ?thesis
     by (auto simp: continuous_on_iff)
 qed
 
 lemma indefinite_integral_continuous_1':
   fixes f::"real \<Rightarrow> 'a::banach"
   assumes "f integrable_on {a..b}"
   shows "continuous_on {a..b} (\<lambda>x. integral {x..b} f)"
 proof -
   have "integral {a..b} f - integral {a..x} f = integral {x..b} f" if "x \<in> {a..b}" for x
     using integral_combine[OF _ _ assms, of x] that
     by (auto simp: algebra_simps)
   with _ show ?thesis
     by (rule continuous_on_eq) (auto intro!: continuous_intros indefinite_integral_continuous_1 assms)
 qed
 
 theorem integral_has_vector_derivative':
   fixes f :: "real \<Rightarrow> 'b::banach"
   assumes "continuous_on {a..b} f"
     and "x \<in> {a..b}"
   shows "((\<lambda>u. integral {u..b} f) has_vector_derivative - f x) (at x within {a..b})"
 proof -
   have *: "integral {x..b} f = integral {a .. b} f - integral {a .. x} f" if "a \<le> x" "x \<le> b" for x
     using integral_combine[of a x b for x, OF that integrable_continuous_real[OF assms(1)]]
     by (simp add: algebra_simps)
   show ?thesis
     using \<open>x \<in> _\<close> *
     by (rule has_vector_derivative_transform)
       (auto intro!: derivative_eq_intros assms integral_has_vector_derivative)
 qed
 
 lemma integral_has_real_derivative':
   assumes "continuous_on {a..b} g"
   assumes "t \<in> {a..b}"
   shows "((\<lambda>x. integral {x..b} g) has_real_derivative -g t) (at t within {a..b})"
   using integral_has_vector_derivative'[OF assms]
   by (auto simp: has_real_derivative_iff_has_vector_derivative)
 
 
 subsection \<open>This doesn't directly involve integration, but that gives an easy proof\<close>
 
 lemma has_derivative_zero_unique_strong_interval:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "finite k"
     and contf: "continuous_on {a..b} f"
     and "f a = y"
     and fder: "\<And>x. x \<in> {a..b} - k \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within {a..b})"
     and x: "x \<in> {a..b}"
   shows "f x = y"
 proof -
   have "a \<le> b" "a \<le> x"
     using assms by auto
   have "((\<lambda>x. 0::'a) has_integral f x - f a) {a..x}"
   proof (rule fundamental_theorem_of_calculus_interior_strong[OF \<open>finite k\<close> \<open>a \<le> x\<close>]; clarify?)
     have "{a..x} \<subseteq> {a..b}"
       using x by auto
     then show "continuous_on {a..x} f"
       by (rule continuous_on_subset[OF contf])
     show "(f has_vector_derivative 0) (at z)" if z: "z \<in> {a<..<x}" and notin: "z \<notin> k" for z
       unfolding has_vector_derivative_def
     proof (simp add: at_within_open[OF z, symmetric])
       show "(f has_derivative (\<lambda>x. 0)) (at z within {a<..<x})"
         by (rule has_derivative_subset [OF fder]) (use x z notin in auto)
     qed
   qed
   from has_integral_unique[OF has_integral_0 this]
   show ?thesis
     unfolding assms by auto
 qed
 
 
 subsection \<open>Generalize a bit to any convex set\<close>
 
 lemma has_derivative_zero_unique_strong_convex:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "convex S" "finite K"
     and contf: "continuous_on S f"
     and "c \<in> S" "f c = y"
     and derf: "\<And>x. x \<in> S - K \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within S)"
     and "x \<in> S"
   shows "f x = y"
 proof (cases "x = c")
   case True with \<open>f c = y\<close> show ?thesis
     by blast
 next
   case False
   let ?\<phi> = "\<lambda>u. (1 - u) *\<^sub>R c + u *\<^sub>R x"
   have contf': "continuous_on {0 ..1} (f \<circ> ?\<phi>)"
   proof (rule continuous_intros continuous_on_subset[OF contf])+
     show "(\<lambda>u. (1 - u) *\<^sub>R c + u *\<^sub>R x) ` {0..1} \<subseteq> S"
       using \<open>convex S\<close> \<open>x \<in> S\<close> \<open>c \<in> S\<close> by (auto simp add: convex_alt algebra_simps)
   qed
   have "t = u" if "?\<phi> t = ?\<phi> u" for t u
   proof -
     from that have "(t - u) *\<^sub>R x = (t - u) *\<^sub>R c"
       by (auto simp add: algebra_simps)
     then show ?thesis
       using \<open>x \<noteq> c\<close> by auto
   qed
   then have eq: "(SOME t. ?\<phi> t = ?\<phi> u) = u" for u
     by blast
   then have "(?\<phi> -` K) \<subseteq> (\<lambda>z. SOME t. ?\<phi> t = z) ` K"
     by (clarsimp simp: image_iff) (metis (no_types) eq)
   then have fin: "finite (?\<phi> -` K)"
     by (rule finite_surj[OF \<open>finite K\<close>])
 
   have derf': "((\<lambda>u. f (?\<phi> u)) has_derivative (\<lambda>h. 0)) (at t within {0..1})"
                if "t \<in> {0..1} - {t. ?\<phi> t \<in> K}" for t
   proof -
     have df: "(f has_derivative (\<lambda>h. 0)) (at (?\<phi> t) within ?\<phi> ` {0..1})"
       using \<open>convex S\<close> \<open>x \<in> S\<close> \<open>c \<in> S\<close> that 
       by (auto simp add: convex_alt algebra_simps intro: has_derivative_subset [OF derf])
     have "(f \<circ> ?\<phi> has_derivative (\<lambda>x. 0) \<circ> (\<lambda>z. (0 - z *\<^sub>R c) + z *\<^sub>R x)) (at t within {0..1})"
       by (rule derivative_eq_intros df | simp)+
     then show ?thesis
       unfolding o_def .
   qed
   have "(f \<circ> ?\<phi>) 1 = y"
     apply (rule has_derivative_zero_unique_strong_interval[OF fin contf'])
     unfolding o_def using \<open>f c = y\<close> derf' by auto
   then show ?thesis
     by auto
 qed
 
 
 text \<open>Also to any open connected set with finite set of exceptions. Could
  generalize to locally convex set with limpt-free set of exceptions.\<close>
 
 lemma has_derivative_zero_unique_strong_connected:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "connected S"
     and "open S"
     and "finite K"
     and contf: "continuous_on S f"
     and "c \<in> S"
     and "f c = y"
     and derf: "\<And>x. x \<in> S - K \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within S)"
     and "x \<in> S"
   shows "f x = y"
 proof -
   have "\<exists>e>0. ball x e \<subseteq> (S \<inter> f -` {f x})" if "x \<in> S" for x
   proof -
     obtain e where "0 < e" and e: "ball x e \<subseteq> S"
       using \<open>x \<in> S\<close> \<open>open S\<close> open_contains_ball by blast
     have "ball x e \<subseteq> {u \<in> S. f u \<in> {f x}}"
     proof safe
       fix y
       assume y: "y \<in> ball x e"
       then show "y \<in> S"
         using e by auto
       show "f y = f x"
       proof (rule has_derivative_zero_unique_strong_convex[OF convex_ball \<open>finite K\<close>])
         show "continuous_on (ball x e) f"
           using contf continuous_on_subset e by blast
         show "(f has_derivative (\<lambda>h. 0)) (at u within ball x e)"
              if "u \<in> ball x e - K" for u
           by (metis Diff_iff contra_subsetD derf e has_derivative_subset that)
       qed (use y e \<open>0 < e\<close> in auto)
     qed
     then show "\<exists>e>0. ball x e \<subseteq> (S \<inter> f -` {f x})"
       using \<open>0 < e\<close> by blast
   qed
   then have "openin (top_of_set S) (S \<inter> f -` {y})"
     by (auto intro!: open_openin_trans[OF \<open>open S\<close>] simp: open_contains_ball)
   moreover have "closedin (top_of_set S) (S \<inter> f -` {y})"
     by (force intro!: continuous_closedin_preimage [OF contf])
   ultimately have "(S \<inter> f -` {y}) = {} \<or> (S \<inter> f -` {y}) = S"
     using \<open>connected S\<close> by (simp add: connected_clopen)
   then show ?thesis
     using \<open>x \<in> S\<close> \<open>f c = y\<close> \<open>c \<in> S\<close> by auto
 qed
 
 lemma has_derivative_zero_connected_constant_on:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "connected S" "open S" "finite K" "continuous_on S f"
       and "\<forall>x\<in>S-K. (f has_derivative (\<lambda>h. 0)) (at x within S)"
   shows   "f constant_on S"
   by (smt (verit, best) assms constant_on_def has_derivative_zero_unique_strong_connected)
 
 lemma DERIV_zero_connected_constant_on:
   fixes f :: "'a::{real_normed_field,euclidean_space} \<Rightarrow> 'a"
   assumes *: "connected S" "open S" "finite K" "continuous_on S f"
       and 0: "\<forall>x\<in>S-K. DERIV f x :> 0"
   shows   "f constant_on S"
   using has_derivative_zero_connected_constant_on [OF *] 0
   by (metis has_derivative_at_withinI has_field_derivative_def lambda_zero)
 
 lemma DERIV_zero_connected_constant:
   fixes f :: "'a::{real_normed_field,euclidean_space} \<Rightarrow> 'a"
   assumes "connected S" and "open S" and "finite K" and "continuous_on S f"
       and "\<forall>x\<in>S-K. DERIV f x :> 0"
     obtains c where "\<And>x. x \<in> S \<Longrightarrow> f(x) = c"
   by (metis DERIV_zero_connected_constant_on [OF assms] constant_on_def)
 
 lemma has_field_derivative_0_imp_constant_on:
   fixes f :: "'a::{real_normed_field,euclidean_space} \<Rightarrow> 'a"
   assumes "\<And>z. z \<in> S \<Longrightarrow> (f has_field_derivative 0) (at z)" and S: "connected S" "open S"
   shows   "f constant_on S"
   using DERIV_zero_connected_constant_on [where K="Basis"]
   by (metis DERIV_isCont Diff_iff assms continuous_at_imp_continuous_on eucl.finite_Basis)
 
 
 subsection \<open>Integrating characteristic function of an interval\<close>
 
 lemma has_integral_restrict_open_subinterval:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes intf: "(f has_integral i) (cbox c d)"
     and cb: "cbox c d \<subseteq> cbox a b"
   shows "((\<lambda>x. if x \<in> box c d then f x else 0) has_integral i) (cbox a b)"
 proof (cases "cbox c d = {}")
   case True
   then have "box c d = {}"
     by (metis bot.extremum_uniqueI box_subset_cbox)
   then show ?thesis
     using True intf by auto
 next
   case False
   then obtain p where pdiv: "p division_of cbox a b" and inp: "cbox c d \<in> p"
     using cb partial_division_extend_1 by blast
   define g where [abs_def]: "g x = (if x \<in>box c d then f x else 0)" for x
   interpret operative "lift_option plus" "Some (0 :: 'b)"
     "\<lambda>i. if g integrable_on i then Some (integral i g) else None"
     by (fact operative_integralI)
   note operat = division [OF pdiv, symmetric]
   show ?thesis
   proof (cases "(g has_integral i) (cbox a b)")
     case True then show ?thesis
       by (simp add: g_def)
   next
     case False
     have iterate:"F (\<lambda>i. if g integrable_on i then Some (integral i g) else None) (p - {cbox c d}) = Some 0"
     proof (intro neutral ballI)
       fix x
       assume x: "x \<in> p - {cbox c d}"
       then have "x \<in> p"
         by auto
       then obtain u v where uv: "x = cbox u v"
         using pdiv by blast
       have "interior x \<inter> interior (cbox c d) = {}"
         using pdiv inp x by blast 
       then have "(g has_integral 0) x"
         unfolding uv using has_integral_spike_interior[where f="\<lambda>x. 0"]
         by (metis (no_types, lifting) disjoint_iff_not_equal g_def has_integral_0_eq interior_cbox)
       then show "(if g integrable_on x then Some (integral x g) else None) = Some 0"
         by auto
     qed
     interpret comm_monoid_set "lift_option plus" "Some (0 :: 'b)"
       by (intro comm_monoid_set.intro comm_monoid_lift_option add.comm_monoid_axioms)
     have intg: "g integrable_on cbox c d"
       using integrable_spike_interior[where f=f]
       by (meson g_def has_integral_integrable intf)
     moreover have "integral (cbox c d) g = i"
       by (meson g_def has_integral_iff has_integral_spike_interior intf)
     ultimately have "F (\<lambda>A. if g integrable_on A then Some (integral A g) else None) p = Some i"
       by (metis (full_types, lifting) division_of_finite inp iterate pdiv remove right_neutral)
     with False show ?thesis
       by (metis integrable_integral not_None_eq operat option.inject)
   qed
 qed
 
 
 lemma has_integral_restrict_closed_subinterval:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "(f has_integral i) (cbox c d)"
     and "cbox c d \<subseteq> cbox a b"
   shows "((\<lambda>x. if x \<in> cbox c d then f x else 0) has_integral i) (cbox a b)"
 proof -
   note has_integral_restrict_open_subinterval[OF assms]
   note * = has_integral_spike[OF negligible_frontier_interval _ this]
   show ?thesis
     by (rule *[of c d]) (use box_subset_cbox[of c d] in auto)
 qed
 
 lemma has_integral_restrict_closed_subintervals_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "cbox c d \<subseteq> cbox a b"
   shows "((\<lambda>x. if x \<in> cbox c d then f x else 0) has_integral i) (cbox a b) \<longleftrightarrow> (f has_integral i) (cbox c d)"
   (is "?l = ?r")
 proof (cases "cbox c d = {}")
   case False
   let ?g = "\<lambda>x. if x \<in> cbox c d then f x else 0"
   show ?thesis
   proof 
     assume ?l
     then have "?g integrable_on cbox c d"
       using assms has_integral_integrable integrable_subinterval by blast
     then have "f integrable_on cbox c d"
       by (rule integrable_eq) auto
     moreover then have "i = integral (cbox c d) f"
       by (meson \<open>((\<lambda>x. if x \<in> cbox c d then f x else 0) has_integral i) (cbox a b)\<close> assms has_integral_restrict_closed_subinterval has_integral_unique integrable_integral)
     ultimately show ?r by auto
   next
     assume ?r then show ?l
       by (rule has_integral_restrict_closed_subinterval[OF _ assms])
   qed
 qed auto
 
 
 text \<open>Hence we can apply the limit process uniformly to all integrals.\<close>
 
 lemma has_integral':
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "(f has_integral i) S \<longleftrightarrow>
     (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       (\<exists>z. ((\<lambda>x. if x \<in> S then f(x) else 0) has_integral z) (cbox a b) \<and> norm(z - i) < e))"
   (is "?l \<longleftrightarrow> (\<forall>e>0. ?r e)")
 proof (cases "\<exists>a b. S = cbox a b")
   case False then show ?thesis 
     by (simp add: has_integral_alt)
 next
   case True
   then obtain a b where S: "S = cbox a b"
     by blast 
   obtain B where " 0 < B" and B: "\<And>x. x \<in> cbox a b \<Longrightarrow> norm x \<le> B"
     using bounded_cbox[unfolded bounded_pos] by blast
   show ?thesis
   proof safe
     fix e :: real
     assume ?l and "e > 0"
     have "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) (cbox c d)"
       if "ball 0 (B+1) \<subseteq> cbox c d" for c d
         unfolding S using B that
         by (force intro: \<open>?l\<close>[unfolded S] has_integral_restrict_closed_subinterval)
     then show "?r e"
       by (meson \<open>0 < B\<close> \<open>0 < e\<close> add_pos_pos le_less_trans zero_less_one norm_pths(2))
   next
     assume as: "\<forall>e>0. ?r e"
     then obtain C 
       where C: "\<And>a b. ball 0 C \<subseteq> cbox a b \<Longrightarrow>
                 \<exists>z. ((\<lambda>x. if x \<in> S then f x else 0) has_integral z) (cbox a b)"
       by (meson zero_less_one)
     define c :: 'n where "c = (\<Sum>i\<in>Basis. (- max B C) *\<^sub>R i)"
     define d :: 'n where "d = (\<Sum>i\<in>Basis. max B C *\<^sub>R i)"
     have "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" if "norm x \<le> B" "i \<in> Basis" for x i
       using that and Basis_le_norm[OF \<open>i\<in>Basis\<close>, of x]
       by (auto simp add: field_simps sum_negf c_def d_def)
     then have c_d: "cbox a b \<subseteq> cbox c d"
       by (meson B mem_box(2) subsetI)
     have "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i"
       if x: "norm (0 - x) < C" and i: "i \<in> Basis" for x i
         using Basis_le_norm[OF i, of x] x i by (auto simp: sum_negf c_def d_def)
       then have "ball 0 C \<subseteq> cbox c d"
         by (auto simp: mem_box dist_norm)
     with C obtain y where y: "(f has_integral y) (cbox a b)"
       using c_d has_integral_restrict_closed_subintervals_eq S by blast
     have "y = i"
     proof (rule ccontr)
       assume "y \<noteq> i"
       then have "0 < norm (y - i)"
         by auto
       from as[rule_format,OF this]
       obtain C where C: "\<And>a b. ball 0 C \<subseteq> cbox a b \<Longrightarrow> 
            \<exists>z. ((\<lambda>x. if x \<in> S then f x else 0) has_integral z) (cbox a b) \<and> norm (z-i) < norm (y-i)"
         by auto
       define c :: 'n where "c = (\<Sum>i\<in>Basis. (- max B C) *\<^sub>R i)"
       define d :: 'n where "d = (\<Sum>i\<in>Basis. max B C *\<^sub>R i)"
       have "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i"
         if "norm x \<le> B" and "i \<in> Basis" for x i
           using that Basis_le_norm[of i x] by (auto simp add: field_simps sum_negf c_def d_def)
         then have c_d: "cbox a b \<subseteq> cbox c d"
         by (simp add: B mem_box(2) subset_eq)
       have "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" if "norm (0 - x) < C" and "i \<in> Basis" for x i
         using Basis_le_norm[of i x] that by (auto simp: sum_negf c_def d_def)
       then have "ball 0 C \<subseteq> cbox c d"
         by (auto simp: mem_box dist_norm)
       with C obtain z where z: "(f has_integral z) (cbox a b)" "norm (z-i) < norm (y-i)"
         using has_integral_restrict_closed_subintervals_eq[OF c_d] S by blast
       moreover then have "z = y" 
         by (blast intro: has_integral_unique[OF _ y])
       ultimately show False
         by auto
     qed
     then show ?l
       using y by (auto simp: S)
   qed
 qed
 
 lemma has_integral_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes fg: "(f has_integral i) S" "(g has_integral j) S"
     and le: "\<And>x. x \<in> S \<Longrightarrow> f x \<le> g x"
   shows "i \<le> j"
   using has_integral_component_le[OF _ fg, of 1] le  by auto
 
 lemma integral_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "f integrable_on S"
     and "g integrable_on S"
     and "\<And>x. x \<in> S \<Longrightarrow> f x \<le> g x"
   shows "integral S f \<le> integral S g"
   by (meson assms has_integral_le integrable_integral)
 
 lemma has_integral_nonneg:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "(f has_integral i) S" and "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f x"
   shows "0 \<le> i"
   using assms has_integral_0 has_integral_le by blast
 
 lemma integral_nonneg:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes f: "f integrable_on S" and 0: "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f x"
   shows "0 \<le> integral S f"
   by (rule has_integral_nonneg[OF f[unfolded has_integral_integral] 0])
 
 
 text \<open>Hence a general restriction property.\<close>
 
 lemma has_integral_restrict [simp]:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   assumes "S \<subseteq> T"
   shows "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) T \<longleftrightarrow> (f has_integral i) S"
 proof -
   have *: "\<And>x. (if x \<in> T then if x \<in> S then f x else 0 else 0) =  (if x\<in>S then f x else 0)"
     using assms by auto
   show ?thesis
     apply (subst(2) has_integral')
     apply (subst has_integral')
       apply (simp add: *)
     done
 qed
 
 corollary has_integral_restrict_UNIV:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "((\<lambda>x. if x \<in> s then f x else 0) has_integral i) UNIV \<longleftrightarrow> (f has_integral i) s"
   by auto
 
 lemma has_integral_restrict_Int:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) T \<longleftrightarrow> (f has_integral i) (S \<inter> T)"
 proof -
   have "((\<lambda>x. if x \<in> T then if x \<in> S then f x else 0 else 0) has_integral i) UNIV =
         ((\<lambda>x. if x \<in> S \<inter> T then f x else 0) has_integral i) UNIV"
     by (rule has_integral_cong) auto
   then show ?thesis
     using has_integral_restrict_UNIV by fastforce
 qed
 
 lemma integral_restrict_Int:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "integral T (\<lambda>x. if x \<in> S then f x else 0) = integral (S \<inter> T) f"
   by (metis (no_types, lifting) has_integral_cong has_integral_restrict_Int integrable_integral integral_unique not_integrable_integral)
 
 lemma integrable_restrict_Int:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "(\<lambda>x. if x \<in> S then f x else 0) integrable_on T \<longleftrightarrow> f integrable_on (S \<inter> T)"
   using has_integral_restrict_Int by fastforce
 
 lemma has_integral_on_superset:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "(f has_integral i) S"
       and "\<And>x. x \<notin> S \<Longrightarrow> f x = 0"
       and "S \<subseteq> T"
     shows "(f has_integral i) T"
   by (smt (verit, ccfv_SIG) assms has_integral_cong has_integral_restrict)
 
 lemma integrable_on_superset:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on S" and "\<And>x. x \<notin> S \<Longrightarrow> f x = 0" and "S \<subseteq> t"
   shows "f integrable_on t"
   by (meson assms has_integral_on_superset integrable_integral integrable_on_def)
 
 lemma integral_subset_negligible:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   assumes "S \<subseteq> T" "negligible (T - S)"
   shows   "integral S f = integral T f"
 proof -
   have "integral T f = integral T (\<lambda>x. if x \<in> S then f x else 0)"
     by (rule integral_spike[of "T - S"]) (use assms in auto)
   also have "\<dots> = integral (S \<inter> T) f"
     by (subst integral_restrict_Int) auto
   also have "S \<inter> T = S" using assms by auto
   finally show ?thesis ..
 qed
 
 lemma integral_restrict_UNIV:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "integral UNIV (\<lambda>x. if x \<in> S then f x else 0) = integral S f"
   by (simp add: integral_restrict_Int)
 
 lemma integrable_restrict_UNIV:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "(\<lambda>x. if x \<in> s then f x else 0) integrable_on UNIV \<longleftrightarrow> f integrable_on s"
   unfolding integrable_on_def
   by auto
 
 lemma has_integral_subset_component_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes k: "k \<in> Basis"
     and "S \<subseteq> T" "(f has_integral i) S" "(f has_integral j) T" "\<And>x. x\<in>T \<Longrightarrow> 0 \<le> f(x)\<bullet>k"
   shows "i\<bullet>k \<le> j\<bullet>k"
 proof -
   have \<section>: "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) UNIV"
           "((\<lambda>x. if x \<in> T then f x else 0) has_integral j) UNIV"
     by (simp_all add: assms)
   show ?thesis
     using assms by (force intro!: has_integral_component_le[OF k \<section>])
 qed
 
 subsection\<open>Integrals on set differences\<close>
 
 lemma has_integral_setdiff:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes S: "(f has_integral i) S" and T: "(f has_integral j) T"
     and neg: "negligible (T - S)"
   shows "(f has_integral (i - j)) (S - T)"
 proof -
   show ?thesis
     unfolding has_integral_restrict_UNIV [symmetric, of f]
   proof (rule has_integral_spike [OF neg])
     have eq: "(\<lambda>x. (if x \<in> S then f x else 0) - (if x \<in> T then f x else 0)) =
             (\<lambda>x. if x \<in> T - S then - f x else if x \<in> S - T then f x else 0)"
       by (force simp add: )
     have "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) UNIV"
       "((\<lambda>x. if x \<in> T then f x else 0) has_integral j) UNIV"
       using S T has_integral_restrict_UNIV by auto
     from has_integral_diff [OF this]
     show "((\<lambda>x. if x \<in> T - S then - f x else if x \<in> S - T then f x else 0)
                    has_integral i-j) UNIV"
       by (simp add: eq)
   qed force
 qed
 
 lemma integral_setdiff:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "f integrable_on S" "f integrable_on T" "negligible(T - S)"
  shows "integral (S - T) f = integral S f - integral T f"
   by (rule integral_unique) (simp add: assms has_integral_setdiff integrable_integral)
 
 lemma integrable_setdiff:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "(f has_integral i) S" "(f has_integral j) T" "negligible (T - S)"
   shows "f integrable_on (S - T)"
   using has_integral_setdiff [OF assms]
   by (simp add: has_integral_iff)
 
 lemma negligible_setdiff [simp]: "T \<subseteq> S \<Longrightarrow> negligible (T - S)"
   by (metis Diff_eq_empty_iff negligible_empty)
 
 lemma negligible_on_intervals: "negligible s \<longleftrightarrow> (\<forall>a b. negligible(s \<inter> cbox a b))" (is "?l \<longleftrightarrow> ?r")
 proof
   assume R: ?r
   show ?l
     unfolding negligible_def
     by (metis Diff_iff Int_iff R has_integral_negligible indicator_simps(2))
 qed (simp add: negligible_Int)
 
 lemma negligible_translation:
   assumes "negligible S"
     shows "negligible ((+) c ` S)"
 proof -
   have inj: "inj ((+) c)"
     by simp
   show ?thesis
   using assms
   proof (clarsimp simp: negligible_def)
     fix a b
     assume "\<forall>x y. (indicator S has_integral 0) (cbox x y)"
     then have *: "(indicator S has_integral 0) (cbox (a-c) (b-c))"
       by (meson Diff_iff assms has_integral_negligible indicator_simps(2))
     have eq: "indicator ((+) c ` S) = (\<lambda>x. indicator S (x - c))"
       by (force simp add: indicator_def)
     show "(indicator ((+) c ` S) has_integral 0) (cbox a b)"
       using has_integral_affinity [OF *, of 1 "-c"]
             cbox_translation [of "c" "-c+a" "-c+b"]
       by (simp add: eq) (simp add: ac_simps)
   qed
 qed
 
 lemma negligible_translation_rev:
   assumes "negligible ((+) c ` S)"
   shows "negligible S"
   by (metis negligible_translation [OF assms, of "-c"] translation_galois)
 
 lemma negligible_atLeastAtMostI: "b \<le> a \<Longrightarrow> negligible {a..(b::real)}"
   using negligible_insert by fastforce
 
 lemma has_integral_spike_set_eq:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "negligible {x \<in> S - T. f x \<noteq> 0}" "negligible {x \<in> T - S. f x \<noteq> 0}"
   shows "(f has_integral y) S \<longleftrightarrow> (f has_integral y) T"
 proof -
   have "((\<lambda>x. if x \<in> S then f x else 0) has_integral y) UNIV =
         ((\<lambda>x. if x \<in> T then f x else 0) has_integral y) UNIV"
   proof (rule has_integral_spike_eq)
     show "negligible ({x \<in> S - T. f x \<noteq> 0} \<union> {x \<in> T - S. f x \<noteq> 0})"
       by (rule negligible_Un [OF assms])
   qed auto
   then show ?thesis
     by (simp add: has_integral_restrict_UNIV)
 qed
 
 corollary integral_spike_set:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "negligible {x \<in> S - T. f x \<noteq> 0}" "negligible {x \<in> T - S. f x \<noteq> 0}"
   shows "integral S f = integral T f"
   using has_integral_spike_set_eq [OF assms]
   by (metis eq_integralD integral_unique)
 
 lemma integrable_spike_set:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on S" and neg: "negligible {x \<in> S - T. f x \<noteq> 0}" "negligible {x \<in> T - S. f x \<noteq> 0}"
   shows "f integrable_on T"
   using has_integral_spike_set_eq [OF neg] f by blast
 
 lemma integrable_spike_set_eq:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "negligible ((S - T) \<union> (T - S))"
   shows "f integrable_on S \<longleftrightarrow> f integrable_on T"
   by (blast intro: integrable_spike_set assms negligible_subset)
 
 lemma integrable_on_insert_iff: "f integrable_on (insert x X) \<longleftrightarrow> f integrable_on X"
   for f::"_ \<Rightarrow> 'a::banach"
   by (rule integrable_spike_set_eq) (auto simp: insert_Diff_if)
 
 lemma has_integral_interior:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "negligible(frontier S) \<Longrightarrow> (f has_integral y) (interior S) \<longleftrightarrow> (f has_integral y) S"
   by (rule has_integral_spike_set_eq [OF empty_imp_negligible negligible_subset])
      (use interior_subset in \<open>auto simp: frontier_def closure_def\<close>)
 
 lemma has_integral_closure:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "negligible(frontier S) \<Longrightarrow> (f has_integral y) (closure S) \<longleftrightarrow> (f has_integral y) S"
   by (rule has_integral_spike_set_eq [OF negligible_subset empty_imp_negligible]) (auto simp: closure_Un_frontier )
 
 lemma has_integral_open_interval:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "(f has_integral y) (box a b) \<longleftrightarrow> (f has_integral y) (cbox a b)"
   unfolding interior_cbox [symmetric]
   by (metis frontier_cbox has_integral_interior negligible_frontier_interval)
 
 lemma integrable_on_open_interval:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "f integrable_on box a b \<longleftrightarrow> f integrable_on cbox a b"
   by (simp add: has_integral_open_interval integrable_on_def)
 
 lemma integral_open_interval:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "integral(box a b) f = integral(cbox a b) f"
   by (metis has_integral_integrable_integral has_integral_open_interval not_integrable_integral)
 
 lemma integrable_on_open_interval_real:
   fixes f :: "real \<Rightarrow> 'b :: banach"
   shows "f integrable_on {a<..<b} \<longleftrightarrow> f integrable_on {a..b}"
   using integrable_on_open_interval[of f a b] by simp
 
 lemma integral_open_interval_real:
   "integral {a..b} (f :: real \<Rightarrow> 'a :: banach) = integral {a<..<(b::real)} f"
   using integral_open_interval[of a b f] by simp
 
 lemma has_integral_Icc_iff_Ioo:
   fixes f :: "real \<Rightarrow> 'a :: banach"
   shows "(f has_integral I) {a..b} \<longleftrightarrow> (f has_integral I) {a<..<b}"
   by (metis box_real(1) cbox_interval has_integral_open_interval)
 
 lemma integrable_on_Icc_iff_Ioo:
   fixes f :: "real \<Rightarrow> 'a :: banach"
   shows "f integrable_on {a..b} \<longleftrightarrow> f integrable_on {a<..<b}"
   using has_integral_Icc_iff_Ioo by blast
 
 
 subsection \<open>More lemmas that are useful later\<close>
 
 lemma has_integral_subset_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "s \<subseteq> t"
     and "(f has_integral i) s"
     and "(f has_integral j) t"
     and "\<forall>x\<in>t. 0 \<le> f x"
   shows "i \<le> j"
   using assms has_integral_subset_component_le[OF _ assms(1), of 1 f i j]
   by auto
 
 lemma integral_subset_component_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes "k \<in> Basis"
     and "s \<subseteq> t"
     and "f integrable_on s"
     and "f integrable_on t"
     and "\<forall>x \<in> t. 0 \<le> f x \<bullet> k"
   shows "(integral s f)\<bullet>k \<le> (integral t f)\<bullet>k"
   by (meson assms has_integral_subset_component_le integrable_integral)
 
 lemma integral_subset_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "s \<subseteq> t"
     and "f integrable_on s"
     and "f integrable_on t"
     and "\<forall>x \<in> t. 0 \<le> f x"
   shows "integral s f \<le> integral t f"
   using assms has_integral_subset_le by blast
 
 lemma has_integral_alt':
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "(f has_integral i) s \<longleftrightarrow> 
           (\<forall>a b. (\<lambda>x. if x \<in> s then f x else 0) integrable_on cbox a b) \<and>
           (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
             norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) - i) < e)"
   (is "?l = ?r")
 proof
   assume rhs: ?r
   show ?l
   proof (subst has_integral', intro allI impI)
     fix e::real
     assume "e > 0"
     from rhs[THEN conjunct2,rule_format,OF this] 
     show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
                    (\<exists>z. ((\<lambda>x. if x \<in> s then f x else 0) has_integral z)
                          (cbox a b) \<and> norm (z - i) < e)"
       by (simp add: has_integral_iff rhs)
   qed
 next
   let ?\<Phi> = "\<lambda>e a b. \<exists>z. ((\<lambda>x. if x \<in> s then f x else 0) has_integral z) (cbox a b) \<and> norm (z - i) < e"
   assume ?l 
   then have lhs: "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow> ?\<Phi> e a b" if "e > 0" for e
     using that has_integral'[of f] by auto
   let ?f = "\<lambda>x. if x \<in> s then f x else 0"
   show ?r
   proof (intro conjI allI impI)
     fix a b :: 'n
     from lhs[OF zero_less_one]
     obtain B where "0 < B" and B: "\<And>a b. ball 0 B \<subseteq> cbox a b \<Longrightarrow> ?\<Phi> 1 a b"
       by blast
     let ?a = "\<Sum>i\<in>Basis. min (a\<bullet>i) (-B) *\<^sub>R i::'n"
     let ?b = "\<Sum>i\<in>Basis. max (b\<bullet>i) B *\<^sub>R i::'n"
     show "?f integrable_on cbox a b"
     proof (rule integrable_subinterval[of _ ?a ?b])
       have "?a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> ?b \<bullet> i" if "norm (0 - x) < B" "i \<in> Basis" for x i
         using Basis_le_norm[of i x] that by (auto simp add:field_simps)
       then have "ball 0 B \<subseteq> cbox ?a ?b"
         by (auto simp: mem_box dist_norm)
       then show "?f integrable_on cbox ?a ?b"
         unfolding integrable_on_def using B by blast
       show "cbox a b \<subseteq> cbox ?a ?b"
         by (force simp: mem_box)
     qed
     fix e :: real
     assume "e > 0"
     with lhs show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) - i) < e"
       by (metis (no_types, lifting) has_integral_integrable_integral)
   qed
 qed
 
 
 subsection \<open>Continuity of the integral (for a 1-dimensional interval)\<close>
 
 lemma integrable_alt:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "f integrable_on s \<longleftrightarrow>
     (\<forall>a b. (\<lambda>x. if x \<in> s then f x else 0) integrable_on cbox a b) \<and>
     (\<forall>e>0. \<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
     norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) -
       integral (cbox c d)  (\<lambda>x. if x \<in> s then f x else 0)) < e)"
   (is "?l = ?r")
 proof
   let ?F = "\<lambda>x. if x \<in> s then f x else 0"
   assume ?l
   then obtain y where intF: "\<And>a b. ?F integrable_on cbox a b"
           and y: "\<And>e. 0 < e \<Longrightarrow>
               \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow> norm (integral (cbox a b) ?F - y) < e"
     unfolding integrable_on_def has_integral_alt'[of f] by auto
   show ?r
   proof (intro conjI allI impI intF)
     fix e::real
     assume "e > 0"
     then have "e/2 > 0"
       by auto
     obtain B where "0 < B" 
        and B: "\<And>a b. ball 0 B \<subseteq> cbox a b \<Longrightarrow> norm (integral (cbox a b) ?F - y) < e/2"
       using \<open>0 < e/2\<close> y by blast
     show "\<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
                   norm (integral (cbox a b) ?F - integral (cbox c d) ?F) < e"
     proof (intro conjI exI impI allI, rule \<open>0 < B\<close>)
       fix a b c d::'n
       assume sub: "ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d"
       show "norm (integral (cbox a b) ?F - integral (cbox c d) ?F) < e"
         using sub by (auto intro: norm_triangle_half_l dest: B)
     qed
   qed
 next
   let ?F = "\<lambda>x. if x \<in> s then f x else 0"
   assume rhs: ?r
   let ?cube = "\<lambda>n. cbox (\<Sum>i\<in>Basis. - real n *\<^sub>R i::'n) (\<Sum>i\<in>Basis. real n *\<^sub>R i)"
   have "Cauchy (\<lambda>n. integral (?cube n) ?F)"
     unfolding Cauchy_def
   proof (intro allI impI)
     fix e::real
     assume "e > 0"
     with rhs obtain B where "0 < B" 
       and B: "\<And>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d 
                         \<Longrightarrow> norm (integral (cbox a b) ?F - integral (cbox c d) ?F) < e"
       by blast
     obtain N where N: "B \<le> real N"
       using real_arch_simple by blast
     have "ball 0 B \<subseteq> ?cube n" if n: "n \<ge> N" for n
     proof -
       have "sum ((*\<^sub>R) (- real n)) Basis \<bullet> i \<le> x \<bullet> i \<and>
             x \<bullet> i \<le> sum ((*\<^sub>R) (real n)) Basis \<bullet> i"
         if "norm x < B" "i \<in> Basis" for x i::'n
           using Basis_le_norm[of i x] n N that by (auto simp add: field_simps sum_negf)
       then show ?thesis
         by (auto simp: mem_box dist_norm)
     qed
     then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (integral (?cube m) ?F) (integral (?cube n) ?F) < e"
       by (fastforce simp add: dist_norm intro!: B)
   qed
   then obtain i where i: "(\<lambda>n. integral (?cube n) ?F) \<longlonglongrightarrow> i"
     using convergent_eq_Cauchy by blast
   have "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow> norm (integral (cbox a b) ?F - i) < e"
     if "e > 0" for e
   proof -
     have *: "e/2 > 0" using that by auto
     then obtain N where N: "\<And>n. N \<le> n \<Longrightarrow> norm (i - integral (?cube n) ?F) < e/2"
       using i[THEN LIMSEQ_D, simplified norm_minus_commute] by meson
     obtain B where "0 < B" 
       and B: "\<And>a b c d. \<lbrakk>ball 0 B \<subseteq> cbox a b; ball 0 B \<subseteq> cbox c d\<rbrakk> \<Longrightarrow>
                   norm (integral (cbox a b) ?F - integral (cbox c d) ?F) < e/2"
       using rhs * by meson
     let ?B = "max (real N) B"
     show ?thesis
     proof (intro exI conjI allI impI)
       show "0 < ?B"
         using \<open>B > 0\<close> by auto
       fix a b :: 'n
       assume "ball 0 ?B \<subseteq> cbox a b"
       moreover obtain n where n: "max (real N) B \<le> real n"
         using real_arch_simple by blast
       moreover have "ball 0 B \<subseteq> ?cube n"
       proof 
         fix x :: 'n
         assume x: "x \<in> ball 0 B"
         have "\<lbrakk>norm (0 - x) < B; i \<in> Basis\<rbrakk>
               \<Longrightarrow> sum ((*\<^sub>R) (-n)) Basis \<bullet> i\<le> x \<bullet> i \<and> x \<bullet> i \<le> sum ((*\<^sub>R) n) Basis \<bullet> i" for i
           using Basis_le_norm[of i x] n by (auto simp add: field_simps sum_negf)
         then show "x \<in> ?cube n"
           using x by (auto simp: mem_box dist_norm)
       qed 
       ultimately show "norm (integral (cbox a b) ?F - i) < e"
         using norm_triangle_half_l [OF B N] by force
     qed
   qed
   then show ?l unfolding integrable_on_def has_integral_alt'[of f]
     using rhs by blast
 qed
 
 lemma integrable_altD:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on s"
   shows "\<And>a b. (\<lambda>x. if x \<in> s then f x else 0) integrable_on cbox a b"
     and "\<And>e. e > 0 \<Longrightarrow> \<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
       norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) - integral (cbox c d)  (\<lambda>x. if x \<in> s then f x else 0)) < e"
   using assms[unfolded integrable_alt[of f]] by auto
 
 lemma integrable_alt_subset:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   shows
      "f integrable_on S \<longleftrightarrow>
       (\<forall>a b. (\<lambda>x. if x \<in> S then f x else 0) integrable_on cbox a b) \<and>
       (\<forall>e>0. \<exists>B>0. \<forall>a b c d.
                       ball 0 B \<subseteq> cbox a b \<and> cbox a b \<subseteq> cbox c d
                       \<longrightarrow> norm(integral (cbox a b) (\<lambda>x. if x \<in> S then f x else 0) -
                                integral (cbox c d) (\<lambda>x. if x \<in> S then f x else 0)) < e)"
       (is "_ = ?rhs")
 proof -
   let ?g = "\<lambda>x. if x \<in> S then f x else 0"
   have "f integrable_on S \<longleftrightarrow>
         (\<forall>a b. ?g integrable_on cbox a b) \<and>
         (\<forall>e>0. \<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
            norm (integral (cbox a b) ?g - integral (cbox c d)  ?g) < e)"
     by (rule integrable_alt)
   also have "\<dots> = ?rhs"
   proof -
     { fix e :: "real"
       assume e: "\<And>e. e>0 \<Longrightarrow> \<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> cbox a b \<subseteq> cbox c d \<longrightarrow>
                                    norm (integral (cbox a b) ?g - integral (cbox c d) ?g) < e"
         and "e > 0"
       obtain B where "B > 0"
         and B: "\<And>a b c d. \<lbrakk>ball 0 B \<subseteq> cbox a b; cbox a b \<subseteq> cbox c d\<rbrakk> \<Longrightarrow>
                            norm (integral (cbox a b) ?g - integral (cbox c d) ?g) < e/2"
         using \<open>e > 0\<close> e [of "e/2"] by force
       have "\<exists>B>0. \<forall>a b c d.
                ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
                norm (integral (cbox a b) ?g - integral (cbox c d) ?g) < e"
       proof (intro exI allI conjI impI)
         fix a b c d :: "'a"
         let ?\<alpha> = "\<Sum>i\<in>Basis. max (a \<bullet> i) (c \<bullet> i) *\<^sub>R i"
         let ?\<beta> = "\<Sum>i\<in>Basis. min (b \<bullet> i) (d \<bullet> i) *\<^sub>R i"
         show "norm (integral (cbox a b) ?g - integral (cbox c d) ?g) < e"
           if ball: "ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d"
         proof -
           have B': "norm (integral (cbox a b \<inter> cbox c d) ?g - integral (cbox x y) ?g) < e/2"
             if "cbox a b \<inter> cbox c d \<subseteq> cbox x y" for x y
             using B [of ?\<alpha> ?\<beta> x y] ball that by (simp add: Int_interval [symmetric])
           show ?thesis
             using B' [of a b] B' [of c d] norm_triangle_half_r by blast
         qed
       qed (use \<open>B > 0\<close> in auto)}
     then show ?thesis
       by force
   qed
   finally show ?thesis .
 qed
 
 lemma integrable_on_subcbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes intf: "f integrable_on S"
     and sub: "cbox a b \<subseteq> S"
   shows "f integrable_on cbox a b"
 proof -
   have "(\<lambda>x. if x \<in> S then f x else 0) integrable_on cbox a b"
     by (simp add: intf integrable_altD(1))
 then show ?thesis
   by (metis (mono_tags) sub integrable_restrict_Int le_inf_iff order_refl subset_antisym)
 qed
 
 
 subsection \<open>A straddling criterion for integrability\<close>
 
 lemma integrable_straddle_interval:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "\<And>e. e>0 \<Longrightarrow> \<exists>g h i j. (g has_integral i) (cbox a b) \<and> (h has_integral j) (cbox a b) \<and>
                             \<bar>i - j\<bar> < e \<and> (\<forall>x\<in>cbox a b. (g x) \<le> f x \<and> f x \<le> h x)"
   shows "f integrable_on cbox a b"
 proof -
   have "\<exists>d. gauge d \<and>
             (\<forall>p1 p2. p1 tagged_division_of cbox a b \<and> d fine p1 \<and>
                      p2 tagged_division_of cbox a b \<and> d fine p2 \<longrightarrow>
                      \<bar>(\<Sum>(x,K)\<in>p1. content K *\<^sub>R f x) - (\<Sum>(x,K)\<in>p2. content K *\<^sub>R f x)\<bar> < e)"
     if "e > 0" for e
   proof -
     have e: "e/3 > 0"
       using that by auto
     then obtain g h i j where ij: "\<bar>i - j\<bar> < e/3"
             and "(g has_integral i) (cbox a b)"
             and "(h has_integral j) (cbox a b)"
             and fgh: "\<And>x. x \<in> cbox a b \<Longrightarrow> g x \<le> f x \<and> f x \<le> h x"
       using assms real_norm_def by metis
     then obtain d1 d2 where "gauge d1" "gauge d2"
             and d1: "\<And>p. \<lbrakk>p tagged_division_of cbox a b; d1 fine p\<rbrakk> \<Longrightarrow>
                           \<bar>(\<Sum>(x,K)\<in>p. content K *\<^sub>R g x) - i\<bar> < e/3"
             and d2: "\<And>p. \<lbrakk>p tagged_division_of cbox a b; d2 fine p\<rbrakk> \<Longrightarrow>
                           \<bar>(\<Sum>(x,K) \<in> p. content K *\<^sub>R h x) - j\<bar> < e/3"
       by (metis e has_integral real_norm_def)
     have "\<bar>(\<Sum>(x,K) \<in> p1. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p2. content K *\<^sub>R f x)\<bar> < e"
       if p1: "p1 tagged_division_of cbox a b" and 11: "d1 fine p1" and 21: "d2 fine p1"
        and p2: "p2 tagged_division_of cbox a b" and 12: "d1 fine p2" and 22: "d2 fine p2" for p1 p2
     proof -
       have *: "\<And>g1 g2 h1 h2 f1 f2.
                   \<lbrakk>\<bar>g2 - i\<bar> < e/3; \<bar>g1 - i\<bar> < e/3; \<bar>h2 - j\<bar> < e/3; \<bar>h1 - j\<bar> < e/3;
                    g1 - h2 \<le> f1 - f2; f1 - f2 \<le> h1 - g2\<rbrakk>
                   \<Longrightarrow> \<bar>f1 - f2\<bar> < e"
         using \<open>e > 0\<close> ij by arith
       have 0: "(\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p1. content k *\<^sub>R g x) \<ge> 0"
               "0 \<le> (\<Sum>(x, k)\<in>p2. content k *\<^sub>R h x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)"
               "(\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R g x) \<ge> 0"
               "0 \<le> (\<Sum>(x, k)\<in>p1. content k *\<^sub>R h x) - (\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x)"
         unfolding sum_subtractf[symmetric]
            apply (auto intro!: sum_nonneg)
            apply (meson fgh measure_nonneg mult_left_mono tag_in_interval that sum_nonneg)+
         done
       show ?thesis
       proof (rule *)
         show "\<bar>(\<Sum>(x,K) \<in> p2. content K *\<^sub>R g x) - i\<bar> < e/3"
           by (rule d1[OF p2 12])
         show "\<bar>(\<Sum>(x,K) \<in> p1. content K *\<^sub>R g x) - i\<bar> < e/3"
           by (rule d1[OF p1 11])
         show "\<bar>(\<Sum>(x,K) \<in> p2. content K *\<^sub>R h x) - j\<bar> < e/3"
           by (rule d2[OF p2 22])
         show "\<bar>(\<Sum>(x,K) \<in> p1. content K *\<^sub>R h x) - j\<bar> < e/3"
           by (rule d2[OF p1 21])
       qed (use 0 in auto)
     qed
     then show ?thesis
       by (rule_tac x="\<lambda>x. d1 x \<inter> d2 x" in exI)
         (auto simp: fine_Int intro: \<open>gauge d1\<close> \<open>gauge d2\<close> d1 d2)
   qed
   then show ?thesis
     by (simp add: integrable_Cauchy)
 qed
 
 lemma integrable_straddle:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "\<And>e. e>0 \<Longrightarrow> \<exists>g h i j. (g has_integral i) s \<and> (h has_integral j) s \<and>
                      \<bar>i - j\<bar> < e \<and> (\<forall>x\<in>s. g x \<le> f x \<and> f x \<le> h x)"
   shows "f integrable_on s"
 proof -
   let ?fs = "(\<lambda>x. if x \<in> s then f x else 0)"
   have "?fs integrable_on cbox a b" for a b
   proof (rule integrable_straddle_interval)
     fix e::real
     assume "e > 0"
     then have *: "e/4 > 0"
       by auto
     with assms obtain g h i j where g: "(g has_integral i) s" and h: "(h has_integral j) s"
                  and ij: "\<bar>i - j\<bar> < e/4"
                  and fgh: "\<And>x. x \<in> s \<Longrightarrow> g x \<le> f x \<and> f x \<le> h x"
       by metis
     let ?gs = "(\<lambda>x. if x \<in> s then g x else 0)"
     let ?hs = "(\<lambda>x. if x \<in> s then h x else 0)"
     obtain Bg where Bg: "\<And>a b. ball 0 Bg \<subseteq> cbox a b \<Longrightarrow> \<bar>integral (cbox a b) ?gs - i\<bar> < e/4"
               and int_g: "\<And>a b. ?gs integrable_on cbox a b"
       using g * unfolding has_integral_alt' real_norm_def by meson
     obtain Bh where
           Bh: "\<And>a b. ball 0 Bh \<subseteq> cbox a b \<Longrightarrow> \<bar>integral (cbox a b) ?hs - j\<bar> < e/4"
          and int_h: "\<And>a b. ?hs integrable_on cbox a b"
       using h * unfolding has_integral_alt' real_norm_def by meson
     define c where "c = (\<Sum>i\<in>Basis. min (a\<bullet>i) (- (max Bg Bh)) *\<^sub>R i)"
     define d where "d = (\<Sum>i\<in>Basis. max (b\<bullet>i) (max Bg Bh) *\<^sub>R i)"
     have "\<lbrakk>norm (0 - x) < Bg; i \<in> Basis\<rbrakk> \<Longrightarrow> c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" for x i
       using Basis_le_norm[of i x] unfolding c_def d_def by auto
     then have ballBg: "ball 0 Bg \<subseteq> cbox c d"
       by (auto simp: mem_box dist_norm)
     have "\<lbrakk>norm (0 - x) < Bh; i \<in> Basis\<rbrakk> \<Longrightarrow> c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" for x i
       using Basis_le_norm[of i x] unfolding c_def d_def by auto
     then have ballBh: "ball 0 Bh \<subseteq> cbox c d"
       by (auto simp: mem_box dist_norm)
     have ab_cd: "cbox a b \<subseteq> cbox c d"
       by (auto simp: c_def d_def subset_box_imp)
     have **: "\<And>ch cg ag ah::real. \<lbrakk>\<bar>ah - ag\<bar> \<le> \<bar>ch - cg\<bar>; \<bar>cg - i\<bar> < e/4; \<bar>ch - j\<bar> < e/4\<rbrakk>
        \<Longrightarrow> \<bar>ag - ah\<bar> < e"
       using ij by arith
     show "\<exists>g h i j. (g has_integral i) (cbox a b) \<and> (h has_integral j) (cbox a b) \<and> \<bar>i - j\<bar> < e \<and>
           (\<forall>x\<in>cbox a b. g x \<le> (if x \<in> s then f x else 0) \<and>
                         (if x \<in> s then f x else 0) \<le> h x)"
     proof (intro exI ballI conjI)
       have eq: "\<And>x f g. (if x \<in> s then f x else 0) - (if x \<in> s then g x else 0) =
                        (if x \<in> s then f x - g x else (0::real))"
         by auto
       have int_hg: "(\<lambda>x. if x \<in> s then h x - g x else 0) integrable_on cbox a b"
                    "(\<lambda>x. if x \<in> s then h x - g x else 0) integrable_on cbox c d"
         by (metis (no_types) integrable_diff g h has_integral_integrable integrable_altD(1))+
       show "(?gs has_integral integral (cbox a b) ?gs) (cbox a b)"
            "(?hs has_integral integral (cbox a b) ?hs) (cbox a b)"
         by (intro integrable_integral int_g int_h)+
       then have "integral (cbox a b) ?gs \<le> integral (cbox a b) ?hs"
         using fgh by (force intro: has_integral_le)
       then have "0 \<le> integral (cbox a b) ?hs - integral (cbox a b) ?gs"
         by simp
       then have "\<bar>integral (cbox a b) ?hs - integral (cbox a b) ?gs\<bar>
               \<le> \<bar>integral (cbox c d) ?hs - integral (cbox c d) ?gs\<bar>"
         apply (simp add: integral_diff [symmetric] int_g int_h)
         apply (subst abs_of_nonneg[OF integral_nonneg[OF integrable_diff, OF int_h int_g]])
         using fgh apply (force simp: eq intro!: integral_subset_le [OF ab_cd int_hg])+
         done
       then show "\<bar>integral (cbox a b) ?gs - integral (cbox a b) ?hs\<bar> < e"
         using ** Bg ballBg Bh ballBh by blast
       show "\<And>x. x \<in> cbox a b \<Longrightarrow> ?gs x \<le> ?fs x" "\<And>x. x \<in> cbox a b \<Longrightarrow> ?fs x \<le> ?hs x"
         using fgh by auto
     qed
   qed
   then have int_f: "?fs integrable_on cbox a b" for a b
     by simp
   have "\<exists>B>0. \<forall>a b c d.
                   ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
                   abs (integral (cbox a b) ?fs - integral (cbox c d) ?fs) < e"
       if "0 < e" for e
   proof -
     have *: "e/3 > 0"
       using that by auto
     with assms obtain g h i j where g: "(g has_integral i) s" and h: "(h has_integral j) s"
                  and ij: "\<bar>i - j\<bar> < e/3"
                  and fgh: "\<And>x. x \<in> s \<Longrightarrow> g x \<le> f x \<and> f x \<le> h x"
       by metis
     let ?gs = "(\<lambda>x. if x \<in> s then g x else 0)"
     let ?hs = "(\<lambda>x. if x \<in> s then h x else 0)"
     obtain Bg where "Bg > 0"
               and Bg: "\<And>a b. ball 0 Bg \<subseteq> cbox a b \<Longrightarrow> \<bar>integral (cbox a b) ?gs - i\<bar> < e/3"
               and int_g: "\<And>a b. ?gs integrable_on cbox a b"
       using g * unfolding has_integral_alt' real_norm_def by meson
     obtain Bh where "Bh > 0"
               and Bh: "\<And>a b. ball 0 Bh \<subseteq> cbox a b \<Longrightarrow> \<bar>integral (cbox a b) ?hs - j\<bar> < e/3"
               and int_h: "\<And>a b. ?hs integrable_on cbox a b"
       using h * unfolding has_integral_alt' real_norm_def by meson
     { fix a b c d :: 'n
       assume as: "ball 0 (max Bg Bh) \<subseteq> cbox a b" "ball 0 (max Bg Bh) \<subseteq> cbox c d"
       have **: "ball 0 Bg \<subseteq> ball (0::'n) (max Bg Bh)" "ball 0 Bh \<subseteq> ball (0::'n) (max Bg Bh)"
         by auto
       have *: "\<And>ga gc ha hc fa fc. \<lbrakk>\<bar>ga - i\<bar> < e/3; \<bar>gc - i\<bar> < e/3; \<bar>ha - j\<bar> < e/3;
                      \<bar>hc - j\<bar> < e/3; ga \<le> fa; fa \<le> ha; gc \<le> fc; fc \<le> hc\<rbrakk> \<Longrightarrow>
         \<bar>fa - fc\<bar> < e"
         using ij by arith
       have "abs (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) - integral (cbox c d)
         (\<lambda>x. if x \<in> s then f x else 0)) < e"
       proof (rule *)
         show "\<bar>integral (cbox a b) ?gs - i\<bar> < e/3"
           using "**" Bg as by blast
         show "\<bar>integral (cbox c d) ?gs - i\<bar> < e/3"
           using "**" Bg as by blast
         show "\<bar>integral (cbox a b) ?hs - j\<bar> < e/3"
           using "**" Bh as by blast
         show "\<bar>integral (cbox c d) ?hs - j\<bar> < e/3"
           using "**" Bh as by blast
       qed (use int_f int_g int_h fgh in \<open>simp_all add: integral_le\<close>)
     }
     then show ?thesis
       apply (rule_tac x="max Bg Bh" in exI)
         using \<open>Bg > 0\<close> by auto
   qed
   then show ?thesis
     unfolding integrable_alt[of f] real_norm_def by (blast intro: int_f)
 qed
 
 
 subsection \<open>Adding integrals over several sets\<close>
 
 lemma has_integral_Un:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "(f has_integral i) S" "(f has_integral j) T"
     and neg: "negligible (S \<inter> T)"
   shows "(f has_integral (i + j)) (S \<union> T)"
   unfolding has_integral_restrict_UNIV[symmetric, of f]
 proof (rule has_integral_spike[OF neg])
   let ?f = "\<lambda>x. (if x \<in> S then f x else 0) + (if x \<in> T then f x else 0)"
   show "(?f has_integral i + j) UNIV"
     by (simp add: f has_integral_add)
 qed auto
 
 lemma integral_Un [simp]:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on S" "f integrable_on T" "negligible (S \<inter> T)"
   shows "integral (S \<union> T) f = integral S f + integral T f"
   by (simp add: has_integral_Un assms integrable_integral integral_unique)
 
 lemma integrable_Un:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b :: banach"
   assumes "negligible (A \<inter> B)" "f integrable_on A" "f integrable_on B"
   shows   "f integrable_on (A \<union> B)"
 proof -
   from assms obtain y z where "(f has_integral y) A" "(f has_integral z) B"
      by (auto simp: integrable_on_def)
   from has_integral_Un[OF this assms(1)] show ?thesis by (auto simp: integrable_on_def)
 qed
 
 lemma integrable_Un':
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b :: banach"
   assumes "f integrable_on A" "f integrable_on B" "negligible (A \<inter> B)" "C = A \<union> B"
   shows   "f integrable_on C"
   using integrable_Un[of A B f] assms by simp
 
 lemma has_integral_UN:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "finite I"
     and int: "\<And>i. i \<in> I \<Longrightarrow> (f has_integral (g i)) (\<T> i)"
     and neg: "pairwise (\<lambda>i i'. negligible (\<T> i \<inter> \<T> i')) I"
   shows "(f has_integral (sum g I)) (\<Union>i\<in>I. \<T> i)"
 proof -
   let ?\<U> = "((\<lambda>(a,b). \<T> a \<inter> \<T> b) ` {(a,b). a \<in> I \<and> b \<in> I-{a}})"
   have "((\<lambda>x. if x \<in> (\<Union>i\<in>I. \<T> i) then f x else 0) has_integral sum g I) UNIV"
   proof (rule has_integral_spike)
     show "negligible (\<Union>?\<U>)"
     proof (rule negligible_Union)
       have "finite (I \<times> I)"
         by (simp add: \<open>finite I\<close>)
       moreover have "{(a,b). a \<in> I \<and> b \<in> I-{a}} \<subseteq> I \<times> I"
         by auto
       ultimately show "finite ?\<U>"
         by (simp add: finite_subset)
       show "\<And>t. t \<in> ?\<U> \<Longrightarrow> negligible t"
         using neg unfolding pairwise_def by auto
     qed
   next
     show "(if x \<in> (\<Union>i\<in>I. \<T> i) then f x else 0) = (\<Sum>i\<in>I. if x \<in> \<T> i then f x else 0)"
       if "x \<in> UNIV - (\<Union>?\<U>)" for x
     proof clarsimp
       fix i assume i: "i \<in> I" "x \<in> \<T> i"
       then have "\<forall>j\<in>I. x \<in> \<T> j \<longleftrightarrow> j = i"
         using that by blast
       with i show "f x = (\<Sum>i\<in>I. if x \<in> \<T> i then f x else 0)"
         by (simp add: sum.delta[OF \<open>finite I\<close>])
     qed
   next
     show "((\<lambda>x. (\<Sum>i\<in>I. if x \<in> \<T> i then f x else 0)) has_integral sum g I) UNIV"
       using int by (simp add: has_integral_restrict_UNIV has_integral_sum [OF \<open>finite I\<close>])
   qed
   then show ?thesis
     using has_integral_restrict_UNIV by blast
 qed
 
 lemma has_integral_Union:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "finite \<T>"
     and "\<And>S. S \<in> \<T> \<Longrightarrow> (f has_integral (i S)) S"
     and "pairwise (\<lambda>S S'. negligible (S \<inter> S')) \<T>"
   shows "(f has_integral (sum i \<T>)) (\<Union>\<T>)"
 proof -
   have "(f has_integral (sum i \<T>)) (\<Union>S\<in>\<T>. S)"
     by (intro has_integral_UN assms)
   then show ?thesis
     by force
 qed
 
 text \<open>In particular adding integrals over a division, maybe not of an interval.\<close>
 
 lemma has_integral_combine_division:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "\<D> division_of S"
     and "\<And>k. k \<in> \<D> \<Longrightarrow> (f has_integral (i k)) k"
   shows "(f has_integral (sum i \<D>)) S"
 proof -
   note \<D> = division_ofD[OF assms(1)]
   have neg: "negligible (S \<inter> s')" if "S \<in> \<D>" "s' \<in> \<D>" "S \<noteq> s'" for S s'
   proof -
     obtain a c b \<D> where obt: "S = cbox a b" "s' = cbox c \<D>"
       by (meson \<open>S \<in> \<D>\<close> \<open>s' \<in> \<D>\<close> \<D>(4))
     from \<D>(5)[OF that] show ?thesis
       unfolding obt interior_cbox
       by (metis (no_types, lifting) Diff_empty Int_interval box_Int_box negligible_frontier_interval)
   qed
   show ?thesis
     unfolding \<D>(6)[symmetric]
     by (auto intro: \<D> neg assms has_integral_Union pairwiseI)
 qed
 
 lemma integral_combine_division_bottomup:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "\<D> division_of S" "\<And>k. k \<in> \<D> \<Longrightarrow> f integrable_on k"
   shows "integral S f = sum (\<lambda>i. integral i f) \<D>"
   by (meson assms integral_unique has_integral_combine_division has_integral_integrable_integral)
 
 lemma has_integral_combine_division_topdown:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on S"
     and \<D>: "\<D> division_of K"
     and "K \<subseteq> S"
   shows "(f has_integral (sum (\<lambda>i. integral i f) \<D>)) K"
 proof -
   have "f integrable_on L" if "L \<in> \<D>" for L
     by (smt (verit, best) assms cbox_division_memE f integrable_on_subcbox subset_trans that)
   then show ?thesis
     by (meson \<D> has_integral_combine_division has_integral_integrable_integral)
 qed
 
 lemma integral_combine_division_topdown:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on S"
     and "\<D> division_of S"
   shows "integral S f = sum (\<lambda>i. integral i f) \<D>"
   using assms has_integral_combine_division_topdown by blast
 
 lemma integrable_combine_division:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes \<D>: "\<D> division_of S"
     and f: "\<And>i. i \<in> \<D> \<Longrightarrow> f integrable_on i"
   shows "f integrable_on S"
   using f unfolding integrable_on_def by (metis has_integral_combine_division[OF \<D>])
 
 lemma integrable_on_subdivision:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes \<D>: "\<D> division_of i"
     and f: "f integrable_on S"
     and "i \<subseteq> S"
   shows "f integrable_on i"
 proof -
   have "f integrable_on i" if "i \<in> \<D>" for i
     by (smt (verit, best) assms cbox_division_memE f integrable_on_subcbox order_trans that)
   then show ?thesis
     using \<D> integrable_combine_division by blast
 qed
 
 
 subsection \<open>Also tagged divisions\<close>
 
 lemma has_integral_combine_tagged_division:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "p tagged_division_of S"
     and "\<And>x k. (x,k) \<in> p \<Longrightarrow> (f has_integral (i k)) k"
   shows "(f has_integral (\<Sum>(x,k)\<in>p. i k)) S"
 proof -
   have *: "(f has_integral (\<Sum>k\<in>snd`p. integral k f)) S"
     by (smt (verit, del_insts) assms division_of_tagged_division has_integral_combine_division has_integral_iff imageE prod.collapse)
   also have "(\<Sum>k\<in>snd`p. integral k f) = (\<Sum>(x, k)\<in>p. integral k f)"
     by (intro sum.over_tagged_division_lemma[OF assms(1), symmetric] integral_null)
        (simp add: content_eq_0_interior)
   finally show ?thesis
     using assms by (auto simp add: has_integral_iff intro!: sum.cong)
 qed
 
 lemma integral_combine_tagged_division_bottomup:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes p: "p tagged_division_of (cbox a b)"
     and f: "\<And>x k. (x,k)\<in>p \<Longrightarrow> f integrable_on k"
   shows "integral (cbox a b) f = sum (\<lambda>(x,k). integral k f) p"
   by (simp add: has_integral_combine_tagged_division[OF p] integral_unique f integrable_integral)
 
 lemma has_integral_combine_tagged_division_topdown:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on cbox a b"
     and p: "p tagged_division_of (cbox a b)"
   shows "(f has_integral (sum (\<lambda>(x,K). integral K f) p)) (cbox a b)"
 proof -
   have "(f has_integral integral K f) K" if "(x,K) \<in> p" for x K
     by (metis assms integrable_integral integrable_on_subcbox tagged_division_ofD(3,4) that)
   then show ?thesis
     by (simp add: has_integral_combine_tagged_division p)
 qed
 
 lemma integral_combine_tagged_division_topdown:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on cbox a b"
     and "p tagged_division_of (cbox a b)"
   shows "integral (cbox a b) f = sum (\<lambda>(x,k). integral k f) p"
   using assms by (auto intro: integral_unique [OF has_integral_combine_tagged_division_topdown])
 
 
 subsection \<open>Henstock's lemma\<close>
 
 lemma Henstock_lemma_part1:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes intf: "f integrable_on cbox a b"
     and "e > 0"
     and "gauge d"
     and less_e: "\<And>p. \<lbrakk>p tagged_division_of (cbox a b); d fine p\<rbrakk> \<Longrightarrow>
                      norm (sum (\<lambda>(x,K). content K *\<^sub>R f x) p - integral(cbox a b) f) < e"
     and p: "p tagged_partial_division_of (cbox a b)" "d fine p"
   shows "norm (sum (\<lambda>(x,K). content K *\<^sub>R f x - integral K f) p) \<le> e" (is "?lhs \<le> e")
 proof (rule field_le_epsilon)
   fix k :: real
   assume "k > 0"
   let ?SUM = "\<lambda>p. (\<Sum>(x,K) \<in> p. content K *\<^sub>R f x)"
   note p' = tagged_partial_division_ofD[OF p(1)]
   have "\<Union>(snd ` p) \<subseteq> cbox a b"
     using p'(3) by fastforce
   then obtain q where q: "snd ` p \<subseteq> q" and qdiv: "q division_of cbox a b"
     by (meson p(1) partial_division_extend_interval partial_division_of_tagged_division)
   note q' = division_ofD[OF qdiv]
   define r where "r = q - snd ` p"
   have "snd ` p \<inter> r = {}"
     unfolding r_def by auto
   have "finite r"
     using q' unfolding r_def by auto
   have "\<exists>p. p tagged_division_of i \<and> d fine p \<and>
         norm (?SUM p - integral i f) < k / (real (card r) + 1)"
     if "i\<in>r" for i
   proof -
     have gt0: "k / (real (card r) + 1) > 0" using \<open>k > 0\<close> by simp
     have i: "i \<in> q"
       using that unfolding r_def by auto
     then obtain u v where uv: "i = cbox u v"
       using q'(4) by blast
     then have "cbox u v \<subseteq> cbox a b"
       using i q'(2) by auto  
     then have "f integrable_on cbox u v"
       by (rule integrable_subinterval[OF intf])
     with integrable_integral[OF this, unfolded has_integral[of f]]
     obtain dd where "gauge dd" and dd:
       "\<And>\<D>. \<lbrakk>\<D> tagged_division_of cbox u v; dd fine \<D>\<rbrakk> \<Longrightarrow>
     norm (?SUM \<D> - integral (cbox u v) f) < k / (real (card r) + 1)"
       using gt0 by auto
     with gauge_Int[OF \<open>gauge d\<close> \<open>gauge dd\<close>]
     obtain qq where qq: "qq tagged_division_of cbox u v" "(\<lambda>x. d x \<inter> dd x) fine qq"
       using fine_division_exists by blast
     with dd[of qq]  show ?thesis
       by (auto simp: fine_Int uv)
   qed
   then obtain qq where qq: "\<And>i. i \<in> r \<Longrightarrow> qq i tagged_division_of i \<and>
       d fine qq i \<and> norm (?SUM (qq i) - integral i f) < k / (real (card r) + 1)"
     by metis
 
   let ?p = "p \<union> \<Union>(qq ` r)"
   have "norm (?SUM ?p - integral (cbox a b) f) < e"
   proof (rule less_e)
     show "d fine ?p"
       by (metis (mono_tags, opaque_lifting) qq fine_Un fine_Union imageE p(2))
     note ptag = tagged_partial_division_of_Union_self[OF p(1)]
     have "p \<union> \<Union>(qq ` r) tagged_division_of \<Union>(snd ` p) \<union> \<Union>r"
     proof (rule tagged_division_Un[OF ptag tagged_division_Union [OF \<open>finite r\<close>]])
       show "\<And>i. i \<in> r \<Longrightarrow> qq i tagged_division_of i"
         using qq by auto
       show "\<And>i1 i2. \<lbrakk>i1 \<in> r; i2 \<in> r; i1 \<noteq> i2\<rbrakk> \<Longrightarrow> interior i1 \<inter> interior i2 = {}"
         by (simp add: q'(5) r_def)
       show "interior (\<Union>(snd ` p)) \<inter> interior (\<Union>r) = {}"
       proof (rule Int_interior_Union_intervals [OF \<open>finite r\<close>])
         show "open (interior (\<Union>(snd ` p)))"
           by blast
         show "\<And>T. T \<in> r \<Longrightarrow> \<exists>a b. T = cbox a b"
           by (simp add: q'(4) r_def)
         have "interior T \<inter> interior (\<Union>(snd ` p)) = {}" if "T \<in> r" for T
         proof (rule Int_interior_Union_intervals)
           show "\<And>U. U \<in> snd ` p \<Longrightarrow> \<exists>a b. U = cbox a b"
             using q q'(4) by blast
           show "\<And>U. U \<in> snd ` p \<Longrightarrow> interior T \<inter> interior U = {}"
             by (metis DiffE q q'(5) r_def subsetD that)
         qed (use p' in auto)
         then show "\<And>T. T \<in> r \<Longrightarrow> interior (\<Union>(snd ` p)) \<inter> interior T = {}"
           by (metis Int_commute)
       qed
     qed
     moreover have "\<Union>(snd ` p) \<union> \<Union>r = cbox a b" and "{qq i |i. i \<in> r} = qq ` r"
       using qdiv q unfolding Union_Un_distrib[symmetric] r_def by auto
     ultimately show "?p tagged_division_of (cbox a b)"
       by fastforce
   qed
   then have "norm (?SUM p + (?SUM (\<Union>(qq ` r))) - integral (cbox a b) f) < e"
   proof (subst sum.union_inter_neutral[symmetric, OF \<open>finite p\<close>], safe)
     show "content L *\<^sub>R f x = 0" if "(x, L) \<in> p" "(x, L) \<in> qq K" "K \<in> r" for x K L 
     proof -
       obtain u v where uv: "L = cbox u v"
         using \<open>(x,L) \<in> p\<close> p'(4) by blast
       have "L \<subseteq> K"
         using  qq[OF that(3)] tagged_division_ofD(3) \<open>(x,L) \<in> qq K\<close> by metis
       have "L \<in> snd ` p" 
         using \<open>(x,L) \<in> p\<close> image_iff by fastforce 
       then have "L \<in> q" "K \<in> q" "L \<noteq> K"
         using that q(1) unfolding r_def by auto
       with q'(5) show "content L *\<^sub>R f x = 0"
         by (metis \<open>L \<subseteq> K\<close> content_eq_0_interior inf.orderE interior_Int scaleR_eq_0_iff uv)
     qed
     show "finite (\<Union>(qq ` r))"
       by (meson finite_UN qq \<open>finite r\<close> tagged_division_of_finite)
   qed
   moreover have "content M *\<^sub>R f x = 0" 
       if x: "(x,M) \<in> qq K" "(x,M) \<in> qq L" and KL: "qq K \<noteq> qq L" and r: "K \<in> r" "L \<in> r"
     for x M K L
   proof -
     note kl = tagged_division_ofD(3,4)[OF qq[THEN conjunct1]]
     obtain u v where uv: "M = cbox u v"
       using \<open>(x, M) \<in> qq L\<close> \<open>L \<in> r\<close> kl(2) by blast
     have empty: "interior (K \<inter> L) = {}"
       by (metis DiffD1 interior_Int q'(5) r_def KL r)
     with that kl show "content M *\<^sub>R f x = 0"
       by (metis content_eq_0_interior dual_order.refl inf.orderE inf_mono interior_mono 
                 scaleR_eq_0_iff subset_empty uv x)
   qed 
   ultimately have "norm (?SUM p + sum ?SUM (qq ` r) - integral (cbox a b) f) < e"
     apply (subst (asm) sum.Union_comp)
     using qq by (force simp: split_paired_all)+
   moreover have "content M *\<^sub>R f x = 0" 
        if "K \<in> r" "L \<in> r" "K \<noteq> L" "qq K = qq L" "(x, M) \<in> qq K" for K L x M
     using tagged_division_ofD(6) qq that by (metis (no_types, lifting)) 
   ultimately have less_e: "norm (?SUM p + sum (?SUM \<circ> qq) r - integral (cbox a b) f) < e"
   proof (subst (asm) sum.reindex_nontrivial [OF \<open>finite r\<close>])
     qed (auto simp: split_paired_all sum.neutral)
   have norm_le: "norm (cp - ip) \<le> e + k"
                   if "norm ((cp + cr) - i) < e" "norm (cr - ir) < k" "ip + ir = i"
                   for ir ip i cr cp::'a
     using norm_triangle_le[of "cp + cr - i" "- (cr - ir)"] that
     unfolding that(3)[symmetric] norm_minus_cancel
     by (auto simp add: algebra_simps)
 
   have "?lhs =  norm (?SUM p - (\<Sum>(x, k)\<in>p. integral k f))"
     unfolding split_def sum_subtractf ..
   also have "\<dots> \<le> e + k"
   proof (rule norm_le[OF less_e])
     have lessk: "k * real (card r) / (1 + real (card r)) < k"
       using \<open>k>0\<close> by (auto simp add: field_simps)
     have "norm (sum (?SUM \<circ> qq) r - (\<Sum>k\<in>r. integral k f)) \<le> (\<Sum>x\<in>r. k / (real (card r) + 1))"
       unfolding sum_subtractf[symmetric] by (force dest: qq intro!: sum_norm_le)
     also have "... < k"
       by (simp add: lessk add.commute mult.commute)
     finally show "norm (sum (?SUM \<circ> qq) r - (\<Sum>k\<in>r. integral k f)) < k" .
   next
     from q(1) have [simp]: "snd ` p \<union> q = q" by auto
     have "integral l f = 0"
       if inp: "(x, l) \<in> p" "(y, m) \<in> p" and ne: "(x, l) \<noteq> (y, m)" and "l = m" for x l y m
     proof -
       obtain u v where uv: "l = cbox u v"
         using inp p'(4) by blast
       then show ?thesis
         using uv that p
         by (metis content_eq_0_interior dual_order.refl inf.orderE integral_null ne tagged_partial_division_ofD(5))
     qed
     then have "(\<Sum>(x, K)\<in>p. integral K f) = (\<Sum>K\<in>snd ` p. integral K f)"
       apply (subst sum.reindex_nontrivial [OF \<open>finite p\<close>])
       unfolding split_paired_all split_def by auto
     then show "(\<Sum>(x, k)\<in>p. integral k f) + (\<Sum>k\<in>r. integral k f) = integral (cbox a b) f"
       unfolding integral_combine_division_topdown[OF intf qdiv] r_def
       using q'(1) p'(1) sum.union_disjoint [of "snd ` p" "q - snd ` p", symmetric]
         by simp
   qed
   finally show "?lhs \<le> e + k" .
 qed
 
 lemma Henstock_lemma_part2:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes fed: "f integrable_on cbox a b" "e > 0" "gauge d"
     and less_e: "\<And>\<D>. \<lbrakk>\<D> tagged_division_of (cbox a b); d fine \<D>\<rbrakk> \<Longrightarrow>
                      norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) \<D> - integral (cbox a b) f) < e"
     and tag: "p tagged_partial_division_of (cbox a b)"
     and "d fine p"
   shows "sum (\<lambda>(x,k). norm (content k *\<^sub>R f x - integral k f)) p \<le> 2 * real (DIM('n)) * e"
 proof -
   have "finite p"
     using tag tagged_partial_division_ofD by blast
   then show ?thesis
     unfolding split_def
   proof (rule sum_norm_allsubsets_bound)
     fix Q
     assume Q: "Q \<subseteq> p"
     then have fine: "d fine Q"
       by (simp add: \<open>d fine p\<close> fine_subset)
     show "norm (\<Sum>x\<in>Q. content (snd x) *\<^sub>R f (fst x) - integral (snd x) f) \<le> e"
       apply (rule Henstock_lemma_part1[OF fed less_e, unfolded split_def])
       using Q tag tagged_partial_division_subset by (force simp add: fine)+
   qed
 qed
 
 lemma Henstock_lemma:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes intf: "f integrable_on cbox a b"
     and "e > 0"
   obtains \<gamma> where "gauge \<gamma>"
     and "\<And>p. \<lbrakk>p tagged_partial_division_of (cbox a b); \<gamma> fine p\<rbrakk> \<Longrightarrow>
              sum (\<lambda>(x,k). norm(content k *\<^sub>R f x - integral k f)) p < e"
 proof -
   have *: "e/(2 * (real DIM('n) + 1)) > 0" using \<open>e > 0\<close> by simp
   with integrable_integral[OF intf, unfolded has_integral]
   obtain \<gamma> where "gauge \<gamma>"
     and \<gamma>: "\<And>\<D>. \<lbrakk>\<D> tagged_division_of cbox a b; \<gamma> fine \<D>\<rbrakk> \<Longrightarrow>
          norm ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f x) - integral (cbox a b) f)
          < e/(2 * (real DIM('n) + 1))"
     by metis
   show thesis
   proof (rule that [OF \<open>gauge \<gamma>\<close>])
     fix p
     assume p: "p tagged_partial_division_of cbox a b" "\<gamma> fine p"
     have "(\<Sum>(x,K)\<in>p. norm (content K *\<^sub>R f x - integral K f)) 
           \<le> 2 * real DIM('n) * (e/(2 * (real DIM('n) + 1)))"
       using Henstock_lemma_part2[OF intf * \<open>gauge \<gamma>\<close> \<gamma> p] by metis
     also have "... < e"
       using \<open>e > 0\<close> by (auto simp add: field_simps)
     finally
     show "(\<Sum>(x,K)\<in>p. norm (content K *\<^sub>R f x - integral K f)) < e" .
   qed
 qed
 
 
 subsection \<open>Monotone convergence (bounded interval first)\<close>
 
 lemma bounded_increasing_convergent:
   fixes f :: "nat \<Rightarrow> real"
   shows "\<lbrakk>bounded (range f); \<And>n. f n \<le> f (Suc n)\<rbrakk> \<Longrightarrow> \<exists>l. f \<longlonglongrightarrow> l"
   using Bseq_mono_convergent[of f] incseq_Suc_iff[of f]
   by (auto simp: image_def Bseq_eq_bounded convergent_def incseq_def)
 
 lemma monotone_convergence_interval:
   fixes f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real"
   assumes intf: "\<And>k. (f k) integrable_on cbox a b"
     and le: "\<And>k x. x \<in> cbox a b \<Longrightarrow> (f k x) \<le> f (Suc k) x"
     and fg: "\<And>x. x \<in> cbox a b \<Longrightarrow> ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
     and bou: "bounded (range (\<lambda>k. integral (cbox a b) (f k)))"
   shows "g integrable_on cbox a b \<and> ((\<lambda>k. integral (cbox a b) (f k)) \<longlongrightarrow> integral (cbox a b) g) sequentially"
 proof (cases "content (cbox a b) = 0")
   case True then show ?thesis
     by auto
 next
   case False
   have fg1: "(f k x) \<le> (g x)" if x: "x \<in> cbox a b" for x k
   proof -
     have "\<forall>\<^sub>F j in sequentially. f k x \<le> f j x"
     proof (rule eventually_sequentiallyI [of k])
       show "\<And>j. k \<le> j \<Longrightarrow> f k x \<le> f j x"
         using le x by (force intro: transitive_stepwise_le)
     qed
     then show "f k x \<le> g x"
       using tendsto_lowerbound [OF fg] x trivial_limit_sequentially by blast
   qed
   have int_inc: "\<And>n. integral (cbox a b) (f n) \<le> integral (cbox a b) (f (Suc n))"
     by (metis integral_le intf le)
   then obtain i where i: "(\<lambda>k. integral (cbox a b) (f k)) \<longlonglongrightarrow> i"
     using bounded_increasing_convergent bou by blast
   have "\<And>k. \<forall>\<^sub>F x in sequentially. integral (cbox a b) (f k) \<le> integral (cbox a b) (f x)"
     unfolding eventually_sequentially
     by (force intro: transitive_stepwise_le int_inc)
   then have i': "\<And>k. (integral(cbox a b) (f k)) \<le> i"
     using tendsto_le [OF trivial_limit_sequentially i] by blast
   have "(g has_integral i) (cbox a b)"
     unfolding has_integral real_norm_def
   proof clarify
     fix e::real
     assume e: "e > 0"
     have "\<And>k. (\<exists>\<gamma>. gauge \<gamma> \<and> (\<forall>\<D>. \<D> tagged_division_of (cbox a b) \<and> \<gamma> fine \<D> \<longrightarrow>
       abs ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f k x) - integral (cbox a b) (f k)) < e/2 ^ (k + 2)))"
       using intf e by (auto simp: has_integral_integral has_integral)
     then obtain c where c: "\<And>x. gauge (c x)"
           "\<And>x \<D>. \<lbrakk>\<D> tagged_division_of cbox a b; c x fine \<D>\<rbrakk> \<Longrightarrow>
               abs ((\<Sum>(u,K)\<in>\<D>. content K *\<^sub>R f x u) - integral (cbox a b) (f x))
               < e/2 ^ (x + 2)"
       by metis
 
     have "\<exists>r. \<forall>k\<ge>r. 0 \<le> i - (integral (cbox a b) (f k)) \<and> i - (integral (cbox a b) (f k)) < e/4"
     proof -
       have "e/4 > 0"
         using e by auto
       show ?thesis
         using LIMSEQ_D [OF i \<open>e/4 > 0\<close>] i' by auto
     qed
     then obtain r where r: "\<And>k. r \<le> k \<Longrightarrow> 0 \<le> i - integral (cbox a b) (f k)"
                        "\<And>k. r \<le> k \<Longrightarrow> i - integral (cbox a b) (f k) < e/4" 
       by metis
     have "\<exists>n\<ge>r. \<forall>k\<ge>n. 0 \<le> (g x) - (f k x) \<and> (g x) - (f k x) < e/(4 * content(cbox a b))"
       if "x \<in> cbox a b" for x
     proof -
       have "e/(4 * content (cbox a b)) > 0"
         by (simp add: False content_lt_nz e)
       with fg that LIMSEQ_D
       obtain N where "\<forall>n\<ge>N. norm (f n x - g x) < e/(4 * content (cbox a b))"
         by metis
       then show "\<exists>n\<ge>r. \<forall>k\<ge>n. 0 \<le> g x - f k x \<and> g x - f k x < e/(4 * content (cbox a b))"
         apply (rule_tac x="N + r" in exI)
         using fg1[OF that] by (auto simp add: field_simps)
     qed
     then obtain m where r_le_m: "\<And>x. x \<in> cbox a b \<Longrightarrow> r \<le> m x"
        and m: "\<And>x k. \<lbrakk>x \<in> cbox a b; m x \<le> k\<rbrakk>
                      \<Longrightarrow> 0 \<le> g x - f k x \<and> g x - f k x < e/(4 * content (cbox a b))"
       by metis
     define d where "d x = c (m x) x" for x
     show "\<exists>\<gamma>. gauge \<gamma> \<and>
              (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and>
                   \<gamma> fine \<D> \<longrightarrow> abs ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R g x) - i) < e)"
     proof (rule exI, safe)
       show "gauge d"
         using c(1) unfolding gauge_def d_def by auto
     next
       fix \<D>
       assume ptag: "\<D> tagged_division_of (cbox a b)" and "d fine \<D>"
       note p'=tagged_division_ofD[OF ptag]
       obtain s where s: "\<And>x. x \<in> \<D> \<Longrightarrow> m (fst x) \<le> s"
         by (metis finite_imageI finite_nat_set_iff_bounded_le p'(1) rev_image_eqI)
       have *: "\<bar>a - d\<bar> < e" if "\<bar>a - b\<bar> \<le> e/4" "\<bar>b - c\<bar> < e/2" "\<bar>c - d\<bar> < e/4" for a b c d
         using that norm_triangle_lt[of "a - b" "b - c" "3* e/4"]
           norm_triangle_lt[of "a - b + (b - c)" "c - d" e]
         by (auto simp add: algebra_simps)
       show "\<bar>(\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R g x) - i\<bar> < e"
       proof (rule *)
         have "\<bar>(\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R g x) - (\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f (m x) x)\<bar> 
               \<le> (\<Sum>i\<in>\<D>. \<bar>(case i of (x, K) \<Rightarrow> content K *\<^sub>R g x) - (case i of (x, K) \<Rightarrow> content K *\<^sub>R f (m x) x)\<bar>)"
           by (metis (mono_tags) sum_subtractf sum_abs) 
         also have "... \<le> (\<Sum>(x, k)\<in>\<D>. content k * (e/(4 * content (cbox a b))))"
         proof (rule sum_mono, simp add: split_paired_all)
           fix x K
           assume xk: "(x,K) \<in> \<D>"
           with ptag have x: "x \<in> cbox a b"
             by blast
           then have "abs (content K * (g x - f (m x) x)) \<le> content K * (e/(4 * content (cbox a b)))"
             by (metis m[OF x] mult_nonneg_nonneg abs_of_nonneg less_eq_real_def measure_nonneg mult_left_mono order_refl)
           then show "\<bar>content K * g x - content K * f (m x) x\<bar> \<le> content K * e/(4 * content (cbox a b))"
             by (simp add: algebra_simps)
         qed
         also have "... = (e/(4 * content (cbox a b))) * (\<Sum>(x, k)\<in>\<D>. content k)"
           by (simp add: sum_distrib_left sum_divide_distrib split_def mult.commute)
         also have "... \<le> e/4"
           by (metis False additive_content_tagged_division [OF ptag] nonzero_mult_divide_mult_cancel_right order_refl times_divide_eq_left)
         finally show "\<bar>(\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R g x) - (\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f (m x) x)\<bar> \<le> e/4" .
 
       next
         have "norm ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f (m x) x) - (\<Sum>(x,K)\<in>\<D>. integral K (f (m x))))
               \<le> norm (\<Sum>j = 0..s. \<Sum>(x,K)\<in>{xk \<in> \<D>. m (fst xk) = j}. content K *\<^sub>R f (m x) x - integral K (f (m x)))"
           apply (subst sum.group)
           using s by (auto simp: sum_subtractf split_def p'(1))
         also have "\<dots> < e/2"
         proof -
           have "norm (\<Sum>j = 0..s. \<Sum>(x, k)\<in>{xk \<in> \<D>. m (fst xk) = j}. content k *\<^sub>R f (m x) x - integral k (f (m x)))
                 \<le> (\<Sum>i = 0..s. e/2 ^ (i + 2))"
           proof (rule sum_norm_le)
             fix t
             assume "t \<in> {0..s}"
             have "norm (\<Sum>(x,k)\<in>{xk \<in> \<D>. m (fst xk) = t}. content k *\<^sub>R f (m x) x - integral k (f (m x))) =
                   norm (\<Sum>(x,k)\<in>{xk \<in> \<D>. m (fst xk) = t}. content k *\<^sub>R f t x - integral k (f t))"
               by (force intro!: sum.cong arg_cong[where f=norm])
             also have "... \<le> e/2 ^ (t + 2)"
             proof (rule Henstock_lemma_part1 [OF intf])
               show "{xk \<in> \<D>. m (fst xk) = t} tagged_partial_division_of cbox a b"
               proof (rule tagged_partial_division_subset[of \<D>])
                 show "\<D> tagged_partial_division_of cbox a b"
                   using ptag tagged_division_of_def by blast
               qed auto
               show "c t fine {xk \<in> \<D>. m (fst xk) = t}"
                 using \<open>d fine \<D>\<close> by (auto simp: fine_def d_def)
             qed (use c e in auto)
             finally show "norm (\<Sum>(x,K)\<in>{xk \<in> \<D>. m (fst xk) = t}. content K *\<^sub>R f (m x) x -
                                 integral K (f (m x))) \<le> e/2 ^ (t + 2)" .
           qed
           also have "... = (e/2/2) * (\<Sum>i = 0..s. (1/2) ^ i)"
             by (simp add: sum_distrib_left field_simps)
           also have "\<dots> < e/2"
             by (simp add: sum_gp mult_strict_left_mono[OF _ e])
           finally show "norm (\<Sum>j = 0..s. \<Sum>(x, k)\<in>{xk \<in> \<D>.
             m (fst xk) = j}. content k *\<^sub>R f (m x) x - integral k (f (m x))) < e/2" .
         qed 
         finally show "\<bar>(\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f (m x) x) - (\<Sum>(x,K)\<in>\<D>. integral K (f (m x)))\<bar> < e/2"
           by simp
       next
         have comb: "integral (cbox a b) (f y) = (\<Sum>(x, k)\<in>\<D>. integral k (f y))" for y
           using integral_combine_tagged_division_topdown[OF intf ptag] by metis
         have f_le: "\<And>y m n. \<lbrakk>y \<in> cbox a b; n\<ge>m\<rbrakk> \<Longrightarrow> f m y \<le> f n y"
           using le by (auto intro: transitive_stepwise_le)        
         have "(\<Sum>(x, k)\<in>\<D>. integral k (f r)) \<le> (\<Sum>(x, K)\<in>\<D>. integral K (f (m x)))"
         proof (rule sum_mono, simp add: split_paired_all)
           fix x K
           assume xK: "(x, K) \<in> \<D>"
           show "integral K (f r) \<le> integral K (f (m x))"
           proof (rule integral_le)
             show "f r integrable_on K"
               by (metis integrable_on_subcbox intf p'(3) p'(4) xK)
             show "f (m x) integrable_on K"
               by (metis elementary_interval integrable_on_subdivision intf p'(3) p'(4) xK)
             show "f r y \<le> f (m x) y" if "y \<in> K" for y
               using that r_le_m[of x] p'(2-3)[OF xK] f_le by auto
           qed
         qed
         moreover have "(\<Sum>(x, K)\<in>\<D>. integral K (f (m x))) \<le> (\<Sum>(x, k)\<in>\<D>. integral k (f s))"
         proof (rule sum_mono, simp add: split_paired_all)
           fix x K
           assume xK: "(x, K) \<in> \<D>"
           show "integral K (f (m x)) \<le> integral K (f s)"
           proof (rule integral_le)
             show "f (m x) integrable_on K"
               by (metis elementary_interval integrable_on_subdivision intf p'(3) p'(4) xK)
             show "f s integrable_on K"
               by (metis integrable_on_subcbox intf p'(3) p'(4) xK)
             show "f (m x) y \<le> f s y" if "y \<in> K" for y
               using that s xK f_le p'(3) by fastforce
           qed
         qed
         moreover have "0 \<le> i - integral (cbox a b) (f r)" "i - integral (cbox a b) (f r) < e/4"
           using r by auto
         ultimately show "\<bar>(\<Sum>(x,K)\<in>\<D>. integral K (f (m x))) - i\<bar> < e/4"
           using comb i'[of s] by auto
       qed
     qed
   qed 
   with i integral_unique show ?thesis
     by blast
 qed
 
 lemma monotone_convergence_increasing:
   fixes f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real"
   assumes int_f: "\<And>k. (f k) integrable_on S"
     and "\<And>k x. x \<in> S \<Longrightarrow> (f k x) \<le> (f (Suc k) x)"
     and fg: "\<And>x. x \<in> S \<Longrightarrow> ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
     and bou: "bounded (range (\<lambda>k. integral S (f k)))"
   shows "g integrable_on S \<and> ((\<lambda>k. integral S (f k)) \<longlongrightarrow> integral S g) sequentially"
 proof -
   have lem: "g integrable_on S \<and> ((\<lambda>k. integral S (f k)) \<longlongrightarrow> integral S g) sequentially"
     if f0: "\<And>k x. x \<in> S \<Longrightarrow> 0 \<le> f k x"
     and int_f: "\<And>k. (f k) integrable_on S"
     and le: "\<And>k x. x \<in> S \<Longrightarrow> f k x \<le> f (Suc k) x"
     and lim: "\<And>x. x \<in> S \<Longrightarrow> ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
     and bou: "bounded (range(\<lambda>k. integral S (f k)))"
     for f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real" and g S
   proof -
     have fg: "(f k x) \<le> (g x)" if "x \<in> S" for x k
     proof -
       have "\<And>xa. k \<le> xa \<Longrightarrow> f k x \<le> f xa x"
         using le  by (force intro: transitive_stepwise_le that)
       then show ?thesis
         using tendsto_lowerbound [OF lim [OF that]] eventually_sequentiallyI by force
     qed
     obtain i where i: "(\<lambda>k. integral S (f k)) \<longlonglongrightarrow> i"
       using bounded_increasing_convergent [OF bou] le int_f integral_le by blast
     have i': "(integral S (f k)) \<le> i" for k
     proof -
       have "\<And>k. \<And>x. x \<in> S \<Longrightarrow> \<forall>n\<ge>k. f k x \<le> f n x"
         using le  by (force intro: transitive_stepwise_le)
       then show ?thesis
         using tendsto_lowerbound [OF i eventually_sequentiallyI trivial_limit_sequentially]
         by (meson int_f integral_le)
     qed
     let ?f = "(\<lambda>k x. if x \<in> S then f k x else 0)"
     let ?g = "(\<lambda>x. if x \<in> S then g x else 0)"
     have int: "?f k integrable_on cbox a b" for a b k
       by (simp add: int_f integrable_altD(1))
     have int': "\<And>k a b. f k integrable_on cbox a b \<inter> S"
       using int by (simp add: Int_commute integrable_restrict_Int) 
     have g: "?g integrable_on cbox a b \<and>
              (\<lambda>k. integral (cbox a b) (?f k)) \<longlonglongrightarrow> integral (cbox a b) ?g" for a b
     proof (rule monotone_convergence_interval)
       have "norm (integral (cbox a b) (?f k)) \<le> norm (integral S (f k))" for k
       proof -
         have "0 \<le> integral (cbox a b) (?f k)"
           by (metis (no_types) integral_nonneg Int_iff f0 inf_commute integral_restrict_Int int')
         moreover have "0 \<le> integral S (f k)"
           by (simp add: integral_nonneg f0 int_f)
         moreover have "integral (S \<inter> cbox a b) (f k) \<le> integral S (f k)"
           by (metis f0 inf_commute int' int_f integral_subset_le le_inf_iff order_refl)
         ultimately show ?thesis
           by (simp add: integral_restrict_Int)
       qed
       moreover obtain B where "\<And>x. x \<in> range (\<lambda>k. integral S (f k)) \<Longrightarrow> norm x \<le> B"
         using bou unfolding bounded_iff by blast
       ultimately show "bounded (range (\<lambda>k. integral (cbox a b) (?f k)))"
         unfolding bounded_iff by (blast intro: order_trans)
     qed (use int le lim in auto)
     moreover have "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow> norm (integral (cbox a b) ?g - i) < e"
       if "0 < e" for e
     proof -
       have "e/4>0"
         using that by auto
       with LIMSEQ_D [OF i] obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> norm (integral S (f n) - i) < e/4"
         by metis
       with int_f[of N, unfolded has_integral_integral has_integral_alt'[of "f N"]] 
       obtain B where "0 < B" and B: 
         "\<And>a b. ball 0 B \<subseteq> cbox a b \<Longrightarrow> norm (integral (cbox a b) (?f N) - integral S (f N)) < e/4"
         by (meson \<open>0 < e/4\<close>)
       have "norm (integral (cbox a b) ?g - i) < e" if  ab: "ball 0 B \<subseteq> cbox a b" for a b
       proof -
         obtain M where M: "\<And>n. n \<ge> M \<Longrightarrow> abs (integral (cbox a b) (?f n) - integral (cbox a b) ?g) < e/2"
           using \<open>e > 0\<close> g by (fastforce simp add: dest!: LIMSEQ_D [where r = "e/2"])
         have *: "\<And>\<alpha> \<beta> g. \<lbrakk>\<bar>\<alpha> - i\<bar> < e/2; \<bar>\<beta> - g\<bar> < e/2; \<alpha> \<le> \<beta>; \<beta> \<le> i\<rbrakk> \<Longrightarrow> \<bar>g - i\<bar> < e"
           unfolding real_inner_1_right by arith
         show "norm (integral (cbox a b) ?g - i) < e"
           unfolding real_norm_def
         proof (rule *)
           show "\<bar>integral (cbox a b) (?f N) - i\<bar> < e/2"
           proof (rule abs_triangle_half_l)
             show "\<bar>integral (cbox a b) (?f N) - integral S (f N)\<bar> < e/2/2"
               using B[OF ab] by simp
             show "abs (i - integral S (f N)) < e/2/2"
               using N by (simp add: abs_minus_commute)
           qed
           show "\<bar>integral (cbox a b) (?f (M + N)) - integral (cbox a b) ?g\<bar> < e/2"
             by (metis le_add1 M[of "M + N"])
           show "integral (cbox a b) (?f N) \<le> integral (cbox a b) (?f (M + N))"
           proof (intro ballI integral_le[OF int int])
             fix x assume "x \<in> cbox a b"
             have "(f m x) \<le> (f n x)" if "x \<in> S" "n \<ge> m" for m n
             proof (rule transitive_stepwise_le [OF \<open>n \<ge> m\<close> order_refl])
               show "\<And>u y z. \<lbrakk>f u x \<le> f y x; f y x \<le> f z x\<rbrakk> \<Longrightarrow> f u x \<le> f z x"
                 using dual_order.trans by blast
             qed (simp add: le \<open>x \<in> S\<close>)
             then show "(?f N)x \<le> (?f (M+N))x"
               by auto
           qed
           have "integral (cbox a b \<inter> S) (f (M + N)) \<le> integral S (f (M + N))"
             by (metis Int_lower1 f0 inf_commute int' int_f integral_subset_le)
           then have "integral (cbox a b) (?f (M + N)) \<le> integral S (f (M + N))"
             by (metis (no_types) inf_commute integral_restrict_Int)
           also have "... \<le> i"
             using i'[of "M + N"] by auto
           finally show "integral (cbox a b) (?f (M + N)) \<le> i" .
         qed
       qed
       then show ?thesis
         using \<open>0 < B\<close> by blast
     qed
     ultimately have "(g has_integral i) S"
       unfolding has_integral_alt' by auto
     then show ?thesis
       using has_integral_integrable_integral i integral_unique by metis
   qed
 
   have sub: "\<And>k. integral S (\<lambda>x. f k x - f 0 x) = integral S (f k) - integral S (f 0)"
     by (simp add: integral_diff int_f)
   have *: "\<And>x m n. x \<in> S \<Longrightarrow> n\<ge>m \<Longrightarrow> f m x \<le> f n x"
     using assms(2) by (force intro: transitive_stepwise_le)
   have gf: "(\<lambda>x. g x - f 0 x) integrable_on S \<and> ((\<lambda>k. integral S (\<lambda>x. f (Suc k) x - f 0 x)) \<longlongrightarrow>
     integral S (\<lambda>x. g x - f 0 x)) sequentially"
   proof (rule lem)
     show "\<And>k. (\<lambda>x. f (Suc k) x - f 0 x) integrable_on S"
       by (simp add: integrable_diff int_f)
     show "(\<lambda>k. f (Suc k) x - f 0 x) \<longlonglongrightarrow> g x - f 0 x" if "x \<in> S" for x
     proof -
       have "(\<lambda>n. f (Suc n) x) \<longlonglongrightarrow> g x"
         using LIMSEQ_ignore_initial_segment[OF fg[OF \<open>x \<in> S\<close>], of 1] by simp
       then show ?thesis
         by (simp add: tendsto_diff)
     qed
     show "bounded (range (\<lambda>k. integral S (\<lambda>x. f (Suc k) x - f 0 x)))"
     proof -
       obtain B where B: "\<And>k. norm (integral S (f k)) \<le> B"
         using  bou by (auto simp: bounded_iff)
       then have "norm (integral S (\<lambda>x. f (Suc k) x - f 0 x))
               \<le> B + norm (integral S (f 0))" for k
         unfolding sub by (meson add_le_cancel_right norm_triangle_le_diff)
       then show ?thesis
         unfolding bounded_iff by blast
     qed
   qed (use * in auto)
   then have "(\<lambda>x. integral S (\<lambda>xa. f (Suc x) xa - f 0 xa) + integral S (f 0))
              \<longlonglongrightarrow> integral S (\<lambda>x. g x - f 0 x) + integral S (f 0)"
     by (auto simp add: tendsto_add)
   moreover have "(\<lambda>x. g x - f 0 x + f 0 x) integrable_on S"
     using gf integrable_add int_f [of 0] by metis
   ultimately show ?thesis
     by (simp add: integral_diff int_f LIMSEQ_imp_Suc sub)
 qed
 
 lemma has_integral_monotone_convergence_increasing:
   fixes f :: "nat \<Rightarrow> 'a::euclidean_space \<Rightarrow> real"
   assumes f: "\<And>k. (f k has_integral x k) s"
   assumes "\<And>k x. x \<in> s \<Longrightarrow> f k x \<le> f (Suc k) x"
   assumes "\<And>x. x \<in> s \<Longrightarrow> (\<lambda>k. f k x) \<longlonglongrightarrow> g x"
   assumes "x \<longlonglongrightarrow> x'"
   shows "(g has_integral x') s"
 proof -
   have x_eq: "x = (\<lambda>i. integral s (f i))"
     by (simp add: integral_unique[OF f])
   then have x: "range(\<lambda>k. integral s (f k)) = range x"
     by auto
   have *: "g integrable_on s \<and> (\<lambda>k. integral s (f k)) \<longlonglongrightarrow> integral s g"
   proof (intro monotone_convergence_increasing allI ballI assms)
     show "bounded (range(\<lambda>k. integral s (f k)))"
       using x convergent_imp_bounded assms by metis
   qed (use f in auto)
   then have "integral s g = x'"
     by (intro LIMSEQ_unique[OF _ \<open>x \<longlonglongrightarrow> x'\<close>]) (simp add: x_eq)
   with * show ?thesis
     by (simp add: has_integral_integral)
 qed
 
 lemma monotone_convergence_decreasing:
   fixes f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real"
   assumes intf: "\<And>k. (f k) integrable_on S"
     and le: "\<And>k x. x \<in> S \<Longrightarrow> f (Suc k) x \<le> f k x"
     and fg: "\<And>x. x \<in> S \<Longrightarrow> ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
     and bou: "bounded (range(\<lambda>k. integral S (f k)))"
   shows "g integrable_on S \<and> (\<lambda>k. integral S (f k)) \<longlonglongrightarrow> integral S g"
 proof -
   have *: "range(\<lambda>k. integral S (\<lambda>x. - f k x)) = (*\<^sub>R) (- 1) ` (range(\<lambda>k. integral S (f k)))"
     by force
   have "(\<lambda>x. - g x) integrable_on S \<and> (\<lambda>k. integral S (\<lambda>x. - f k x)) \<longlonglongrightarrow> integral S (\<lambda>x. - g x)"
   proof (rule monotone_convergence_increasing)
     show "\<And>k. (\<lambda>x. - f k x) integrable_on S"
       by (blast intro: integrable_neg intf)
     show "\<And>k x. x \<in> S \<Longrightarrow> - f k x \<le> - f (Suc k) x"
       by (simp add: le)
     show "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>k. - f k x) \<longlonglongrightarrow> - g x"
       by (simp add: fg tendsto_minus)
     show "bounded (range(\<lambda>k. integral S (\<lambda>x. - f k x)))"
       using "*" bou bounded_scaling by auto
   qed
   then show ?thesis
     by (force dest: integrable_neg tendsto_minus)
 qed
 
 lemma integral_norm_bound_integral:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes int_f: "f integrable_on S"
     and int_g: "g integrable_on S"
     and le_g: "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> g x"
   shows "norm (integral S f) \<le> integral S g"
 proof -
   have norm: "norm \<eta> \<le> y + e"
     if "norm \<zeta> \<le> x" and "\<bar>x - y\<bar> < e/2" and "norm (\<zeta> - \<eta>) < e/2"
     for e x y and \<zeta> \<eta> :: 'a
   proof -
     have "norm (\<eta> - \<zeta>) < e/2"
       by (metis norm_minus_commute that(3))
     moreover have "x \<le> y + e/2"
       using that(2) by linarith
     ultimately show ?thesis
       using that(1) le_less_trans[OF norm_triangle_sub[of \<eta> \<zeta>]] by (auto simp: less_imp_le)
   qed
   have lem: "norm (integral(cbox a b) f) \<le> integral (cbox a b) g"
     if f: "f integrable_on cbox a b"
     and g: "g integrable_on cbox a b"
     and nle: "\<And>x. x \<in> cbox a b \<Longrightarrow> norm (f x) \<le> g x"
     for f :: "'n \<Rightarrow> 'a" and g a b
   proof (rule field_le_epsilon)
     fix e :: real
     assume "e > 0"
     then have e: "e/2 > 0"
       by auto
     with integrable_integral[OF f,unfolded has_integral[of f]]
     obtain \<gamma> where \<gamma>: "gauge \<gamma>"
               "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> 
            \<Longrightarrow> norm ((\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R f x) - integral (cbox a b) f) < e/2"
       by meson 
     moreover
     from integrable_integral[OF g,unfolded has_integral[of g]] e
     obtain \<delta> where \<delta>: "gauge \<delta>"
               "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> \<delta> fine \<D> 
            \<Longrightarrow> norm ((\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R g x) - integral (cbox a b) g) < e/2"
       by meson
     ultimately have "gauge (\<lambda>x. \<gamma> x \<inter> \<delta> x)"
       using gauge_Int by blast
     with fine_division_exists obtain \<D> 
       where p: "\<D> tagged_division_of cbox a b" "(\<lambda>x. \<gamma> x \<inter> \<delta> x) fine \<D>" 
       by metis
     have "\<gamma> fine \<D>" "\<delta> fine \<D>"
       using fine_Int p(2) by blast+
     show "norm (integral (cbox a b) f) \<le> integral (cbox a b) g + e"
     proof (rule norm)
       have "norm (content K *\<^sub>R f x) \<le> content K *\<^sub>R g x" if  "(x, K) \<in> \<D>" for x K
       proof-
         have K: "x \<in> K" "K \<subseteq> cbox a b"
           using \<open>(x, K) \<in> \<D>\<close> p(1) by blast+
         obtain u v where  "K = cbox u v"
           using \<open>(x, K) \<in> \<D>\<close> p(1) by blast
         moreover have "content K * norm (f x) \<le> content K * g x"
           by (meson K(1) K(2) content_pos_le mult_left_mono nle subsetD)
         then show ?thesis
           by simp
       qed
       then show "norm (\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R f x) \<le> (\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R g x)"
         by (simp add: sum_norm_le split_def)
       show "norm ((\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R f x) - integral (cbox a b) f) < e/2"
         using \<open>\<gamma> fine \<D>\<close> \<gamma> p(1) by simp
       show "\<bar>(\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R g x) - integral (cbox a b) g\<bar> < e/2"
         using \<open>\<delta> fine \<D>\<close> \<delta> p(1) by simp
     qed
   qed
   show ?thesis
   proof (rule field_le_epsilon)
     fix e :: real
     assume "e > 0"
     then have e: "e/2 > 0"
       by auto
     let ?f = "(\<lambda>x. if x \<in> S then f x else 0)"
     let ?g = "(\<lambda>x. if x \<in> S then g x else 0)"
     have f: "?f integrable_on cbox a b" and g: "?g integrable_on cbox a b" for a b
       using int_f int_g integrable_altD by auto
     obtain Bf where "0 < Bf"
       and Bf: "\<And>a b. ball 0 Bf \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?f has_integral z) (cbox a b) \<and> norm (z - integral S f) < e/2"
       using integrable_integral [OF int_f,unfolded has_integral'[of f]] e that by blast
     obtain Bg where "0 < Bg"
       and Bg: "\<And>a b. ball 0 Bg \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?g has_integral z) (cbox a b) \<and> norm (z - integral S g) < e/2"
       using integrable_integral [OF int_g,unfolded has_integral'[of g]] e that by blast
     obtain a b::'n where ab: "ball 0 Bf \<union> ball 0 Bg \<subseteq> cbox a b"
       using ball_max_Un  by (metis bounded_ball bounded_subset_cbox_symmetric)
     have "ball 0 Bf \<subseteq> cbox a b"
       using ab by auto
     with Bf obtain z where int_fz: "(?f has_integral z) (cbox a b)" and z: "norm (z - integral S f) < e/2"
       by meson
     have "ball 0 Bg \<subseteq> cbox a b"
       using ab by auto
     with Bg obtain w where int_gw: "(?g has_integral w) (cbox a b)" and w: "norm (w - integral S g) < e/2"
       by meson
     show "norm (integral S f) \<le> integral S g + e"
     proof (rule norm)
       show "norm (integral (cbox a b) ?f) \<le> integral (cbox a b) ?g"
         by (simp add: le_g lem[OF f g, of a b])
       show "\<bar>integral (cbox a b) ?g - integral S g\<bar> < e/2"
         using int_gw integral_unique w by auto
       show "norm (integral (cbox a b) ?f - integral S f) < e/2"
         using int_fz integral_unique z by blast
     qed
   qed
 qed
 
 lemma continuous_on_imp_absolutely_integrable_on:
   fixes f::"real \<Rightarrow> 'a::banach"
   shows "continuous_on {a..b} f \<Longrightarrow>
     norm (integral {a..b} f) \<le> integral {a..b} (\<lambda>x. norm (f x))"
   by (intro integral_norm_bound_integral integrable_continuous_real continuous_on_norm) auto
 
 lemma integral_bound:
   fixes f::"real \<Rightarrow> 'a::banach"
   assumes "a \<le> b"
   assumes "continuous_on {a .. b} f"
   assumes "\<And>t. t \<in> {a .. b} \<Longrightarrow> norm (f t) \<le> B"
   shows "norm (integral {a .. b} f) \<le> B * (b - a)"
 proof -
   note continuous_on_imp_absolutely_integrable_on[OF assms(2)]
   also have "integral {a..b} (\<lambda>x. norm (f x)) \<le> integral {a..b} (\<lambda>_. B)"
     by (rule integral_le)
       (auto intro!: integrable_continuous_real continuous_intros assms)
   also have "\<dots> = B * (b - a)" using assms by simp
   finally show ?thesis .
 qed
 
 lemma integral_norm_bound_integral_component:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   fixes g :: "'n \<Rightarrow> 'b::euclidean_space"
   assumes f: "f integrable_on S" and g: "g integrable_on S"
     and fg: "\<And>x. x \<in> S \<Longrightarrow> norm(f x) \<le> (g x)\<bullet>k"
   shows "norm (integral S f) \<le> (integral S g)\<bullet>k"
 proof -
   have "norm (integral S f) \<le> integral S ((\<lambda>x. x \<bullet> k) \<circ> g)"
     using integral_norm_bound_integral[OF f integrable_linear[OF g]]
     by (simp add: bounded_linear_inner_left fg)
   then show ?thesis
     unfolding o_def integral_component_eq[OF g] .
 qed
 
 lemma has_integral_norm_bound_integral_component:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   fixes g :: "'n \<Rightarrow> 'b::euclidean_space"
   assumes "(f has_integral i) S" and "(g has_integral j) S"
     and "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> (g x)\<bullet>k"
   shows "norm i \<le> j\<bullet>k"
   by (metis assms has_integral_integrable integral_norm_bound_integral_component integral_unique)
 
 
 lemma uniformly_convergent_improper_integral:
   fixes f :: "'b \<Rightarrow> real \<Rightarrow> 'a :: {banach}"
   assumes deriv: "\<And>x. x \<ge> a \<Longrightarrow> (G has_field_derivative g x) (at x within {a..})"
   assumes integrable: "\<And>a' b x. x \<in> A \<Longrightarrow> a' \<ge> a \<Longrightarrow> b \<ge> a' \<Longrightarrow> f x integrable_on {a'..b}"
   assumes G: "convergent G"
   assumes le: "\<And>y x. y \<in> A \<Longrightarrow> x \<ge> a \<Longrightarrow> norm (f y x) \<le> g x"
   shows   "uniformly_convergent_on A (\<lambda>b x. integral {a..b} (f x))"
 proof (intro Cauchy_uniformly_convergent uniformly_Cauchy_onI', goal_cases)
   case (1 \<epsilon>)
   from G have "Cauchy G"
     by (auto intro!: convergent_Cauchy)
   with 1 obtain M where M: "dist (G (real m)) (G (real n)) < \<epsilon>" if "m \<ge> M" "n \<ge> M" for m n
     by (force simp: Cauchy_def)
   define M' where "M' = max (nat \<lceil>a\<rceil>) M"
 
   show ?case
   proof (rule exI[of _ M'], safe, goal_cases)
     case (1 x m n)
     have M': "M' \<ge> a" "M' \<ge> M" unfolding M'_def by linarith+
     have int_g: "(g has_integral (G (real n) - G (real m))) {real m..real n}"
       using 1 M' by (intro fundamental_theorem_of_calculus) 
                     (auto simp: has_real_derivative_iff_has_vector_derivative [symmetric] 
                           intro!: DERIV_subset[OF deriv])
     have int_f: "f x integrable_on {a'..real n}" if "a' \<ge> a" for a'
       using that 1 by (cases "a' \<le> real n") (auto intro: integrable)
 
     have "dist (integral {a..real m} (f x)) (integral {a..real n} (f x)) =
             norm (integral {a..real n} (f x) - integral {a..real m} (f x))"
       by (simp add: dist_norm norm_minus_commute)
     also have "integral {a..real m} (f x) + integral {real m..real n} (f x) = 
                  integral {a..real n} (f x)"
       using M' and 1 by (intro integral_combine int_f) auto
     hence "integral {a..real n} (f x) - integral {a..real m} (f x) = 
              integral {real m..real n} (f x)"
       by (simp add: algebra_simps)
     also have "norm \<dots> \<le> integral {real m..real n} g"
       using le 1 M' int_f int_g by (intro integral_norm_bound_integral) auto 
     also from int_g have "integral {real m..real n} g = G (real n) - G (real m)"
       by (simp add: has_integral_iff)
     also have "\<dots> \<le> dist (G m) (G n)" 
       by (simp add: dist_norm)
     also from 1 and M' have "\<dots> < \<epsilon>"
       by (intro M) auto
     finally show ?case .
   qed
 qed
 
 lemma uniformly_convergent_improper_integral':
   fixes f :: "'b \<Rightarrow> real \<Rightarrow> 'a :: {banach, real_normed_algebra}"
   assumes deriv: "\<And>x. x \<ge> a \<Longrightarrow> (G has_field_derivative g x) (at x within {a..})"
   assumes integrable: "\<And>a' b x. x \<in> A \<Longrightarrow> a' \<ge> a \<Longrightarrow> b \<ge> a' \<Longrightarrow> f x integrable_on {a'..b}"
   assumes G: "convergent G"
   assumes le: "eventually (\<lambda>x. \<forall>y\<in>A. norm (f y x) \<le> g x) at_top"
   shows   "uniformly_convergent_on A (\<lambda>b x. integral {a..b} (f x))"
 proof -
   from le obtain a'' where le: "\<And>y x. y \<in> A \<Longrightarrow> x \<ge> a'' \<Longrightarrow> norm (f y x) \<le> g x"
     by (auto simp: eventually_at_top_linorder)
   define a' where "a' = max a a''"
 
   have "uniformly_convergent_on A (\<lambda>b x. integral {a'..real b} (f x))"
   proof (rule uniformly_convergent_improper_integral)
     fix t assume t: "t \<ge> a'"
     hence "(G has_field_derivative g t) (at t within {a..})"
       by (intro deriv) (auto simp: a'_def)
     moreover have "{a'..} \<subseteq> {a..}" unfolding a'_def by auto
     ultimately show "(G has_field_derivative g t) (at t within {a'..})"
       by (rule DERIV_subset)
   qed (insert le, auto simp: a'_def intro: integrable G)
   hence "uniformly_convergent_on A (\<lambda>b x. integral {a..a'} (f x) + integral {a'..real b} (f x))" 
     (is ?P) by (intro uniformly_convergent_add) auto
   also have "eventually (\<lambda>x. \<forall>y\<in>A. integral {a..a'} (f y) + integral {a'..x} (f y) =
                    integral {a..x} (f y)) sequentially"
     by (intro eventually_mono [OF eventually_ge_at_top[of "nat \<lceil>a'\<rceil>"]] ballI integral_combine)
        (auto simp: a'_def intro: integrable)
   hence "?P \<longleftrightarrow> ?thesis"
     by (intro uniformly_convergent_cong) simp_all
   finally show ?thesis .
 qed
 
 subsection \<open>differentiation under the integral sign\<close>
 
 lemma integral_continuous_on_param:
   fixes f::"'a::topological_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
   assumes cont_fx: "continuous_on (U \<times> cbox a b) (\<lambda>(x, t). f x t)"
   shows "continuous_on U (\<lambda>x. integral (cbox a b) (f x))"
 proof cases
   assume "content (cbox a b) \<noteq> 0"
   then have ne: "cbox a b \<noteq> {}" by auto
 
   note [continuous_intros] =
     continuous_on_compose2[OF cont_fx, where f="\<lambda>y. Pair x y" for x,
       unfolded split_beta fst_conv snd_conv]
 
   show ?thesis
     unfolding continuous_on_def
   proof (intro strip tendstoI)
     fix e'::real and x
     assume "e' > 0"
     define e where "e = e' / (content (cbox a b) + 1)"
     have "e > 0" using \<open>e' > 0\<close> by (auto simp: e_def intro!: divide_pos_pos add_nonneg_pos)
     assume "x \<in> U"
     from continuous_on_prod_compactE[OF cont_fx compact_cbox \<open>x \<in> U\<close> \<open>0 < e\<close>]
     obtain X0 where X0: "x \<in> X0" "open X0"
       and fx_bound: "\<And>y t. y \<in> X0 \<inter> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> norm (f y t - f x t) \<le> e"
       unfolding split_beta fst_conv snd_conv dist_norm
       by metis
     have "\<forall>\<^sub>F y in at x within U. y \<in> X0 \<inter> U"
       using X0(1) X0(2) eventually_at_topological by auto
     then show "\<forall>\<^sub>F y in at x within U. dist (integral (cbox a b) (f y)) (integral (cbox a b) (f x)) < e'"
     proof eventually_elim
       case (elim y)
       have "dist (integral (cbox a b) (f y)) (integral (cbox a b) (f x)) =
         norm (integral (cbox a b) (\<lambda>t. f y t - f x t))"
         using elim \<open>x \<in> U\<close>
         unfolding dist_norm
         by (subst integral_diff)
            (auto intro!: integrable_continuous continuous_intros)
       also have "\<dots> \<le> e * content (cbox a b)"
         using elim \<open>x \<in> U\<close>
         by (intro integrable_bound)
            (auto intro!: fx_bound \<open>x \<in> U \<close> less_imp_le[OF \<open>0 < e\<close>]
               integrable_continuous continuous_intros)
       also have "\<dots> < e'"
         using \<open>0 < e'\<close> \<open>e > 0\<close>
         by (auto simp: e_def field_split_simps)
       finally show "dist (integral (cbox a b) (f y)) (integral (cbox a b) (f x)) < e'" .
     qed
   qed
 qed (auto intro!: continuous_on_const)
 
 lemma leibniz_rule:
   fixes f::"'a::banach \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
   assumes fx: "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow>
     ((\<lambda>x. f x t) has_derivative blinfun_apply (fx x t)) (at x within U)"
   assumes integrable_f2: "\<And>x. x \<in> U \<Longrightarrow> f x integrable_on cbox a b"
   assumes cont_fx: "continuous_on (U \<times> (cbox a b)) (\<lambda>(x, t). fx x t)"
   assumes [intro]: "x0 \<in> U"
   assumes "convex U"
   shows
     "((\<lambda>x. integral (cbox a b) (f x)) has_derivative integral (cbox a b) (fx x0)) (at x0 within U)"
     (is "(?F has_derivative ?dF) _")
 proof cases
   assume "content (cbox a b) \<noteq> 0"
   then have ne: "cbox a b \<noteq> {}" by auto
   note [continuous_intros] =
     continuous_on_compose2[OF cont_fx, where f="\<lambda>y. Pair x y" for x,
       unfolded split_beta fst_conv snd_conv]
   show ?thesis
   proof (intro has_derivativeI bounded_linear_scaleR_left tendstoI, fold norm_conv_dist)
     have cont_f1: "\<And>t. t \<in> cbox a b \<Longrightarrow> continuous_on U (\<lambda>x. f x t)"
       by (auto simp: continuous_on_eq_continuous_within intro!: has_derivative_continuous fx)
     note [continuous_intros] = continuous_on_compose2[OF cont_f1]
     fix e'::real
     assume "e' > 0"
     define e where "e = e' / (content (cbox a b) + 1)"
     have "e > 0" using \<open>e' > 0\<close> by (auto simp: e_def intro!: divide_pos_pos add_nonneg_pos)
     from continuous_on_prod_compactE[OF cont_fx compact_cbox \<open>x0 \<in> U\<close> \<open>e > 0\<close>]
     obtain X0 where X0: "x0 \<in> X0" "open X0"
       and fx_bound: "\<And>x t. x \<in> X0 \<inter> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> norm (fx x t - fx x0 t) \<le> e"
       unfolding split_beta fst_conv snd_conv
       by (metis dist_norm)
 
     note eventually_closed_segment[OF \<open>open X0\<close> \<open>x0 \<in> X0\<close>, of U]
     moreover
     have "\<forall>\<^sub>F x in at x0 within U. x \<in> X0"
       using \<open>open X0\<close> \<open>x0 \<in> X0\<close> eventually_at_topological by blast
     moreover have "\<forall>\<^sub>F x in at x0 within U. x \<noteq> x0"
       by (auto simp: eventually_at_filter)
     moreover have "\<forall>\<^sub>F x in at x0 within U. x \<in> U"
       by (auto simp: eventually_at_filter)
     ultimately
     show "\<forall>\<^sub>F x in at x0 within U. norm ((?F x - ?F x0 - ?dF (x - x0)) /\<^sub>R norm (x - x0)) < e'"
     proof eventually_elim
       case (elim x)
       from elim have "0 < norm (x - x0)" by simp
       have "closed_segment x0 x \<subseteq> U"
         by (simp add: assms closed_segment_subset elim(4))
       from elim have [intro]: "x \<in> U" by auto
       have "?F x - ?F x0 - ?dF (x - x0) =
         integral (cbox a b) (\<lambda>y. f x y - f x0 y - fx x0 y (x - x0))"
         (is "_ = ?id")
         using \<open>x \<noteq> x0\<close>
         by (subst blinfun_apply_integral integral_diff,
             auto intro!: integrable_diff integrable_f2 continuous_intros
               intro: integrable_continuous)+
       also
       {
         fix t assume t: "t \<in> (cbox a b)"
         then have deriv:
           "((\<lambda>x. f x t) has_derivative (fx y t)) (at y within X0 \<inter> U)"
           if "y \<in> X0 \<inter> U" for y
           using fx has_derivative_subset that by fastforce
         have seg: "\<And>t. t \<in> {0..1} \<Longrightarrow> x0 + t *\<^sub>R (x - x0) \<in> X0 \<inter> U"
           using \<open>closed_segment x0 x \<subseteq> U\<close>
             \<open>closed_segment x0 x \<subseteq> X0\<close>
           by (force simp: closed_segment_def algebra_simps)
         have "\<And>x. x \<in> X0 \<inter> U \<Longrightarrow> onorm (blinfun_apply (fx x t) - (fx x0 t)) \<le> e"
           using fx_bound t
           by (auto simp add: norm_blinfun_def fun_diff_def blinfun.bilinear_simps[symmetric])
         from differentiable_bound_linearization[OF seg deriv this] X0
         have "norm (f x t - f x0 t - fx x0 t (x - x0)) \<le> e * norm (x - x0)"
           by (auto simp add: ac_simps)
       }
       then have "norm ?id \<le> integral (cbox a b) (\<lambda>_. e * norm (x - x0))"
         by (intro integral_norm_bound_integral)
           (auto intro!: continuous_intros integrable_diff integrable_f2
             intro: integrable_continuous)
       also have "\<dots> = content (cbox a b) * e * norm (x - x0)"
         by simp
       also have "\<dots> < e' * norm (x - x0)"
       proof (intro mult_strict_right_mono[OF _ \<open>0 < norm (x - x0)\<close>])
         show "content (cbox a b) * e < e'"
           using \<open>e' > 0\<close> by (simp add: divide_simps e_def not_less)
       qed
       finally have "norm (?F x - ?F x0 - ?dF (x - x0)) < e' * norm (x - x0)" .
       then show ?case
         by (auto simp: divide_simps)
     qed
   qed (rule blinfun.bounded_linear_right)
 qed (auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps)
 
 lemma has_vector_derivative_eq_has_derivative_blinfun:
   "(f has_vector_derivative f') (at x within U) \<longleftrightarrow>
     (f has_derivative blinfun_scaleR_left f') (at x within U)"
   by (simp add: has_vector_derivative_def)
 
 lemma leibniz_rule_vector_derivative:
   fixes f::"real \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
   assumes fx: "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow>
       ((\<lambda>x. f x t) has_vector_derivative (fx x t)) (at x within U)"
   assumes integrable_f2: "\<And>x. x \<in> U \<Longrightarrow> (f x) integrable_on cbox a b"
   assumes cont_fx: "continuous_on (U \<times> cbox a b) (\<lambda>(x, t). fx x t)"
   assumes U: "x0 \<in> U" "convex U"
   shows "((\<lambda>x. integral (cbox a b) (f x)) has_vector_derivative integral (cbox a b) (fx x0))
       (at x0 within U)"
 proof -
   note [continuous_intros] =
     continuous_on_compose2[OF cont_fx, where f="\<lambda>y. Pair x y" for x,
       unfolded split_beta fst_conv snd_conv]
   show ?thesis
     unfolding has_vector_derivative_eq_has_derivative_blinfun
   proof (rule has_derivative_eq_rhs [OF leibniz_rule[OF _ integrable_f2 _ U]])
     show "continuous_on (U \<times> cbox a b) (\<lambda>(x, t). blinfun_scaleR_left (fx x t))"
       using cont_fx by (auto simp: split_beta intro!: continuous_intros)
     show "blinfun_apply (integral (cbox a b) (\<lambda>t. blinfun_scaleR_left (fx x0 t))) =
           blinfun_apply (blinfun_scaleR_left (integral (cbox a b) (fx x0)))"
     by (subst integral_linear[symmetric])
        (auto simp: has_vector_derivative_def o_def
          intro!: integrable_continuous U continuous_intros bounded_linear_intros)
     qed (use fx in \<open>auto simp: has_vector_derivative_def\<close>)
 qed
 
 lemma has_field_derivative_eq_has_derivative_blinfun:
   "(f has_field_derivative f') (at x within U) \<longleftrightarrow> (f has_derivative blinfun_mult_right f') (at x within U)"
   by (simp add: has_field_derivative_def)
 
 lemma leibniz_rule_field_derivative:
   fixes f::"'a::{real_normed_field, banach} \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'a"
   assumes fx: "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> ((\<lambda>x. f x t) has_field_derivative fx x t) (at x within U)"
   assumes integrable_f2: "\<And>x. x \<in> U \<Longrightarrow> (f x) integrable_on cbox a b"
   assumes cont_fx: "continuous_on (U \<times> (cbox a b)) (\<lambda>(x, t). fx x t)"
   assumes U: "x0 \<in> U" "convex U"
   shows "((\<lambda>x. integral (cbox a b) (f x)) has_field_derivative integral (cbox a b) (fx x0)) (at x0 within U)"
 proof -
   note [continuous_intros] =
     continuous_on_compose2[OF cont_fx, where f="\<lambda>y. Pair x y" for x,
       unfolded split_beta fst_conv snd_conv]
   have *: "blinfun_mult_right (integral (cbox a b) (fx x0)) =
     integral (cbox a b) (\<lambda>t. blinfun_mult_right (fx x0 t))"
     by (subst integral_linear[symmetric])
       (auto simp: has_vector_derivative_def o_def
         intro!: integrable_continuous U continuous_intros bounded_linear_intros)
   show ?thesis
     unfolding has_field_derivative_eq_has_derivative_blinfun
   proof (rule has_derivative_eq_rhs [OF leibniz_rule[OF _ integrable_f2 _ U, where fx="\<lambda>x t. blinfun_mult_right (fx x t)"]])
     show "continuous_on (U \<times> cbox a b) (\<lambda>(x, t). blinfun_mult_right (fx x t))"
       using cont_fx by (auto simp: split_beta intro!: continuous_intros)
     show "blinfun_apply (integral (cbox a b) (\<lambda>t. blinfun_mult_right (fx x0 t))) =
           blinfun_apply (blinfun_mult_right (integral (cbox a b) (fx x0)))"
       by (subst integral_linear[symmetric])
         (auto simp: has_vector_derivative_def o_def
           intro!: integrable_continuous U continuous_intros bounded_linear_intros)
   qed (use fx in \<open>auto simp: has_field_derivative_def\<close>)
 qed
 
 lemma leibniz_rule_field_differentiable:
   fixes f::"'a::{real_normed_field, banach} \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'a"
   assumes "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> ((\<lambda>x. f x t) has_field_derivative fx x t) (at x within U)"
   assumes "\<And>x. x \<in> U \<Longrightarrow> (f x) integrable_on cbox a b"
   assumes "continuous_on (U \<times> (cbox a b)) (\<lambda>(x, t). fx x t)"
   assumes "x0 \<in> U" "convex U"
   shows "(\<lambda>x. integral (cbox a b) (f x)) field_differentiable at x0 within U"
   using leibniz_rule_field_derivative[OF assms] by (auto simp: field_differentiable_def)
 
 
 subsection \<open>Exchange uniform limit and integral\<close>
 
 lemma uniform_limit_integral_cbox:
   fixes f::"'a \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
   assumes u: "uniform_limit (cbox a b) f g F"
   assumes c: "\<And>n. continuous_on (cbox a b) (f n)"
   assumes [simp]: "F \<noteq> bot"
   obtains I J where
     "\<And>n. (f n has_integral I n) (cbox a b)"
     "(g has_integral J) (cbox a b)"
     "(I \<longlongrightarrow> J) F"
 proof -
   have fi[simp]: "f n integrable_on (cbox a b)" for n
     by (auto intro!: integrable_continuous assms)
   then obtain I where I: "\<And>n. (f n has_integral I n) (cbox a b)"
     unfolding integrable_on_def by metis
 
   moreover
   have gi[simp]: "g integrable_on (cbox a b)"
     by (auto intro!: integrable_continuous uniform_limit_theorem[OF _ u] eventuallyI c)
   then obtain J where J: "(g has_integral J) (cbox a b)"
     by blast
 
   moreover
   have "(I \<longlongrightarrow> J) F"
   proof cases
     assume "content (cbox a b) = 0"
     hence "I = (\<lambda>_. 0)" "J = 0"
       by (auto intro!: has_integral_unique I J)
     thus ?thesis by simp
   next
     assume content_nonzero: "content (cbox a b) \<noteq> 0"
     show ?thesis
     proof (rule tendstoI)
       fix e::real
       assume "e > 0"
       define e' where "e' = e/2"
       with \<open>e > 0\<close> have "e' > 0" by simp
       then have "\<forall>\<^sub>F n in F. \<forall>x\<in>cbox a b. norm (f n x - g x) < e' / content (cbox a b)"
         using u content_nonzero by (auto simp: uniform_limit_iff dist_norm zero_less_measure_iff)
       then show "\<forall>\<^sub>F n in F. dist (I n) J < e"
       proof eventually_elim
         case (elim n)
         have "I n = integral (cbox a b) (f n)"
             "J = integral (cbox a b) g"
           using I[of n] J by (simp_all add: integral_unique)
         then have "dist (I n) J = norm (integral (cbox a b) (\<lambda>x. f n x - g x))"
           by (simp add: integral_diff dist_norm)
         also have "\<dots> \<le> integral (cbox a b) (\<lambda>x. (e' / content (cbox a b)))"
           using elim
           by (intro integral_norm_bound_integral) (auto intro!: integrable_diff)
         also have "\<dots> < e"
           using \<open>0 < e\<close> by (simp add: e'_def)
         finally show ?case .
       qed
     qed
   qed
   ultimately show ?thesis ..
 qed
 
 lemma uniform_limit_integral:
   fixes f::"'a \<Rightarrow> 'b::ordered_euclidean_space \<Rightarrow> 'c::banach"
   assumes u: "uniform_limit {a..b} f g F"
   assumes c: "\<And>n. continuous_on {a..b} (f n)"
   assumes [simp]: "F \<noteq> bot"
   obtains I J where
     "\<And>n. (f n has_integral I n) {a..b}"
     "(g has_integral J) {a..b}"
     "(I \<longlongrightarrow> J) F"
   by (metis interval_cbox assms uniform_limit_integral_cbox)
 
 
 subsection \<open>Integration by parts\<close>
 
 lemma integration_by_parts_interior_strong:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes bilinear: "bounded_bilinear (prod)"
   assumes s: "finite s" and le: "a \<le> b"
   assumes cont [continuous_intros]: "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes deriv: "\<And>x. x\<in>{a<..<b} - s \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
                  "\<And>x. x\<in>{a<..<b} - s \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes int: "((\<lambda>x. prod (f x) (g' x)) has_integral
                   (prod (f b) (g b) - prod (f a) (g a) - y)) {a..b}"
   shows   "((\<lambda>x. prod (f' x) (g x)) has_integral y) {a..b}"
 proof -
   interpret bounded_bilinear prod by fact
   have "((\<lambda>x. prod (f x) (g' x) + prod (f' x) (g x)) has_integral
           (prod (f b) (g b) - prod (f a) (g a))) {a..b}"
     using deriv by (intro fundamental_theorem_of_calculus_interior_strong[OF s le])
                    (auto intro!: continuous_intros continuous_on has_vector_derivative)
   from has_integral_diff[OF this int] show ?thesis by (simp add: algebra_simps)
 qed
 
 lemma integration_by_parts_interior:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes "bounded_bilinear (prod)" "a \<le> b"
           "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
           "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes "((\<lambda>x. prod (f x) (g' x)) has_integral (prod (f b) (g b) - prod (f a) (g a) - y)) {a..b}"
   shows   "((\<lambda>x. prod (f' x) (g x)) has_integral y) {a..b}"
   by (rule integration_by_parts_interior_strong[of _ "{}" _ _ f g f' g']) (use assms in simp_all)
 
 lemma integration_by_parts:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes "bounded_bilinear (prod)" "a \<le> b"
           "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes "\<And>x. x\<in>{a..b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
           "\<And>x. x\<in>{a..b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes "((\<lambda>x. prod (f x) (g' x)) has_integral (prod (f b) (g b) - prod (f a) (g a) - y)) {a..b}"
   shows   "((\<lambda>x. prod (f' x) (g x)) has_integral y) {a..b}"
   by (rule integration_by_parts_interior[of _ _ _ f g f' g']) (use assms in simp_all)
 
 lemma integrable_by_parts_interior_strong:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes bilinear: "bounded_bilinear (prod)"
   assumes s: "finite s" and le: "a \<le> b"
   assumes cont [continuous_intros]: "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes deriv: "\<And>x. x\<in>{a<..<b} - s \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
                  "\<And>x. x\<in>{a<..<b} - s \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes int: "(\<lambda>x. prod (f x) (g' x)) integrable_on {a..b}"
   shows   "(\<lambda>x. prod (f' x) (g x)) integrable_on {a..b}"
 proof -
   from int obtain I where "((\<lambda>x. prod (f x) (g' x)) has_integral I) {a..b}"
     unfolding integrable_on_def by blast
   hence "((\<lambda>x. prod (f x) (g' x)) has_integral (prod (f b) (g b) - prod (f a) (g a) -
            (prod (f b) (g b) - prod (f a) (g a) - I))) {a..b}" by simp
   from integration_by_parts_interior_strong[OF assms(1-7) this]
     show ?thesis unfolding integrable_on_def by blast
 qed
 
 lemma integrable_by_parts_interior:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes "bounded_bilinear (prod)" "a \<le> b"
           "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
           "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes "(\<lambda>x. prod (f x) (g' x)) integrable_on {a..b}"
   shows   "(\<lambda>x. prod (f' x) (g x)) integrable_on {a..b}"
   by (rule integrable_by_parts_interior_strong[of _ "{}" _ _ f g f' g']) (use assms in simp_all)
 
 lemma integrable_by_parts:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes "bounded_bilinear (prod)" "a \<le> b"
           "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes "\<And>x. x\<in>{a..b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
           "\<And>x. x\<in>{a..b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes "(\<lambda>x. prod (f x) (g' x)) integrable_on {a..b}"
   shows   "(\<lambda>x. prod (f' x) (g x)) integrable_on {a..b}"
   by (rule integrable_by_parts_interior_strong[of _ "{}" _ _ f g f' g']) (use assms in simp_all)
 
 
 subsection \<open>Integration by substitution\<close>
 
 lemma has_integral_substitution_general:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> real"
   assumes s: "finite s" and le: "a \<le> b"
       and subset: "g ` {a..b} \<subseteq> {c..d}"
       and f [continuous_intros]: "continuous_on {c..d} f"
       and g [continuous_intros]: "continuous_on {a..b} g"
       and deriv [derivative_intros]:
               "\<And>x. x \<in> {a..b} - s \<Longrightarrow> (g has_field_derivative g' x) (at x within {a..b})"
     shows "((\<lambda>x. g' x *\<^sub>R f (g x)) has_integral (integral {g a..g b} f - integral {g b..g a} f)) {a..b}"
 proof -
   let ?F = "\<lambda>x. integral {c..g x} f"
   have cont_int: "continuous_on {a..b} ?F"
     by (rule continuous_on_compose2[OF _ g subset] indefinite_integral_continuous_1
           f integrable_continuous_real)+
   have deriv: "(((\<lambda>x. integral {c..x} f) \<circ> g) has_vector_derivative g' x *\<^sub>R f (g x))
                  (at x within {a..b})" if "x \<in> {a..b} - s" for x
   proof (rule has_vector_derivative_eq_rhs [OF vector_diff_chain_within refl])
     show "(g has_vector_derivative g' x) (at x within {a..b})"
       using deriv has_real_derivative_iff_has_vector_derivative that by blast
     show "((\<lambda>x. integral {c..x} f) has_vector_derivative f (g x)) 
           (at (g x) within g ` {a..b})"
       using that le subset
       by (blast intro: has_vector_derivative_within_subset integral_has_vector_derivative f)
   qed
   have deriv: "(?F has_vector_derivative g' x *\<^sub>R f (g x))
                   (at x)" if "x \<in> {a..b} - (s \<union> {a,b})" for x
     using deriv[of x] that by (simp add: at_within_Icc_at o_def)
   have "((\<lambda>x. g' x *\<^sub>R f (g x)) has_integral (?F b - ?F a)) {a..b}"
     using le cont_int s deriv cont_int
     by (intro fundamental_theorem_of_calculus_interior_strong[of "s \<union> {a,b}"]) simp_all
   also
   from subset have "g x \<in> {c..d}" if "x \<in> {a..b}" for x using that by blast
   from this[of a] this[of b] le have cd: "c \<le> g a" "g b \<le> d" "c \<le> g b" "g a \<le> d" by auto
   have "integral {c..g b} f - integral {c..g a} f = integral {g a..g b} f - integral {g b..g a} f"
   proof cases
     assume "g a \<le> g b"
     note le = le this
     from cd have "integral {c..g a} f + integral {g a..g b} f = integral {c..g b} f"
       by (intro integral_combine integrable_continuous_real continuous_on_subset[OF f] le) simp_all
     with le show ?thesis
       by (cases "g a = g b") (simp_all add: algebra_simps)
   next
     assume less: "\<not>g a \<le> g b"
     then have "g a \<ge> g b" by simp
     note le = le this
     from cd have "integral {c..g b} f + integral {g b..g a} f = integral {c..g a} f"
       by (intro integral_combine integrable_continuous_real continuous_on_subset[OF f] le) simp_all
     with less show ?thesis
       by (simp_all add: algebra_simps)
   qed
   finally show ?thesis .
 qed
 
 lemma has_integral_substitution_strong:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> real"
   assumes s: "finite s" and le: "a \<le> b" "g a \<le> g b"
     and subset: "g ` {a..b} \<subseteq> {c..d}"
     and f [continuous_intros]: "continuous_on {c..d} f"
     and g [continuous_intros]: "continuous_on {a..b} g"
     and deriv [derivative_intros]:
     "\<And>x. x \<in> {a..b} - s \<Longrightarrow> (g has_field_derivative g' x) (at x within {a..b})"
   shows "((\<lambda>x. g' x *\<^sub>R f (g x)) has_integral (integral {g a..g b} f)) {a..b}"
   using has_integral_substitution_general[OF s le(1) subset f g deriv] le(2)
   by (cases "g a = g b") auto
 
 lemma has_integral_substitution:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> real"
   assumes "a \<le> b" "g a \<le> g b" "g ` {a..b} \<subseteq> {c..d}"
       and "continuous_on {c..d} f"
       and "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_field_derivative g' x) (at x within {a..b})"
     shows "((\<lambda>x. g' x *\<^sub>R f (g x)) has_integral (integral {g a..g b} f)) {a..b}"
   by (intro has_integral_substitution_strong[of "{}" a b g c d] assms)
      (auto intro: DERIV_continuous_on assms)
 
 lemma integral_shift:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes cont: "continuous_on {a + c..b + c} f"
   shows "integral {a..b} (f \<circ> (\<lambda>x. x + c)) = integral {a + c..b + c} f"
 proof (cases "a \<le> b")
   case True
   have "((\<lambda>x. 1 *\<^sub>R f (x + c)) has_integral integral {a+c..b+c} f) {a..b}"
     using True cont
     by (intro has_integral_substitution[where c = "a + c" and d = "b + c"])
        (auto intro!: derivative_eq_intros)
   thus ?thesis by (simp add: has_integral_iff o_def)
 qed auto
 
 
 subsection \<open>Compute a double integral using iterated integrals and switching the order of integration\<close>
 
 lemma continuous_on_imp_integrable_on_Pair1:
   fixes f :: "_ \<Rightarrow> 'b::banach"
   assumes con: "continuous_on (cbox (a,c) (b,d)) f" and x: "x \<in> cbox a b"
   shows "(\<lambda>y. f (x, y)) integrable_on (cbox c d)"
 proof -
   have "f \<circ> (\<lambda>y. (x, y)) integrable_on (cbox c d)"
   proof (intro integrable_continuous continuous_on_compose [OF _ continuous_on_subset [OF con]])
     show "continuous_on (cbox c d) (Pair x)"
       by (simp add: continuous_on_Pair)
     show "Pair x ` cbox c d \<subseteq> cbox (a,c) (b,d)"
       using x by blast
   qed
   then show ?thesis
     by (simp add: o_def)
 qed
 
 lemma integral_integrable_2dim:
   fixes f :: "('a::euclidean_space * 'b::euclidean_space) \<Rightarrow> 'c::banach"
   assumes "continuous_on (cbox (a,c) (b,d)) f"
     shows "(\<lambda>x. integral (cbox c d) (\<lambda>y. f (x,y))) integrable_on cbox a b"
 proof (cases "content(cbox c d) = 0")
 case True
   then show ?thesis
     by (simp add: True integrable_const)
 next
   case False
   have uc: "uniformly_continuous_on (cbox (a,c) (b,d)) f"
     by (simp add: assms compact_cbox compact_uniformly_continuous)
   { fix x::'a and e::real
     assume x: "x \<in> cbox a b" and e: "0 < e"
     then have e2_gt: "0 < e/2 / content (cbox c d)" and e2_less: "e/2 / content (cbox c d) * content (cbox c d) < e"
       by (auto simp: False content_lt_nz e)
     then obtain dd
     where dd: "\<And>x x'. \<lbrakk>x\<in>cbox (a, c) (b, d); x'\<in>cbox (a, c) (b, d); norm (x' - x) < dd\<rbrakk>
                        \<Longrightarrow> norm (f x' - f x) \<le> e/(2 * content (cbox c d))"  "dd>0"
       using uc [unfolded uniformly_continuous_on_def, THEN spec, of "e/(2 * content (cbox c d))"]
       by (auto simp: dist_norm intro: less_imp_le)
     have "\<exists>delta>0. \<forall>x'\<in>cbox a b. norm (x' - x) < delta \<longrightarrow> norm (integral (cbox c d) (\<lambda>u. f (x', u) - f (x, u))) < e"
       using dd e2_gt assms x
       apply (rule_tac x=dd in exI)
       apply clarify
       apply (rule le_less_trans [OF integrable_bound e2_less])
       apply (auto intro: integrable_diff continuous_on_imp_integrable_on_Pair1)
       done
   } note * = this
   show ?thesis
   proof (rule integrable_continuous)
     show "continuous_on (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x, y)))"
       by (simp add: * continuous_on_iff dist_norm integral_diff [symmetric] continuous_on_imp_integrable_on_Pair1 [OF assms])
   qed
 qed
 
 lemma integral_split:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
   assumes f: "f integrable_on (cbox a b)"
       and k: "k \<in> Basis"
   shows "integral (cbox a b) f =
            integral (cbox a b \<inter> {x. x\<bullet>k \<le> c}) f +
            integral (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) f"
   using k f
   by (auto simp: has_integral_integral intro: integral_unique [OF has_integral_split])
 
 lemma integral_swap_operativeI:
   fixes f :: "('a::euclidean_space * 'b::euclidean_space) \<Rightarrow> 'c::banach"
   assumes f: "continuous_on s f" and e: "0 < e"
     shows "operative conj True
            (\<lambda>k. \<forall>a b c d.
                 cbox (a,c) (b,d) \<subseteq> k \<and> cbox (a,c) (b,d) \<subseteq> s
                 \<longrightarrow> norm(integral (cbox (a,c) (b,d)) f -
                          integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f((x,y)))))
                     \<le> e * content (cbox (a,c) (b,d)))"
 proof (standard, auto)
   fix a::'a and c::'b and b::'a and d::'b and u::'a and v::'a and w::'b and z::'b
   assume *: "box (a, c) (b, d) = {}"
      and cb1: "cbox (u, w) (v, z) \<subseteq> cbox (a, c) (b, d)"
      and cb2: "cbox (u, w) (v, z) \<subseteq> s"
   then have c0: "content (cbox (a, c) (b, d)) = 0"
     using * unfolding content_eq_0_interior by simp
   have c0': "content (cbox (u, w) (v, z)) = 0"
     by (fact content_0_subset [OF c0 cb1])
   show "norm (integral (cbox (u,w) (v,z)) f - integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))))
           \<le> e * content (cbox (u,w) (v,z))"
     using content_cbox_pair_eq0_D [OF c0']
     by (force simp add: c0')
 next
   fix a::'a and c::'b and b::'a and d::'b
   and M::real and i::'a and j::'b
   and u::'a and v::'a and w::'b and z::'b
   assume ij: "(i,j) \<in> Basis"
      and n1: "\<forall>a' b' c' d'.
                 cbox (a',c') (b',d') \<subseteq> cbox (a,c) (b,d) \<and>
                 cbox (a',c') (b',d') \<subseteq> {x. x \<bullet> (i,j) \<le> M} \<and> cbox (a',c') (b',d') \<subseteq> s \<longrightarrow>
                 norm (integral (cbox (a',c') (b',d')) f - integral (cbox a' b') (\<lambda>x. integral (cbox c' d') (\<lambda>y. f (x,y))))
                 \<le> e * content (cbox (a',c') (b',d'))"
      and n2: "\<forall>a' b' c' d'.
                 cbox (a',c') (b',d') \<subseteq> cbox (a,c) (b,d) \<and>
                 cbox (a',c') (b',d') \<subseteq> {x. M \<le> x \<bullet> (i,j)} \<and> cbox (a',c') (b',d') \<subseteq> s \<longrightarrow>
                 norm (integral (cbox (a',c') (b',d')) f - integral (cbox a' b') (\<lambda>x. integral (cbox c' d') (\<lambda>y. f (x,y))))
                 \<le> e * content (cbox (a',c') (b',d'))"
      and subs: "cbox (u,w) (v,z) \<subseteq> cbox (a,c) (b,d)"  "cbox (u,w) (v,z) \<subseteq> s"
   have fcont: "continuous_on (cbox (u, w) (v, z)) f"
     using assms(1) continuous_on_subset  subs(2) by blast
   then have fint: "f integrable_on cbox (u, w) (v, z)"
     by (metis integrable_continuous)
   consider "i \<in> Basis" "j=0" | "j \<in> Basis" "i=0"  using ij
     by (auto simp: Euclidean_Space.Basis_prod_def)
   then show "norm (integral (cbox (u,w) (v,z)) f - integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x,y))))
              \<le> e * content (cbox (u,w) (v,z))" (is ?normle)
   proof cases
     case 1
     then have e: "e * content (cbox (u, w) (v, z)) =
                   e * (content (cbox u v \<inter> {x. x \<bullet> i \<le> M}) * content (cbox w z)) +
                   e * (content (cbox u v \<inter> {x. M \<le> x \<bullet> i}) * content (cbox w z))"
       by (simp add: content_split [where c=M] content_Pair algebra_simps)
     have *: "integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))) =
                 integral (cbox u v \<inter> {x. x \<bullet> i \<le> M}) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))) +
                 integral (cbox u v \<inter> {x. M \<le> x \<bullet> i}) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y)))"
       using 1 f subs integral_integrable_2dim continuous_on_subset
       by (blast intro: integral_split)
     show ?normle
       apply (rule norm_diff2 [OF integral_split [where c=M, OF fint ij] * e])
       using 1 subs
       apply (simp_all add: cbox_Pair_eq setcomp_dot1 [of "\<lambda>u. M\<le>u"] setcomp_dot1 [of "\<lambda>u. u\<le>M"] Sigma_Int_Paircomp1)
       apply (simp_all add: interval_split ij flip: cbox_Pair_eq content_Pair)
       apply (force simp flip: interval_split intro!: n1 [rule_format])
       apply (force simp flip: interval_split intro!: n2 [rule_format])
       done
   next
     case 2
     then have e: "e * content (cbox (u, w) (v, z)) =
                   e * (content (cbox u v) * content (cbox w z \<inter> {x. x \<bullet> j \<le> M})) +
                   e * (content (cbox u v) * content (cbox w z \<inter> {x. M \<le> x \<bullet> j}))"
       by (simp add: content_split [where c=M] content_Pair algebra_simps)
     have "(\<lambda>x. integral (cbox w z \<inter> {x. x \<bullet> j \<le> M}) (\<lambda>y. f (x, y))) integrable_on cbox u v"
          "(\<lambda>x. integral (cbox w z \<inter> {x. M \<le> x \<bullet> j}) (\<lambda>y. f (x, y))) integrable_on cbox u v"
       using 2 subs
       apply (simp_all add: interval_split)
       apply (rule integral_integrable_2dim [OF continuous_on_subset [OF f]]; auto simp: cbox_Pair_eq interval_split [symmetric])+
       done
     with 2 have *: "integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))) =
                    integral (cbox u v) (\<lambda>x. integral (cbox w z \<inter> {x. x \<bullet> j \<le> M}) (\<lambda>y. f (x, y))) +
                    integral (cbox u v) (\<lambda>x. integral (cbox w z \<inter> {x. M \<le> x \<bullet> j}) (\<lambda>y. f (x, y)))"
       by (simp add: integral_add [symmetric] integral_split [symmetric]
                     continuous_on_imp_integrable_on_Pair1 [OF fcont] cong: integral_cong)
     show ?normle
       apply (rule norm_diff2 [OF integral_split [where c=M, OF fint ij] * e])
       using 2 subs
       apply (simp_all add: cbox_Pair_eq setcomp_dot2 [of "\<lambda>u. M\<le>u"] setcomp_dot2 [of "\<lambda>u. u\<le>M"] Sigma_Int_Paircomp2)
       apply (simp_all add: interval_split ij flip: cbox_Pair_eq content_Pair)
       apply (force simp flip: interval_split intro!: n1 [rule_format])
       apply (force simp flip: interval_split intro!: n2 [rule_format])
       done
   qed
 qed
 
 lemma integral_Pair_const:
     "integral (cbox (a,c) (b,d)) (\<lambda>x. k) =
      integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. k))"
   by (simp add: content_Pair)
 
 lemma integral_prod_continuous:
   fixes f :: "('a::euclidean_space * 'b::euclidean_space) \<Rightarrow> 'c::banach"
   assumes "continuous_on (cbox (a, c) (b, d)) f" (is "continuous_on ?CBOX f")
     shows "integral (cbox (a, c) (b, d)) f = integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x, y)))"
 proof (cases "content ?CBOX = 0")
   case True
   then show ?thesis
     by (auto simp: content_Pair)
 next
   case False
   then have cbp: "content ?CBOX > 0"
     using content_lt_nz by blast
   have "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x,y)))) = 0"
   proof (rule dense_eq0_I, simp)
     fix e :: real 
     assume "0 < e"
     with \<open>content ?CBOX > 0\<close> have "0 < e/content ?CBOX"
       by simp
     have f_int_acbd: "f integrable_on ?CBOX"
       by (rule integrable_continuous [OF assms])
     { fix p
       assume p: "p division_of ?CBOX"
       then have "finite p"
         by blast
       define e' where "e' = e/content ?CBOX"
       with \<open>0 < e\<close> \<open>0 < e/content ?CBOX\<close>
       have "0 < e'"
         by simp
       interpret operative conj True
            "\<lambda>k. \<forall>a' b' c' d'.
                 cbox (a', c') (b', d') \<subseteq> k \<and> cbox (a', c') (b', d') \<subseteq> ?CBOX
                 \<longrightarrow> norm (integral (cbox (a', c') (b', d')) f -
                          integral (cbox a' b') (\<lambda>x. integral (cbox c' d') (\<lambda>y. f ((x, y)))))
                     \<le> e' * content (cbox (a', c') (b', d'))"
         using assms \<open>0 < e'\<close> by (rule integral_swap_operativeI)
       have "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x, y))))
           \<le> e' * content ?CBOX"
         if "\<And>t u v w z. t \<in> p \<Longrightarrow> cbox (u, w) (v, z) \<subseteq> t \<Longrightarrow> cbox (u, w) (v, z) \<subseteq> ?CBOX
           \<Longrightarrow> norm (integral (cbox (u, w) (v, z)) f -
               integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))))
               \<le> e' * content (cbox (u, w) (v, z))"
         using that division [of p "(a, c)" "(b, d)"] p \<open>finite p\<close> by (auto simp add: comm_monoid_set_F_and)
       with False have "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x, y))))
           \<le> e"
         if "\<And>t u v w z. t \<in> p \<Longrightarrow> cbox (u, w) (v, z) \<subseteq> t \<Longrightarrow> cbox (u, w) (v, z) \<subseteq> ?CBOX
           \<Longrightarrow> norm (integral (cbox (u, w) (v, z)) f -
               integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))))
               \<le> e * content (cbox (u, w) (v, z)) / content ?CBOX"
         using that by (simp add: e'_def)
     } note op_acbd = this
     { fix k::real and \<D> and u::'a and v w and z::'b and t1 t2 l
       assume k: "0 < k"
          and nf: "\<And>x y u v.
                   \<lbrakk>x \<in> cbox a b; y \<in> cbox c d; u \<in> cbox a b; v\<in>cbox c d; norm (u-x, v-y) < k\<rbrakk>
                   \<Longrightarrow> norm (f(u,v) - f(x,y)) < e/(2 * (content ?CBOX))"
          and p_acbd: "\<D> tagged_division_of cbox (a,c) (b,d)"
          and fine: "(\<lambda>x. ball x k) fine \<D>"  "((t1,t2), l) \<in> \<D>"
          and uwvz_sub: "cbox (u,w) (v,z) \<subseteq> l" "cbox (u,w) (v,z) \<subseteq> cbox (a,c) (b,d)"
       have t: "t1 \<in> cbox a b" "t2 \<in> cbox c d"
         by (meson fine p_acbd cbox_Pair_iff tag_in_interval)+
       have ls: "l \<subseteq> ball (t1,t2) k"
         using fine by (simp add: fine_def Ball_def)
       { fix x1 x2
         assume xuvwz: "x1 \<in> cbox u v" "x2 \<in> cbox w z"
         then have x: "x1 \<in> cbox a b" "x2 \<in> cbox c d"
           using uwvz_sub by auto
         have "norm (x1 - t1, x2 - t2) = norm (t1 - x1, t2 - x2)"
           by (simp add: norm_Pair norm_minus_commute)
         also have "norm (t1 - x1, t2 - x2) < k"
           using xuvwz ls uwvz_sub unfolding ball_def
           by (force simp add: cbox_Pair_eq dist_norm )
         finally have "norm (f (x1,x2) - f (t1,t2)) \<le> e/content ?CBOX/2"
           using nf [OF t x]  by simp
       } note nf' = this
       have f_int_uwvz: "f integrable_on cbox (u,w) (v,z)"
         using f_int_acbd uwvz_sub integrable_on_subcbox by blast
       have f_int_uv: "\<And>x. x \<in> cbox u v \<Longrightarrow> (\<lambda>y. f (x,y)) integrable_on cbox w z"
         using assms continuous_on_subset uwvz_sub
         by (blast intro: continuous_on_imp_integrable_on_Pair1)
       have 1: "norm (integral (cbox (u,w) (v,z)) f - integral (cbox (u,w) (v,z)) (\<lambda>x. f (t1,t2)))
              \<le> e * content (cbox (u,w) (v,z)) / content ?CBOX/2"
         using cbp \<open>0 < e/content ?CBOX\<close> nf'
         apply (simp only: integral_diff [symmetric] f_int_uwvz integrable_const)
         apply (auto simp: integrable_diff f_int_uwvz integrable_const intro: order_trans [OF integrable_bound [of "e/content ?CBOX/2"]])
         done
       have int_integrable: "(\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))) integrable_on cbox u v"
         using assms integral_integrable_2dim continuous_on_subset uwvz_sub(2) by blast
       have normint_wz:
          "\<And>x. x \<in> cbox u v \<Longrightarrow>
                norm (integral (cbox w z) (\<lambda>y. f (x, y)) - integral (cbox w z) (\<lambda>y. f (t1, t2)))
                \<le> e * content (cbox w z) / content (cbox (a, c) (b, d))/2"
         using cbp \<open>0 < e/content ?CBOX\<close> nf'
         apply (simp only: integral_diff [symmetric] f_int_uv integrable_const)
         apply (auto simp: integrable_diff f_int_uv integrable_const intro: order_trans [OF integrable_bound [of "e/content ?CBOX/2"]])
         done
       have "norm (integral (cbox u v)
                (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x,y)) - integral (cbox w z) (\<lambda>y. f (t1,t2))))
             \<le> e * content (cbox w z) / content ?CBOX/2 * content (cbox u v)"
         using cbp \<open>0 < e/content ?CBOX\<close>
         apply (intro integrable_bound [OF _ _ normint_wz])
         apply (auto simp: field_split_simps integrable_diff int_integrable integrable_const)
         done
       also have "... \<le> e * content (cbox (u,w) (v,z)) / content ?CBOX/2"
         by (simp add: content_Pair field_split_simps)
       finally have 2: "norm (integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x,y))) -
                       integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (t1,t2))))
                 \<le> e * content (cbox (u,w) (v,z)) / content ?CBOX/2"
         by (simp only: integral_diff [symmetric] int_integrable integrable_const)
       have norm_xx: "\<lbrakk>x' = y'; norm(x - x') \<le> e/2; norm(y - y') \<le> e/2\<rbrakk> \<Longrightarrow> norm(x - y) \<le> e" for x::'c and y x' y' e
         using norm_triangle_mono [of "x-y'" "e/2" "y'-y" "e/2"] field_sum_of_halves
         by (simp add: norm_minus_commute)
       have "norm (integral (cbox (u,w) (v,z)) f - integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x,y))))
             \<le> e * content (cbox (u,w) (v,z)) / content ?CBOX"
         by (rule norm_xx [OF integral_Pair_const 1 2])
     } note * = this
     have "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x,y)))) \<le> e" 
       if "\<forall>x\<in>?CBOX. \<forall>x'\<in>?CBOX. norm (x' - x) < k \<longrightarrow> norm (f x' - f x) < e /(2 * content (?CBOX))" "0 < k" for k
     proof -
       obtain p where ptag: "p tagged_division_of cbox (a, c) (b, d)" 
                  and fine: "(\<lambda>x. ball x k) fine p"
         using fine_division_exists \<open>0 < k\<close> by blast
       show ?thesis
         using that fine ptag \<open>0 < k\<close> 
         by (auto simp: * intro: op_acbd [OF division_of_tagged_division [OF ptag]])
     qed
     then show "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x,y)))) \<le> e"
       using compact_uniformly_continuous [OF assms compact_cbox]
       apply (simp add: uniformly_continuous_on_def dist_norm)
       apply (drule_tac x="e/2 / content?CBOX" in spec)
       using cbp \<open>0 < e\<close> by (auto simp: zero_less_mult_iff)
   qed
   then show ?thesis
     by simp
 qed
 
 lemma integral_swap_2dim:
   fixes f :: "['a::euclidean_space, 'b::euclidean_space] \<Rightarrow> 'c::banach"
   assumes "continuous_on (cbox (a,c) (b,d)) (\<lambda>(x,y). f x y)"
     shows "integral (cbox (a, c) (b, d)) (\<lambda>(x, y). f x y) = integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)"
 proof -
   have "((\<lambda>(x, y). f x y) has_integral integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)) (prod.swap ` (cbox (c, a) (d, b)))"
   proof (rule has_integral_twiddle [of 1 prod.swap prod.swap "\<lambda>(x,y). f y x" "integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)", simplified])
     show "\<And>u v. content (prod.swap ` cbox u v) = content (cbox u v)"
       by (metis content_Pair mult.commute old.prod.exhaust swap_cbox_Pair)
     show "((\<lambda>(x, y). f y x) has_integral integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)) (cbox (c, a) (d, b))"
       by (simp add: assms integrable_continuous integrable_integral swap_continuous)
   qed (use isCont_swap in \<open>fastforce+\<close>)
  then show ?thesis
    by force
 qed
 
 theorem integral_swap_continuous:
   fixes f :: "['a::euclidean_space, 'b::euclidean_space] \<Rightarrow> 'c::banach"
   assumes "continuous_on (cbox (a,c) (b,d)) (\<lambda>(x,y). f x y)"
     shows "integral (cbox a b) (\<lambda>x. integral (cbox c d) (f x)) =
            integral (cbox c d) (\<lambda>y. integral (cbox a b) (\<lambda>x. f x y))"
 proof -
   have "integral (cbox a b) (\<lambda>x. integral (cbox c d) (f x)) = integral (cbox (a, c) (b, d)) (\<lambda>(x, y). f x y)"
     using integral_prod_continuous [OF assms] by auto
   also have "... = integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)"
     by (rule integral_swap_2dim [OF assms])
   also have "... = integral (cbox c d) (\<lambda>y. integral (cbox a b) (\<lambda>x. f x y))"
     using integral_prod_continuous [OF swap_continuous] assms
     by auto
   finally show ?thesis .
 qed
 
 
 subsection \<open>Definite integrals for exponential and power function\<close>
 
 lemma has_integral_exp_minus_to_infinity:
   assumes a: "a > 0"
   shows   "((\<lambda>x::real. exp (-a*x)) has_integral exp (-a*c)/a) {c..}"
 proof -
   define f where "f = (\<lambda>k x. if x \<in> {c..real k} then exp (-a*x) else 0)"
   {
     fix k :: nat assume k: "of_nat k \<ge> c"
     from k a
       have "((\<lambda>x. exp (-a*x)) has_integral (-exp (-a*real k)/a - (-exp (-a*c)/a))) {c..real k}"
       by (intro fundamental_theorem_of_calculus)
          (auto intro!: derivative_eq_intros
                simp: has_real_derivative_iff_has_vector_derivative [symmetric])
     hence "(f k has_integral (exp (-a*c)/a - exp (-a*real k)/a)) {c..}" unfolding f_def
       by (subst has_integral_restrict) simp_all
   } note has_integral_f = this
 
   have [simp]: "f k = (\<lambda>_. 0)" if "of_nat k < c" for k using that by (auto simp: fun_eq_iff f_def)
   have integral_f: "integral {c..} (f k) =
                       (if real k \<ge> c then exp (-a*c)/a - exp (-a*real k)/a else 0)"
     for k using integral_unique[OF has_integral_f[of k]] by simp
 
   have A: "(\<lambda>x. exp (-a*x)) integrable_on {c..} \<and>
              (\<lambda>k. integral {c..} (f k)) \<longlonglongrightarrow> integral {c..} (\<lambda>x. exp (-a*x))"
   proof (intro monotone_convergence_increasing allI ballI)
     fix k ::nat
     have "(\<lambda>x. exp (-a*x)) integrable_on {c..of_real k}" 
       unfolding f_def by (auto intro!: continuous_intros integrable_continuous_real)
     hence  "(f k) integrable_on {c..of_real k}"
       by (rule integrable_eq) (simp add: f_def)
     then show "f k integrable_on {c..}"
       by (rule integrable_on_superset) (auto simp: f_def)
   next
     fix x assume x: "x \<in> {c..}"
     have "sequentially \<le> principal {nat \<lceil>x\<rceil>..}" unfolding at_top_def by (simp add: Inf_lower)
     also have "{nat \<lceil>x\<rceil>..} \<subseteq> {k. x \<le> real k}" by auto
     also have "inf (principal \<dots>) (principal {k. \<not>x \<le> real k}) =
                  principal ({k. x \<le> real k} \<inter> {k. \<not>x \<le> real k})" 
       by simp
     also have "{k. x \<le> real k} \<inter> {k. \<not>x \<le> real k} = {}" by blast
     finally have "inf sequentially (principal {k. \<not>x \<le> real k}) = bot"
       by (simp add: inf.coboundedI1 bot_unique)
     with x show "(\<lambda>k. f k x) \<longlonglongrightarrow> exp (-a*x)" unfolding f_def
       by (intro filterlim_If) auto
   next
     have "\<bar>integral {c..} (f k)\<bar> \<le> exp (-a*c)/a" for k
     proof (cases "c > of_nat k")
       case False
       hence "abs (integral {c..} (f k)) = abs (exp (- (a * c)) / a - exp (- (a * real k)) / a)"
         by (simp add: integral_f)
       also have "abs (exp (- (a * c)) / a - exp (- (a * real k)) / a) =
                    exp (- (a * c)) / a - exp (- (a * real k)) / a"
         using False a by (intro abs_of_nonneg) (simp_all add: field_simps)
       also have "\<dots> \<le> exp (- a * c) / a" using a by simp
       finally show ?thesis .
     qed (insert a, simp_all add: integral_f)
     thus "bounded (range(\<lambda>k. integral {c..} (f k)))"
       by (intro boundedI[of _ "exp (-a*c)/a"]) auto
   qed (auto simp: f_def)
   have "(\<lambda>k. exp (-a*c)/a - exp (-a * of_nat k)/a) \<longlonglongrightarrow> exp (-a*c)/a - 0/a"
     by (intro tendsto_intros filterlim_compose[OF exp_at_bot]
         filterlim_tendsto_neg_mult_at_bot[OF tendsto_const] filterlim_real_sequentially)+
       (use a in simp_all)
   moreover
   from eventually_gt_at_top[of "nat \<lceil>c\<rceil>"] have "eventually (\<lambda>k. of_nat k > c) sequentially"
     by eventually_elim linarith
   hence "eventually (\<lambda>k. exp (-a*c)/a - exp (-a * of_nat k)/a = integral {c..} (f k)) sequentially"
     by eventually_elim (simp add: integral_f) 
   ultimately have "(\<lambda>k. integral {c..} (f k)) \<longlonglongrightarrow> exp (-a*c)/a - 0/a"
     by (rule Lim_transform_eventually)
   from LIMSEQ_unique[OF conjunct2[OF A] this]
   have "integral {c..} (\<lambda>x. exp (-a*x)) = exp (-a*c)/a" by simp
   with conjunct1[OF A] show ?thesis
     by (simp add: has_integral_integral)
 qed
 
 lemma integrable_on_exp_minus_to_infinity: "a > 0 \<Longrightarrow> (\<lambda>x. exp (-a*x) :: real) integrable_on {c..}"
   using has_integral_exp_minus_to_infinity[of a c] unfolding integrable_on_def by blast
 
 lemma has_integral_powr_from_0:
   assumes a: "a > (-1::real)" and c: "c \<ge> 0"
   shows   "((\<lambda>x. x powr a) has_integral (c powr (a+1) / (a+1))) {0..c}"
 proof (cases "c = 0")
   case False
   define f where "f = (\<lambda>k x. if x \<in> {inverse (of_nat (Suc k))..c} then x powr a else 0)"
   define F where "F = (\<lambda>k. if inverse (of_nat (Suc k)) \<le> c then
                              c powr (a+1)/(a+1) - inverse (real (Suc k)) powr (a+1)/(a+1) else 0)"
   have has_integral_f: "(f k has_integral F k) {0..c}" for k::nat
   proof (cases "inverse (of_nat (Suc k)) \<le> c")
     case True
     have x: "x > 0" if "x \<ge> inverse (1 + real k)" for x
       by (smt (verit) that inverse_Suc of_nat_Suc)
     hence "((\<lambda>x. x powr a) has_integral c powr (a + 1) / (a + 1) -
                inverse (real (Suc k)) powr (a + 1) / (a + 1)) {inverse (real (Suc k))..c}"
       using True a by (intro fundamental_theorem_of_calculus)
         (auto intro!: derivative_eq_intros continuous_on_powr' continuous_on_const
           simp: has_real_derivative_iff_has_vector_derivative [symmetric])
     with True show ?thesis unfolding f_def F_def by (subst has_integral_restrict) simp_all
   next
     case False
     thus ?thesis unfolding f_def F_def 
       by (subst has_integral_restrict) auto
   qed
   then have integral_f: "integral {0..c} (f k) = F k" for k
     by blast
 
   have A: "(\<lambda>x. x powr a) integrable_on {0..c} \<and>
            (\<lambda>k. integral {0..c} (f k)) \<longlonglongrightarrow> integral {0..c} (\<lambda>x. x powr a)"
   proof (intro monotone_convergence_increasing ballI allI)
     fix k from has_integral_f[of k] show "f k integrable_on {0..c}"
       by (auto simp: integrable_on_def)
   next
     fix k :: nat and x :: real
     {
       assume x: "inverse (real (Suc k)) \<le> x"
       then have "inverse (real (Suc (Suc k))) \<le> x"
         using dual_order.trans by fastforce 
     }
     thus "f k x \<le> f (Suc k) x" by (auto simp: f_def simp del: of_nat_Suc)
   next
     fix x assume x: "x \<in> {0..c}"
     show "(\<lambda>k. f k x) \<longlonglongrightarrow> x powr a"
     proof (cases "x = 0")
       case False
       with x have "x > 0" by simp
       from order_tendstoD(2)[OF LIMSEQ_inverse_real_of_nat this]
         have "eventually (\<lambda>k. x powr a = f k x) sequentially"
         by eventually_elim (insert x, simp add: f_def)
       moreover have "(\<lambda>_. x powr a) \<longlonglongrightarrow> x powr a" by simp
       ultimately show ?thesis by (blast intro: Lim_transform_eventually)
     qed (simp_all add: f_def)
   next
     {
       fix k
       from a have "F k \<le> c powr (a + 1) / (a + 1)"
         by (auto simp add: F_def divide_simps)
       also from a have "F k \<ge> 0"
         by (auto simp: F_def divide_simps simp del: of_nat_Suc intro!: powr_mono2)
       hence "F k = abs (F k)" by simp
       finally have "abs (F k) \<le>  c powr (a + 1) / (a + 1)" .
     }
     thus "bounded (range(\<lambda>k. integral {0..c} (f k)))"
       by (intro boundedI[of _ "c powr (a+1) / (a+1)"]) (auto simp: integral_f)
   qed
 
   from False c have "c > 0" by simp
   from order_tendstoD(2)[OF LIMSEQ_inverse_real_of_nat this]
     have "eventually (\<lambda>k. c powr (a + 1) / (a + 1) - inverse (real (Suc k)) powr (a+1) / (a+1) =
             integral {0..c} (f k)) sequentially"
     by eventually_elim (simp add: integral_f F_def)
   moreover have "(\<lambda>k. c powr (a + 1) / (a + 1) - inverse (real (Suc k)) powr (a + 1) / (a + 1))
                    \<longlonglongrightarrow> c powr (a + 1) / (a + 1) - 0 powr (a + 1) / (a + 1)"
     using a by (intro tendsto_intros LIMSEQ_inverse_real_of_nat) auto
   hence "(\<lambda>k. c powr (a + 1) / (a + 1) - inverse (real (Suc k)) powr (a + 1) / (a + 1))
           \<longlonglongrightarrow> c powr (a + 1) / (a + 1)" by simp
   ultimately have "(\<lambda>k. integral {0..c} (f k)) \<longlonglongrightarrow> c powr (a+1) / (a+1)"
     by (blast intro: Lim_transform_eventually)
   with A have "integral {0..c} (\<lambda>x. x powr a) = c powr (a+1) / (a+1)"
     by (blast intro: LIMSEQ_unique)
   with A show ?thesis by (simp add: has_integral_integral)
 qed (simp_all add: has_integral_refl)
 
 lemma integrable_on_powr_from_0:
   assumes a: "a > (-1::real)" and c: "c \<ge> 0"
   shows   "(\<lambda>x. x powr a) integrable_on {0..c}"
   using has_integral_powr_from_0[OF assms] unfolding integrable_on_def by blast
 
 lemma has_integral_powr_to_inf:
   fixes a e :: real
   assumes "e < -1" "a > 0"
   shows   "((\<lambda>x. x powr e) has_integral -(a powr (e + 1)) / (e + 1)) {a..}"
 proof -
   define f :: "nat \<Rightarrow> real \<Rightarrow> real" where "f = (\<lambda>n x. if x \<in> {a..n} then x powr e else 0)"
   define F where "F = (\<lambda>x. x powr (e + 1) / (e + 1))"
 
   have has_integral_f: "(f n has_integral (F n - F a)) {a..}"
     if n: "n \<ge> a" for n :: nat
   proof -
     from n assms have "((\<lambda>x. x powr e) has_integral (F n - F a)) {a..n}"
       by (intro fundamental_theorem_of_calculus) (auto intro!: derivative_eq_intros
             simp: has_real_derivative_iff_has_vector_derivative [symmetric] F_def)
     hence "(f n has_integral (F n - F a)) {a..n}"
       by (rule has_integral_eq [rotated]) (simp add: f_def)
     thus "(f n has_integral (F n - F a)) {a..}"
       by (rule has_integral_on_superset) (auto simp: f_def)
   qed
   have integral_f: "integral {a..} (f n) = (if n \<ge> a then F n - F a else 0)" for n :: nat
   proof (cases "n \<ge> a")
     case True
     with has_integral_f[OF this] show ?thesis by (simp add: integral_unique)
   next
     case False
     have "(f n has_integral 0) {a}" by (rule has_integral_refl)
     hence "(f n has_integral 0) {a..}"
       using False f_def by force
     with False show ?thesis by (simp add: integral_unique)
   qed
 
   have *: "(\<lambda>x. x powr e) integrable_on {a..} \<and>
            (\<lambda>n. integral {a..} (f n)) \<longlonglongrightarrow> integral {a..} (\<lambda>x. x powr e)"
   proof (intro monotone_convergence_increasing allI ballI)
     fix n :: nat
     from assms have "(\<lambda>x. x powr e) integrable_on {a..n}"
       by (auto intro!: integrable_continuous_real continuous_intros)
     hence "f n integrable_on {a..n}"
       by (rule integrable_eq) (auto simp: f_def)
     thus "f n integrable_on {a..}"
       by (rule integrable_on_superset) (auto simp: f_def)
   next
     fix n :: nat and x :: real
     show "f n x \<le> f (Suc n) x" by (auto simp: f_def)
   next
     fix x :: real assume x: "x \<in> {a..}"
     from filterlim_real_sequentially
       have "eventually (\<lambda>n. real n \<ge> x) at_top"
       by (simp add: filterlim_at_top)
     with x have "eventually (\<lambda>n. f n x = x powr e) at_top"
       by (auto elim!: eventually_mono simp: f_def)
     thus "(\<lambda>n. f n x) \<longlonglongrightarrow> x powr e" by (simp add: tendsto_eventually)
   next
     have "norm (integral {a..} (f n)) \<le> -F a" for n :: nat
     proof (cases "n \<ge> a")
       case True
       with assms have "a powr (e + 1) \<ge> n powr (e + 1)"
         by (intro powr_mono2') simp_all
       with assms show ?thesis by (auto simp: divide_simps F_def integral_f)
     qed (use assms in \<open>simp add: integral_f F_def field_split_simps\<close>)
     thus "bounded (range(\<lambda>k. integral {a..} (f k)))"
       unfolding bounded_iff by (intro exI[of _ "-F a"]) auto
   qed
 
   from filterlim_real_sequentially
     have "eventually (\<lambda>n. real n \<ge> a) at_top"
     by (simp add: filterlim_at_top)
   hence "eventually (\<lambda>n. F n - F a = integral {a..} (f n)) at_top"
     by eventually_elim (simp add: integral_f)
   moreover have "(\<lambda>n. F n - F a) \<longlonglongrightarrow> 0 / (e + 1) - F a" unfolding F_def
     by (insert assms, (rule tendsto_intros filterlim_compose[OF tendsto_neg_powr]
           filterlim_ident filterlim_real_sequentially | simp)+)
   hence "(\<lambda>n. F n - F a) \<longlonglongrightarrow> -F a" by simp
   ultimately have "(\<lambda>n. integral {a..} (f n)) \<longlonglongrightarrow> -F a" by (blast intro: Lim_transform_eventually)
   then have "integral {a..} (\<lambda>x. x powr e) = -F a"
     using "*" LIMSEQ_unique by blast
   with * show ?thesis
     by (simp add: has_integral_integral F_def)
 qed
 
 lemma has_integral_inverse_power_to_inf:
   fixes a :: real and n :: nat
   assumes "n > 1" "a > 0"
   shows   "((\<lambda>x. 1 / x ^ n) has_integral 1 / (real (n - 1) * a ^ (n - 1))) {a..}"
 proof -
   from assms have "real_of_int (-int n) < -1" by simp
   note has_integral_powr_to_inf[OF this \<open>a > 0\<close>]
   also have "- (a powr (real_of_int (- int n) + 1)) / (real_of_int (- int n) + 1) =
                  1 / (real (n - 1) * a powr (real (n - 1)))" using assms
     by (simp add: field_split_simps powr_add [symmetric] of_nat_diff)
   also from assms have "a powr (real (n - 1)) = a ^ (n - 1)"
     by (intro powr_realpow)
   finally show ?thesis
     by (rule has_integral_eq [rotated])
        (insert assms, simp_all add: powr_minus powr_realpow field_split_simps)
 qed
 
 subsubsection \<open>Adaption to ordered Euclidean spaces and the Cartesian Euclidean space\<close>
 
 lemma integral_component_eq_cart[simp]:
   fixes f :: "'n::euclidean_space \<Rightarrow> real^'m"
   assumes "f integrable_on s"
   shows "integral s (\<lambda>x. f x $ k) = integral s f $ k"
   using integral_linear[OF assms(1) bounded_linear_vec_nth,unfolded o_def] .
 
 lemma content_closed_interval:
   fixes a :: "'a::ordered_euclidean_space"
   assumes "a \<le> b"
   shows "content {a..b} = (\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   using content_cbox[of a b] assms by (simp add: cbox_interval eucl_le[where 'a='a])
 
 lemma integrable_const_ivl[intro]:
   fixes a::"'a::ordered_euclidean_space"
   shows "(\<lambda>x. c) integrable_on {a..b}"
   unfolding cbox_interval[symmetric] by (rule integrable_const)
 
 lemma integrable_on_subinterval:
   fixes f :: "'n::ordered_euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on S" "{a..b} \<subseteq> S"
   shows "f integrable_on {a..b}"
   using integrable_on_subcbox[of f S a b] assms by (simp add: cbox_interval)
 
 end
diff --git a/src/HOL/Analysis/Homotopy.thy b/src/HOL/Analysis/Homotopy.thy
--- a/src/HOL/Analysis/Homotopy.thy
+++ b/src/HOL/Analysis/Homotopy.thy
@@ -1,5381 +1,5390 @@
 (*  Title:      HOL/Analysis/Path_Connected.thy
     Authors:    LC Paulson and Robert Himmelmann (TU Muenchen), based on material from HOL Light
 *)
 
 section \<open>Homotopy of Maps\<close>
 
 theory Homotopy
   imports Path_Connected Product_Topology Uncountable_Sets
 begin
 
 definition\<^marker>\<open>tag important\<close> homotopic_with
 where
  "homotopic_with P X Y f g \<equiv>
    (\<exists>h. continuous_map (prod_topology (top_of_set {0..1::real}) X) Y h \<and>
        (\<forall>x. h(0, x) = f x) \<and>
        (\<forall>x. h(1, x) = g x) \<and>
        (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t,x))))"
 
 text\<open>\<open>p\<close>, \<open>q\<close> are functions \<open>X \<rightarrow> Y\<close>, and the property \<open>P\<close> restricts all intermediate maps.
 We often just want to require that \<open>P\<close> fixes some subset, but to include the case of a loop homotopy,
 it is convenient to have a general property \<open>P\<close>.\<close>
 
 abbreviation homotopic_with_canon ::
   "[('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> bool, 'a set, 'b set, 'a \<Rightarrow> 'b, 'a \<Rightarrow> 'b] \<Rightarrow> bool"
 where
  "homotopic_with_canon P S T p q \<equiv> homotopic_with P (top_of_set S) (top_of_set T) p q"
 
 lemma split_01: "{0..1::real} = {0..1/2} \<union> {1/2..1}"
   by force
 
 lemma split_01_prod: "{0..1::real} \<times> X = ({0..1/2} \<times> X) \<union> ({1/2..1} \<times> X)"
   by force
 
 lemma image_Pair_const: "(\<lambda>x. (x, c)) ` A = A \<times> {c}"
   by auto
 
 lemma fst_o_paired [simp]: "fst \<circ> (\<lambda>(x,y). (f x y, g x y)) = (\<lambda>(x,y). f x y)"
   by auto
 
 lemma snd_o_paired [simp]: "snd \<circ> (\<lambda>(x,y). (f x y, g x y)) = (\<lambda>(x,y). g x y)"
   by auto
 
 lemma continuous_on_o_Pair: "\<lbrakk>continuous_on (T \<times> X) h; t \<in> T\<rbrakk> \<Longrightarrow> continuous_on X (h \<circ> Pair t)"
   by (fast intro: continuous_intros elim!: continuous_on_subset)
 
 lemma continuous_map_o_Pair: 
   assumes h: "continuous_map (prod_topology X Y) Z h" and t: "t \<in> topspace X"
   shows "continuous_map Y Z (h \<circ> Pair t)"
   by (intro continuous_map_compose [OF _ h] continuous_intros; simp add: t)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Trivial properties\<close>
 
 text \<open>We often want to just localize the ending function equality or whatever.\<close>
 text\<^marker>\<open>tag important\<close> \<open>%whitespace\<close>
 proposition homotopic_with:
   assumes "\<And>h k. (\<And>x. x \<in> topspace X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k)"
   shows "homotopic_with P X Y p q \<longleftrightarrow>
            (\<exists>h. continuous_map (prod_topology (subtopology euclideanreal {0..1}) X) Y h \<and>
               (\<forall>x \<in> topspace X. h(0,x) = p x) \<and>
               (\<forall>x \<in> topspace X. h(1,x) = q x) \<and>
               (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
   unfolding homotopic_with_def
   apply (rule iffI, blast, clarify)
   apply (rule_tac x="\<lambda>(u,v). if v \<in> topspace X then h(u,v) else if u = 0 then p v else q v" in exI)
   apply simp
   by (smt (verit, best) SigmaE assms case_prod_conv continuous_map_eq topspace_prod_topology)
 
 lemma homotopic_with_mono:
   assumes hom: "homotopic_with P X Y f g"
     and Q: "\<And>h. \<lbrakk>continuous_map X Y h; P h\<rbrakk> \<Longrightarrow> Q h"
   shows "homotopic_with Q X Y f g"
   using hom unfolding homotopic_with_def
   by (force simp: o_def dest: continuous_map_o_Pair intro: Q)
 
 lemma homotopic_with_imp_continuous_maps:
     assumes "homotopic_with P X Y f g"
     shows "continuous_map X Y f \<and> continuous_map X Y g"
 proof -
   obtain h :: "real \<times> 'a \<Rightarrow> 'b"
     where conth: "continuous_map (prod_topology (top_of_set {0..1}) X) Y h"
       and h: "\<forall>x. h (0, x) = f x" "\<forall>x. h (1, x) = g x"
     using assms by (auto simp: homotopic_with_def)
   have *: "t \<in> {0..1} \<Longrightarrow> continuous_map X Y (h \<circ> (\<lambda>x. (t,x)))" for t
     by (rule continuous_map_compose [OF _ conth]) (simp add: o_def continuous_map_pairwise)
   show ?thesis
     using h *[of 0] *[of 1] by (simp add: continuous_map_eq)
 qed
 
 lemma homotopic_with_imp_continuous:
     assumes "homotopic_with_canon P X Y f g"
     shows "continuous_on X f \<and> continuous_on X g"
   by (meson assms continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 lemma homotopic_with_imp_property:
   assumes "homotopic_with P X Y f g"
   shows "P f \<and> P g"
 proof
   obtain h where h: "\<And>x. h(0, x) = f x" "\<And>x. h(1, x) = g x" and P: "\<And>t. t \<in> {0..1::real} \<Longrightarrow> P(\<lambda>x. h(t,x))"
     using assms by (force simp: homotopic_with_def)
   show "P f" "P g"
     using P [of 0] P [of 1] by (force simp: h)+
 qed
 
 lemma homotopic_with_equal:
   assumes "P f" "P g" and contf: "continuous_map X Y f" and fg: "\<And>x. x \<in> topspace X \<Longrightarrow> f x = g x"
   shows "homotopic_with P X Y f g"
   unfolding homotopic_with_def
 proof (intro exI conjI allI ballI)
   let ?h = "\<lambda>(t::real,x). if t = 1 then g x else f x"
   show "continuous_map (prod_topology (top_of_set {0..1}) X) Y ?h"
   proof (rule continuous_map_eq)
     show "continuous_map (prod_topology (top_of_set {0..1}) X) Y (f \<circ> snd)"
       by (simp add: contf continuous_map_of_snd)
   qed (auto simp: fg)
   show "P (\<lambda>x. ?h (t, x))" if "t \<in> {0..1}" for t
     by (cases "t = 1") (simp_all add: assms)
 qed auto
 
 lemma homotopic_with_imp_subset1:
      "homotopic_with_canon P X Y f g \<Longrightarrow> f ` X \<subseteq> Y"
   by (meson continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 lemma homotopic_with_imp_subset2:
      "homotopic_with_canon P X Y f g \<Longrightarrow> g ` X \<subseteq> Y"
   by (meson continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 lemma homotopic_with_imp_funspace1:
      "homotopic_with_canon P X Y f g \<Longrightarrow> f \<in> X \<rightarrow> Y"
   using homotopic_with_imp_subset1 by blast
 
 lemma homotopic_with_imp_funspace2:
      "homotopic_with_canon P X Y f g \<Longrightarrow> g \<in> X \<rightarrow> Y"
   using homotopic_with_imp_subset2 by blast
 
 lemma homotopic_with_subset_left:
      "\<lbrakk>homotopic_with_canon P X Y f g; Z \<subseteq> X\<rbrakk> \<Longrightarrow> homotopic_with_canon P Z Y f g"
   unfolding homotopic_with_def by (auto elim!: continuous_on_subset ex_forward)
 
 lemma homotopic_with_subset_right:
      "\<lbrakk>homotopic_with_canon P X Y f g; Y \<subseteq> Z\<rbrakk> \<Longrightarrow> homotopic_with_canon P X Z f g"
   unfolding homotopic_with_def by (auto elim!: continuous_on_subset ex_forward)
 
 subsection\<open>Homotopy with P is an equivalence relation\<close>
 
 text \<open>(on continuous functions mapping X into Y that satisfy P, though this only affects reflexivity)\<close>
 
 lemma homotopic_with_refl [simp]: "homotopic_with P X Y f f \<longleftrightarrow> continuous_map X Y f \<and> P f"
   by (metis homotopic_with_equal homotopic_with_imp_continuous_maps homotopic_with_imp_property)
 
 lemma homotopic_with_symD:
     assumes "homotopic_with P X Y f g"
       shows "homotopic_with P X Y g f"
 proof -
   let ?I01 = "subtopology euclideanreal {0..1}"
   let ?j = "\<lambda>y. (1 - fst y, snd y)"
   have 1: "continuous_map (prod_topology ?I01 X) (prod_topology euclideanreal X) ?j"
     by (intro continuous_intros; simp add: continuous_map_subtopology_fst prod_topology_subtopology)
   have *: "continuous_map (prod_topology ?I01 X) (prod_topology ?I01 X) ?j"
   proof -
     have "continuous_map (prod_topology ?I01 X) (subtopology (prod_topology euclideanreal X) ({0..1} \<times> topspace X)) ?j"
       by (simp add: continuous_map_into_subtopology [OF 1] image_subset_iff flip: image_subset_iff_funcset)
     then show ?thesis
       by (simp add: prod_topology_subtopology(1))
   qed
   show ?thesis
     using assms
     apply (clarsimp simp: homotopic_with_def)
     subgoal for h
       by (rule_tac x="h \<circ> (\<lambda>y. (1 - fst y, snd y))" in exI) (simp add: continuous_map_compose [OF *])
     done
 qed
 
 lemma homotopic_with_sym:
    "homotopic_with P X Y f g \<longleftrightarrow> homotopic_with P X Y g f"
   by (metis homotopic_with_symD)
 
 proposition homotopic_with_trans:
     assumes "homotopic_with P X Y f g"  "homotopic_with P X Y g h"
     shows "homotopic_with P X Y f h"
 proof -
   let ?X01 = "prod_topology (subtopology euclideanreal {0..1}) X"
   obtain k1 k2
     where contk1: "continuous_map ?X01 Y k1" and contk2: "continuous_map ?X01 Y k2"
       and k12: "\<forall>x. k1 (1, x) = g x" "\<forall>x. k2 (0, x) = g x"
       "\<forall>x. k1 (0, x) = f x" "\<forall>x. k2 (1, x) = h x"
       and P:   "\<forall>t\<in>{0..1}. P (\<lambda>x. k1 (t, x))" "\<forall>t\<in>{0..1}. P (\<lambda>x. k2 (t, x))"
     using assms by (auto simp: homotopic_with_def)
   define k where "k \<equiv> \<lambda>y. if fst y \<le> 1/2
                              then (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y
                              else (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y"
   have keq: "k1 (2 * u, v) = k2 (2 * u -1, v)" if "u = 1/2"  for u v
     by (simp add: k12 that)
   show ?thesis
     unfolding homotopic_with_def
   proof (intro exI conjI)
     show "continuous_map ?X01 Y k"
       unfolding k_def
     proof (rule continuous_map_cases_le)
       show fst: "continuous_map ?X01 euclideanreal fst"
         using continuous_map_fst continuous_map_in_subtopology by blast
       show "continuous_map ?X01 euclideanreal (\<lambda>x. 1/2)"
         by simp
       show "continuous_map (subtopology ?X01 {y \<in> topspace ?X01. fst y \<le> 1/2}) Y
                (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x)))"
         apply (intro fst continuous_map_compose [OF _ contk1] continuous_intros continuous_map_into_subtopology continuous_map_from_subtopology | simp)+
         by (force simp: prod_topology_subtopology)
       show "continuous_map (subtopology ?X01 {y \<in> topspace ?X01. 1/2 \<le> fst y}) Y
                (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x)))"
         apply (intro fst continuous_map_compose [OF _ contk2] continuous_intros continuous_map_into_subtopology continuous_map_from_subtopology | simp)+
         by (force simp: prod_topology_subtopology)
       show "(k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y = (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y"
         if "y \<in> topspace ?X01" and "fst y = 1/2" for y
         using that by (simp add: keq)
     qed
     show "\<forall>x. k (0, x) = f x"
       by (simp add: k12 k_def)
     show "\<forall>x. k (1, x) = h x"
       by (simp add: k12 k_def)
     show "\<forall>t\<in>{0..1}. P (\<lambda>x. k (t, x))"
     proof 
       fix t show "t\<in>{0..1} \<Longrightarrow> P (\<lambda>x. k (t, x))"
         by (cases "t \<le> 1/2") (auto simp: k_def P)
     qed
   qed
 qed
 
 lemma homotopic_with_id2: 
   "(\<And>x. x \<in> topspace X \<Longrightarrow> g (f x) = x) \<Longrightarrow> homotopic_with (\<lambda>x. True) X X (g \<circ> f) id"
   by (metis comp_apply continuous_map_id eq_id_iff homotopic_with_equal homotopic_with_symD)
 
 subsection\<open>Continuity lemmas\<close>
 
 lemma homotopic_with_compose_continuous_map_left:
   "\<lbrakk>homotopic_with p X1 X2 f g; continuous_map X2 X3 h; \<And>j. p j \<Longrightarrow> q(h \<circ> j)\<rbrakk>
    \<Longrightarrow> homotopic_with q X1 X3 (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_with_def
   apply clarify
   subgoal for k
     by (rule_tac x="h \<circ> k" in exI) (rule conjI continuous_map_compose | simp add: o_def)+
   done
 
 lemma homotopic_with_compose_continuous_map_right:
   assumes hom: "homotopic_with p X2 X3 f g" and conth: "continuous_map X1 X2 h"
     and q: "\<And>j. p j \<Longrightarrow> q(j \<circ> h)"
   shows "homotopic_with q X1 X3 (f \<circ> h) (g \<circ> h)"
 proof -
   obtain k
     where contk: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X2) X3 k"
       and k: "\<forall>x. k (0, x) = f x" "\<forall>x. k (1, x) = g x" and p: "\<And>t. t\<in>{0..1} \<Longrightarrow> p (\<lambda>x. k (t, x))"
     using hom unfolding homotopic_with_def by blast
   have hsnd: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) X2 (h \<circ> snd)"
     by (rule continuous_map_compose [OF continuous_map_snd conth])
   let ?h = "k \<circ> (\<lambda>(t,x). (t,h x))"
   show ?thesis
     unfolding homotopic_with_def
   proof (intro exI conjI allI ballI)
     have "continuous_map (prod_topology (top_of_set {0..1}) X1)
      (prod_topology (top_of_set {0..1::real}) X2) (\<lambda>(t, x). (t, h x))"
       by (metis (mono_tags, lifting) case_prod_beta' comp_def continuous_map_eq continuous_map_fst continuous_map_pairedI hsnd)
     then show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) X3 ?h"
       by (intro conjI continuous_map_compose [OF _ contk])
     show "q (\<lambda>x. ?h (t, x))" if "t \<in> {0..1}" for t
       using q [OF p [OF that]] by (simp add: o_def)
   qed (auto simp: k)
 qed
 
 corollary homotopic_compose:
   assumes "homotopic_with (\<lambda>x. True) X Y f f'" "homotopic_with (\<lambda>x. True) Y Z g g'"
   shows "homotopic_with (\<lambda>x. True) X Z (g \<circ> f) (g' \<circ> f')"
   by (metis assms homotopic_with_compose_continuous_map_left homotopic_with_compose_continuous_map_right homotopic_with_imp_continuous_maps homotopic_with_trans)
 
 proposition homotopic_with_compose_continuous_right:
     "\<lbrakk>homotopic_with_canon (\<lambda>f. p (f \<circ> h)) X Y f g; continuous_on W h; h \<in> W \<rightarrow> X\<rbrakk>
      \<Longrightarrow> homotopic_with_canon p W Y (f \<circ> h) (g \<circ> h)"
   by (simp add: homotopic_with_compose_continuous_map_right image_subset_iff_funcset)
 
 proposition homotopic_with_compose_continuous_left:
      "\<lbrakk>homotopic_with_canon (\<lambda>f. p (h \<circ> f)) X Y f g; continuous_on Y h; h \<in> Y \<rightarrow> Z\<rbrakk>
       \<Longrightarrow> homotopic_with_canon p X Z (h \<circ> f) (h \<circ> g)"
   by (simp add: homotopic_with_compose_continuous_map_left image_subset_iff_funcset)
 
 lemma homotopic_from_subtopology:
    "homotopic_with P X X' f g \<Longrightarrow> homotopic_with P (subtopology X S) X' f g"
   by (metis continuous_map_id_subt homotopic_with_compose_continuous_map_right o_id)
 
 lemma homotopic_on_emptyI:
   assumes "P f" "P g"
   shows "homotopic_with P trivial_topology X f g"
   by (metis assms continuous_map_on_empty empty_iff homotopic_with_equal topspace_discrete_topology)
 
 lemma homotopic_on_empty:
    "(homotopic_with P trivial_topology X f g \<longleftrightarrow> P f \<and> P g)"
   using homotopic_on_emptyI homotopic_with_imp_property by metis
 
 lemma homotopic_with_canon_on_empty: "homotopic_with_canon (\<lambda>x. True) {} t f g"
   by (auto intro: homotopic_with_equal)
 
 lemma homotopic_constant_maps:
    "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. a) (\<lambda>x. b) \<longleftrightarrow>
     X = trivial_topology \<or> path_component_of X' a b" (is "?lhs = ?rhs")
 proof (cases "X = trivial_topology")
   case False
   then obtain c where c: "c \<in> topspace X"
     by fastforce
   have "\<exists>g. continuous_map (top_of_set {0..1::real}) X' g \<and> g 0 = a \<and> g 1 = b"
     if "x \<in> topspace X" and hom: "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. a) (\<lambda>x. b)" for x
   proof -
     obtain h :: "real \<times> 'a \<Rightarrow> 'b"
       where conth: "continuous_map (prod_topology (top_of_set {0..1}) X) X' h"
         and h: "\<And>x. h (0, x) = a" "\<And>x. h (1, x) = b"
       using hom by (auto simp: homotopic_with_def)
     have cont: "continuous_map (top_of_set {0..1}) X' (h \<circ> (\<lambda>t. (t, c)))"
       by (rule continuous_map_compose [OF _ conth] continuous_intros | simp add: c)+
     then show ?thesis
       by (force simp: h)
   qed
   moreover have "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. g 0) (\<lambda>x. g 1)"
     if "x \<in> topspace X" "a = g 0" "b = g 1" "continuous_map (top_of_set {0..1}) X' g"
     for x and g :: "real \<Rightarrow> 'b"
     unfolding homotopic_with_def
     by (force intro!: continuous_map_compose continuous_intros c that)
   ultimately show ?thesis
     using False
     by (metis c path_component_of_set pathin_def)
 qed (simp add: homotopic_on_empty)
 
 proposition homotopic_with_eq:
    assumes h: "homotopic_with P X Y f g"
        and f': "\<And>x. x \<in> topspace X \<Longrightarrow> f' x = f x"
        and g': "\<And>x. x \<in> topspace X \<Longrightarrow> g' x = g x"
        and P:  "(\<And>h k. (\<And>x. x \<in> topspace X \<Longrightarrow> h x = k x) \<Longrightarrow> P h \<longleftrightarrow> P k)"
    shows "homotopic_with P X Y f' g'"
   by (smt (verit, ccfv_SIG) assms homotopic_with)
 
 lemma homotopic_with_prod_topology:
   assumes "homotopic_with p X1 Y1 f f'" and "homotopic_with q X2 Y2 g g'"
     and r: "\<And>i j. \<lbrakk>p i; q j\<rbrakk> \<Longrightarrow> r(\<lambda>(x,y). (i x, j y))"
   shows "homotopic_with r (prod_topology X1 X2) (prod_topology Y1 Y2)
                           (\<lambda>z. (f(fst z),g(snd z))) (\<lambda>z. (f'(fst z), g'(snd z)))"
 proof -
   obtain h
     where h: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) Y1 h"
       and h0: "\<And>x. h (0, x) = f x"
       and h1: "\<And>x. h (1, x) = f' x"
       and p: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> p (\<lambda>x. h (t,x))"
     using assms unfolding homotopic_with_def by auto
   obtain k
     where k: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X2) Y2 k"
       and k0: "\<And>x. k (0, x) = g x"
       and k1: "\<And>x. k (1, x) = g' x"
       and q: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> q (\<lambda>x. k (t,x))"
     using assms unfolding homotopic_with_def by auto
   let ?hk = "\<lambda>(t,x,y). (h(t,x), k(t,y))"
   show ?thesis
     unfolding homotopic_with_def
   proof (intro conjI allI exI)
     show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (prod_topology X1 X2))
                          (prod_topology Y1 Y2) ?hk"
       unfolding continuous_map_pairwise case_prod_unfold
       by (rule conjI continuous_map_pairedI continuous_intros continuous_map_id [unfolded id_def]
           continuous_map_fst_of [unfolded o_def] continuous_map_snd_of [unfolded o_def]
           continuous_map_compose [OF _ h, unfolded o_def]
           continuous_map_compose [OF _ k, unfolded o_def])+
   next
     fix x
     show "?hk (0, x) = (f (fst x), g (snd x))" "?hk (1, x) = (f' (fst x), g' (snd x))"
       by (auto simp: case_prod_beta h0 k0 h1 k1)
   qed (auto simp: p q r)
 qed
 
 
 lemma homotopic_with_product_topology:
   assumes ht: "\<And>i. i \<in> I \<Longrightarrow> homotopic_with (p i) (X i) (Y i) (f i) (g i)"
     and pq: "\<And>h. (\<And>i. i \<in> I \<Longrightarrow> p i (h i)) \<Longrightarrow> q(\<lambda>x. (\<lambda>i\<in>I. h i (x i)))"
   shows "homotopic_with q (product_topology X I) (product_topology Y I)
                           (\<lambda>z. (\<lambda>i\<in>I. (f i) (z i))) (\<lambda>z. (\<lambda>i\<in>I. (g i) (z i)))"
 proof -
   obtain h
     where h: "\<And>i. i \<in> I \<Longrightarrow> continuous_map (prod_topology (subtopology euclideanreal {0..1}) (X i)) (Y i) (h i)"
       and h0: "\<And>i x. i \<in> I \<Longrightarrow> h i (0, x) = f i x"
       and h1: "\<And>i x. i \<in> I \<Longrightarrow> h i (1, x) = g i x"
       and p: "\<And>i t. \<lbrakk>i \<in> I; t \<in> {0..1}\<rbrakk> \<Longrightarrow> p i (\<lambda>x. h i (t,x))"
     using ht unfolding homotopic_with_def by metis
   show ?thesis
     unfolding homotopic_with_def
   proof (intro conjI allI exI)
     let ?h = "\<lambda>(t,z). \<lambda>i\<in>I. h i (t,z i)"
     have "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (product_topology X I))
                          (Y i) (\<lambda>x. h i (fst x, snd x i))" if "i \<in> I" for i
     proof -
       have \<section>: "continuous_map (prod_topology (top_of_set {0..1}) (product_topology X I)) (X i) (\<lambda>x. snd x i)"
         using continuous_map_componentwise continuous_map_snd that by fastforce
       show ?thesis
         unfolding continuous_map_pairwise case_prod_unfold
         by (intro conjI that \<section> continuous_intros continuous_map_compose [OF _ h, unfolded o_def])
     qed
     then show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (product_topology X I))
          (product_topology Y I) ?h"
       by (auto simp: continuous_map_componentwise case_prod_beta)
     show "?h (0, x) = (\<lambda>i\<in>I. f i (x i))" "?h (1, x) = (\<lambda>i\<in>I. g i (x i))" for x
       by (auto simp: case_prod_beta h0 h1)
     show "\<forall>t\<in>{0..1}. q (\<lambda>x. ?h (t, x))"
       by (force intro: p pq)
   qed
 qed
 
 text\<open>Homotopic triviality implicitly incorporates path-connectedness.\<close>
 lemma homotopic_triviality:
   shows  "(\<forall>f g. continuous_on S f \<and> f \<in> S \<rightarrow> T \<and>
                  continuous_on S g \<and> g \<in> S \<rightarrow> T
                  \<longrightarrow> homotopic_with_canon (\<lambda>x. True) S T f g) \<longleftrightarrow>
           (S = {} \<or> path_connected T) \<and>
           (\<forall>f. continuous_on S f \<and> f \<in> S \<rightarrow> T \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)))"
           (is "?lhs = ?rhs")
 proof (cases "S = {} \<or> T = {}")
   case True then show ?thesis
     by (auto simp: homotopic_on_emptyI simp flip: image_subset_iff_funcset)
 next
   case False show ?thesis
   proof
     assume LHS [rule_format]: ?lhs
     have pab: "path_component T a b" if "a \<in> T" "b \<in> T" for a b
     proof -
       have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. b)"
         by (simp add: LHS image_subset_iff that)
       then show ?thesis
         using False homotopic_constant_maps [of "top_of_set S" "top_of_set T" a b]
         by (metis path_component_of_canon_iff topspace_discrete_topology topspace_euclidean_subtopology)
     qed
     moreover
     have "\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)" if "continuous_on S f" "f \<in> S \<rightarrow> T" for f
       using False LHS continuous_on_const that by blast
     ultimately show ?rhs
       by (simp add: path_connected_component)
   next
     assume RHS: ?rhs
     with False have T: "path_connected T"
       by blast
     show ?lhs
     proof clarify
       fix f g
       assume "continuous_on S f" "f \<in> S \<rightarrow> T" "continuous_on S g" "g \<in> S \<rightarrow> T"
       obtain c d where c: "homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)" and d: "homotopic_with_canon (\<lambda>x. True) S T g (\<lambda>x. d)"
         using RHS \<open>continuous_on S f\<close> \<open>continuous_on S g\<close> \<open>f \<in> S \<rightarrow> T\<close> \<open>g \<in> S \<rightarrow> T\<close> by presburger
       with T have "path_component T c d"
         by (metis False ex_in_conv homotopic_with_imp_subset2 image_subset_iff path_connected_component)
       then have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. c) (\<lambda>x. d)"
         by (simp add: homotopic_constant_maps)
       with c d show "homotopic_with_canon (\<lambda>x. True) S T f g"
         by (meson homotopic_with_symD homotopic_with_trans)
     qed
   qed
 qed
 
 
 subsection\<open>Homotopy of paths, maintaining the same endpoints\<close>
 
 
 definition\<^marker>\<open>tag important\<close> homotopic_paths :: "['a set, real \<Rightarrow> 'a, real \<Rightarrow> 'a::topological_space] \<Rightarrow> bool"
   where
      "homotopic_paths S p q \<equiv>
        homotopic_with_canon (\<lambda>r. pathstart r = pathstart p \<and> pathfinish r = pathfinish p) {0..1} S p q"
 
 lemma homotopic_paths:
    "homotopic_paths S p q \<longleftrightarrow>
       (\<exists>h. continuous_on ({0..1} \<times> {0..1}) h \<and>
           h \<in> ({0..1} \<times> {0..1}) \<rightarrow> S \<and>
           (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
           (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
           (\<forall>t \<in> {0..1::real}. pathstart(h \<circ> Pair t) = pathstart p \<and>
                         pathfinish(h \<circ> Pair t) = pathfinish p))"
   by (auto simp: homotopic_paths_def homotopic_with pathstart_def pathfinish_def)
 
 proposition homotopic_paths_imp_pathstart:
      "homotopic_paths S p q \<Longrightarrow> pathstart p = pathstart q"
   by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
 
 proposition homotopic_paths_imp_pathfinish:
      "homotopic_paths S p q \<Longrightarrow> pathfinish p = pathfinish q"
   by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
 
 lemma homotopic_paths_imp_path:
      "homotopic_paths S p q \<Longrightarrow> path p \<and> path q"
   using homotopic_paths_def homotopic_with_imp_continuous_maps path_def continuous_map_subtopology_eu by blast
 
 lemma homotopic_paths_imp_subset:
      "homotopic_paths S p q \<Longrightarrow> path_image p \<subseteq> S \<and> path_image q \<subseteq> S"
   by (metis (mono_tags) continuous_map_subtopology_eu homotopic_paths_def homotopic_with_imp_continuous_maps path_image_def)
 
 proposition homotopic_paths_refl [simp]: "homotopic_paths S p p \<longleftrightarrow> path p \<and> path_image p \<subseteq> S"
   by (simp add: homotopic_paths_def path_def path_image_def)
 
 proposition homotopic_paths_sym: "homotopic_paths S p q \<Longrightarrow> homotopic_paths S q p"
   by (metis (mono_tags) homotopic_paths_def homotopic_paths_imp_pathfinish homotopic_paths_imp_pathstart homotopic_with_symD)
 
 proposition homotopic_paths_sym_eq: "homotopic_paths S p q \<longleftrightarrow> homotopic_paths S q p"
   by (metis homotopic_paths_sym)
 
 proposition homotopic_paths_trans [trans]:
   assumes "homotopic_paths S p q" "homotopic_paths S q r"
   shows "homotopic_paths S p r"
   using assms homotopic_paths_imp_pathfinish homotopic_paths_imp_pathstart unfolding homotopic_paths_def
   by (smt (verit, ccfv_SIG) homotopic_with_mono homotopic_with_trans)
 
 proposition homotopic_paths_eq:
      "\<lbrakk>path p; path_image p \<subseteq> S; \<And>t. t \<in> {0..1} \<Longrightarrow> p t = q t\<rbrakk> \<Longrightarrow> homotopic_paths S p q"
   by (smt (verit, best) homotopic_paths homotopic_paths_refl)
 
 proposition homotopic_paths_reparametrize:
   assumes "path p"
       and pips: "path_image p \<subseteq> S"
       and contf: "continuous_on {0..1} f"
       and f01 :"f \<in> {0..1} \<rightarrow> {0..1}"
       and [simp]: "f(0) = 0" "f(1) = 1"
       and q: "\<And>t. t \<in> {0..1} \<Longrightarrow> q(t) = p(f t)"
     shows "homotopic_paths S p q"
 proof -
   have contp: "continuous_on {0..1} p"
     by (metis \<open>path p\<close> path_def)
   then have "continuous_on {0..1} (p \<circ> f)"
     by (meson assms(4) contf continuous_on_compose continuous_on_subset image_subset_iff_funcset)
   then have "path q"
     by (simp add: path_def) (metis q continuous_on_cong)
   have piqs: "path_image q \<subseteq> S"
     by (smt (verit, ccfv_threshold) Pi_iff assms(2) assms(4) assms(7) image_subset_iff path_defs(4))
   have fb0: "\<And>a b. \<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> (1 - a) * f b + a * b"
     using f01 by force
   have fb1: "\<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> (1 - a) * f b + a * b \<le> 1" for a b
     by (intro convex_bound_le) (use f01 in auto)
   have "homotopic_paths S q p"
   proof (rule homotopic_paths_trans)
     show "homotopic_paths S q (p \<circ> f)"
       using q by (force intro: homotopic_paths_eq [OF  \<open>path q\<close> piqs])
   next
     show "homotopic_paths S (p \<circ> f) p"
       using pips [unfolded path_image_def]
       apply (simp add: homotopic_paths_def homotopic_with_def)
       apply (rule_tac x="p \<circ> (\<lambda>y. (1 - (fst y)) *\<^sub>R ((f \<circ> snd) y) + (fst y) *\<^sub>R snd y)"  in exI)
       apply (rule conjI contf continuous_intros continuous_on_subset [OF contp] | simp)+
       by (auto simp: fb0 fb1 pathstart_def pathfinish_def)
   qed
   then show ?thesis
     by (simp add: homotopic_paths_sym)
 qed
 
 lemma homotopic_paths_subset: "\<lbrakk>homotopic_paths S p q; S \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t p q"
   unfolding homotopic_paths by fast
 
 
 text\<open> A slightly ad-hoc but useful lemma in constructing homotopies.\<close>
 lemma continuous_on_homotopic_join_lemma:
   fixes q :: "[real,real] \<Rightarrow> 'a::topological_space"
   assumes p: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. p (fst y) (snd y))" (is "continuous_on ?A ?p")
       and q: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. q (fst y) (snd y))" (is "continuous_on ?A ?q")
       and pf: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish(p t) = pathstart(q t)"
     shows "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. (p(fst y) +++ q(fst y)) (snd y))"
 proof -
   have \<section>: "(\<lambda>t. p (fst t) (2 * snd t)) = ?p \<circ> (\<lambda>y. (fst y, 2 * snd y))"
           "(\<lambda>t. q (fst t) (2 * snd t - 1)) = ?q \<circ> (\<lambda>y. (fst y, 2 * snd y - 1))"
     by force+
   show ?thesis
     unfolding joinpaths_def
   proof (rule continuous_on_cases_le)
     show "continuous_on {y \<in> ?A. snd y \<le> 1/2} (\<lambda>t. p (fst t) (2 * snd t))" 
          "continuous_on {y \<in> ?A. 1/2 \<le> snd y} (\<lambda>t. q (fst t) (2 * snd t - 1))"
          "continuous_on ?A snd"
       unfolding \<section>
       by (rule continuous_intros continuous_on_subset [OF p] continuous_on_subset [OF q] | force)+
   qed (use pf in \<open>auto simp: mult.commute pathstart_def pathfinish_def\<close>)
 qed
 
 text\<open> Congruence properties of homotopy w.r.t. path-combining operations.\<close>
 
 lemma homotopic_paths_reversepath_D:
       assumes "homotopic_paths S p q"
       shows   "homotopic_paths S (reversepath p) (reversepath q)"
   using assms
   apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
   apply (rule_tac x="h \<circ> (\<lambda>x. (fst x, 1 - snd x))" in exI)
   apply (rule conjI continuous_intros)+
   apply (auto simp: reversepath_def pathstart_def pathfinish_def elim!: continuous_on_subset)
   done
 
 proposition homotopic_paths_reversepath:
      "homotopic_paths S (reversepath p) (reversepath q) \<longleftrightarrow> homotopic_paths S p q"
   using homotopic_paths_reversepath_D by force
 
 
 proposition homotopic_paths_join:
     "\<lbrakk>homotopic_paths S p p'; homotopic_paths S q q'; pathfinish p = pathstart q\<rbrakk> \<Longrightarrow> homotopic_paths S (p +++ q) (p' +++ q')"
   apply (clarsimp simp: homotopic_paths_def homotopic_with_def)
   apply (rename_tac k1 k2)
   apply (rule_tac x="(\<lambda>y. ((k1 \<circ> Pair (fst y)) +++ (k2 \<circ> Pair (fst y))) (snd y))" in exI)
   apply (intro conjI continuous_intros continuous_on_homotopic_join_lemma; force simp: joinpaths_def pathstart_def pathfinish_def path_image_def)
   done
 
 proposition homotopic_paths_continuous_image:
     "\<lbrakk>homotopic_paths S f g; continuous_on S h; h \<in> S \<rightarrow> t\<rbrakk> \<Longrightarrow> homotopic_paths t (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_paths_def
   by (simp add: homotopic_with_compose_continuous_map_left pathfinish_compose pathstart_compose image_subset_iff_funcset)
 
 
 subsection\<open>Group properties for homotopy of paths\<close>
 
 text\<^marker>\<open>tag important\<close>\<open>So taking equivalence classes under homotopy would give the fundamental group\<close>
 
 proposition homotopic_paths_rid:
   assumes "path p" "path_image p \<subseteq> S"
   shows "homotopic_paths S (p +++ linepath (pathfinish p) (pathfinish p)) p"
 proof -
   have \<section>: "continuous_on {0..1} (\<lambda>t::real. if t \<le> 1/2 then 2 *\<^sub>R t else 1)"
     unfolding split_01
     by (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
   show ?thesis
     apply (rule homotopic_paths_sym)
     using assms unfolding pathfinish_def joinpaths_def
     by (intro \<section> continuous_on_cases continuous_intros homotopic_paths_reparametrize [where f = "\<lambda>t. if t \<le> 1/2 then 2 *\<^sub>R t else 1"]; force)
 qed
 
 proposition homotopic_paths_lid:
    "\<lbrakk>path p; path_image p \<subseteq> S\<rbrakk> \<Longrightarrow> homotopic_paths S (linepath (pathstart p) (pathstart p) +++ p) p"
   using homotopic_paths_rid [of "reversepath p" S]
   by (metis homotopic_paths_reversepath path_image_reversepath path_reversepath pathfinish_linepath
         pathfinish_reversepath reversepath_joinpaths reversepath_linepath)
 
+lemma homotopic_paths_rid':
+  assumes "path p" "path_image p \<subseteq> s" "x = pathfinish p"
+  shows "homotopic_paths s (p +++ linepath x x) p"
+  using homotopic_paths_rid[of p s] assms by simp
+
+lemma homotopic_paths_lid':
+   "\<lbrakk>path p; path_image p \<subseteq> s; x = pathstart p\<rbrakk> \<Longrightarrow> homotopic_paths s (linepath x x +++ p) p"
+  using homotopic_paths_lid[of p s] by simp
+
 proposition homotopic_paths_assoc:
    "\<lbrakk>path p; path_image p \<subseteq> S; path q; path_image q \<subseteq> S; path r; path_image r \<subseteq> S; pathfinish p = pathstart q;
      pathfinish q = pathstart r\<rbrakk>
     \<Longrightarrow> homotopic_paths S (p +++ (q +++ r)) ((p +++ q) +++ r)"
   apply (subst homotopic_paths_sym)
   apply (rule homotopic_paths_reparametrize
            [where f = "\<lambda>t. if  t \<le> 1/2 then inverse 2 *\<^sub>R t
                            else if  t \<le> 3 / 4 then t - (1 / 4)
                            else 2 *\<^sub>R t - 1"])
   apply (simp_all del: le_divide_eq_numeral1 add: subset_path_image_join)
   apply (rule continuous_on_cases_1 continuous_intros | auto simp: joinpaths_def)+
   done
 
 proposition homotopic_paths_rinv:
   assumes "path p" "path_image p \<subseteq> S"
     shows "homotopic_paths S (p +++ reversepath p) (linepath (pathstart p) (pathstart p))"
 proof -
   have p: "continuous_on {0..1} p" 
     using assms by (auto simp: path_def)
   let ?A = "{0..1} \<times> {0..1}"
   have "continuous_on ?A (\<lambda>x. (subpath 0 (fst x) p +++ reversepath (subpath 0 (fst x) p)) (snd x))"
     unfolding joinpaths_def subpath_def reversepath_def path_def add_0_right diff_0_right
   proof (rule continuous_on_cases_le)
     show "continuous_on {x \<in> ?A. snd x \<le> 1/2} (\<lambda>t. p (fst t * (2 * snd t)))"
          "continuous_on {x \<in> ?A. 1/2 \<le> snd x} (\<lambda>t. p (fst t * (1 - (2 * snd t - 1))))"
          "continuous_on ?A snd"
       by (intro continuous_on_compose2 [OF p] continuous_intros; auto simp: mult_le_one)+
   qed (auto simp: algebra_simps)
   then show ?thesis
     using assms
     apply (subst homotopic_paths_sym_eq)
     unfolding homotopic_paths_def homotopic_with_def
     apply (rule_tac x="(\<lambda>y. (subpath 0 (fst y) p +++ reversepath(subpath 0 (fst y) p)) (snd y))" in exI)
     apply (force simp: mult_le_one path_defs joinpaths_def subpath_def reversepath_def)
     done
 qed
 
 proposition homotopic_paths_linv:
   assumes "path p" "path_image p \<subseteq> S"
     shows "homotopic_paths S (reversepath p +++ p) (linepath (pathfinish p) (pathfinish p))"
   using homotopic_paths_rinv [of "reversepath p" S] assms by simp
 
 
 subsection\<open>Homotopy of loops without requiring preservation of endpoints\<close>
 
 definition\<^marker>\<open>tag important\<close> homotopic_loops :: "'a::topological_space set \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool"  where
  "homotopic_loops S p q \<equiv>
      homotopic_with_canon (\<lambda>r. pathfinish r = pathstart r) {0..1} S p q"
 
 lemma homotopic_loops:
    "homotopic_loops S p q \<longleftrightarrow>
       (\<exists>h. continuous_on ({0..1::real} \<times> {0..1}) h \<and>
           image h ({0..1} \<times> {0..1}) \<subseteq> S \<and>
           (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
           (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
           (\<forall>t \<in> {0..1}. pathfinish(h \<circ> Pair t) = pathstart(h \<circ> Pair t)))"
   by (simp add: homotopic_loops_def pathstart_def pathfinish_def homotopic_with)
 
 proposition homotopic_loops_imp_loop:
      "homotopic_loops S p q \<Longrightarrow> pathfinish p = pathstart p \<and> pathfinish q = pathstart q"
 using homotopic_with_imp_property homotopic_loops_def by blast
 
 proposition homotopic_loops_imp_path:
      "homotopic_loops S p q \<Longrightarrow> path p \<and> path q"
   unfolding homotopic_loops_def path_def
   using homotopic_with_imp_continuous_maps continuous_map_subtopology_eu by blast
 
 proposition homotopic_loops_imp_subset:
      "homotopic_loops S p q \<Longrightarrow> path_image p \<subseteq> S \<and> path_image q \<subseteq> S"
   unfolding homotopic_loops_def path_image_def
   by (meson continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 proposition homotopic_loops_refl:
      "homotopic_loops S p p \<longleftrightarrow>
       path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p"
   by (simp add: homotopic_loops_def path_image_def path_def)
 
 proposition homotopic_loops_sym: "homotopic_loops S p q \<Longrightarrow> homotopic_loops S q p"
   by (simp add: homotopic_loops_def homotopic_with_sym)
 
 proposition homotopic_loops_sym_eq: "homotopic_loops S p q \<longleftrightarrow> homotopic_loops S q p"
   by (metis homotopic_loops_sym)
 
 proposition homotopic_loops_trans:
    "\<lbrakk>homotopic_loops S p q; homotopic_loops S q r\<rbrakk> \<Longrightarrow> homotopic_loops S p r"
   unfolding homotopic_loops_def by (blast intro: homotopic_with_trans)
 
 proposition homotopic_loops_subset:
    "\<lbrakk>homotopic_loops S p q; S \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t p q"
   by (fastforce simp: homotopic_loops)
 
 proposition homotopic_loops_eq:
    "\<lbrakk>path p; path_image p \<subseteq> S; pathfinish p = pathstart p; \<And>t. t \<in> {0..1} \<Longrightarrow> p(t) = q(t)\<rbrakk>
           \<Longrightarrow> homotopic_loops S p q"
   unfolding homotopic_loops_def path_image_def path_def pathstart_def pathfinish_def
   by (auto intro: homotopic_with_eq [OF homotopic_with_refl [where f = p, THEN iffD2]])
 
 proposition homotopic_loops_continuous_image:
    "\<lbrakk>homotopic_loops S f g; continuous_on S h; h \<in> S \<rightarrow> t\<rbrakk> \<Longrightarrow> homotopic_loops t (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_loops_def
   by (simp add: homotopic_with_compose_continuous_map_left pathfinish_def pathstart_def image_subset_iff_funcset)
 
 
 subsection\<open>Relations between the two variants of homotopy\<close>
 
 proposition homotopic_paths_imp_homotopic_loops:
     "\<lbrakk>homotopic_paths S p q; pathfinish p = pathstart p; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> homotopic_loops S p q"
   by (auto simp: homotopic_with_def homotopic_paths_def homotopic_loops_def)
 
 proposition homotopic_loops_imp_homotopic_paths_null:
   assumes "homotopic_loops S p (linepath a a)"
     shows "homotopic_paths S p (linepath (pathstart p) (pathstart p))"
 proof -
   have "path p" by (metis assms homotopic_loops_imp_path)
   have ploop: "pathfinish p = pathstart p" by (metis assms homotopic_loops_imp_loop)
   have pip: "path_image p \<subseteq> S" by (metis assms homotopic_loops_imp_subset)
   let ?A = "{0..1::real} \<times> {0..1::real}"
   obtain h where conth: "continuous_on ?A h"
              and hs: "h \<in> ?A \<rightarrow> S"
              and h0[simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(0,x) = p x"
              and h1[simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(1,x) = a"
              and ends: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish (h \<circ> Pair t) = pathstart (h \<circ> Pair t)"
     using assms by (auto simp: homotopic_loops homotopic_with image_subset_iff_funcset)
   have conth0: "path (\<lambda>u. h (u, 0))"
     unfolding path_def
   proof (rule continuous_on_compose [of _ _ h, unfolded o_def])
     show "continuous_on ((\<lambda>x. (x, 0)) ` {0..1}) h"
       by (force intro: continuous_on_subset [OF conth])
   qed (force intro: continuous_intros)
   have pih0: "path_image (\<lambda>u. h (u, 0)) \<subseteq> S"
     using hs by (force simp: path_image_def)
   have c1: "continuous_on ?A (\<lambda>x. h (fst x * snd x, 0))"
   proof (rule continuous_on_compose [of _ _ h, unfolded o_def])
     show "continuous_on ((\<lambda>x. (fst x * snd x, 0)) ` ?A) h"
       by (force simp: mult_le_one intro: continuous_on_subset [OF conth])
   qed (force intro: continuous_intros)+
   have c2: "continuous_on ?A (\<lambda>x. h (fst x - fst x * snd x, 0))"
   proof (rule continuous_on_compose [of _ _ h, unfolded o_def])
     show "continuous_on ((\<lambda>x. (fst x - fst x * snd x, 0)) ` ?A) h"
       by (auto simp: algebra_simps add_increasing2 mult_left_le intro: continuous_on_subset [OF conth])
   qed (force intro: continuous_intros)
   have [simp]: "\<And>t. \<lbrakk>0 \<le> t \<and> t \<le> 1\<rbrakk> \<Longrightarrow> h (t, 1) = h (t, 0)"
     using ends by (simp add: pathfinish_def pathstart_def)
   have adhoc_le: "c * 4 \<le> 1 + c * (d * 4)" if "\<not> d * 4 \<le> 3" "0 \<le> c" "c \<le> 1" for c d::real
   proof -
     have "c * 3 \<le> c * (d * 4)" using that less_eq_real_def by auto
     with \<open>c \<le> 1\<close> show ?thesis by fastforce
   qed
   have *: "\<And>p x. \<lbrakk>path p \<and> path(reversepath p);
                   path_image p \<subseteq> S \<and> path_image(reversepath p) \<subseteq> S;
                   pathfinish p = pathstart(linepath a a +++ reversepath p) \<and>
                    pathstart(reversepath p) = a \<and> pathstart p = x\<rbrakk>
                   \<Longrightarrow> homotopic_paths S (p +++ linepath a a +++ reversepath p) (linepath x x)"
     by (metis homotopic_paths_lid homotopic_paths_join
               homotopic_paths_trans homotopic_paths_sym homotopic_paths_rinv)
   have 1: "homotopic_paths S p (p +++ linepath (pathfinish p) (pathfinish p))"
     using \<open>path p\<close> homotopic_paths_rid homotopic_paths_sym pip by blast
   moreover have "homotopic_paths S (p +++ linepath (pathfinish p) (pathfinish p))
                                    (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))"
     using homotopic_paths_lid [of "p +++ linepath (pathfinish p) (pathfinish p)" S]
     by (metis 1 homotopic_paths_imp_path homotopic_paths_imp_subset homotopic_paths_sym pathstart_join)
   moreover 
   have "homotopic_paths S (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))
                                    ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))"
     unfolding homotopic_paths_def homotopic_with_def
   proof (intro exI strip conjI)
     let ?h = "\<lambda>y. (subpath 0 (fst y) (\<lambda>u. h (u, 0)) +++ (\<lambda>u. h (Pair (fst y) u)) 
                +++ subpath (fst y) 0 (\<lambda>u. h (u, 0))) (snd y)" 
     have "continuous_on ?A ?h"
       by (intro continuous_on_homotopic_join_lemma; simp add: path_defs joinpaths_def subpath_def conth c1 c2)
     moreover have "?h \<in> ?A \<rightarrow> S"
       using hs
       unfolding joinpaths_def subpath_def
       by (force simp: algebra_simps mult_le_one mult_left_le  intro: adhoc_le)
   ultimately show "continuous_map (prod_topology (top_of_set {0..1}) (top_of_set {0..1}))
                          (top_of_set S) ?h"
     by (simp add: subpath_reversepath image_subset_iff_funcset)
   qed (use ploop in \<open>simp_all add: reversepath_def path_defs joinpaths_def o_def subpath_def conth c1 c2\<close>)
   moreover have "homotopic_paths S ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))
                                    (linepath (pathstart p) (pathstart p))"
     by (rule *; simp add: pih0 pathstart_def pathfinish_def conth0; simp add: reversepath_def joinpaths_def)
   ultimately show ?thesis
     by (blast intro: homotopic_paths_trans)
 qed
 
 proposition homotopic_loops_conjugate:
   fixes S :: "'a::real_normed_vector set"
   assumes "path p" "path q" and pip: "path_image p \<subseteq> S" and piq: "path_image q \<subseteq> S"
       and pq: "pathfinish p = pathstart q" and qloop: "pathfinish q = pathstart q"
     shows "homotopic_loops S (p +++ q +++ reversepath p) q"
 proof -
   have contp: "continuous_on {0..1} p"  using \<open>path p\<close> [unfolded path_def] by blast
   have contq: "continuous_on {0..1} q"  using \<open>path q\<close> [unfolded path_def] by blast
   let ?A = "{0..1::real} \<times> {0..1::real}"
   have c1: "continuous_on ?A (\<lambda>x. p ((1 - fst x) * snd x + fst x))"
   proof (rule continuous_on_compose [of _ _ p, unfolded o_def])
     show "continuous_on ((\<lambda>x. (1 - fst x) * snd x + fst x) ` ?A) p"
       by (auto intro: continuous_on_subset [OF contp] simp: algebra_simps add_increasing2 mult_right_le_one_le sum_le_prod1)
   qed (force intro: continuous_intros)
   have c2: "continuous_on ?A (\<lambda>x. p ((fst x - 1) * snd x + 1))"
   proof (rule continuous_on_compose [of _ _ p, unfolded o_def])
     show "continuous_on ((\<lambda>x. (fst x - 1) * snd x + 1) ` ?A) p"
       by (auto intro: continuous_on_subset [OF contp] simp: algebra_simps add_increasing2 mult_left_le_one_le)
   qed (force intro: continuous_intros)
 
   have ps1: "\<And>a b. \<lbrakk>b * 2 \<le> 1; 0 \<le> b; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((1 - a) * (2 * b) + a) \<in> S"
     using sum_le_prod1
     by (force simp: algebra_simps add_increasing2 mult_left_le intro: pip [unfolded path_image_def, THEN subsetD])
   have ps2: "\<And>a b. \<lbrakk>\<not> 4 * b \<le> 3; b \<le> 1; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((a - 1) * (4 * b - 3) + 1) \<in> S"
     apply (rule pip [unfolded path_image_def, THEN subsetD])
     apply (rule image_eqI, blast)
     apply (simp add: algebra_simps)
     by (metis add_mono affine_ineq linear mult.commute mult.left_neutral mult_right_mono
               add.commute zero_le_numeral)
   have qs: "\<And>a b. \<lbrakk>4 * b \<le> 3; \<not> b * 2 \<le> 1\<rbrakk> \<Longrightarrow> q (4 * b - 2) \<in> S"
     using path_image_def piq by fastforce
   have "homotopic_loops S (p +++ q +++ reversepath p)
                           (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q))"
     unfolding homotopic_loops_def homotopic_with_def
   proof (intro exI strip conjI)
     let ?h = "(\<lambda>y. (subpath (fst y) 1 p +++ q +++ subpath 1 (fst y) p) (snd y))" 
     have "continuous_on ?A (\<lambda>y. q (snd y))"
       by (force simp: contq intro: continuous_on_compose [of _ _ q, unfolded o_def] continuous_on_id continuous_on_snd)
     then have "continuous_on ?A ?h"
       using pq qloop
       by (intro continuous_on_homotopic_join_lemma) (auto simp: path_defs joinpaths_def subpath_def c1 c2)
     then show "continuous_map (prod_topology (top_of_set {0..1}) (top_of_set {0..1})) (top_of_set S) ?h"
       by (auto simp: joinpaths_def subpath_def  ps1 ps2 qs)
     show "?h (1,x) = (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q)) x"  for x
       using pq by (simp add: pathfinish_def subpath_refl)
   qed (auto simp: subpath_reversepath)
   moreover have "homotopic_loops S (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q)) q"
   proof -
     have "homotopic_paths S (linepath (pathfinish q) (pathfinish q) +++ q) q"
       using \<open>path q\<close> homotopic_paths_lid qloop piq by auto
     hence 1: "\<And>f. homotopic_paths S f q \<or> \<not> homotopic_paths S f (linepath (pathfinish q) (pathfinish q) +++ q)"
       using homotopic_paths_trans by blast
     hence "homotopic_paths S (linepath (pathfinish q) (pathfinish q) +++ q +++ linepath (pathfinish q) (pathfinish q)) q"
       by (smt (verit, best) \<open>path q\<close> homotopic_paths_imp_path homotopic_paths_imp_subset homotopic_paths_lid 
           homotopic_paths_rid homotopic_paths_trans pathstart_join piq qloop)
     thus ?thesis
       by (metis (no_types) qloop homotopic_loops_sym homotopic_paths_imp_homotopic_loops homotopic_paths_imp_pathfinish homotopic_paths_sym)
   qed
   ultimately show ?thesis
     by (blast intro: homotopic_loops_trans)
 qed
 
 lemma homotopic_paths_loop_parts:
   assumes loops: "homotopic_loops S (p +++ reversepath q) (linepath a a)" and "path q"
   shows "homotopic_paths S p q"
 proof -
   have paths: "homotopic_paths S (p +++ reversepath q) (linepath (pathstart p) (pathstart p))"
     using homotopic_loops_imp_homotopic_paths_null [OF loops] by simp
   then have "path p"
     using \<open>path q\<close> homotopic_loops_imp_path loops path_join path_join_path_ends path_reversepath by blast
   show ?thesis
   proof (cases "pathfinish p = pathfinish q")
     case True
     obtain pipq: "path_image p \<subseteq> S" "path_image q \<subseteq> S"
       by (metis Un_subset_iff paths \<open>path p\<close> \<open>path q\<close> homotopic_loops_imp_subset homotopic_paths_imp_path loops
            path_image_join path_image_reversepath path_imp_reversepath path_join_eq)
     have "homotopic_paths S p (p +++ (linepath (pathfinish p) (pathfinish p)))"
       using \<open>path p\<close> \<open>path_image p \<subseteq> S\<close> homotopic_paths_rid homotopic_paths_sym by blast
     moreover have "homotopic_paths S (p +++ (linepath (pathfinish p) (pathfinish p))) (p +++ (reversepath q +++ q))"
       by (simp add: True \<open>path p\<close> \<open>path q\<close> pipq homotopic_paths_join homotopic_paths_linv homotopic_paths_sym)
     moreover have "homotopic_paths S (p +++ (reversepath q +++ q)) ((p +++ reversepath q) +++ q)"
       by (simp add: True \<open>path p\<close> \<open>path q\<close> homotopic_paths_assoc pipq)
     moreover have "homotopic_paths S ((p +++ reversepath q) +++ q) (linepath (pathstart p) (pathstart p) +++ q)"
       by (simp add: \<open>path q\<close> homotopic_paths_join paths pipq)
     ultimately show ?thesis
       by (metis \<open>path q\<close> homotopic_paths_imp_path homotopic_paths_lid homotopic_paths_trans path_join_path_ends pathfinish_linepath pipq(2))
   next
     case False
     then show ?thesis
       using \<open>path q\<close> homotopic_loops_imp_path loops path_join_path_ends by fastforce
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Homotopy of "nearby" function, paths and loops\<close>
 
 lemma homotopic_with_linear:
   fixes f g :: "_ \<Rightarrow> 'b::real_normed_vector"
   assumes contf: "continuous_on S f"
       and contg:"continuous_on S g"
       and sub: "\<And>x. x \<in> S \<Longrightarrow> closed_segment (f x) (g x) \<subseteq> t"
     shows "homotopic_with_canon (\<lambda>z. True) S t f g"
   unfolding homotopic_with_def
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R f(snd y) + (fst y) *\<^sub>R g(snd y))" in exI)
   using sub closed_segment_def
      by (fastforce intro: continuous_intros continuous_on_subset [OF contf] continuous_on_compose2 [where g=f]
             continuous_on_subset [OF contg] continuous_on_compose2 [where g=g])
 
 lemma homotopic_paths_linear:
   fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
           "\<And>t. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> S"
     shows "homotopic_paths S g h"
   using assms
   unfolding path_def
   apply (simp add: closed_segment_def pathstart_def pathfinish_def homotopic_paths_def homotopic_with_def)
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R (g \<circ> snd) y + (fst y) *\<^sub>R (h \<circ> snd) y)" in exI)
   apply (intro conjI subsetI continuous_intros; force)
   done
 
 lemma homotopic_loops_linear:
   fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
           "\<And>t x. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> S"
     shows "homotopic_loops S g h"
   using assms
   unfolding path_defs homotopic_loops_def homotopic_with_def
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R g(snd y) + (fst y) *\<^sub>R h(snd y))" in exI)
   by (force simp: closed_segment_def intro!: continuous_intros intro: continuous_on_compose2 [where g=g] continuous_on_compose2 [where g=h])
 
 lemma homotopic_paths_nearby_explicit:
   assumes \<section>: "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
       and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> S\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
     shows "homotopic_paths S g h"
   using homotopic_paths_linear [OF \<section>] by (metis linorder_not_le no norm_minus_commute segment_bound1 subsetI)
 
 lemma homotopic_loops_nearby_explicit:
   assumes \<section>: "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
       and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> S\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
     shows "homotopic_loops S g h"
   using homotopic_loops_linear [OF \<section>] by (metis linorder_not_le no norm_minus_commute segment_bound1 subsetI)
 
 lemma homotopic_nearby_paths:
   fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "path g" "open S" "path_image g \<subseteq> S"
     shows "\<exists>e. 0 < e \<and>
                (\<forall>h. path h \<and>
                     pathstart h = pathstart g \<and> pathfinish h = pathfinish g \<and>
                     (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_paths S g h)"
 proof -
   obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - S \<Longrightarrow> e \<le> dist x y"
     using separate_compact_closed [of "path_image g" "-S"] assms by force
   show ?thesis
     using e [unfolded dist_norm] \<open>e > 0\<close>
     by (fastforce simp: path_image_def intro!: homotopic_paths_nearby_explicit assms exI)
 qed
 
 lemma homotopic_nearby_loops:
   fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "path g" "open S" "path_image g \<subseteq> S" "pathfinish g = pathstart g"
     shows "\<exists>e. 0 < e \<and>
                (\<forall>h. path h \<and> pathfinish h = pathstart h \<and>
                     (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_loops S g h)"
 proof -
   obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - S \<Longrightarrow> e \<le> dist x y"
     using separate_compact_closed [of "path_image g" "-S"] assms by force
   show ?thesis
     using e [unfolded dist_norm] \<open>e > 0\<close>
     by (fastforce simp: path_image_def intro!: homotopic_loops_nearby_explicit assms exI)
 qed
 
 
 subsection\<open> Homotopy and subpaths\<close>
 
 lemma homotopic_join_subpaths1:
   assumes "path g" and pag: "path_image g \<subseteq> S"
       and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}" "u \<le> v" "v \<le> w"
     shows "homotopic_paths S (subpath u v g +++ subpath v w g) (subpath u w g)"
 proof -
   have 1: "t * 2 \<le> 1 \<Longrightarrow> u + t * (v * 2) \<le> v + t * (u * 2)" for t
     using affine_ineq \<open>u \<le> v\<close> by fastforce
   have 2: "t * 2 > 1 \<Longrightarrow> u + (2*t - 1) * v \<le> v + (2*t - 1) * w" for t
     by (metis add_mono_thms_linordered_semiring(1) diff_gt_0_iff_gt less_eq_real_def mult.commute mult_right_mono \<open>u \<le> v\<close> \<open>v \<le> w\<close>)
   have t2: "\<And>t::real. t*2 = 1 \<Longrightarrow> t = 1/2" by auto
   have "homotopic_paths (path_image g) (subpath u v g +++ subpath v w g) (subpath u w g)"
   proof (cases "w = u")
     case True
     then show ?thesis
       by (metis \<open>path g\<close> homotopic_paths_rinv path_image_subpath_subset path_subpath pathstart_subpath reversepath_subpath subpath_refl u v)
   next
     case False
     let ?f = "\<lambda>t. if  t \<le> 1/2 then inverse((w - u)) *\<^sub>R (2 * (v - u)) *\<^sub>R t
                                else inverse((w - u)) *\<^sub>R ((v - u) + (w - v) *\<^sub>R (2 *\<^sub>R t - 1))"
     show ?thesis
     proof (rule homotopic_paths_sym [OF homotopic_paths_reparametrize [where f = ?f]])
       show "path (subpath u w g)"
         using assms(1) path_subpath u w(1) by blast
       show "path_image (subpath u w g) \<subseteq> path_image g"
         by (meson path_image_subpath_subset u w(1))
       show "continuous_on {0..1} ?f"
         unfolding split_01
         by (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def dest!: t2)+
       show "?f \<in> {0..1} \<rightarrow> {0..1}"
         using False assms
         by (force simp: field_simps not_le mult_left_mono affine_ineq dest!: 1 2)
       show "(subpath u v g +++ subpath v w g) t = subpath u w g (?f t)" if "t \<in> {0..1}" for t 
         using assms
         unfolding joinpaths_def subpath_def by (auto simp: divide_simps add.commute mult.commute mult.left_commute)
     qed (use False in auto)
   qed
   then show ?thesis
     by (rule homotopic_paths_subset [OF _ pag])
 qed
 
 lemma homotopic_join_subpaths2:
   assumes "homotopic_paths S (subpath u v g +++ subpath v w g) (subpath u w g)"
   shows "homotopic_paths S (subpath w v g +++ subpath v u g) (subpath w u g)"
   by (metis assms homotopic_paths_reversepath_D pathfinish_subpath pathstart_subpath reversepath_joinpaths reversepath_subpath)
 
 lemma homotopic_join_subpaths3:
   assumes hom: "homotopic_paths S (subpath u v g +++ subpath v w g) (subpath u w g)"
       and "path g" and pag: "path_image g \<subseteq> S"
       and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}"
     shows "homotopic_paths S (subpath v w g +++ subpath w u g) (subpath v u g)"
 proof -
   obtain wvg: "path (subpath w v g)" "path_image (subpath w v g) \<subseteq> S" 
      and wug: "path (subpath w u g)" "path_image (subpath w u g) \<subseteq> S"
      and vug: "path (subpath v u g)" "path_image (subpath v u g) \<subseteq> S"
     by (meson \<open>path g\<close> pag path_image_subpath_subset path_subpath subset_trans u v w)
   have "homotopic_paths S (subpath u w g +++ subpath w v g) 
                           ((subpath u v g +++ subpath v w g) +++ subpath w v g)"
     by (simp add: hom homotopic_paths_join homotopic_paths_sym wvg)
   also have "homotopic_paths S \<dots>  (subpath u v g +++ subpath v w g +++ subpath w v g)"
     using wvg vug \<open>path g\<close>
     by (metis homotopic_paths_assoc homotopic_paths_sym path_image_subpath_commute path_subpath
         pathfinish_subpath pathstart_subpath u v w)
   also have "homotopic_paths S \<dots> (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g)))"
     using wvg vug \<open>path g\<close>
     by (metis homotopic_paths_join homotopic_paths_linv homotopic_paths_refl path_image_subpath_commute
         path_subpath pathfinish_subpath pathstart_join pathstart_subpath reversepath_subpath u v)
   also have "homotopic_paths S \<dots> (subpath u v g)"
     using vug \<open>path g\<close> by (metis homotopic_paths_rid path_image_subpath_commute path_subpath u v)
   finally have "homotopic_paths S (subpath u w g +++ subpath w v g) (subpath u v g)" .
   then show ?thesis
     using homotopic_join_subpaths2 by blast
 qed
 
 proposition homotopic_join_subpaths:
    "\<lbrakk>path g; path_image g \<subseteq> S; u \<in> {0..1}; v \<in> {0..1}; w \<in> {0..1}\<rbrakk>
     \<Longrightarrow> homotopic_paths S (subpath u v g +++ subpath v w g) (subpath u w g)"
   by (smt (verit, del_insts) homotopic_join_subpaths1 homotopic_join_subpaths2 homotopic_join_subpaths3)
 
 text\<open>Relating homotopy of trivial loops to path-connectedness.\<close>
 
 lemma path_component_imp_homotopic_points:
   assumes "path_component S a b"
   shows "homotopic_loops S (linepath a a) (linepath b b)"
 proof -
   obtain g :: "real \<Rightarrow> 'a" where g: "continuous_on {0..1} g" "g \<in> {0..1} \<rightarrow> S" "g 0 = a" "g 1 = b"
     using assms by (auto simp: path_defs)
   then have "continuous_on ({0..1} \<times> {0..1}) (g \<circ> fst)"
     by (fastforce intro!: continuous_intros)+
   with g show ?thesis
     by (auto simp: homotopic_loops_def homotopic_with_def path_defs Pi_iff)
 qed
 
 lemma homotopic_loops_imp_path_component_value:
   "\<lbrakk>homotopic_loops S p q; 0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> path_component S (p t) (q t)"
   apply (clarsimp simp: homotopic_loops_def homotopic_with_def path_defs)
   apply (rule_tac x="h \<circ> (\<lambda>u. (u, t))" in exI)
   apply (fastforce elim!: continuous_on_subset intro!: continuous_intros)
   done
 
 lemma homotopic_points_eq_path_component:
    "homotopic_loops S (linepath a a) (linepath b b) \<longleftrightarrow> path_component S a b"
   using homotopic_loops_imp_path_component_value path_component_imp_homotopic_points by fastforce
 
 lemma path_connected_eq_homotopic_points:
   "path_connected S \<longleftrightarrow>
       (\<forall>a b. a \<in> S \<and> b \<in> S \<longrightarrow> homotopic_loops S (linepath a a) (linepath b b))"
   by (auto simp: path_connected_def path_component_def homotopic_points_eq_path_component)
 
 
 subsection\<open>Simply connected sets\<close>
 
 text\<^marker>\<open>tag important\<close>\<open>defined as "all loops are homotopic (as loops)\<close>
 
 definition\<^marker>\<open>tag important\<close> simply_connected where
   "simply_connected S \<equiv>
         \<forall>p q. path p \<and> pathfinish p = pathstart p \<and> path_image p \<subseteq> S \<and>
               path q \<and> pathfinish q = pathstart q \<and> path_image q \<subseteq> S
               \<longrightarrow> homotopic_loops S p q"
 
 lemma simply_connected_empty [iff]: "simply_connected {}"
   by (simp add: simply_connected_def)
 
 lemma simply_connected_imp_path_connected:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<Longrightarrow> path_connected S"
   by (simp add: simply_connected_def path_connected_eq_homotopic_points)
 
 lemma simply_connected_imp_connected:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<Longrightarrow> connected S"
   by (simp add: path_connected_imp_connected simply_connected_imp_path_connected)
 
 lemma simply_connected_eq_contractible_loop_any:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
             (\<forall>p a. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p \<and> a \<in> S
                   \<longrightarrow> homotopic_loops S p (linepath a a))"
         (is "?lhs = ?rhs")
 proof
   assume ?rhs then show ?lhs
     unfolding simply_connected_def
     by (metis pathfinish_in_path_image subsetD  homotopic_loops_trans homotopic_loops_sym)
 qed (force simp: simply_connected_def)
 
 lemma simply_connected_eq_contractible_loop_some:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
                 path_connected S \<and>
                 (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
                     \<longrightarrow> (\<exists>a. a \<in> S \<and> homotopic_loops S p (linepath a a)))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
   using simply_connected_eq_contractible_loop_any by (blast intro: simply_connected_imp_path_connected)
 next
   assume ?rhs
   then show ?lhs
     by (meson homotopic_loops_trans path_connected_eq_homotopic_points simply_connected_eq_contractible_loop_any)
 qed
 
 lemma simply_connected_eq_contractible_loop_all:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
          S = {} \<or>
          (\<exists>a \<in> S. \<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
                 \<longrightarrow> homotopic_loops S p (linepath a a))"
   by (meson ex_in_conv homotopic_loops_sym homotopic_loops_trans simply_connected_def simply_connected_eq_contractible_loop_any)
 
 lemma simply_connected_eq_contractible_path:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
            path_connected S \<and>
            (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
             \<longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p)))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding simply_connected_imp_path_connected
     by (metis simply_connected_eq_contractible_loop_some homotopic_loops_imp_homotopic_paths_null)
 next
   assume  ?rhs
   then show ?lhs
     using homotopic_paths_imp_homotopic_loops simply_connected_eq_contractible_loop_some by fastforce
 qed
 
 lemma simply_connected_eq_homotopic_paths:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
           path_connected S \<and>
           (\<forall>p q. path p \<and> path_image p \<subseteq> S \<and>
                 path q \<and> path_image q \<subseteq> S \<and>
                 pathstart q = pathstart p \<and> pathfinish q = pathfinish p
                 \<longrightarrow> homotopic_paths S p q)"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have pc: "path_connected S"
         and *:  "\<And>p. \<lbrakk>path p; path_image p \<subseteq> S;
                        pathfinish p = pathstart p\<rbrakk>
                       \<Longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p))"
     by (auto simp: simply_connected_eq_contractible_path)
   have "homotopic_paths S p q"
         if "path p" "path_image p \<subseteq> S" "path q"
            "path_image q \<subseteq> S" "pathstart q = pathstart p"
            "pathfinish q = pathfinish p" for p q
   proof -
     have "homotopic_paths S p (p +++ reversepath q +++ q)"
       using that
       by (smt (verit, best) homotopic_paths_join homotopic_paths_linv homotopic_paths_rid homotopic_paths_sym 
           homotopic_paths_trans pathstart_linepath)
     also have "homotopic_paths S \<dots> ((p +++ reversepath q) +++ q)"
       by (simp add: that homotopic_paths_assoc)
     also have "homotopic_paths S \<dots> (linepath (pathstart q) (pathstart q) +++ q)"
       using * [of "p +++ reversepath q"] that
       by (simp add: homotopic_paths_assoc homotopic_paths_join path_image_join)
     also have "homotopic_paths S \<dots> q"
       using that homotopic_paths_lid by blast
     finally show ?thesis .
   qed
   then show ?rhs
     by (blast intro: pc *)
 next
   assume ?rhs
   then show ?lhs
     by (force simp: simply_connected_eq_contractible_path)
 qed
 
 proposition simply_connected_Times:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   assumes S: "simply_connected S" and T: "simply_connected T"
     shows "simply_connected(S \<times> T)"
 proof -
   have "homotopic_loops (S \<times> T) p (linepath (a, b) (a, b))"
        if "path p" "path_image p \<subseteq> S \<times> T" "p 1 = p 0" "a \<in> S" "b \<in> T"
        for p a b
   proof -
     have "path (fst \<circ> p)"
       by (simp add: continuous_on_fst Path_Connected.path_continuous_image [OF \<open>path p\<close>])
     moreover have "path_image (fst \<circ> p) \<subseteq> S"
       using that by (force simp: path_image_def)
     ultimately have p1: "homotopic_loops S (fst \<circ> p) (linepath a a)"
       using S that
       by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
     have "path (snd \<circ> p)"
       by (simp add: continuous_on_snd Path_Connected.path_continuous_image [OF \<open>path p\<close>])
     moreover have "path_image (snd \<circ> p) \<subseteq> T"
       using that by (force simp: path_image_def)
     ultimately have p2: "homotopic_loops T (snd \<circ> p) (linepath b b)"
       using T that
       by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
     show ?thesis
       using p1 p2 unfolding homotopic_loops
       apply clarify
       subgoal for h k
         by (rule_tac x="\<lambda>z. (h z, k z)" in exI) (force intro: continuous_intros simp: path_defs)
       done
   qed
   with assms show ?thesis
     by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
 qed
 
 
 subsection\<open>Contractible sets\<close>
 
 definition\<^marker>\<open>tag important\<close> contractible where
  "contractible S \<equiv> \<exists>a. homotopic_with_canon (\<lambda>x. True) S S id (\<lambda>x. a)"
 
 proposition contractible_imp_simply_connected:
   fixes S :: "_::real_normed_vector set"
   assumes "contractible S" shows "simply_connected S"
 proof (cases "S = {}")
   case True then show ?thesis by force
 next
   case False
   obtain a where a: "homotopic_with_canon (\<lambda>x. True) S S id (\<lambda>x. a)"
     using assms by (force simp: contractible_def)
   then have "a \<in> S"
     using False homotopic_with_imp_funspace2 by fastforce
   have "\<forall>p. path p \<and>
             path_image p \<subseteq> S \<and> pathfinish p = pathstart p \<longrightarrow>
             homotopic_loops S p (linepath a a)"
     using a apply (clarsimp simp: homotopic_loops_def homotopic_with_def path_defs)
     apply (rule_tac x="(h \<circ> (\<lambda>y. (fst y, (p \<circ> snd) y)))" in exI)
     apply (intro conjI continuous_on_compose continuous_intros; force elim: continuous_on_subset)
     done
   with \<open>a \<in> S\<close> show ?thesis
     by (auto simp: simply_connected_eq_contractible_loop_all False)
 qed
 
 corollary contractible_imp_connected:
   fixes S :: "_::real_normed_vector set"
   shows "contractible S \<Longrightarrow> connected S"
   by (simp add: contractible_imp_simply_connected simply_connected_imp_connected)
 
 lemma contractible_imp_path_connected:
   fixes S :: "_::real_normed_vector set"
   shows "contractible S \<Longrightarrow> path_connected S"
   by (simp add: contractible_imp_simply_connected simply_connected_imp_path_connected)
 
 lemma nullhomotopic_through_contractible:
   fixes S :: "_::topological_space set"
   assumes f: "continuous_on S f" "f \<in> S \<rightarrow> T"
       and g: "continuous_on T g" "g \<in> T \<rightarrow> U"
       and T: "contractible T"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S U (g \<circ> f) (\<lambda>x. c)"
 proof -
   obtain b where b: "homotopic_with_canon (\<lambda>x. True) T T id (\<lambda>x. b)"
     using assms by (force simp: contractible_def)
   have "homotopic_with_canon (\<lambda>f. True) T U (g \<circ> id) (g \<circ> (\<lambda>x. b))"
     by (metis b continuous_map_subtopology_eu g homotopic_with_compose_continuous_map_left image_subset_iff_funcset)
   then have "homotopic_with_canon (\<lambda>f. True) S U (g \<circ> id \<circ> f) (g \<circ> (\<lambda>x. b) \<circ> f)"
     by (simp add: f homotopic_with_compose_continuous_map_right image_subset_iff_funcset)
   then show ?thesis
     by (simp add: comp_def that)
 qed
 
 lemma nullhomotopic_into_contractible:
   assumes f: "continuous_on S f" "f \<in> S \<rightarrow> T"
       and T: "contractible T"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S T f (\<lambda>x. c)"
   by (rule nullhomotopic_through_contractible [OF f, of id T]) (use assms in auto)
 
 lemma nullhomotopic_from_contractible:
   assumes f: "continuous_on S f" "f \<in> S \<rightarrow> T"
       and S: "contractible S"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S T f (\<lambda>x. c)"
   by (auto simp: comp_def intro: nullhomotopic_through_contractible [OF continuous_on_id _ f S])
 
 lemma homotopic_through_contractible:
   fixes S :: "_::real_normed_vector set"
   assumes "continuous_on S f1" "f1 \<in> S \<rightarrow> T"
           "continuous_on T g1" "g1 \<in> T \<rightarrow> U"
           "continuous_on S f2" "f2 \<in> S \<rightarrow> T"
           "continuous_on T g2" "g2 \<in> T \<rightarrow> U"
           "contractible T" "path_connected U"
    shows "homotopic_with_canon (\<lambda>h. True) S U (g1 \<circ> f1) (g2 \<circ> f2)"
 proof -
   obtain c1 where c1: "homotopic_with_canon (\<lambda>h. True) S U (g1 \<circ> f1) (\<lambda>x. c1)"
     by (rule nullhomotopic_through_contractible [of S f1 T g1 U]) (use assms in auto)
   obtain c2 where c2: "homotopic_with_canon (\<lambda>h. True) S U (g2 \<circ> f2) (\<lambda>x. c2)"
     by (rule nullhomotopic_through_contractible [of S f2 T g2 U]) (use assms in auto)
   have "S = {} \<or> (\<exists>t. path_connected t \<and> t \<subseteq> U \<and> c2 \<in> t \<and> c1 \<in> t)"
   proof (cases "S = {}")
     case True then show ?thesis by force
   next
     case False
     with c1 c2 have "c1 \<in> U" "c2 \<in> U"
       using homotopic_with_imp_continuous_maps
        by (metis PiE equals0I homotopic_with_imp_funspace2)+
     with \<open>path_connected U\<close> show ?thesis by blast
   qed
   then have "homotopic_with_canon (\<lambda>h. True) S U (\<lambda>x. c2) (\<lambda>x. c1)"
     by (auto simp: path_component homotopic_constant_maps)
   then show ?thesis
     using c1 c2 homotopic_with_symD homotopic_with_trans by blast
 qed
 
 lemma homotopic_into_contractible:
   fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
   assumes f: "continuous_on S f" "f \<in> S \<rightarrow> T"
     and g: "continuous_on S g" "g \<in> S \<rightarrow> T"
     and T: "contractible T"
   shows "homotopic_with_canon (\<lambda>h. True) S T f g"
   using homotopic_through_contractible [of S f T id T g id]
   by (simp add: assms contractible_imp_path_connected)
 
 lemma homotopic_from_contractible:
   fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
   assumes f: "continuous_on S f" "f \<in> S \<rightarrow> T"
     and g: "continuous_on S g" "g \<in> S \<rightarrow> T"
     and "contractible S" "path_connected T"
   shows "homotopic_with_canon (\<lambda>h. True) S T f g"
   using homotopic_through_contractible [of S id S f T id g]
   by (simp add: assms contractible_imp_path_connected)
 
 subsection\<open>Starlike sets\<close>
 
 definition\<^marker>\<open>tag important\<close> "starlike S \<longleftrightarrow> (\<exists>a\<in>S. \<forall>x\<in>S. closed_segment a x \<subseteq> S)"
 
 lemma starlike_UNIV [simp]: "starlike UNIV"
   by (simp add: starlike_def)
 
 lemma convex_imp_starlike:
   "convex S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> starlike S"
   unfolding convex_contains_segment starlike_def by auto
 
 lemma starlike_convex_tweak_boundary_points:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "S \<noteq> {}" and ST: "rel_interior S \<subseteq> T" and TS: "T \<subseteq> closure S"
   shows "starlike T"
 proof -
   have "rel_interior S \<noteq> {}"
     by (simp add: assms rel_interior_eq_empty)
   with ST obtain a where a: "a \<in> rel_interior S" and "a \<in> T" by blast
   have "\<And>x. x \<in> T \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
     by (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> a]) (use assms in auto)
   then have "\<forall>x\<in>T. a \<in> T \<and> open_segment a x \<subseteq> T"
     using ST by (blast intro: a \<open>a \<in> T\<close> rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
   then show ?thesis
     unfolding starlike_def using bexI [OF _ \<open>a \<in> T\<close>]
     by (simp add: closed_segment_eq_open)
 qed
 
 lemma starlike_imp_contractible_gen:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "starlike S"
       and P: "\<And>a T. \<lbrakk>a \<in> S; 0 \<le> T; T \<le> 1\<rbrakk> \<Longrightarrow> P(\<lambda>x. (1 - T) *\<^sub>R x + T *\<^sub>R a)"
     obtains a where "homotopic_with_canon P S S (\<lambda>x. x) (\<lambda>x. a)"
 proof -
   obtain a where "a \<in> S" and a: "\<And>x. x \<in> S \<Longrightarrow> closed_segment a x \<subseteq> S"
     using S by (auto simp: starlike_def)
   have "\<And>t b. 0 \<le> t \<and> t \<le> 1 \<Longrightarrow>
               \<exists>u. (1 - t) *\<^sub>R b + t *\<^sub>R a = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1"
     by (metis add_diff_cancel_right' diff_ge_0_iff_ge le_add_diff_inverse pth_c(1))
   then have "(\<lambda>y. (1 - fst y) *\<^sub>R snd y + fst y *\<^sub>R a) ` ({0..1} \<times> S) \<subseteq> S"
     using a [unfolded closed_segment_def] by force
   then have "homotopic_with_canon P S S (\<lambda>x. x) (\<lambda>x. a)"
     using \<open>a \<in> S\<close>
     unfolding homotopic_with_def
     apply (rule_tac x="\<lambda>y. (1 - (fst y)) *\<^sub>R snd y + (fst y) *\<^sub>R a" in exI)
     apply (force simp: P intro: continuous_intros)
     done
   then show ?thesis
     using that by blast
 qed
 
 lemma starlike_imp_contractible:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> contractible S"
   using starlike_imp_contractible_gen contractible_def by (fastforce simp: id_def)
 
 lemma contractible_UNIV [simp]: "contractible (UNIV :: 'a::real_normed_vector set)"
   by (simp add: starlike_imp_contractible)
 
 lemma starlike_imp_simply_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> simply_connected S"
   by (simp add: contractible_imp_simply_connected starlike_imp_contractible)
 
 lemma convex_imp_simply_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "convex S \<Longrightarrow> simply_connected S"
   using convex_imp_starlike starlike_imp_simply_connected by blast
 
 lemma starlike_imp_path_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> path_connected S"
   by (simp add: simply_connected_imp_path_connected starlike_imp_simply_connected)
 
 lemma starlike_imp_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> connected S"
   by (simp add: path_connected_imp_connected starlike_imp_path_connected)
 
 lemma is_interval_simply_connected_1:
   fixes S :: "real set"
   shows "is_interval S \<longleftrightarrow> simply_connected S"
   by (meson convex_imp_simply_connected is_interval_connected_1 is_interval_convex_1 simply_connected_imp_connected)
 
 lemma contractible_empty [simp]: "contractible {}"
   by (simp add: contractible_def homotopic_on_emptyI)
 
 lemma contractible_convex_tweak_boundary_points:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" and TS: "rel_interior S \<subseteq> T" "T \<subseteq> closure S"
   shows "contractible T"
   by (metis assms closure_eq_empty contractible_empty empty_subsetI 
       starlike_convex_tweak_boundary_points starlike_imp_contractible subset_antisym)
 
 lemma convex_imp_contractible:
   fixes S :: "'a::real_normed_vector set"
   shows "convex S \<Longrightarrow> contractible S"
   using contractible_empty convex_imp_starlike starlike_imp_contractible by blast
 
 lemma contractible_sing [simp]:
   fixes a :: "'a::real_normed_vector"
   shows "contractible {a}"
   by (rule convex_imp_contractible [OF convex_singleton])
 
 lemma is_interval_contractible_1:
   fixes S :: "real set"
   shows  "is_interval S \<longleftrightarrow> contractible S"
   using contractible_imp_simply_connected convex_imp_contractible is_interval_convex_1
     is_interval_simply_connected_1 by auto
 
 lemma contractible_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes S: "contractible S" and T: "contractible T"
   shows "contractible (S \<times> T)"
 proof -
   obtain a h where conth: "continuous_on ({0..1} \<times> S) h"
              and hsub: "h \<in> ({0..1} \<times> S) \<rightarrow> S"
              and [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (0, x) = x"
              and [simp]: "\<And>x. x \<in> S \<Longrightarrow>  h (1::real, x) = a"
     using S by (force simp: contractible_def homotopic_with)
   obtain b k where contk: "continuous_on ({0..1} \<times> T) k"
              and ksub: "k \<in> ({0..1} \<times> T) \<rightarrow> T"
              and [simp]: "\<And>x. x \<in> T \<Longrightarrow> k (0, x) = x"
              and [simp]: "\<And>x. x \<in> T \<Longrightarrow>  k (1::real, x) = b"
     using T by (force simp: contractible_def homotopic_with)
   show ?thesis
     apply (simp add: contractible_def homotopic_with)
     apply (rule exI [where x=a])
     apply (rule exI [where x=b])
     apply (rule exI [where x = "\<lambda>z. (h (fst z, fst(snd z)), k (fst z, snd(snd z)))"])
     using hsub ksub
     apply (fastforce intro!: continuous_intros continuous_on_compose2 [OF conth] continuous_on_compose2 [OF contk])
     done
 qed
 
 
 subsection\<open>Local versions of topological properties in general\<close>
 
 definition\<^marker>\<open>tag important\<close> locally :: "('a::topological_space set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
 where
  "locally P S \<equiv>
         \<forall>w x. openin (top_of_set S) w \<and> x \<in> w
               \<longrightarrow> (\<exists>U V. openin (top_of_set S) U \<and> P V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> w)"
 
 lemma locallyI:
   assumes "\<And>w x. \<lbrakk>openin (top_of_set S) w; x \<in> w\<rbrakk>
                   \<Longrightarrow> \<exists>U V. openin (top_of_set S) U \<and> P V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> w"
     shows "locally P S"
 using assms by (force simp: locally_def)
 
 lemma locallyE:
   assumes "locally P S" "openin (top_of_set S) w" "x \<in> w"
   obtains U V where "openin (top_of_set S) U" "P V" "x \<in> U" "U \<subseteq> V" "V \<subseteq> w"
   using assms unfolding locally_def by meson
 
 lemma locally_mono:
   assumes "locally P S" "\<And>T. P T \<Longrightarrow> Q T"
     shows "locally Q S"
 by (metis assms locally_def)
 
 lemma locally_open_subset:
   assumes "locally P S" "openin (top_of_set S) t"
     shows "locally P t"
   by (smt (verit, ccfv_SIG) assms order.trans locally_def openin_imp_subset openin_subset_trans openin_trans)
 
 lemma locally_diff_closed:
     "\<lbrakk>locally P S; closedin (top_of_set S) t\<rbrakk> \<Longrightarrow> locally P (S - t)"
   using locally_open_subset closedin_def by fastforce
 
 lemma locally_empty [iff]: "locally P {}"
   by (simp add: locally_def openin_subtopology)
 
 lemma locally_singleton [iff]:
   fixes a :: "'a::metric_space"
   shows "locally P {a} \<longleftrightarrow> P {a}"
 proof -
   have "\<forall>x::real. \<not> 0 < x \<Longrightarrow> P {a}"
     using zero_less_one by blast
   then show ?thesis
     unfolding locally_def
     by (auto simp: openin_euclidean_subtopology_iff subset_singleton_iff conj_disj_distribR)
 qed
 
 lemma locally_iff:
     "locally P S \<longleftrightarrow>
      (\<forall>T x. open T \<and> x \<in> S \<inter> T \<longrightarrow> (\<exists>U. open U \<and> (\<exists>V. P V \<and> x \<in> S \<inter> U \<and> S \<inter> U \<subseteq> V \<and> V \<subseteq> S \<inter> T)))"
   by (smt (verit) locally_def openin_open)
 
 lemma locally_Int:
   assumes S: "locally P S" and T: "locally P T"
       and P: "\<And>S T. P S \<and> P T \<Longrightarrow> P(S \<inter> T)"
   shows "locally P (S \<inter> T)"
   unfolding locally_iff
 proof clarify
   fix A x
   assume "open A" "x \<in> A" "x \<in> S" "x \<in> T"
   then obtain U1 V1 U2 V2 
     where "open U1" "P V1" "x \<in> S \<inter> U1" "S \<inter> U1 \<subseteq> V1 \<and> V1 \<subseteq> S \<inter> A" 
           "open U2" "P V2" "x \<in> T \<inter> U2" "T \<inter> U2 \<subseteq> V2 \<and> V2 \<subseteq> T \<inter> A"
     using S T unfolding locally_iff by (meson IntI)
   then have "S \<inter> T \<inter> (U1 \<inter> U2) \<subseteq> V1 \<inter> V2" "V1 \<inter> V2 \<subseteq> S \<inter> T \<inter> A" "x \<in> S \<inter> T \<inter> (U1 \<inter> U2)"
     by blast+
   moreover have "P (V1 \<inter> V2)"
     by (simp add: P \<open>P V1\<close> \<open>P V2\<close>)
   ultimately show "\<exists>U. open U \<and> (\<exists>V. P V \<and> x \<in> S \<inter> T \<inter> U \<and> S \<inter> T \<inter> U \<subseteq> V \<and> V \<subseteq> S \<inter> T \<inter> A)"
     using \<open>open U1\<close> \<open>open U2\<close> by blast
 qed
 
 
 lemma locally_Times:
   fixes S :: "('a::metric_space) set" and T :: "('b::metric_space) set"
   assumes PS: "locally P S" and QT: "locally Q T" and R: "\<And>S T. P S \<and> Q T \<Longrightarrow> R(S \<times> T)"
   shows "locally R (S \<times> T)"
     unfolding locally_def
 proof (clarify)
   fix W x y
   assume W: "openin (top_of_set (S \<times> T)) W" and xy: "(x, y) \<in> W"
   then obtain U V where "openin (top_of_set S) U" "x \<in> U"
                         "openin (top_of_set T) V" "y \<in> V" "U \<times> V \<subseteq> W"
     using Times_in_interior_subtopology by metis
   then obtain U1 U2 V1 V2
          where opeS: "openin (top_of_set S) U1 \<and> P U2 \<and> x \<in> U1 \<and> U1 \<subseteq> U2 \<and> U2 \<subseteq> U"
            and opeT: "openin (top_of_set T) V1 \<and> Q V2 \<and> y \<in> V1 \<and> V1 \<subseteq> V2 \<and> V2 \<subseteq> V"
     by (meson PS QT locallyE)
   then have "openin (top_of_set (S \<times> T)) (U1 \<times> V1)"
     by (simp add: openin_Times)
   moreover have "R (U2 \<times> V2)"
     by (simp add: R opeS opeT)
   moreover have "U1 \<times> V1 \<subseteq> U2 \<times> V2 \<and> U2 \<times> V2 \<subseteq> W"
     using opeS opeT \<open>U \<times> V \<subseteq> W\<close> by auto 
   ultimately show "\<exists>U V. openin (top_of_set (S \<times> T)) U \<and> R V \<and> (x,y) \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W"
     using opeS opeT by auto 
 qed
 
 
 proposition homeomorphism_locally_imp:
   fixes S :: "'a::metric_space set" and T :: "'b::t2_space set"
   assumes S: "locally P S" and hom: "homeomorphism S T f g"
       and Q: "\<And>S S'. \<lbrakk>P S; homeomorphism S S' f g\<rbrakk> \<Longrightarrow> Q S'"
     shows "locally Q T"
 proof (clarsimp simp: locally_def)
   fix W y
   assume "y \<in> W" and "openin (top_of_set T) W"
   then obtain A where T: "open A" "W = T \<inter> A"
     by (force simp: openin_open)
   then have "W \<subseteq> T" by auto
   have f: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "f ` S = T" "continuous_on S f"
    and g: "\<And>y. y \<in> T \<Longrightarrow> f(g y) = y" "g ` T = S" "continuous_on T g"
     using hom by (auto simp: homeomorphism_def)
   have gw: "g ` W = S \<inter> f -` W"
     using \<open>W \<subseteq> T\<close> g by force
   have "openin (top_of_set S) (g ` W)"
     using \<open>openin (top_of_set T) W\<close> continuous_on_open f gw by auto
   then obtain U V
     where osu: "openin (top_of_set S) U" and uv: "P V" "g y \<in> U" "U \<subseteq> V" "V \<subseteq> g ` W"
     by (metis S \<open>y \<in> W\<close> image_eqI locallyE)
   have "V \<subseteq> S" using uv by (simp add: gw)
   have fv: "f ` V = T \<inter> {x. g x \<in> V}"
     using \<open>f ` S = T\<close> f \<open>V \<subseteq> S\<close> by auto
   have contvf: "continuous_on V f"
     using \<open>V \<subseteq> S\<close> continuous_on_subset f(3) by blast
   have "openin (top_of_set (g ` T)) U"
     using \<open>g ` T = S\<close> by (simp add: osu)
   then have "openin (top_of_set T) (T \<inter> g -` U)"
     using \<open>continuous_on T g\<close> continuous_on_open [THEN iffD1] by blast
   moreover have "\<exists>V. Q V \<and> y \<in> (T \<inter> g -` U) \<and> (T \<inter> g -` U) \<subseteq> V \<and> V \<subseteq> W"
   proof (intro exI conjI)
     show "f ` V \<subseteq> W"
       using uv using Int_lower2 gw image_subsetI mem_Collect_eq subset_iff by auto
     then have contvg: "continuous_on (f ` V) g"
       using \<open>W \<subseteq> T\<close> continuous_on_subset [OF g(3)] by blast
     have "V \<subseteq> g ` f ` V"
       by (metis \<open>V \<subseteq> S\<close> hom homeomorphism_def homeomorphism_of_subsets order_refl)
     then have homv: "homeomorphism V (f ` V) f g"
       using \<open>V \<subseteq> S\<close> f by (auto simp: homeomorphism_def contvf contvg)
     show "Q (f ` V)"
       using Q homv \<open>P V\<close> by blast
     show "y \<in> T \<inter> g -` U"
       using T(2) \<open>y \<in> W\<close> \<open>g y \<in> U\<close> by blast
     show "T \<inter> g -` U \<subseteq> f ` V"
       using g(1) image_iff uv(3) by fastforce
   qed
   ultimately show "\<exists>U. openin (top_of_set T) U \<and> (\<exists>v. Q v \<and> y \<in> U \<and> U \<subseteq> v \<and> v \<subseteq> W)"
     by meson
 qed
 
 lemma homeomorphism_locally:
   fixes f:: "'a::metric_space \<Rightarrow> 'b::metric_space"
   assumes "homeomorphism S T f g"
       and "\<And>S T. homeomorphism S T f g \<Longrightarrow> (P S \<longleftrightarrow> Q T)"
     shows "locally P S \<longleftrightarrow> locally Q T"
   by (smt (verit) assms homeomorphism_locally_imp homeomorphism_symD)
 
 lemma homeomorphic_locally:
   fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
   assumes hom: "S homeomorphic T"
           and iff: "\<And>X Y. X homeomorphic Y \<Longrightarrow> (P X \<longleftrightarrow> Q Y)"
     shows "locally P S \<longleftrightarrow> locally Q T"
   by (smt (verit, ccfv_SIG) hom homeomorphic_def homeomorphism_locally homeomorphism_locally_imp iff)
 
 lemma homeomorphic_local_compactness:
   fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
   shows "S homeomorphic T \<Longrightarrow> locally compact S \<longleftrightarrow> locally compact T"
   by (simp add: homeomorphic_compactness homeomorphic_locally)
 
 lemma locally_translation:
   fixes P :: "'a :: real_normed_vector set \<Rightarrow> bool"
   shows "(\<And>S. P ((+) a ` S) = P S) \<Longrightarrow> locally P ((+) a ` S) = locally P S"
   using homeomorphism_locally [OF homeomorphism_translation]
   by (metis (full_types) homeomorphism_image2)
 
 lemma locally_injective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes f: "linear f" "inj f" and iff: "\<And>S. P (f ` S) \<longleftrightarrow> Q S"
   shows "locally P (f ` S) \<longleftrightarrow> locally Q S"
   by (smt (verit) f homeomorphism_image2 homeomorphism_locally iff linear_homeomorphism_image)
 
 lemma locally_open_map_image:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes P: "locally P S"
       and f: "continuous_on S f"
       and oo: "\<And>T. openin (top_of_set S) T \<Longrightarrow> openin (top_of_set (f ` S)) (f ` T)"
       and Q: "\<And>T. \<lbrakk>T \<subseteq> S; P T\<rbrakk> \<Longrightarrow> Q(f ` T)"
     shows "locally Q (f ` S)"
 proof (clarsimp simp: locally_def)
   fix W y
   assume oiw: "openin (top_of_set (f ` S)) W" and "y \<in> W"
   then have "W \<subseteq> f ` S" by (simp add: openin_euclidean_subtopology_iff)
   have oivf: "openin (top_of_set S) (S \<inter> f -` W)"
     by (rule continuous_on_open [THEN iffD1, rule_format, OF f oiw])
   then obtain x where "x \<in> S" "f x = y"
     using \<open>W \<subseteq> f ` S\<close> \<open>y \<in> W\<close> by blast
   then obtain U V
     where "openin (top_of_set S) U" "P V" "x \<in> U" "U \<subseteq> V" "V \<subseteq> S \<inter> f -` W"
     by (metis IntI P \<open>y \<in> W\<close> locallyE oivf vimageI)
   then have "openin (top_of_set (f ` S)) (f ` U)"
     by (simp add: oo)
   then show "\<exists>X. openin (top_of_set (f ` S)) X \<and> (\<exists>Y. Q Y \<and> y \<in> X \<and> X \<subseteq> Y \<and> Y \<subseteq> W)"
     using Q \<open>P V\<close> \<open>U \<subseteq> V\<close> \<open>V \<subseteq> S \<inter> f -` W\<close> \<open>f x = y\<close> \<open>x \<in> U\<close> by blast
 qed
 
 
 subsection\<open>An induction principle for connected sets\<close>
 
 proposition connected_induction:
   assumes "connected S"
       and opD: "\<And>T a. \<lbrakk>openin (top_of_set S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<and> Q x \<longrightarrow> Q y)"
       and etc: "a \<in> S" "b \<in> S" "P a" "P b" "Q a"
     shows "Q b"
 proof -
   let ?A = "{b. \<exists>T. openin (top_of_set S) T \<and> b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> Q x)}"
   let ?B = "{b. \<exists>T. openin (top_of_set S) T \<and> b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> \<not> Q x)}"
   have "?A \<inter> ?B = {}"
     by (clarsimp simp: set_eq_iff) (metis (no_types, opaque_lifting) Int_iff opD openin_Int)
   moreover have "S \<subseteq> ?A \<union> ?B"
     by clarsimp (meson opI)
   moreover have "openin (top_of_set S) ?A"
     by (subst openin_subopen, blast)
   moreover have "openin (top_of_set S) ?B"
     by (subst openin_subopen, blast)
   ultimately have "?A = {} \<or> ?B = {}"
     by (metis (no_types, lifting) \<open>connected S\<close> connected_openin)
   then show ?thesis
     by clarsimp (meson opI etc)
 qed
 
 lemma connected_equivalence_relation_gen:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S" "P a" "P b"
       and trans: "\<And>x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z"
       and opD: "\<And>T a. \<lbrakk>openin (top_of_set S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<longrightarrow> R x y)"
     shows "R a b"
 proof -
   have "\<And>a b c. \<lbrakk>a \<in> S; P a; b \<in> S; c \<in> S; P b; P c; R a b\<rbrakk> \<Longrightarrow> R a c"
     apply (rule connected_induction [OF \<open>connected S\<close> opD], simp_all)
     by (meson trans opI)
   then show ?thesis by (metis etc opI)
 qed
 
 lemma connected_induction_simple:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S" "P a"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<longrightarrow> P y)"
     shows "P b"
   by (rule connected_induction [OF \<open>connected S\<close> _, where P = "\<lambda>x. True"])
      (use opI etc in auto)
 
 lemma connected_equivalence_relation:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S"
       and sym: "\<And>x y. \<lbrakk>R x y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> R y x"
       and trans: "\<And>x y z. \<lbrakk>R x y; R y z; x \<in> S; y \<in> S; z \<in> S\<rbrakk> \<Longrightarrow> R x z"
       and opI: "\<And>a. a \<in> S \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. R a x)"
     shows "R a b"
 proof -
   have "\<And>a b c. \<lbrakk>a \<in> S; b \<in> S; c \<in> S; R a b\<rbrakk> \<Longrightarrow> R a c"
     by (smt (verit, ccfv_threshold) connected_induction_simple [OF \<open>connected S\<close>] 
             assms openin_imp_subset subset_eq)
   then show ?thesis by (metis etc opI)
 qed
 
 lemma locally_constant_imp_constant:
   assumes "connected S"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. f x = f a)"
     shows "f constant_on S"
 proof -
   have "\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f x = f y"
     apply (rule connected_equivalence_relation [OF \<open>connected S\<close>], simp_all)
     by (metis opI)
   then show ?thesis
     by (metis constant_on_def)
 qed
 
 lemma locally_constant:
   assumes "connected S"
   shows "locally (\<lambda>U. f constant_on U) S \<longleftrightarrow> f constant_on S" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (smt (verit, del_insts) assms constant_on_def locally_constant_imp_constant locally_def openin_subtopology_self subset_iff)
 next
   assume ?rhs then show ?lhs
     by (metis constant_on_subset locallyI openin_imp_subset order_refl)
 qed
 
 
 subsection\<open>Basic properties of local compactness\<close>
 
 proposition locally_compact:
   fixes S :: "'a :: metric_space set"
   shows
     "locally compact S \<longleftrightarrow>
      (\<forall>x \<in> S. \<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> S \<and>
                     openin (top_of_set S) u \<and> compact v)"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (meson locallyE openin_subtopology_self)
 next
   assume r [rule_format]: ?rhs
   have *: "\<exists>u v.
               openin (top_of_set S) u \<and>
               compact v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> S \<inter> T"
           if "open T" "x \<in> S" "x \<in> T" for x T
   proof -
     obtain U V where uv: "x \<in> U" "U \<subseteq> V" "V \<subseteq> S" "compact V" "openin (top_of_set S) U"
       using r [OF \<open>x \<in> S\<close>] by auto
     obtain e where "e>0" and e: "cball x e \<subseteq> T"
       using open_contains_cball \<open>open T\<close> \<open>x \<in> T\<close> by blast
     show ?thesis
       apply (rule_tac x="(S \<inter> ball x e) \<inter> U" in exI)
       apply (rule_tac x="cball x e \<inter> V" in exI)
       using that \<open>e > 0\<close> e uv
       apply auto
       done
   qed
   show ?lhs
     by (rule locallyI) (metis "*" Int_iff openin_open)
 qed
 
 lemma locally_compactE:
   fixes S :: "'a :: metric_space set"
   assumes "locally compact S"
   obtains u v where "\<And>x. x \<in> S \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> S \<and>
                              openin (top_of_set S) (u x) \<and> compact (v x)"
   using assms unfolding locally_compact by metis
 
 lemma locally_compact_alt:
   fixes S :: "'a :: heine_borel set"
   shows "locally compact S \<longleftrightarrow>
          (\<forall>x \<in> S. \<exists>U. x \<in> U \<and>
                     openin (top_of_set S) U \<and> compact(closure U) \<and> closure U \<subseteq> S)"
   by (smt (verit, ccfv_threshold) bounded_subset closure_closed closure_mono closure_subset 
       compact_closure compact_imp_closed order.trans locally_compact)
 
 lemma locally_compact_Int_cball:
   fixes S :: "'a :: heine_borel set"
   shows "locally compact S \<longleftrightarrow> (\<forall>x \<in> S. \<exists>e. 0 < e \<and> closed(cball x e \<inter> S))"
         (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then have "\<And>x U V e. \<lbrakk>U \<subseteq> V; V \<subseteq> S; compact V; 0 < e; cball x e \<inter> S \<subseteq> U\<rbrakk>
        \<Longrightarrow> closed (cball x e \<inter> S)"
     by (metis compact_Int compact_cball compact_imp_closed inf.absorb_iff2 inf.assoc inf.orderE)
   with L show ?rhs
     by (meson locally_compactE openin_contains_cball)
 next
   assume R: ?rhs
   show ?lhs unfolding locally_compact 
   proof
     fix x
     assume "x \<in> S"
     then obtain e where "e>0" and "compact (cball x e \<inter> S)"
       by (metis Int_commute compact_Int_closed compact_cball inf.right_idem R)
     moreover have "\<forall>y\<in>ball x e \<inter> S. \<exists>\<epsilon>>0. cball y \<epsilon> \<inter> S \<subseteq> ball x e"
       by (meson Elementary_Metric_Spaces.open_ball IntD1 le_infI1 open_contains_cball_eq)
     moreover have "openin (top_of_set S) (ball x e \<inter> S)"
       by (simp add: inf_commute openin_open_Int)
     ultimately show "\<exists>U V. x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and> openin (top_of_set S) U \<and> compact V"
       by (metis Int_iff \<open>0 < e\<close> \<open>x \<in> S\<close> ball_subset_cball centre_in_ball inf_commute inf_le1 inf_mono order_refl)
   qed
 qed
 
 lemma locally_compact_compact:
   fixes S :: "'a :: heine_borel set"
   shows "locally compact S \<longleftrightarrow>
          (\<forall>K. K \<subseteq> S \<and> compact K
               \<longrightarrow> (\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and>
                          openin (top_of_set S) U \<and> compact V))"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain u v where
     uv: "\<And>x. x \<in> S \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> S \<and>
                              openin (top_of_set S) (u x) \<and> compact (v x)"
     by (metis locally_compactE)
   have *: "\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and> openin (top_of_set S) U \<and> compact V"
           if "K \<subseteq> S" "compact K" for K
   proof -
     have "\<And>C. (\<forall>c\<in>C. openin (top_of_set K) c) \<and> K \<subseteq> \<Union>C \<Longrightarrow>
                     \<exists>D\<subseteq>C. finite D \<and> K \<subseteq> \<Union>D"
       using that by (simp add: compact_eq_openin_cover)
     moreover have "\<forall>c \<in> (\<lambda>x. K \<inter> u x) ` K. openin (top_of_set K) c"
       using that by clarify (metis subsetD inf.absorb_iff2 openin_subset openin_subtopology_Int_subset topspace_euclidean_subtopology uv)
     moreover have "K \<subseteq> \<Union>((\<lambda>x. K \<inter> u x) ` K)"
       using that by clarsimp (meson subsetCE uv)
     ultimately obtain D where "D \<subseteq> (\<lambda>x. K \<inter> u x) ` K" "finite D" "K \<subseteq> \<Union>D"
       by metis
     then obtain T where T: "T \<subseteq> K" "finite T" "K \<subseteq> \<Union>((\<lambda>x. K \<inter> u x) ` T)"
       by (metis finite_subset_image)
     have Tuv: "\<Union>(u ` T) \<subseteq> \<Union>(v ` T)"
       using T that by (force dest!: uv)
     moreover
     have "openin (top_of_set S) (\<Union> (u ` T))"
       using T that uv by fastforce
     moreover
     obtain "compact (\<Union> (v ` T))" "\<Union> (v ` T) \<subseteq> S"
       by (metis T UN_subset_iff \<open>K \<subseteq> S\<close> compact_UN subset_iff uv)
     ultimately show ?thesis
       using T by auto 
   qed
   show ?rhs
     by (blast intro: *)
 next
   assume ?rhs
   then show ?lhs
     apply (clarsimp simp: locally_compact)
     apply (drule_tac x="{x}" in spec, simp)
     done
 qed
 
 lemma open_imp_locally_compact:
   fixes S :: "'a :: heine_borel set"
   assumes "open S"
     shows "locally compact S"
 proof -
   have *: "\<exists>U V. x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and> openin (top_of_set S) U \<and> compact V"
           if "x \<in> S" for x
   proof -
     obtain e where "e>0" and e: "cball x e \<subseteq> S"
       using open_contains_cball assms \<open>x \<in> S\<close> by blast
     have ope: "openin (top_of_set S) (ball x e)"
       by (meson e open_ball ball_subset_cball dual_order.trans open_subset)
     show ?thesis
       by (meson \<open>0 < e\<close> ball_subset_cball centre_in_ball compact_cball e ope)
   qed
   show ?thesis
     unfolding locally_compact by (blast intro: *)
 qed
 
 lemma closed_imp_locally_compact:
   fixes S :: "'a :: heine_borel set"
   assumes "closed S"
     shows "locally compact S"
 proof -
   have *: "\<exists>U V. x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and> openin (top_of_set S) U \<and> compact V"
           if "x \<in> S" for x
     apply (rule_tac x = "S \<inter> ball x 1" in exI, rule_tac x = "S \<inter> cball x 1" in exI)
     using \<open>x \<in> S\<close> assms by auto
   show ?thesis
     unfolding locally_compact by (blast intro: *)
 qed
 
 lemma locally_compact_UNIV: "locally compact (UNIV :: 'a :: heine_borel set)"
   by (simp add: closed_imp_locally_compact)
 
 lemma locally_compact_Int:
   fixes S :: "'a :: t2_space set"
   shows "\<lbrakk>locally compact S; locally compact T\<rbrakk> \<Longrightarrow> locally compact (S \<inter> T)"
   by (simp add: compact_Int locally_Int)
 
 lemma locally_compact_closedin:
   fixes S :: "'a :: heine_borel set"
   shows "\<lbrakk>closedin (top_of_set S) T; locally compact S\<rbrakk>
         \<Longrightarrow> locally compact T"
   unfolding closedin_closed
   using closed_imp_locally_compact locally_compact_Int by blast
 
 lemma locally_compact_delete:
      fixes S :: "'a :: t1_space set"
      shows "locally compact S \<Longrightarrow> locally compact (S - {a})"
   by (auto simp: openin_delete locally_open_subset)
 
 lemma locally_closed:
   fixes S :: "'a :: heine_borel set"
   shows "locally closed S \<longleftrightarrow> locally compact S"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding locally_def
     apply (elim all_forward imp_forward asm_rl exE)
     apply (rename_tac U V)
     apply (rule_tac x = "U \<inter> ball x 1" in exI)
     apply (rule_tac x = "V \<inter> cball x 1" in exI)
     apply (force intro: openin_trans)
     done
 next
   assume ?rhs then show ?lhs
     using compact_eq_bounded_closed locally_mono by blast
 qed
 
 lemma locally_compact_openin_Un:
   fixes S :: "'a::euclidean_space set"
   assumes LCS: "locally compact S" and LCT: "locally compact T"
       and opS: "openin (top_of_set (S \<union> T)) S"
       and opT: "openin (top_of_set (S \<union> T)) T"
     shows "locally compact (S \<union> T)"
 proof -
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> S"
       by (meson \<open>x \<in> S\<close> opS openin_contains_cball)
     then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> S"
       by force
     ultimately have "closed (cball x (min e1 e2) \<inter> (S \<union> T))"
       by (metis (no_types, lifting) cball_min_Int closed_Int closed_cball inf_assoc inf_commute)
     then show ?thesis
       by (metis \<open>0 < e1\<close> \<open>0 < e2\<close> min_def)
   qed
   moreover have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> T"
       by (meson \<open>x \<in> T\<close> opT openin_contains_cball)
     then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> T"
       by force
     moreover have "closed (cball x e1 \<inter> (cball x e2 \<inter> T))"
       by (metis closed_Int closed_cball e1 inf_left_commute)
     ultimately show ?thesis
       by (rule_tac x="min e1 e2" in exI) (simp add: \<open>0 < e2\<close> cball_min_Int inf_assoc)
   qed
   ultimately show ?thesis
     by (force simp: locally_compact_Int_cball)
 qed
 
 lemma locally_compact_closedin_Un:
   fixes S :: "'a::euclidean_space set"
   assumes LCS: "locally compact S" and LCT:"locally compact T"
       and clS: "closedin (top_of_set (S \<union> T)) S"
       and clT: "closedin (top_of_set (S \<union> T)) T"
     shows "locally compact (S \<union> T)"
 proof -
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2 > 0" and e2: "closed (cball x e2 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     moreover have "closed (cball x (min e1 e2) \<inter> (S \<union> T))"
       by (smt (verit) Int_Un_distrib2 Int_commute cball_min_Int closed_Int closed_Un closed_cball e1 e2 inf_left_commute)
     ultimately show ?thesis
       by (rule_tac x="min e1 e2" in exI) linarith
   qed
   moreover
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<in> S" "x \<notin> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S - T"
       using clT x by (fastforce simp: openin_contains_cball closedin_def)
     then have "closed (cball x e2 \<inter> T)"
     proof -
       have "{} = T - (T - cball x e2)"
         using Diff_subset Int_Diff \<open>cball x e2 \<inter> (S \<union> T) \<subseteq> S - T\<close> by auto
       then show ?thesis
         by (simp add: Diff_Diff_Int inf_commute)
     qed
     with e1 have "closed ((cball x e1 \<inter> cball x e2) \<inter> (S \<union> T))"
       apply (simp add: inf_commute inf_sup_distrib2)
       by (metis closed_Int closed_Un closed_cball inf_assoc inf_left_commute)
     then have "closed (cball x (min e1 e2) \<inter> (S \<union> T))"
       by (simp add: cball_min_Int inf_commute)
     ultimately show ?thesis
       using \<open>0 < e2\<close> by (rule_tac x="min e1 e2" in exI) linarith 
   qed
   moreover
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<notin> S" "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S \<union> T - S"
       using clS x by (fastforce simp: openin_contains_cball closedin_def)
     then have "closed (cball x e2 \<inter> S)"
       by (metis Diff_disjoint Int_empty_right closed_empty inf.left_commute inf.orderE inf_sup_absorb)
     with e1 have "closed ((cball x e1 \<inter> cball x e2) \<inter> (S \<union> T))"
       apply (simp add: inf_commute inf_sup_distrib2)
       by (metis closed_Int closed_Un closed_cball inf_assoc inf_left_commute)
     then have "closed (cball x (min e1 e2) \<inter> (S \<union> T))"
       by (auto simp: cball_min_Int)
     ultimately show ?thesis
       using \<open>0 < e2\<close> by (rule_tac x="min e1 e2" in exI) linarith
   qed
   ultimately show ?thesis
     by (auto simp: locally_compact_Int_cball)
 qed
 
 lemma locally_compact_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   shows "\<lbrakk>locally compact S; locally compact T\<rbrakk> \<Longrightarrow> locally compact (S \<times> T)"
   by (auto simp: compact_Times locally_Times)
 
 lemma locally_compact_compact_subopen:
   fixes S :: "'a :: heine_borel set"
   shows
    "locally compact S \<longleftrightarrow>
     (\<forall>K T. K \<subseteq> S \<and> compact K \<and> open T \<and> K \<subseteq> T
           \<longrightarrow> (\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
                      openin (top_of_set S) U \<and> compact V))"
    (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof clarify
     fix K :: "'a set" and T :: "'a set"
     assume "K \<subseteq> S" and "compact K" and "open T" and "K \<subseteq> T"
     obtain U V where "K \<subseteq> U" "U \<subseteq> V" "V \<subseteq> S" "compact V"
                  and ope: "openin (top_of_set S) U"
       using L unfolding locally_compact_compact by (meson \<open>K \<subseteq> S\<close> \<open>compact K\<close>)
     show "\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
                 openin (top_of_set S) U \<and> compact V"
     proof (intro exI conjI)
       show "K \<subseteq> U \<inter> T"
         by (simp add: \<open>K \<subseteq> T\<close> \<open>K \<subseteq> U\<close>)
       show "U \<inter> T \<subseteq> closure(U \<inter> T)"
         by (rule closure_subset)
       show "closure (U \<inter> T) \<subseteq> S"
         by (metis \<open>U \<subseteq> V\<close> \<open>V \<subseteq> S\<close> \<open>compact V\<close> closure_closed closure_mono compact_imp_closed inf.cobounded1 subset_trans)
       show "openin (top_of_set S) (U \<inter> T)"
         by (simp add: \<open>open T\<close> ope openin_Int_open)
       show "compact (closure (U \<inter> T))"
         by (meson Int_lower1 \<open>U \<subseteq> V\<close> \<open>compact V\<close> bounded_subset compact_closure compact_eq_bounded_closed)
     qed auto
   qed
 next
   assume ?rhs then show ?lhs
     unfolding locally_compact_compact
     by (metis open_openin openin_topspace subtopology_superset top.extremum topspace_euclidean_subtopology)
 qed
 
 
 subsection\<open>Sura-Bura's results about compact components of sets\<close>
 
 proposition Sura_Bura_compact:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and C: "C \<in> components S"
   shows "C = \<Inter>{T. C \<subseteq> T \<and> openin (top_of_set S) T \<and>
                            closedin (top_of_set S) T}"
          (is "C = \<Inter>?\<T>")
 proof
   obtain x where x: "C = connected_component_set S x" and "x \<in> S"
     using C by (auto simp: components_def)
   have "C \<subseteq> S"
     by (simp add: C in_components_subset)
   have "\<Inter>?\<T> \<subseteq> connected_component_set S x"
   proof (rule connected_component_maximal)
     have "x \<in> C"
       by (simp add: \<open>x \<in> S\<close> x)
     then show "x \<in> \<Inter>?\<T>"
       by blast
     have clo: "closed (\<Inter>?\<T>)"
       by (simp add: \<open>compact S\<close> closed_Inter closedin_compact_eq compact_imp_closed)
     have False
       if K1: "closedin (top_of_set (\<Inter>?\<T>)) K1" and
          K2: "closedin (top_of_set (\<Inter>?\<T>)) K2" and
          K12_Int: "K1 \<inter> K2 = {}" and K12_Un: "K1 \<union> K2 = \<Inter>?\<T>" and "K1 \<noteq> {}" "K2 \<noteq> {}"
        for K1 K2
     proof -
       have "closed K1" "closed K2"
         using closedin_closed_trans clo K1 K2 by blast+
       then obtain V1 V2 where "open V1" "open V2" "K1 \<subseteq> V1" "K2 \<subseteq> V2" and V12: "V1 \<inter> V2 = {}"
         using separation_normal \<open>K1 \<inter> K2 = {}\<close> by metis
       have SV12_ne: "(S - (V1 \<union> V2)) \<inter> (\<Inter>?\<T>) \<noteq> {}"
       proof (rule compact_imp_fip)
         show "compact (S - (V1 \<union> V2))"
           by (simp add: \<open>open V1\<close> \<open>open V2\<close> \<open>compact S\<close> compact_diff open_Un)
         show clo\<T>: "closed T" if "T \<in> ?\<T>" for T
           using that \<open>compact S\<close>
           by (force intro: closedin_closed_trans simp add: compact_imp_closed)
         show "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> \<noteq> {}" if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
         proof
           assume djo: "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> = {}"
           obtain D where opeD: "openin (top_of_set S) D"
                    and cloD: "closedin (top_of_set S) D"
                    and "C \<subseteq> D" and DV12: "D \<subseteq> V1 \<union> V2"
           proof (cases "\<F> = {}")
             case True
             with \<open>C \<subseteq> S\<close> djo that show ?thesis
               by force
           next
             case False show ?thesis
             proof
               show ope: "openin (top_of_set S) (\<Inter>\<F>)"
                 using openin_Inter \<open>finite \<F>\<close> False \<F> by blast
               then show "closedin (top_of_set S) (\<Inter>\<F>)"
                 by (meson clo\<T> \<F> closed_Inter closed_subset openin_imp_subset subset_eq)
               show "C \<subseteq> \<Inter>\<F>"
                 using \<F> by auto
               show "\<Inter>\<F> \<subseteq> V1 \<union> V2"
                 using ope djo openin_imp_subset by fastforce
             qed
           qed
           have "connected C"
             by (simp add: x)
           have "closed D"
             using \<open>compact S\<close> cloD closedin_closed_trans compact_imp_closed by blast
           have cloV1: "closedin (top_of_set D) (D \<inter> closure V1)"
             and cloV2: "closedin (top_of_set D) (D \<inter> closure V2)"
             by (simp_all add: closedin_closed_Int)
           moreover have "D \<inter> closure V1 = D \<inter> V1" "D \<inter> closure V2 = D \<inter> V2"
             using \<open>D \<subseteq> V1 \<union> V2\<close> \<open>open V1\<close> \<open>open V2\<close> V12
             by (auto simp: closure_subset [THEN subsetD] closure_iff_nhds_not_empty, blast+)
           ultimately have cloDV1: "closedin (top_of_set D) (D \<inter> V1)"
                       and cloDV2:  "closedin (top_of_set D) (D \<inter> V2)"
             by metis+
           then obtain U1 U2 where "closed U1" "closed U2"
                and D1: "D \<inter> V1 = D \<inter> U1" and D2: "D \<inter> V2 = D \<inter> U2"
             by (auto simp: closedin_closed)
           have "D \<inter> U1 \<inter> C \<noteq> {}"
           proof
             assume "D \<inter> U1 \<inter> C = {}"
             then have *: "C \<subseteq> D \<inter> V2"
               using D1 DV12 \<open>C \<subseteq> D\<close> by auto
             have 1: "openin (top_of_set S) (D \<inter> V2)"
               by (simp add: \<open>open V2\<close> opeD openin_Int_open)
             have 2: "closedin (top_of_set S) (D \<inter> V2)"
               using cloD cloDV2 closedin_trans by blast
             have "\<Inter> ?\<T> \<subseteq> D \<inter> V2"
               by (rule Inter_lower) (use * 1 2 in simp)
             then show False
               using K1 V12 \<open>K1 \<noteq> {}\<close> \<open>K1 \<subseteq> V1\<close> closedin_imp_subset by blast
           qed
           moreover have "D \<inter> U2 \<inter> C \<noteq> {}"
           proof
             assume "D \<inter> U2 \<inter> C = {}"
             then have *: "C \<subseteq> D \<inter> V1"
               using D2 DV12 \<open>C \<subseteq> D\<close> by auto
             have 1: "openin (top_of_set S) (D \<inter> V1)"
               by (simp add: \<open>open V1\<close> opeD openin_Int_open)
             have 2: "closedin (top_of_set S) (D \<inter> V1)"
               using cloD cloDV1 closedin_trans by blast
             have "\<Inter>?\<T> \<subseteq> D \<inter> V1"
               by (rule Inter_lower) (use * 1 2 in simp)
             then show False
               using K2 V12 \<open>K2 \<noteq> {}\<close> \<open>K2 \<subseteq> V2\<close> closedin_imp_subset by blast
           qed
           ultimately show False
             using \<open>connected C\<close> [unfolded connected_closed, simplified, rule_format, of concl: "D \<inter> U1" "D \<inter> U2"]
             using \<open>C \<subseteq> D\<close> D1 D2 V12 DV12 \<open>closed U1\<close> \<open>closed U2\<close> \<open>closed D\<close>
             by blast
         qed
       qed
       show False
         by (metis (full_types) DiffE UnE Un_upper2 SV12_ne \<open>K1 \<subseteq> V1\<close> \<open>K2 \<subseteq> V2\<close> disjoint_iff_not_equal subsetCE sup_ge1 K12_Un)
     qed
     then show "connected (\<Inter>?\<T>)"
       by (auto simp: connected_closedin_eq)
     show "\<Inter>?\<T> \<subseteq> S"
       by (fastforce simp: C in_components_subset)
   qed
   with x show "\<Inter>?\<T> \<subseteq> C" by simp
 qed auto
 
 
 corollary Sura_Bura_clopen_subset:
   fixes S :: "'a::euclidean_space set"
   assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
       and U: "open U" "C \<subseteq> U"
   obtains K where "openin (top_of_set S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
 proof (rule ccontr)
   assume "\<not> thesis"
   with that have neg: "\<nexists>K. openin (top_of_set S) K \<and> compact K \<and> C \<subseteq> K \<and> K \<subseteq> U"
     by metis
   obtain V K where "C \<subseteq> V" "V \<subseteq> U" "V \<subseteq> K" "K \<subseteq> S" "compact K"
                and opeSV: "openin (top_of_set S) V"
     using S U \<open>compact C\<close> by (meson C in_components_subset locally_compact_compact_subopen)
   let ?\<T> = "{T. C \<subseteq> T \<and> openin (top_of_set K) T \<and> compact T \<and> T \<subseteq> K}"
   have CK: "C \<in> components K"
     by (meson C \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> components_intermediate_subset subset_trans)
   with \<open>compact K\<close>
   have "C = \<Inter>{T. C \<subseteq> T \<and> openin (top_of_set K) T \<and> closedin (top_of_set K) T}"
     by (simp add: Sura_Bura_compact)
   then have Ceq: "C = \<Inter>?\<T>"
     by (simp add: closedin_compact_eq \<open>compact K\<close>)
   obtain W where "open W" and W: "V = S \<inter> W"
     using opeSV by (auto simp: openin_open)
   have "-(U \<inter> W) \<inter> \<Inter>?\<T> \<noteq> {}"
   proof (rule closed_imp_fip_compact)
     show "- (U \<inter> W) \<inter> \<Inter>\<F> \<noteq> {}"
       if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
     proof (cases "\<F> = {}")
       case True
       have False if "U = UNIV" "W = UNIV"
       proof -
         have "V = S"
           by (simp add: W \<open>W = UNIV\<close>)
         with neg show False
           using \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> \<open>V \<subseteq> U\<close> \<open>compact K\<close> by auto
       qed
       with True show ?thesis
         by auto
     next
       case False
       show ?thesis
       proof
         assume "- (U \<inter> W) \<inter> \<Inter>\<F> = {}"
         then have FUW: "\<Inter>\<F> \<subseteq> U \<inter> W"
           by blast
         have "C \<subseteq> \<Inter>\<F>"
           using \<F> by auto
         moreover have "compact (\<Inter>\<F>)"
           by (metis (no_types, lifting) compact_Inter False mem_Collect_eq subsetCE \<F>)
         moreover have "\<Inter>\<F> \<subseteq> K"
           using False that(2) by fastforce
         moreover have opeKF: "openin (top_of_set K) (\<Inter>\<F>)"
           using False \<F> \<open>finite \<F>\<close> by blast
         then have opeVF: "openin (top_of_set V) (\<Inter>\<F>)"
           using W \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> opeKF \<open>\<Inter>\<F> \<subseteq> K\<close> FUW openin_subset_trans by fastforce
         then have "openin (top_of_set S) (\<Inter>\<F>)"
           by (metis opeSV openin_trans)
         moreover have "\<Inter>\<F> \<subseteq> U"
           by (meson \<open>V \<subseteq> U\<close> opeVF dual_order.trans openin_imp_subset)
         ultimately show False
           using neg by blast
       qed
     qed
   qed (use \<open>open W\<close> \<open>open U\<close> in auto)
   with W Ceq \<open>C \<subseteq> V\<close> \<open>C \<subseteq> U\<close> show False
     by auto
 qed
 
 
 corollary Sura_Bura_clopen_subset_alt:
   fixes S :: "'a::euclidean_space set"
   assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
       and opeSU: "openin (top_of_set S) U" and "C \<subseteq> U"
   obtains K where "openin (top_of_set S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
 proof -
   obtain V where "open V" "U = S \<inter> V"
     using opeSU by (auto simp: openin_open)
   with \<open>C \<subseteq> U\<close> have "C \<subseteq> V"
     by auto
   then show ?thesis
     using Sura_Bura_clopen_subset [OF S C \<open>compact C\<close> \<open>open V\<close>]
     by (metis \<open>U = S \<inter> V\<close> inf.bounded_iff openin_imp_subset that)
 qed
 
 corollary Sura_Bura:
   fixes S :: "'a::euclidean_space set"
   assumes "locally compact S" "C \<in> components S" "compact C"
   shows "C = \<Inter> {K. C \<subseteq> K \<and> compact K \<and> openin (top_of_set S) K}"
          (is "C = ?rhs")
 proof
   show "?rhs \<subseteq> C"
   proof (clarsimp, rule ccontr)
     fix x
     assume *: "\<forall>X. C \<subseteq> X \<and> compact X \<and> openin (top_of_set S) X \<longrightarrow> x \<in> X"
       and "x \<notin> C"
     obtain U V where "open U" "open V" "{x} \<subseteq> U" "C \<subseteq> V" "U \<inter> V = {}"
       using separation_normal [of "{x}" C]
       by (metis Int_empty_left \<open>x \<notin> C\<close> \<open>compact C\<close> closed_empty closed_insert compact_imp_closed insert_disjoint(1))
     have "x \<notin> V"
       using \<open>U \<inter> V = {}\<close> \<open>{x} \<subseteq> U\<close> by blast
     then show False
       by (meson "*" Sura_Bura_clopen_subset \<open>C \<subseteq> V\<close> \<open>open V\<close> assms(1) assms(2) assms(3) subsetCE)
   qed
 qed blast
 
 
 subsection\<open>Special cases of local connectedness and path connectedness\<close>
 
 lemma locally_connected_1:
   assumes
     "\<And>V x. \<lbrakk>openin (top_of_set S) V; x \<in> V\<rbrakk> \<Longrightarrow> \<exists>U. openin (top_of_set S) U \<and> connected U \<and> x \<in> U \<and> U \<subseteq> V"
    shows "locally connected S"
   by (metis assms locally_def)
 
 lemma locally_connected_2:
   assumes "locally connected S"
           "openin (top_of_set S) t"
           "x \<in> t"
    shows "openin (top_of_set S) (connected_component_set t x)"
 proof -
   { fix y :: 'a
     let ?SS = "top_of_set S"
     assume 1: "openin ?SS t"
               "\<forall>w x. openin ?SS w \<and> x \<in> w \<longrightarrow> (\<exists>u. openin ?SS u \<and> (\<exists>v. connected v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w))"
     and "connected_component t x y"
     then have "y \<in> t" and y: "y \<in> connected_component_set t x"
       using connected_component_subset by blast+
     obtain F where
       "\<forall>x y. (\<exists>w. openin ?SS w \<and> (\<exists>u. connected u \<and> x \<in> w \<and> w \<subseteq> u \<and> u \<subseteq> y)) = (openin ?SS (F x y) \<and> (\<exists>u. connected u \<and> x \<in> F x y \<and> F x y \<subseteq> u \<and> u \<subseteq> y))"
       by moura
     then obtain G where
        "\<forall>a A. (\<exists>U. openin ?SS U \<and> (\<exists>V. connected V \<and> a \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> A)) = (openin ?SS (F a A) \<and> connected (G a A) \<and> a \<in> F a A \<and> F a A \<subseteq> G a A \<and> G a A \<subseteq> A)"
       by moura
     then have *: "openin ?SS (F y t) \<and> connected (G y t) \<and> y \<in> F y t \<and> F y t \<subseteq> G y t \<and> G y t \<subseteq> t"
       using 1 \<open>y \<in> t\<close> by presburger
     have "G y t \<subseteq> connected_component_set t y"
       by (metis (no_types) * connected_component_eq_self connected_component_mono contra_subsetD)
     then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> connected_component_set t x"
       by (metis (no_types) * connected_component_eq dual_order.trans y)
   }
   then show ?thesis
     using assms openin_subopen by (force simp: locally_def)
 qed
 
 lemma locally_connected_3:
   assumes "\<And>t x. \<lbrakk>openin (top_of_set S) t; x \<in> t\<rbrakk>
               \<Longrightarrow> openin (top_of_set S)
                           (connected_component_set t x)"
           "openin (top_of_set S) v" "x \<in> v"
    shows  "\<exists>u. openin (top_of_set S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v"
 using assms connected_component_subset by fastforce
 
 lemma locally_connected:
   "locally connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
           \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v))"
 by (metis locally_connected_1 locally_connected_2 locally_connected_3)
 
 lemma locally_connected_open_connected_component:
   "locally connected S \<longleftrightarrow>
    (\<forall>t x. openin (top_of_set S) t \<and> x \<in> t
           \<longrightarrow> openin (top_of_set S) (connected_component_set t x))"
 by (metis locally_connected_1 locally_connected_2 locally_connected_3)
 
 lemma locally_path_connected_1:
   assumes
     "\<And>v x. \<lbrakk>openin (top_of_set S) v; x \<in> v\<rbrakk>
               \<Longrightarrow> \<exists>u. openin (top_of_set S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
    shows "locally path_connected S"
   by (force simp: locally_def dest: assms)
 
 lemma locally_path_connected_2:
   assumes "locally path_connected S"
           "openin (top_of_set S) t"
           "x \<in> t"
    shows "openin (top_of_set S) (path_component_set t x)"
 proof -
   { fix y :: 'a
     let ?SS = "top_of_set S"
     assume 1: "openin ?SS t"
               "\<forall>w x. openin ?SS w \<and> x \<in> w \<longrightarrow> (\<exists>u. openin ?SS u \<and> (\<exists>v. path_connected v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w))"
     and "path_component t x y"
     then have "y \<in> t" and y: "y \<in> path_component_set t x"
       using path_component_mem(2) by blast+
     obtain F where
       "\<forall>x y. (\<exists>w. openin ?SS w \<and> (\<exists>u. path_connected u \<and> x \<in> w \<and> w \<subseteq> u \<and> u \<subseteq> y)) = (openin ?SS (F x y) \<and> (\<exists>u. path_connected u \<and> x \<in> F x y \<and> F x y \<subseteq> u \<and> u \<subseteq> y))"
       by moura
     then obtain G where
        "\<forall>a A. (\<exists>U. openin ?SS U \<and> (\<exists>V. path_connected V \<and> a \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> A)) = (openin ?SS (F a A) \<and> path_connected (G a A) \<and> a \<in> F a A \<and> F a A \<subseteq> G a A \<and> G a A \<subseteq> A)"
       by moura
     then have *: "openin ?SS (F y t) \<and> path_connected (G y t) \<and> y \<in> F y t \<and> F y t \<subseteq> G y t \<and> G y t \<subseteq> t"
       using 1 \<open>y \<in> t\<close> by presburger
     have "G y t \<subseteq> path_component_set t y"
       using * path_component_maximal rev_subsetD by blast
     then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> path_component_set t x"
       by (metis "*" \<open>G y t \<subseteq> path_component_set t y\<close> dual_order.trans path_component_eq y)
   }
   then show ?thesis
     using assms openin_subopen by (force simp: locally_def)
 qed
 
 lemma locally_path_connected_3:
   assumes "\<And>t x. \<lbrakk>openin (top_of_set S) t; x \<in> t\<rbrakk>
               \<Longrightarrow> openin (top_of_set S) (path_component_set t x)"
           "openin (top_of_set S) v" "x \<in> v"
    shows  "\<exists>u. openin (top_of_set S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
 proof -
   have "path_component v x x"
     by (meson assms(3) path_component_refl)
   then show ?thesis
     by (metis assms mem_Collect_eq path_component_subset path_connected_path_component)
 qed
 
 proposition locally_path_connected:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>V x. openin (top_of_set S) V \<and> x \<in> V
           \<longrightarrow> (\<exists>U. openin (top_of_set S) U \<and> path_connected U \<and> x \<in> U \<and> U \<subseteq> V))"
   by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
 
 proposition locally_path_connected_open_path_component:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>t x. openin (top_of_set S) t \<and> x \<in> t
           \<longrightarrow> openin (top_of_set S) (path_component_set t x))"
   by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
 
 lemma locally_connected_open_component:
   "locally connected S \<longleftrightarrow>
    (\<forall>t c. openin (top_of_set S) t \<and> c \<in> components t
           \<longrightarrow> openin (top_of_set S) c)"
 by (metis components_iff locally_connected_open_connected_component)
 
 proposition locally_connected_im_kleinen:
   "locally connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
        \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and>
                 x \<in> u \<and> u \<subseteq> v \<and>
                 (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> v \<and> x \<in> c \<and> y \<in> c))))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (fastforce simp: locally_connected)
 next
   assume ?rhs
   have *: "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> c"
        if "openin (top_of_set S) t" and c: "c \<in> components t" and "x \<in> c" for t c x
   proof -
     from that \<open>?rhs\<close> [rule_format, of t x]
     obtain u where u:
       "openin (top_of_set S) u \<and> x \<in> u \<and> u \<subseteq> t \<and>
        (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> t \<and> x \<in> c \<and> y \<in> c))"
       using in_components_subset by auto
     obtain F :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
       "\<forall>x y. (\<exists>z. z \<in> x \<and> y = connected_component_set x z) = (F x y \<in> x \<and> y = connected_component_set x (F x y))"
       by moura
     then have F: "F t c \<in> t \<and> c = connected_component_set t (F t c)"
       by (meson components_iff c)
     obtain G :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
         G: "\<forall>x y. (\<exists>z. z \<in> y \<and> z \<notin> x) = (G x y \<in> y \<and> G x y \<notin> x)"
       by moura
      have "G c u \<notin> u \<or> G c u \<in> c"
       using F by (metis (full_types) u connected_componentI connected_component_eq mem_Collect_eq that(3))
     then show ?thesis
       using G u by auto
   qed
   show ?lhs
     unfolding locally_connected_open_component by (meson "*" openin_subopen)
 qed
 
 proposition locally_path_connected_im_kleinen:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
        \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and>
                 x \<in> u \<and> u \<subseteq> v \<and>
                 (\<forall>y. y \<in> u \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> v \<and>
                                 pathstart p = x \<and> pathfinish p = y))))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply (simp add: locally_path_connected path_connected_def)
     apply (erule all_forward ex_forward imp_forward conjE | simp)+
     by (meson dual_order.trans)
 next
   assume ?rhs
   have *: "\<exists>T. openin (top_of_set S) T \<and>
                x \<in> T \<and> T \<subseteq> path_component_set u z"
        if "openin (top_of_set S) u" and "z \<in> u" and c: "path_component u z x" for u z x
   proof -
     have "x \<in> u"
       by (meson c path_component_mem(2))
     with that \<open>?rhs\<close> [rule_format, of u x]
     obtain U where U:
       "openin (top_of_set S) U \<and> x \<in> U \<and> U \<subseteq> u \<and>
        (\<forall>y. y \<in> U \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> u \<and> pathstart p = x \<and> pathfinish p = y))"
        by blast
     show ?thesis
       by (metis U c mem_Collect_eq path_component_def path_component_eq subsetI)
   qed
   show ?lhs
     unfolding locally_path_connected_open_path_component
     using "*" openin_subopen by fastforce
 qed
 
 lemma locally_path_connected_imp_locally_connected:
   "locally path_connected S \<Longrightarrow> locally connected S"
 using locally_mono path_connected_imp_connected by blast
 
 lemma locally_connected_components:
   "\<lbrakk>locally connected S; c \<in> components S\<rbrakk> \<Longrightarrow> locally connected c"
 by (meson locally_connected_open_component locally_open_subset openin_subtopology_self)
 
 lemma locally_path_connected_components:
   "\<lbrakk>locally path_connected S; c \<in> components S\<rbrakk> \<Longrightarrow> locally path_connected c"
 by (meson locally_connected_open_component locally_open_subset locally_path_connected_imp_locally_connected openin_subtopology_self)
 
 lemma locally_path_connected_connected_component:
   "locally path_connected S \<Longrightarrow> locally path_connected (connected_component_set S x)"
 by (metis components_iff connected_component_eq_empty locally_empty locally_path_connected_components)
 
 lemma open_imp_locally_path_connected:
   fixes S :: "'a :: real_normed_vector set"
   assumes "open S"
   shows "locally path_connected S"
 proof (rule locally_mono)
   show "locally convex S"
     using assms unfolding locally_def
     by (meson open_ball centre_in_ball convex_ball openE open_subset openin_imp_subset openin_open_trans subset_trans)
   show "\<And>T::'a set. convex T \<Longrightarrow> path_connected T"
     using convex_imp_path_connected by blast
 qed
 
 lemma open_imp_locally_connected:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> locally connected S"
 by (simp add: locally_path_connected_imp_locally_connected open_imp_locally_path_connected)
 
 lemma locally_path_connected_UNIV: "locally path_connected (UNIV::'a :: real_normed_vector set)"
   by (simp add: open_imp_locally_path_connected)
 
 lemma locally_connected_UNIV: "locally connected (UNIV::'a :: real_normed_vector set)"
   by (simp add: open_imp_locally_connected)
 
 lemma openin_connected_component_locally_connected:
     "locally connected S
      \<Longrightarrow> openin (top_of_set S) (connected_component_set S x)"
   by (metis connected_component_eq_empty locally_connected_2 openin_empty openin_subtopology_self)
 
 lemma openin_components_locally_connected:
     "\<lbrakk>locally connected S; c \<in> components S\<rbrakk> \<Longrightarrow> openin (top_of_set S) c"
   using locally_connected_open_component openin_subtopology_self by blast
 
 lemma openin_path_component_locally_path_connected:
   "locally path_connected S
         \<Longrightarrow> openin (top_of_set S) (path_component_set S x)"
 by (metis (no_types) empty_iff locally_path_connected_2 openin_subopen openin_subtopology_self path_component_eq_empty)
 
 lemma closedin_path_component_locally_path_connected:
   assumes "locally path_connected S"
   shows "closedin (top_of_set S) (path_component_set S x)"
 proof -
   have "openin (top_of_set S) (\<Union> ({path_component_set S y |y. y \<in> S} - {path_component_set S x}))"
     using locally_path_connected_2 assms by fastforce
   then show ?thesis
     by  (simp add: closedin_def path_component_subset complement_path_component_Union)
 qed
 
 lemma convex_imp_locally_path_connected:
   fixes S :: "'a:: real_normed_vector set"
   assumes "convex S"
   shows "locally path_connected S"
 proof (clarsimp simp: locally_path_connected)
   fix V x
   assume "openin (top_of_set S) V" and "x \<in> V"
   then obtain T e where  "V = S \<inter> T" "x \<in> S" "0 < e" "ball x e \<subseteq> T"
     by (metis Int_iff openE openin_open)
   then have "openin (top_of_set S) (S \<inter> ball x e)" "path_connected (S \<inter> ball x e)"
     by (simp_all add: assms convex_Int convex_imp_path_connected openin_open_Int)
   then show "\<exists>U. openin (top_of_set S) U \<and> path_connected U \<and> x \<in> U \<and> U \<subseteq> V"
     using \<open>0 < e\<close> \<open>V = S \<inter> T\<close> \<open>ball x e \<subseteq> T\<close> \<open>x \<in> S\<close> by auto
 qed
 
 lemma convex_imp_locally_connected:
   fixes S :: "'a:: real_normed_vector set"
   shows "convex S \<Longrightarrow> locally connected S"
   by (simp add: locally_path_connected_imp_locally_connected convex_imp_locally_path_connected)
 
 
 subsection\<open>Relations between components and path components\<close>
 
 lemma path_component_eq_connected_component:
   assumes "locally path_connected S"
     shows "(path_component S x = connected_component S x)"
 proof (cases "x \<in> S")
   case True
   have "openin (top_of_set (connected_component_set S x)) (path_component_set S x)"
   proof (rule openin_subset_trans)
     show "openin (top_of_set S) (path_component_set S x)"
       by (simp add: True assms locally_path_connected_2)
     show "connected_component_set S x \<subseteq> S"
       by (simp add: connected_component_subset)
   qed (simp add: path_component_subset_connected_component)
   moreover have "closedin (top_of_set (connected_component_set S x)) (path_component_set S x)"
     proof (rule closedin_subset_trans [of S])
   show "closedin (top_of_set S) (path_component_set S x)"
     by (simp add: assms closedin_path_component_locally_path_connected)
   show "connected_component_set S x \<subseteq> S"
     by (simp add: connected_component_subset)
   qed (simp add: path_component_subset_connected_component)
   ultimately have *: "path_component_set S x = connected_component_set S x"
     by (metis connected_connected_component connected_clopen True path_component_eq_empty)
   then show ?thesis
     by blast
 next
   case False then show ?thesis
     by (metis Collect_empty_eq_bot connected_component_eq_empty path_component_eq_empty)
 qed
 
 lemma path_component_eq_connected_component_set:
      "locally path_connected S \<Longrightarrow> (path_component_set S x = connected_component_set S x)"
 by (simp add: path_component_eq_connected_component)
 
 lemma locally_path_connected_path_component:
      "locally path_connected S \<Longrightarrow> locally path_connected (path_component_set S x)"
 using locally_path_connected_connected_component path_component_eq_connected_component by fastforce
 
 lemma open_path_connected_component:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> path_component S x = connected_component S x"
 by (simp add: path_component_eq_connected_component open_imp_locally_path_connected)
 
 lemma open_path_connected_component_set:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> path_component_set S x = connected_component_set S x"
 by (simp add: open_path_connected_component)
 
 proposition locally_connected_quotient_image:
   assumes lcS: "locally connected S"
       and oo: "\<And>T. T \<subseteq> f ` S
                 \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow>
                     openin (top_of_set (f ` S)) T"
     shows "locally connected (f ` S)"
 proof (clarsimp simp: locally_connected_open_component)
   fix U C
   assume opefSU: "openin (top_of_set (f ` S)) U" and "C \<in> components U"
   then have "C \<subseteq> U" "U \<subseteq> f ` S"
     by (meson in_components_subset openin_imp_subset)+
   then have "openin (top_of_set (f ` S)) C \<longleftrightarrow>
              openin (top_of_set S) (S \<inter> f -` C)"
     by (auto simp: oo)
   moreover have "openin (top_of_set S) (S \<inter> f -` C)"
   proof (subst openin_subopen, clarify)
     fix x
     assume "x \<in> S" "f x \<in> C"
     show "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> (S \<inter> f -` C)"
     proof (intro conjI exI)
       show "openin (top_of_set S) (connected_component_set (S \<inter> f -` U) x)"
       proof (rule ccontr)
         assume **: "\<not> openin (top_of_set S) (connected_component_set (S \<inter> f -` U) x)"
         then have "x \<notin> (S \<inter> f -` U)"
           using \<open>U \<subseteq> f ` S\<close> opefSU lcS locally_connected_2 oo by blast
         with ** show False
           by (metis (no_types) connected_component_eq_empty empty_iff openin_subopen)
       qed
     next
       show "x \<in> connected_component_set (S \<inter> f -` U) x"
         using \<open>C \<subseteq> U\<close> \<open>f x \<in> C\<close> \<open>x \<in> S\<close> by auto
     next
       have contf: "continuous_on S f"
         by (simp add: continuous_on_open oo openin_imp_subset)
       then have "continuous_on (connected_component_set (S \<inter> f -` U) x) f"
         by (meson connected_component_subset continuous_on_subset inf.boundedE)
       then have "connected (f ` connected_component_set (S \<inter> f -` U) x)"
         by (rule connected_continuous_image [OF _ connected_connected_component])
       moreover have "f ` connected_component_set (S \<inter> f -` U) x \<subseteq> U"
         using connected_component_in by blast
       moreover have "C \<inter> f ` connected_component_set (S \<inter> f -` U) x \<noteq> {}"
         using \<open>C \<subseteq> U\<close> \<open>f x \<in> C\<close> \<open>x \<in> S\<close> by fastforce
       ultimately have fC: "f ` (connected_component_set (S \<inter> f -` U) x) \<subseteq> C"
         by (rule components_maximal [OF \<open>C \<in> components U\<close>])
       have cUC: "connected_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` C)"
         using connected_component_subset fC by blast
       have "connected_component_set (S \<inter> f -` U) x \<subseteq> connected_component_set (S \<inter> f -` C) x"
       proof -
         { assume "x \<in> connected_component_set (S \<inter> f -` U) x"
           then have ?thesis
             using cUC connected_component_idemp connected_component_mono by blast }
         then show ?thesis
           using connected_component_eq_empty by auto
       qed
       also have "\<dots> \<subseteq> (S \<inter> f -` C)"
         by (rule connected_component_subset)
       finally show "connected_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` C)" .
     qed
   qed
   ultimately show "openin (top_of_set (f ` S)) C"
     by metis
 qed
 
 text\<open>The proof resembles that above but is not identical!\<close>
 proposition locally_path_connected_quotient_image:
   assumes lcS: "locally path_connected S"
       and oo: "\<And>T. T \<subseteq> f ` S
                 \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow> openin (top_of_set (f ` S)) T"
     shows "locally path_connected (f ` S)"
 proof (clarsimp simp: locally_path_connected_open_path_component)
   fix U y
   assume opefSU: "openin (top_of_set (f ` S)) U" and "y \<in> U"
   then have "path_component_set U y \<subseteq> U" "U \<subseteq> f ` S"
     by (meson path_component_subset openin_imp_subset)+
   then have "openin (top_of_set (f ` S)) (path_component_set U y) \<longleftrightarrow>
              openin (top_of_set S) (S \<inter> f -` path_component_set U y)"
   proof -
     have "path_component_set U y \<subseteq> f ` S"
       using \<open>U \<subseteq> f ` S\<close> \<open>path_component_set U y \<subseteq> U\<close> by blast
     then show ?thesis
       using oo by blast
   qed
   moreover have "openin (top_of_set S) (S \<inter> f -` path_component_set U y)"
   proof (subst openin_subopen, clarify)
     fix x
     assume "x \<in> S" and Uyfx: "path_component U y (f x)"
     then have "f x \<in> U"
       using path_component_mem by blast
     show "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> (S \<inter> f -` path_component_set U y)"
     proof (intro conjI exI)
       show "openin (top_of_set S) (path_component_set (S \<inter> f -` U) x)"
       proof (rule ccontr)
         assume **: "\<not> openin (top_of_set S) (path_component_set (S \<inter> f -` U) x)"
         then have "x \<notin> (S \<inter> f -` U)"
           by (metis (no_types, lifting) \<open>U \<subseteq> f ` S\<close> opefSU lcS oo locally_path_connected_open_path_component)
         then show False
           using ** \<open>path_component_set U y \<subseteq> U\<close>  \<open>x \<in> S\<close> \<open>path_component U y (f x)\<close> by blast
       qed
     next
       show "x \<in> path_component_set (S \<inter> f -` U) x"
         by (simp add: \<open>f x \<in> U\<close> \<open>x \<in> S\<close> path_component_refl)
     next
       have contf: "continuous_on S f"
         by (simp add: continuous_on_open oo openin_imp_subset)
       then have "continuous_on (path_component_set (S \<inter> f -` U) x) f"
         by (meson Int_lower1 continuous_on_subset path_component_subset)
       then have "path_connected (f ` path_component_set (S \<inter> f -` U) x)"
         by (simp add: path_connected_continuous_image)
       moreover have "f ` path_component_set (S \<inter> f -` U) x \<subseteq> U"
         using path_component_mem by fastforce
       moreover have "f x \<in> f ` path_component_set (S \<inter> f -` U) x"
         by (force simp: \<open>x \<in> S\<close> \<open>f x \<in> U\<close> path_component_refl_eq)
       ultimately have "f ` (path_component_set (S \<inter> f -` U) x) \<subseteq> path_component_set U (f x)"
         by (meson path_component_maximal)
        also have  "\<dots> \<subseteq> path_component_set U y"
         by (simp add: Uyfx path_component_maximal path_component_subset path_component_sym)
       finally have fC: "f ` (path_component_set (S \<inter> f -` U) x) \<subseteq> path_component_set U y" .
       have cUC: "path_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` path_component_set U y)"
         using path_component_subset fC by blast
       have "path_component_set (S \<inter> f -` U) x \<subseteq> path_component_set (S \<inter> f -` path_component_set U y) x"
       proof -
         have "\<And>a. path_component_set (path_component_set (S \<inter> f -` U) x) a \<subseteq> path_component_set (S \<inter> f -` path_component_set U y) a"
           using cUC path_component_mono by blast
         then show ?thesis
           using path_component_path_component by blast
       qed
       also have "\<dots> \<subseteq> (S \<inter> f -` path_component_set U y)"
         by (rule path_component_subset)
       finally show "path_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` path_component_set U y)" .
     qed
   qed
   ultimately show "openin (top_of_set (f ` S)) (path_component_set U y)"
     by metis
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Components, continuity, openin, closedin\<close>
 
 lemma continuous_on_components_gen:
  fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   assumes "\<And>C. C \<in> components S \<Longrightarrow>
               openin (top_of_set S) C \<and> continuous_on C f"
     shows "continuous_on S f"
 proof (clarsimp simp: continuous_openin_preimage_eq)
   fix t :: "'b set"
   assume "open t"
   have *: "S \<inter> f -` t = (\<Union>c \<in> components S. c \<inter> f -` t)"
     by auto
   show "openin (top_of_set S) (S \<inter> f -` t)"
     unfolding * using \<open>open t\<close> assms continuous_openin_preimage_gen openin_trans openin_Union by blast
 qed
 
 lemma continuous_on_components:
  fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   assumes "locally connected S " "\<And>C. C \<in> components S \<Longrightarrow> continuous_on C f"
   shows "continuous_on S f"
 proof (rule continuous_on_components_gen)
   fix C
   assume "C \<in> components S"
   then show "openin (top_of_set S) C \<and> continuous_on C f"
     by (simp add: assms openin_components_locally_connected)
 qed
 
 lemma continuous_on_components_eq:
     "locally connected S
      \<Longrightarrow> (continuous_on S f \<longleftrightarrow> (\<forall>c \<in> components S. continuous_on c f))"
 by (meson continuous_on_components continuous_on_subset in_components_subset)
 
 lemma continuous_on_components_open:
  fixes S :: "'a::real_normed_vector set"
   assumes "open S "
           "\<And>c. c \<in> components S \<Longrightarrow> continuous_on c f"
     shows "continuous_on S f"
 using continuous_on_components open_imp_locally_connected assms by blast
 
 lemma continuous_on_components_open_eq:
   fixes S :: "'a::real_normed_vector set"
   shows "open S \<Longrightarrow> (continuous_on S f \<longleftrightarrow> (\<forall>c \<in> components S. continuous_on c f))"
 using continuous_on_subset in_components_subset
 by (blast intro: continuous_on_components_open)
 
 lemma closedin_union_complement_components:
   assumes U: "locally connected U"
       and S: "closedin (top_of_set U) S"
       and cuS: "c \<subseteq> components(U - S)"
     shows "closedin (top_of_set U) (S \<union> \<Union>c)"
 proof -
   have di: "(\<And>S T. S \<in> c \<and> T \<in> c' \<Longrightarrow> disjnt S T) \<Longrightarrow> disjnt (\<Union> c) (\<Union> c')" for c'
     by (simp add: disjnt_def) blast
   have "S \<subseteq> U"
     using S closedin_imp_subset by blast
   moreover have "U - S = \<Union>c \<union> \<Union>(components (U - S) - c)"
     by (metis Diff_partition Union_components Union_Un_distrib assms(3))
   moreover have "disjnt (\<Union>c) (\<Union>(components (U - S) - c))"
     apply (rule di)
     by (metis di DiffD1 DiffD2 assms(3) components_nonoverlap disjnt_def subsetCE)
   ultimately have eq: "S \<union> \<Union>c = U - (\<Union>(components(U - S) - c))"
     by (auto simp: disjnt_def)
   have *: "openin (top_of_set U) (\<Union>(components (U - S) - c))"
   proof (rule openin_Union [OF openin_trans [of "U - S"]])
     show "openin (top_of_set (U - S)) T" if "T \<in> components (U - S) - c" for T
       using that by (simp add: U S locally_diff_closed openin_components_locally_connected)
     show "openin (top_of_set U) (U - S)" if "T \<in> components (U - S) - c" for T
       using that by (simp add: openin_diff S)
   qed
   have "closedin (top_of_set U) (U - \<Union> (components (U - S) - c))"
     by (metis closedin_diff closedin_topspace topspace_euclidean_subtopology *)
   then have "openin (top_of_set U) (U - (U - \<Union>(components (U - S) - c)))"
     by (simp add: openin_diff)
   then show ?thesis
     by (force simp: eq closedin_def)
 qed
 
 lemma closed_union_complement_components:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "closed S" and c: "c \<subseteq> components(- S)"
     shows "closed(S \<union> \<Union> c)"
 proof -
   have "closedin (top_of_set UNIV) (S \<union> \<Union>c)"
     by (metis Compl_eq_Diff_UNIV S c closed_closedin closedin_union_complement_components locally_connected_UNIV subtopology_UNIV)
   then show ?thesis by simp
 qed
 
 lemma closedin_Un_complement_component:
   fixes S :: "'a::real_normed_vector set"
   assumes u: "locally connected u"
       and S: "closedin (top_of_set u) S"
       and c: " c \<in> components(u - S)"
     shows "closedin (top_of_set u) (S \<union> c)"
 proof -
   have "closedin (top_of_set u) (S \<union> \<Union>{c})"
     using c by (blast intro: closedin_union_complement_components [OF u S])
   then show ?thesis
     by simp
 qed
 
 lemma closed_Un_complement_component:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "closed S" and c: " c \<in> components(-S)"
     shows "closed (S \<union> c)"
   by (metis Compl_eq_Diff_UNIV S c closed_closedin closedin_Un_complement_component
       locally_connected_UNIV subtopology_UNIV)
 
 
 subsection\<open>Existence of isometry between subspaces of same dimension\<close>
 
 lemma isometry_subset_subspace:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S \<le> dim T"
   obtains f where "linear f" "f \<in> S \<rightarrow> T" "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
 proof -
   obtain B where "B \<subseteq> S" and Borth: "pairwise orthogonal B"
              and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "finite B" "card B = dim S" "span B = S"
     by (metis orthonormal_basis_subspace [OF S] independent_imp_finite)
   obtain C where "C \<subseteq> T" and Corth: "pairwise orthogonal C"
              and C1:"\<And>x. x \<in> C \<Longrightarrow> norm x = 1"
              and "independent C" "finite C" "card C = dim T" "span C = T"
     by (metis orthonormal_basis_subspace [OF T] independent_imp_finite)
   obtain fb where "fb ` B \<subseteq> C" "inj_on fb B"
     by (metis \<open>card B = dim S\<close> \<open>card C = dim T\<close> \<open>finite B\<close> \<open>finite C\<close> card_le_inj d)
   then have pairwise_orth_fb: "pairwise (\<lambda>v j. orthogonal (fb v) (fb j)) B"
     using Corth unfolding pairwise_def inj_on_def
     by (blast intro: orthogonal_clauses)
   obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
     using linear_independent_extend \<open>independent B\<close> by fastforce
   have "span (f ` B) \<subseteq> span C"
     by (metis \<open>fb ` B \<subseteq> C\<close> ffb image_cong span_mono)
   then have "f ` S \<subseteq> T"
     unfolding \<open>span B = S\<close> \<open>span C = T\<close> span_linear_image[OF \<open>linear f\<close>] .
   have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
     using B1 C1 \<open>fb ` B \<subseteq> C\<close> by auto
   have "norm (f x) = norm x" if "x \<in> S" for x
   proof -
     interpret linear f by fact
     obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
       using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
     have "norm (f x)^2 = norm (\<Sum>v\<in>B. a v *\<^sub>R fb v)^2" by (simp add: sum scale ffb x)
     also have "\<dots> = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
     proof (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
       show "pairwise (\<lambda>v j. orthogonal (a v *\<^sub>R fb v) (a j *\<^sub>R fb j)) B"
         by (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
     qed
     also have "\<dots> = norm x ^2"
       by (simp add: x pairwise_ortho_scaleR Borth norm_sum_Pythagorean [OF \<open>finite B\<close>])
     finally show ?thesis
       by (simp add: norm_eq_sqrt_inner)
   qed
   then show ?thesis
     by (meson \<open>f ` S \<subseteq> T\<close> \<open>linear f\<close> image_subset_iff_funcset that)
 qed
 
 proposition isometries_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
   obtains f g where "linear f" "linear g" "f ` S = T" "g ` T = S"
                     "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
                     "\<And>x. x \<in> T \<Longrightarrow> norm(g x) = norm x"
                     "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
                     "\<And>x. x \<in> T \<Longrightarrow> f(g x) = x"
 proof -
   obtain B where "B \<subseteq> S" and Borth: "pairwise orthogonal B"
              and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "finite B" "card B = dim S" "span B = S"
     by (metis orthonormal_basis_subspace [OF S] independent_imp_finite)
   obtain C where "C \<subseteq> T" and Corth: "pairwise orthogonal C"
              and C1:"\<And>x. x \<in> C \<Longrightarrow> norm x = 1"
              and "independent C" "finite C" "card C = dim T" "span C = T"
     by (metis orthonormal_basis_subspace [OF T] independent_imp_finite)
   obtain fb where "bij_betw fb B C"
     by (metis \<open>finite B\<close> \<open>finite C\<close> bij_betw_iff_card \<open>card B = dim S\<close> \<open>card C = dim T\<close> d)
   then have pairwise_orth_fb: "pairwise (\<lambda>v j. orthogonal (fb v) (fb j)) B"
     using Corth unfolding pairwise_def inj_on_def bij_betw_def
     by (blast intro: orthogonal_clauses)
   obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
     using linear_independent_extend \<open>independent B\<close> by fastforce
   interpret f: linear f by fact
   define gb where "gb \<equiv> inv_into B fb"
   then have pairwise_orth_gb: "pairwise (\<lambda>v j. orthogonal (gb v) (gb j)) C"
     using Borth \<open>bij_betw fb B C\<close> unfolding pairwise_def bij_betw_def by force
   obtain g where "linear g" and ggb: "\<And>x. x \<in> C \<Longrightarrow> g x = gb x"
     using linear_independent_extend \<open>independent C\<close> by fastforce
   interpret g: linear g by fact
   have "span (f ` B) \<subseteq> span C"
     by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on eq_iff ffb image_cong)
   then have "f ` S \<subseteq> T"
     unfolding \<open>span B = S\<close> \<open>span C = T\<close> span_linear_image[OF \<open>linear f\<close>] .
   have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
     using B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on by fastforce
   have f [simp]: "norm (f x) = norm x" "g (f x) = x" if "x \<in> S" for x
   proof -
     obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
       using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
     have "f x = (\<Sum>v \<in> B. f (a v *\<^sub>R v))"
       using linear_sum [OF \<open>linear f\<close>] x by auto
     also have "\<dots> = (\<Sum>v \<in> B. a v *\<^sub>R f v)"
       by (simp add: f.sum f.scale)
     also have "\<dots> = (\<Sum>v \<in> B. a v *\<^sub>R fb v)"
       by (simp add: ffb cong: sum.cong)
     finally have *: "f x = (\<Sum>v\<in>B. a v *\<^sub>R fb v)" .
     then have "(norm (f x))\<^sup>2 = (norm (\<Sum>v\<in>B. a v *\<^sub>R fb v))\<^sup>2" by simp
     also have "\<dots> = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
     proof (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
       show "pairwise (\<lambda>v j. orthogonal (a v *\<^sub>R fb v) (a j *\<^sub>R fb j)) B"
         by (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
     qed
     also have "\<dots> = (norm x)\<^sup>2"
       by (simp add: x pairwise_ortho_scaleR Borth norm_sum_Pythagorean [OF \<open>finite B\<close>])
     finally show "norm (f x) = norm x"
       by (simp add: norm_eq_sqrt_inner)
     have "g (f x) = g (\<Sum>v\<in>B. a v *\<^sub>R fb v)" by (simp add: *)
     also have "\<dots> = (\<Sum>v\<in>B. g (a v *\<^sub>R fb v))"
       by (simp add: g.sum g.scale)
     also have "\<dots> = (\<Sum>v\<in>B. a v *\<^sub>R g (fb v))"
       by (simp add: g.scale)
     also have "\<dots> = (\<Sum>v\<in>B. a v *\<^sub>R v)"
     proof (rule sum.cong [OF refl])
       show "a x *\<^sub>R g (fb x) = a x *\<^sub>R x" if "x \<in> B" for x
         using that \<open>bij_betw fb B C\<close> bij_betwE bij_betw_inv_into_left gb_def ggb by fastforce
     qed
     also have "\<dots> = x"
       using x by blast
     finally show "g (f x) = x" .
   qed
   have [simp]: "\<And>x. x \<in> C \<Longrightarrow> norm (gb x) = norm x"
     by (metis B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on gb_def inv_into_into)
   have g [simp]: "f (g x) = x" if "x \<in> T" for x
   proof -
     obtain a where x: "x = (\<Sum>v \<in> C. a v *\<^sub>R v)"
       using \<open>finite C\<close> \<open>span C = T\<close> \<open>x \<in> T\<close> span_finite by fastforce
     have "g x = (\<Sum>v \<in> C. g (a v *\<^sub>R v))"
       by (simp add: x g.sum)
     also have "\<dots> = (\<Sum>v \<in> C. a v *\<^sub>R g v)"
       by (simp add: g.scale)
     also have "\<dots> = (\<Sum>v \<in> C. a v *\<^sub>R gb v)"
       by (simp add: ggb cong: sum.cong)
     finally have "f (g x) = f (\<Sum>v\<in>C. a v *\<^sub>R gb v)" by simp
     also have "\<dots> = (\<Sum>v\<in>C. f (a v *\<^sub>R gb v))"
       by (simp add: f.scale f.sum)
     also have "\<dots> = (\<Sum>v\<in>C. a v *\<^sub>R f (gb v))"
       by (simp add: f.scale f.sum)
     also have "\<dots> = (\<Sum>v\<in>C. a v *\<^sub>R v)"
       using \<open>bij_betw fb B C\<close>
       by (simp add: bij_betw_def gb_def bij_betw_inv_into_right ffb inv_into_into)
     also have "\<dots> = x"
       using x by blast
     finally show "f (g x) = x" .
   qed
   have gim: "g ` T = S"
     by (metis (full_types) S T \<open>f ` S \<subseteq> T\<close> d dim_eq_span dim_image_le f(2) g.linear_axioms
         image_iff linear_subspace_image span_eq_iff subset_iff)
   have fim: "f ` S = T"
     using \<open>g ` T = S\<close> image_iff by fastforce
   have [simp]: "norm (g x) = norm x" if "x \<in> T" for x
     using fim that by auto
   show ?thesis
     by (rule that [OF \<open>linear f\<close> \<open>linear g\<close>]) (simp_all add: fim gim)
 qed
 
 corollary isometry_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
   obtains f where "linear f" "f ` S = T" "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
 using isometries_subspaces [OF assms]
 by metis
 
 corollary isomorphisms_UNIV_UNIV:
   assumes "DIM('M) = DIM('N)"
   obtains f::"'M::euclidean_space \<Rightarrow>'N::euclidean_space" and g
   where "linear f" "linear g"
                     "\<And>x. norm(f x) = norm x" "\<And>y. norm(g y) = norm y"
                     "\<And>x. g (f x) = x" "\<And>y. f(g y) = y"
   using assms by (auto intro: isometries_subspaces [of "UNIV::'M set" "UNIV::'N set"])
 
 lemma homeomorphic_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
     shows "S homeomorphic T"
 proof -
   obtain f g where "linear f" "linear g" "f ` S = T" "g ` T = S"
                    "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "\<And>x. x \<in> T \<Longrightarrow> f(g x) = x"
     by (blast intro: isometries_subspaces [OF assms])
   then show ?thesis
     unfolding homeomorphic_def homeomorphism_def
     apply (rule_tac x=f in exI, rule_tac x=g in exI)
     apply (auto simp: linear_continuous_on linear_conv_bounded_linear)
     done
 qed
 
 lemma homeomorphic_affine_sets:
   assumes "affine S" "affine T" "aff_dim S = aff_dim T"
     shows "S homeomorphic T"
 proof (cases "S = {} \<or> T = {}")
   case True  with assms aff_dim_empty homeomorphic_empty show ?thesis
     by metis
 next
   case False
   then obtain a b where ab: "a \<in> S" "b \<in> T" by auto
   then have ss: "subspace ((+) (- a) ` S)" "subspace ((+) (- b) ` T)"
     using affine_diffs_subspace assms by blast+
   have dd: "dim ((+) (- a) ` S) = dim ((+) (- b) ` T)"
     using assms ab  by (simp add: aff_dim_eq_dim  [OF hull_inc] image_def)
   have "S homeomorphic ((+) (- a) ` S)"
     by (fact homeomorphic_translation)
   also have "\<dots> homeomorphic ((+) (- b) ` T)"
     by (rule homeomorphic_subspaces [OF ss dd])
   also have "\<dots> homeomorphic T"
     using homeomorphic_translation [of T "- b"] by (simp add: homeomorphic_sym [of T])
   finally show ?thesis .
 qed
 
 
 subsection\<open>Retracts, in a general sense, preserve (co)homotopic triviality)\<close>
 
 locale\<^marker>\<open>tag important\<close> Retracts =
   fixes S h t k
   assumes conth: "continuous_on S h"
       and imh: "h ` S = t"
       and contk: "continuous_on t k"
       and imk: "k \<in> t \<rightarrow> S"
       and idhk: "\<And>y. y \<in> t \<Longrightarrow> h(k y) = y"
 
 begin
 
 lemma homotopically_trivial_retraction_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on U f; f \<in> U \<rightarrow> t; Q f\<rbrakk> \<Longrightarrow> P(k \<circ> f)"
       and Q: "\<And>f. \<lbrakk>continuous_on U f; f \<in> U \<rightarrow> S; P f\<rbrakk> \<Longrightarrow> Q(h \<circ> f)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> U \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on U f; f \<in> U \<rightarrow> S; P f;
                        continuous_on U g; g \<in> U \<rightarrow> S; P g\<rbrakk>
                        \<Longrightarrow> homotopic_with_canon P U S f g"
       and contf: "continuous_on U f" and imf: "f \<in> U \<rightarrow> t" and Qf: "Q f"
       and contg: "continuous_on U g" and img: "g \<in> U \<rightarrow> t" and Qg: "Q g"
     shows "homotopic_with_canon Q U t f g"
 proof -
   have "continuous_on U (k \<circ> f)"
     by (meson contf continuous_on_compose continuous_on_subset contk funcset_image imf)
   moreover have "(k \<circ> f) ` U \<subseteq> S"
     using imf imk by fastforce
   moreover have "P (k \<circ> f)"
     by (simp add: P Qf contf imf)
   moreover have "continuous_on U (k \<circ> g)"
     by (meson contg continuous_on_compose continuous_on_subset contk funcset_image img)
   moreover have "(k \<circ> g) ` U \<subseteq> S"
     using img imk by fastforce
   moreover have "P (k \<circ> g)"
     by (simp add: P Qg contg img)
   ultimately have "homotopic_with_canon P U S (k \<circ> f) (k \<circ> g)"
     by (simp add: hom image_subset_iff)
   then have "homotopic_with_canon Q U t (h \<circ> (k \<circ> f)) (h \<circ> (k \<circ> g))"
     apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono])
     using Q conth imh by force+
   then show ?thesis
   proof (rule homotopic_with_eq; simp)
     show "\<And>h k. (\<And>x. x \<in> U \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       using Qeq topspace_euclidean_subtopology by blast
     show "\<And>x. x \<in> U \<Longrightarrow> f x = h (k (f x))" "\<And>x. x \<in> U \<Longrightarrow> g x = h (k (g x))"
       using idhk imf img by fastforce+
   qed 
 qed
 
 lemma homotopically_trivial_retraction_null_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on U f; f \<in> U \<rightarrow> t; Q f\<rbrakk> \<Longrightarrow> P(k \<circ> f)"
       and Q: "\<And>f. \<lbrakk>continuous_on U f; f \<in> U \<rightarrow> S; P f\<rbrakk> \<Longrightarrow> Q(h \<circ> f)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> U \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f. \<lbrakk>continuous_on U f; f \<in> U \<rightarrow> S; P f\<rbrakk>
                      \<Longrightarrow> \<exists>c. homotopic_with_canon P U S f (\<lambda>x. c)"
       and contf: "continuous_on U f" and imf:"f \<in> U \<rightarrow> t" and Qf: "Q f"
   obtains c where "homotopic_with_canon Q U t f (\<lambda>x. c)"
 proof -
   have feq: "\<And>x. x \<in> U \<Longrightarrow> (h \<circ> (k \<circ> f)) x = f x" using idhk imf by auto
   have "continuous_on U (k \<circ> f)"
     by (meson contf continuous_on_compose continuous_on_subset contk funcset_image imf)
   moreover have "(k \<circ> f) \<in> U \<rightarrow> S"
     using imf imk by fastforce
   moreover have "P (k \<circ> f)"
     by (simp add: P Qf contf imf)
   ultimately obtain c where "homotopic_with_canon P U S (k \<circ> f) (\<lambda>x. c)"
     by (metis hom)
   then have "homotopic_with_canon Q U t (h \<circ> (k \<circ> f)) (h \<circ> (\<lambda>x. c))"
     apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono])
     using Q conth imh by force+
   then have "homotopic_with_canon Q U t f (\<lambda>x. h c)"
   proof (rule homotopic_with_eq)
     show "\<And>x. x \<in> topspace (top_of_set U) \<Longrightarrow> f x = (h \<circ> (k \<circ> f)) x"
       using feq by auto
     show "\<And>h k. (\<And>x. x \<in> topspace (top_of_set U) \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       using Qeq topspace_euclidean_subtopology by blast
   qed auto
   then show ?thesis
     using that by blast
 qed
 
 lemma cohomotopically_trivial_retraction_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on t f; f \<in> t \<rightarrow> U; Q f\<rbrakk> \<Longrightarrow> P(f \<circ> h)"
       and Q: "\<And>f. \<lbrakk>continuous_on S f; f \<in> S \<rightarrow> U; P f\<rbrakk> \<Longrightarrow> Q(f \<circ> k)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> t \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on S f; f \<in> S \<rightarrow> U; P f;
                        continuous_on S g; g \<in> S \<rightarrow> U; P g\<rbrakk>
                        \<Longrightarrow> homotopic_with_canon P S U f g"
       and contf: "continuous_on t f" and imf: "f \<in> t \<rightarrow> U" and Qf: "Q f"
       and contg: "continuous_on t g" and img: "g \<in> t \<rightarrow> U" and Qg: "Q g"
     shows "homotopic_with_canon Q t U f g"
 proof -
   have feq: "\<And>x. x \<in> t \<Longrightarrow> (f \<circ> h \<circ> k) x = f x" using idhk imf by auto
   have geq: "\<And>x. x \<in> t \<Longrightarrow> (g \<circ> h \<circ> k) x = g x" using idhk img by auto
   have "continuous_on S (f \<circ> h)"
     using contf conth continuous_on_compose imh by blast
   moreover have "(f \<circ> h) \<in> S \<rightarrow> U"
     using imf imh by fastforce
   moreover have "P (f \<circ> h)"
     by (simp add: P Qf contf imf)
   moreover have "continuous_on S (g \<circ> h)"
     using contg continuous_on_compose continuous_on_subset conth imh by blast
   moreover have "(g \<circ> h) \<in> S \<rightarrow> U"
     using img imh by fastforce
   moreover have "P (g \<circ> h)"
     by (simp add: P Qg contg img)
   ultimately have "homotopic_with_canon P S U (f \<circ> h) (g \<circ> h)"
     by (simp add: hom)
   then have "homotopic_with_canon Q t U (f \<circ> h \<circ> k) (g \<circ> h \<circ> k)"
     apply (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono])
     using Q contk imk by force+
   then show ?thesis
   proof (rule homotopic_with_eq)
     show "f x = (f \<circ> h \<circ> k) x" "g x = (g \<circ> h \<circ> k) x" 
       if "x \<in> topspace (top_of_set t)" for x
       using feq geq that by force+
   qed (use Qeq topspace_euclidean_subtopology in blast)
 qed
 
 lemma cohomotopically_trivial_retraction_null_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on t f; f \<in> t \<rightarrow> U; Q f\<rbrakk> \<Longrightarrow> P(f \<circ> h)"
       and Q: "\<And>f. \<lbrakk>continuous_on S f; f \<in> S \<rightarrow> U; P f\<rbrakk> \<Longrightarrow> Q(f \<circ> k)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> t \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on S f; f \<in> S \<rightarrow> U; P f\<rbrakk>
                        \<Longrightarrow> \<exists>c. homotopic_with_canon P S U f (\<lambda>x. c)"
       and contf: "continuous_on t f" and imf: "f \<in> t \<rightarrow> U" and Qf: "Q f"
   obtains c where "homotopic_with_canon Q t U f (\<lambda>x. c)"
 proof -
   have feq: "\<And>x. x \<in> t \<Longrightarrow> (f \<circ> h \<circ> k) x = f x" using idhk imf by auto
   have "continuous_on S (f \<circ> h)"
     using contf conth continuous_on_compose imh by blast
   moreover have "(f \<circ> h) \<in> S \<rightarrow> U"
     using imf imh by fastforce
   moreover have "P (f \<circ> h)"
     by (simp add: P Qf contf imf)
   ultimately obtain c where "homotopic_with_canon P S U (f \<circ> h) (\<lambda>x. c)"
     by (metis hom)
   then have \<section>: "homotopic_with_canon Q t U (f \<circ> h \<circ> k) ((\<lambda>x. c) \<circ> k)"
   proof (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono])
     show "\<And>h. \<lbrakk>continuous_map (top_of_set S) (top_of_set U) h; P h\<rbrakk> \<Longrightarrow> Q (h \<circ> k)"
       using Q by auto
   qed (use contk imk in force)+
   moreover have "homotopic_with_canon Q t U f (\<lambda>x. c)"
     using homotopic_with_eq [OF \<section>] feq Qeq by fastforce
   ultimately show ?thesis 
     using that by blast
 qed
 
 end
 
 lemma simply_connected_retraction_gen:
   shows "\<lbrakk>simply_connected S; continuous_on S h; h ` S = T;
           continuous_on T k; k \<in> T \<rightarrow> S; \<And>y. y \<in> T \<Longrightarrow> h(k y) = y\<rbrakk>
         \<Longrightarrow> simply_connected T"
 apply (simp add: simply_connected_def path_def path_image_def homotopic_loops_def, clarify)
 apply (rule Retracts.homotopically_trivial_retraction_gen
         [of S h _ k _ "\<lambda>p. pathfinish p = pathstart p"  "\<lambda>p. pathfinish p = pathstart p"])
 apply (simp_all add: Retracts_def pathfinish_def pathstart_def image_subset_iff_funcset)
 done
 
 lemma homeomorphic_simply_connected:
     "\<lbrakk>S homeomorphic T; simply_connected S\<rbrakk> \<Longrightarrow> simply_connected T"
   by (auto simp: homeomorphic_def homeomorphism_def intro: simply_connected_retraction_gen)
 
 lemma homeomorphic_simply_connected_eq:
     "S homeomorphic T \<Longrightarrow> (simply_connected S \<longleftrightarrow> simply_connected T)"
   by (metis homeomorphic_simply_connected homeomorphic_sym)
 
 
 subsection\<open>Homotopy equivalence\<close>
 
 subsection\<open>Homotopy equivalence of topological spaces.\<close>
 
 definition\<^marker>\<open>tag important\<close> homotopy_equivalent_space
              (infix "homotopy'_equivalent'_space" 50)
   where "X homotopy_equivalent_space Y \<equiv>
         (\<exists>f g. continuous_map X Y f \<and>
               continuous_map Y X g \<and>
               homotopic_with (\<lambda>x. True) X X (g \<circ> f) id \<and>
               homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) id)"
 
 lemma homeomorphic_imp_homotopy_equivalent_space:
   "X homeomorphic_space Y \<Longrightarrow> X homotopy_equivalent_space Y"
   unfolding homeomorphic_space_def homotopy_equivalent_space_def
   apply (erule ex_forward)+
   by (simp add: homotopic_with_equal homotopic_with_sym homeomorphic_maps_def)
 
 lemma homotopy_equivalent_space_refl:
    "X homotopy_equivalent_space X"
   by (simp add: homeomorphic_imp_homotopy_equivalent_space homeomorphic_space_refl)
 
 lemma homotopy_equivalent_space_sym:
    "X homotopy_equivalent_space Y \<longleftrightarrow> Y homotopy_equivalent_space X"
   by (meson homotopy_equivalent_space_def)
 
 lemma homotopy_eqv_trans [trans]:
   assumes 1: "X homotopy_equivalent_space Y" and 2: "Y homotopy_equivalent_space U"
     shows "X homotopy_equivalent_space U"
 proof -
   obtain f1 g1 where f1: "continuous_map X Y f1"
                  and g1: "continuous_map Y X g1"
                  and hom1: "homotopic_with (\<lambda>x. True) X X (g1 \<circ> f1) id"
                            "homotopic_with (\<lambda>x. True) Y Y (f1 \<circ> g1) id"
     using 1 by (auto simp: homotopy_equivalent_space_def)
   obtain f2 g2 where f2: "continuous_map Y U f2"
                  and g2: "continuous_map U Y g2"
                  and hom2: "homotopic_with (\<lambda>x. True) Y Y (g2 \<circ> f2) id"
                            "homotopic_with (\<lambda>x. True) U U (f2 \<circ> g2) id"
     using 2 by (auto simp: homotopy_equivalent_space_def)
   have "homotopic_with (\<lambda>f. True) X Y (g2 \<circ> f2 \<circ> f1) (id \<circ> f1)"
     using f1 hom2(1) homotopic_with_compose_continuous_map_right by metis
   then have "homotopic_with (\<lambda>f. True) X Y (g2 \<circ> (f2 \<circ> f1)) (id \<circ> f1)"
     by (simp add: o_assoc)
   then have "homotopic_with (\<lambda>x. True) X X
          (g1 \<circ> (g2 \<circ> (f2 \<circ> f1))) (g1 \<circ> (id \<circ> f1))"
     by (simp add: g1 homotopic_with_compose_continuous_map_left)
   moreover have "homotopic_with (\<lambda>x. True) X X (g1 \<circ> id \<circ> f1) id"
     using hom1 by simp
   ultimately have SS: "homotopic_with (\<lambda>x. True) X X (g1 \<circ> g2 \<circ> (f2 \<circ> f1)) id"
     by (metis comp_assoc homotopic_with_trans id_comp)
   have "homotopic_with (\<lambda>f. True) U Y (f1 \<circ> g1 \<circ> g2) (id \<circ> g2)"
     using g2 hom1(2) homotopic_with_compose_continuous_map_right by fastforce
   then have "homotopic_with (\<lambda>f. True) U Y (f1 \<circ> (g1 \<circ> g2)) (id \<circ> g2)"
     by (simp add: o_assoc)
   then have "homotopic_with (\<lambda>x. True) U U
          (f2 \<circ> (f1 \<circ> (g1 \<circ> g2))) (f2 \<circ> (id \<circ> g2))"
     by (simp add: f2 homotopic_with_compose_continuous_map_left)
   moreover have "homotopic_with (\<lambda>x. True) U U (f2 \<circ> id \<circ> g2) id"
     using hom2 by simp
   ultimately have UU: "homotopic_with (\<lambda>x. True) U U (f2 \<circ> f1 \<circ> (g1 \<circ> g2)) id"
     by (simp add: fun.map_comp hom2(2) homotopic_with_trans)
   show ?thesis
     unfolding homotopy_equivalent_space_def
     by (blast intro: f1 f2 g1 g2 continuous_map_compose SS UU)
 qed
 
 lemma deformation_retraction_imp_homotopy_equivalent_space:
   "\<lbrakk>homotopic_with (\<lambda>x. True) X X (S \<circ> r) id; retraction_maps X Y r S\<rbrakk>
     \<Longrightarrow> X homotopy_equivalent_space Y"
   unfolding homotopy_equivalent_space_def retraction_maps_def
   using homotopic_with_id2 by fastforce
 
 lemma deformation_retract_imp_homotopy_equivalent_space:
    "\<lbrakk>homotopic_with (\<lambda>x. True) X X r id; retraction_maps X Y r id\<rbrakk>
     \<Longrightarrow> X homotopy_equivalent_space Y"
   using deformation_retraction_imp_homotopy_equivalent_space by force
 
 lemma deformation_retract_of_space:
   "S \<subseteq> topspace X \<and>
    (\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id) \<longleftrightarrow>
    S retract_of_space X \<and> (\<exists>f. homotopic_with (\<lambda>x. True) X X id f \<and> f ` (topspace X) \<subseteq> S)"
 proof (cases "S \<subseteq> topspace X")
   case True
   moreover have "(\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id)
              \<longleftrightarrow> (S retract_of_space X \<and> (\<exists>f. homotopic_with (\<lambda>x. True) X X id f \<and> f ` topspace X \<subseteq> S))"
     unfolding retract_of_space_def
   proof safe
     fix f r
     assume f: "homotopic_with (\<lambda>x. True) X X id f"
       and fS: "f ` topspace X \<subseteq> S"
       and r: "continuous_map X (subtopology X S) r"
       and req: "\<forall>x\<in>S. r x = x"
     show "\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id"
     proof (intro exI conjI)
       have "homotopic_with (\<lambda>x. True) X X f r"
         proof (rule homotopic_with_eq)
           show "homotopic_with (\<lambda>x. True) X X (r \<circ> f) (r \<circ> id)"
             by (metis continuous_map_into_fulltopology f homotopic_with_compose_continuous_map_left homotopic_with_symD r)
           show "f x = (r \<circ> f) x" if "x \<in> topspace X" for x
             using that fS req by auto
         qed auto
       then show "homotopic_with (\<lambda>x. True) X X id r"
         by (rule homotopic_with_trans [OF f])
     next
       show "retraction_maps X (subtopology X S) r id"
         by (simp add: r req retraction_maps_def)
     qed
   qed (use True in \<open>auto simp: retraction_maps_def topspace_subtopology_subset continuous_map_in_subtopology\<close>)
   ultimately show ?thesis by simp
 qed (auto simp: retract_of_space_def retraction_maps_def)
 
 
 
 subsection\<open>Contractible spaces\<close>
 
 text\<open>The definition (which agrees with "contractible" on subsets of Euclidean space)
 is a little cryptic because we don't in fact assume that the constant "a" is in the space.
 This forces the convention that the empty space / set is contractible, avoiding some special cases. \<close>
 
 definition contractible_space where
   "contractible_space X \<equiv> \<exists>a. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
 
 lemma contractible_space_top_of_set [simp]:"contractible_space (top_of_set S) \<longleftrightarrow> contractible S"
   by (auto simp: contractible_space_def contractible_def)
 
 lemma contractible_space_empty [simp]:
    "contractible_space trivial_topology"
   unfolding contractible_space_def homotopic_with_def
   apply (rule_tac x=undefined in exI)
   apply (rule_tac x="\<lambda>(t,x). if t = 0 then x else undefined" in exI)
   apply (auto simp: continuous_map_on_empty)
   done
 
 lemma contractible_space_singleton [simp]:
   "contractible_space (discrete_topology{a})"
   unfolding contractible_space_def homotopic_with_def
   apply (rule_tac x=a in exI)
   apply (rule_tac x="\<lambda>(t,x). if t = 0 then x else a" in exI)
   apply (auto intro: continuous_map_eq [where f = "\<lambda>z. a"])
   done
 
 lemma contractible_space_subset_singleton:
    "topspace X \<subseteq> {a} \<Longrightarrow> contractible_space X"
   by (metis contractible_space_empty contractible_space_singleton null_topspace_iff_trivial subset_singletonD subtopology_eq_discrete_topology_sing)
 
 lemma contractible_space_subtopology_singleton [simp]:
    "contractible_space (subtopology X {a})"
   by (meson contractible_space_subset_singleton insert_subset path_connectedin_singleton path_connectedin_subtopology subsetI)
 
 lemma contractible_space:
    "contractible_space X \<longleftrightarrow>
         X = trivial_topology \<or>
         (\<exists>a \<in> topspace X. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a))"
 proof (cases "X = trivial_topology")
   case False
   then show ?thesis
     using homotopic_with_imp_continuous_maps  by (fastforce simp: contractible_space_def)
 qed (simp add: contractible_space_empty)
 
 lemma contractible_imp_path_connected_space:
   assumes "contractible_space X" shows "path_connected_space X"
 proof (cases "X = trivial_topology")
   case False
   have *: "path_connected_space X"
     if "a \<in> topspace X" and conth: "continuous_map (prod_topology (top_of_set {0..1}) X) X h"
       and h: "\<forall>x. h (0, x) = x" "\<forall>x. h (1, x) = a"
     for a and h :: "real \<times> 'a \<Rightarrow> 'a"
   proof -
     have "path_component_of X b a" if "b \<in> topspace X" for b
       unfolding path_component_of_def
     proof (intro exI conjI)
       let ?g = "h \<circ> (\<lambda>x. (x,b))"
       show "pathin X ?g"
         unfolding pathin_def
       proof (rule continuous_map_compose [OF _ conth])
         show "continuous_map (top_of_set {0..1}) (prod_topology (top_of_set {0..1}) X) (\<lambda>x. (x, b))"
           using that by (auto intro!: continuous_intros)
       qed
     qed (use h in auto)
   then show ?thesis
     by (metis path_component_of_equiv path_connected_space_iff_path_component)
   qed
   show ?thesis
     using assms False by (auto simp: contractible_space homotopic_with_def *)
 qed (simp add: path_connected_space_topspace_empty)
 
 lemma contractible_imp_connected_space:
    "contractible_space X \<Longrightarrow> connected_space X"
   by (simp add: contractible_imp_path_connected_space path_connected_imp_connected_space)
 
 lemma contractible_space_alt:
    "contractible_space X \<longleftrightarrow> (\<forall>a \<in> topspace X. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a))" (is "?lhs = ?rhs")
 proof
   assume X: ?lhs
   then obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
     by (auto simp: contractible_space_def)
   show ?rhs
   proof
     show "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. b)" if "b \<in> topspace X" for b
     proof (rule homotopic_with_trans [OF a])
       show "homotopic_with (\<lambda>x. True) X X (\<lambda>x. a) (\<lambda>x. b)"
         using homotopic_constant_maps path_connected_space_imp_path_component_of
         by (metis X a contractible_imp_path_connected_space homotopic_with_sym homotopic_with_trans path_component_of_equiv that)
     qed
   qed
 next
   assume R: ?rhs
   then show ?lhs
     using contractible_space_def by fastforce
 qed
 
 
 lemma compose_const [simp]: "f \<circ> (\<lambda>x. a) = (\<lambda>x. f a)" "(\<lambda>x. a) \<circ> g = (\<lambda>x. a)"
   by (simp_all add: o_def)
 
 lemma nullhomotopic_through_contractible_space:
   assumes f: "continuous_map X Y f" and g: "continuous_map Y Z g" and Y: "contractible_space Y"
   obtains c where "homotopic_with (\<lambda>h. True) X Z (g \<circ> f) (\<lambda>x. c)"
 proof -
   obtain b where b: "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. b)"
     using Y by (auto simp: contractible_space_def)
   show thesis
     using homotopic_with_compose_continuous_map_right
            [OF homotopic_with_compose_continuous_map_left [OF b g] f]
     by (force simp: that)
 qed
 
 lemma nullhomotopic_into_contractible_space:
   assumes f: "continuous_map X Y f" and Y: "contractible_space Y"
   obtains c where "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
   using nullhomotopic_through_contractible_space [OF f _ Y]
   by (metis continuous_map_id id_comp)
 
 lemma nullhomotopic_from_contractible_space:
   assumes f: "continuous_map X Y f" and X: "contractible_space X"
   obtains c where "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
   using nullhomotopic_through_contractible_space [OF _ f X]
   by (metis comp_id continuous_map_id)
 
 lemma homotopy_dominated_contractibility:
   assumes f: "continuous_map X Y f" and g: "continuous_map Y X g"
     and hom: "homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) id" and X: "contractible_space X"
   shows "contractible_space Y"
 proof -
   obtain c where c: "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
     using nullhomotopic_from_contractible_space [OF f X] .
   have "homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) (\<lambda>x. c)"
     using homotopic_with_compose_continuous_map_right [OF c g] by fastforce
   then have "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. c)"
     using homotopic_with_trans [OF _ hom] homotopic_with_symD by blast
   then show ?thesis
     unfolding contractible_space_def ..
 qed
 
 lemma homotopy_equivalent_space_contractibility:
    "X homotopy_equivalent_space Y \<Longrightarrow> (contractible_space X \<longleftrightarrow> contractible_space Y)"
   unfolding homotopy_equivalent_space_def
   by (blast intro: homotopy_dominated_contractibility)
 
 lemma homeomorphic_space_contractibility:
    "X homeomorphic_space Y
         \<Longrightarrow> (contractible_space X \<longleftrightarrow> contractible_space Y)"
   by (simp add: homeomorphic_imp_homotopy_equivalent_space homotopy_equivalent_space_contractibility)
 
 lemma homotopic_through_contractible_space:
    "continuous_map X Y f \<and>
         continuous_map X Y f' \<and>
         continuous_map Y Z g \<and>
         continuous_map Y Z g' \<and>
         contractible_space Y \<and> path_connected_space Z
         \<Longrightarrow> homotopic_with (\<lambda>h. True) X Z (g \<circ> f) (g' \<circ> f')"
   using nullhomotopic_through_contractible_space [of X Y f Z g]
   using nullhomotopic_through_contractible_space [of X Y f' Z g']
   by (smt (verit) continuous_map_const homotopic_constant_maps homotopic_with_imp_continuous_maps
       homotopic_with_symD homotopic_with_trans path_connected_space_imp_path_component_of)
 
 lemma homotopic_from_contractible_space:
    "continuous_map X Y f \<and> continuous_map X Y g \<and>
         contractible_space X \<and> path_connected_space Y
         \<Longrightarrow> homotopic_with (\<lambda>x. True) X Y f g"
   by (metis comp_id continuous_map_id homotopic_through_contractible_space)
 
 lemma homotopic_into_contractible_space:
    "continuous_map X Y f \<and> continuous_map X Y g \<and>
         contractible_space Y
         \<Longrightarrow> homotopic_with (\<lambda>x. True) X Y f g"
   by (metis continuous_map_id contractible_imp_path_connected_space homotopic_through_contractible_space id_comp)
 
 lemma contractible_eq_homotopy_equivalent_singleton_subtopology:
    "contractible_space X \<longleftrightarrow>
         X = trivial_topology \<or> (\<exists>a \<in> topspace X. X homotopy_equivalent_space (subtopology X {a}))"(is "?lhs = ?rhs")
 proof (cases "X = trivial_topology")
   case False
   show ?thesis
   proof
     assume ?lhs
     then obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
       by (auto simp: contractible_space_def)
     then have "a \<in> topspace X"
       by (metis False continuous_map_const homotopic_with_imp_continuous_maps)
     then have "homotopic_with (\<lambda>x. True) (subtopology X {a}) (subtopology X {a}) id (\<lambda>x. a)"
       using connectedin_absolute connectedin_sing contractible_space_alt contractible_space_subtopology_singleton by fastforce
     then have "X homotopy_equivalent_space subtopology X {a}"
       unfolding homotopy_equivalent_space_def using \<open>a \<in> topspace X\<close>
       by (metis (full_types) a comp_id continuous_map_const continuous_map_id_subt empty_subsetI homotopic_with_symD
            id_comp insertI1 insert_subset topspace_subtopology_subset)
     with \<open>a \<in> topspace X\<close> show ?rhs
       by blast
   next
     assume ?rhs
     then show ?lhs
       by (meson False contractible_space_subtopology_singleton homotopy_equivalent_space_contractibility)
   qed
 qed (simp add: contractible_space_empty)
 
 lemma contractible_space_retraction_map_image:
   assumes "retraction_map X Y f" and X: "contractible_space X"
   shows "contractible_space Y"
 proof -
   obtain g where f: "continuous_map X Y f" and g: "continuous_map Y X g" and fg: "\<forall>y \<in> topspace Y. f(g y) = y"
     using assms by (auto simp: retraction_map_def retraction_maps_def)
   obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
     using X by (auto simp: contractible_space_def)
   have "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. f a)"
   proof (rule homotopic_with_eq)
     show "homotopic_with (\<lambda>x. True) Y Y (f \<circ> id \<circ> g) (f \<circ> (\<lambda>x. a) \<circ> g)"
       using f g a homotopic_with_compose_continuous_map_left homotopic_with_compose_continuous_map_right by metis
   qed (use fg in auto)
   then show ?thesis
     unfolding contractible_space_def by blast
 qed
 
 lemma contractible_space_prod_topology:
    "contractible_space(prod_topology X Y) \<longleftrightarrow>
     X = trivial_topology \<or> Y = trivial_topology \<or> contractible_space X \<and> contractible_space Y"
 proof (cases "X = trivial_topology \<or> Y = trivial_topology")
   case True
   then have "(prod_topology X Y) = trivial_topology"
     by simp
   then show ?thesis
     by (auto simp: contractible_space_empty)
 next
   case False
   have "contractible_space(prod_topology X Y) \<longleftrightarrow> contractible_space X \<and> contractible_space Y"
   proof safe
     assume XY: "contractible_space (prod_topology X Y)"
     with False have "retraction_map (prod_topology X Y) X fst"
       by (auto simp: contractible_space False retraction_map_fst)
     then show "contractible_space X"
       by (rule contractible_space_retraction_map_image [OF _ XY])
     have "retraction_map (prod_topology X Y) Y snd"
       using False XY  by (auto simp: contractible_space False retraction_map_snd)
     then show "contractible_space Y"
       by (rule contractible_space_retraction_map_image [OF _ XY])
   next
     assume "contractible_space X" and "contractible_space Y"
     with False obtain a b
       where "a \<in> topspace X" and a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
         and "b \<in> topspace Y" and b: "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. b)"
       by (auto simp: contractible_space)
     with False show "contractible_space (prod_topology X Y)"
       apply (simp add: contractible_space)
       apply (rule_tac x=a in bexI)
        apply (rule_tac x=b in bexI)
       using homotopic_with_prod_topology [OF a b]
         apply (metis (no_types, lifting) case_prod_Pair case_prod_beta' eq_id_iff)
        apply auto
       done
   qed
   with False show ?thesis
     by auto
 qed
 
 
 lemma contractible_space_product_topology:
   "contractible_space(product_topology X I) \<longleftrightarrow>
     (product_topology X I) = trivial_topology \<or> (\<forall>i \<in> I. contractible_space(X i))"
 proof (cases "(product_topology X I) = trivial_topology")
   case False
   have 1: "contractible_space (X i)"
     if XI: "contractible_space (product_topology X I)" and "i \<in> I"
     for i
   proof (rule contractible_space_retraction_map_image [OF _ XI])
     show "retraction_map (product_topology X I) (X i) (\<lambda>x. x i)"
       using False by (simp add: retraction_map_product_projection \<open>i \<in> I\<close>)
   qed
   have 2: "contractible_space (product_topology X I)"
     if "x \<in> topspace (product_topology X I)" and cs: "\<forall>i\<in>I. contractible_space (X i)"
     for x :: "'a \<Rightarrow> 'b"
   proof -
     obtain f where f: "\<And>i. i\<in>I \<Longrightarrow> homotopic_with (\<lambda>x. True) (X i) (X i) id (\<lambda>x. f i)"
       using cs unfolding contractible_space_def by metis
     have "homotopic_with (\<lambda>x. True)
                          (product_topology X I) (product_topology X I) id (\<lambda>x. restrict f I)"
       by (rule homotopic_with_eq [OF homotopic_with_product_topology [OF f]]) (auto)
     then show ?thesis
       by (auto simp: contractible_space_def)
   qed
   show ?thesis
     using False 1 2 by (meson equals0I subtopology_eq_discrete_topology_empty)
 qed auto
 
 
 lemma contractible_space_subtopology_euclideanreal [simp]:
   "contractible_space(subtopology euclideanreal S) \<longleftrightarrow> is_interval S"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "path_connectedin (subtopology euclideanreal S) S"
     using contractible_imp_path_connected_space path_connectedin_topspace path_connectedin_absolute
     by (simp add: contractible_imp_path_connected) 
   then show ?rhs
     by (simp add: is_interval_path_connected_1)
 next
   assume ?rhs
   then have "convex S"
     by (simp add: is_interval_convex_1)
   show ?lhs
   proof (cases "S = {}")
     case False
     then obtain z where "z \<in> S"
       by blast
     show ?thesis
       unfolding contractible_space_def homotopic_with_def
     proof (intro exI conjI allI)
       note \<section> = convexD [OF \<open>convex S\<close>, simplified]
       show "continuous_map (prod_topology (top_of_set {0..1}) (top_of_set S)) (top_of_set S)
                            (\<lambda>(t,x). (1 - t) * x + t * z)"
         using  \<open>z \<in> S\<close> 
         by (auto simp: case_prod_unfold intro!: continuous_intros \<section>)
     qed auto
   qed (simp add: contractible_space_empty)
 qed
 
 
 corollary contractible_space_euclideanreal: "contractible_space euclideanreal"
 proof -
   have "contractible_space (subtopology euclideanreal UNIV)"
     using contractible_space_subtopology_euclideanreal by blast
   then show ?thesis
     by simp
 qed
 
 
 abbreviation\<^marker>\<open>tag important\<close> homotopy_eqv :: "'a::topological_space set \<Rightarrow> 'b::topological_space set \<Rightarrow> bool"
              (infix "homotopy'_eqv" 50)
   where "S homotopy_eqv T \<equiv> top_of_set S homotopy_equivalent_space top_of_set T"
 
 lemma homeomorphic_imp_homotopy_eqv: "S homeomorphic T \<Longrightarrow> S homotopy_eqv T"
   unfolding homeomorphic_def homeomorphism_def homotopy_equivalent_space_def
   by (metis continuous_map_subtopology_eu homotopic_with_id2 openin_imp_subset openin_subtopology_self topspace_euclidean_subtopology)
 
 lemma homotopy_eqv_inj_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "(f ` S) homotopy_eqv S"
   by (metis assms homeomorphic_sym homeomorphic_imp_homotopy_eqv linear_homeomorphic_image)
 
 lemma homotopy_eqv_translation:
     fixes S :: "'a::real_normed_vector set"
     shows "(+) a ` S homotopy_eqv S"
   using homeomorphic_imp_homotopy_eqv homeomorphic_translation homeomorphic_sym by blast
 
 lemma homotopy_eqv_homotopic_triviality_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on U f" "f \<in> U \<rightarrow> T"
       and g: "continuous_on U g" "g \<in> U \<rightarrow> T"
       and homUS: "\<And>f g. \<lbrakk>continuous_on U f; f \<in> U \<rightarrow> S;
                          continuous_on U g; g \<in> U \<rightarrow> S\<rbrakk>
                          \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) U S f g"
     shows "homotopic_with_canon (\<lambda>x. True) U T f g"
 proof -
   obtain h k where h: "continuous_on S h" "h \<in> S \<rightarrow> T"
                and k: "continuous_on T k" "k \<in> T \<rightarrow> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (force simp: homotopy_equivalent_space_def image_subset_iff_funcset)
   have "homotopic_with_canon (\<lambda>f. True) U S (k \<circ> f) (k \<circ> g)"
   proof (rule homUS)
     show "continuous_on U (k \<circ> f)" "continuous_on U (k \<circ> g)"
       using continuous_on_compose continuous_on_subset f g k by (metis funcset_image)+
   qed (use f g k in \<open>(force simp: o_def)+\<close> )
   then have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> (k \<circ> f)) (h \<circ> (k \<circ> g))"
     by (simp add: h homotopic_with_compose_continuous_map_left image_subset_iff_funcset)
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> k \<circ> f) (id \<circ> f)"
     by (rule homotopic_with_compose_continuous_right [where X=T and Y=T]; simp add: hom f)
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> k \<circ> g) (id \<circ> g)"
     by (rule homotopic_with_compose_continuous_right [where X=T and Y=T]; simp add: hom g)
   ultimately show "homotopic_with_canon (\<lambda>x. True) U T f g"
     unfolding o_assoc
     by (metis homotopic_with_trans homotopic_with_sym id_comp) 
 qed
 
 lemma homotopy_eqv_homotopic_triviality:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f g. continuous_on U f \<and> f \<in> U \<rightarrow> S \<and>
                    continuous_on U g \<and> g \<in> U \<rightarrow> S
                    \<longrightarrow> homotopic_with_canon (\<lambda>x. True) U S f g) \<longleftrightarrow>
            (\<forall>f g. continuous_on U f \<and> f \<in> U \<rightarrow> T \<and>
                   continuous_on U g \<and> g \<in> U \<rightarrow> T
                   \<longrightarrow> homotopic_with_canon (\<lambda>x. True) U T f g)"
       (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (metis assms homotopy_eqv_homotopic_triviality_imp)
 next
   assume ?rhs
   moreover
   have "T homotopy_eqv S"
     using assms homotopy_equivalent_space_sym by blast
   ultimately show ?lhs
     by (blast intro: homotopy_eqv_homotopic_triviality_imp)
 qed
 
 
 lemma homotopy_eqv_cohomotopic_triviality_null_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on T f" "f \<in> T \<rightarrow> U"
       and homSU: "\<And>f. \<lbrakk>continuous_on S f; f \<in> S \<rightarrow> U\<rbrakk>
                       \<Longrightarrow> \<exists>c. homotopic_with_canon (\<lambda>x. True) S U f (\<lambda>x. c)"
   obtains c where "homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. c)"
 proof -
   obtain h k where h: "continuous_on S h" "h \<in> S \<rightarrow> T"
                and k: "continuous_on T k" "k \<in> T \<rightarrow> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (force simp: homotopy_equivalent_space_def image_subset_iff_funcset)
   obtain c where "homotopic_with_canon (\<lambda>x. True) S U (f \<circ> h) (\<lambda>x. c)"
   proof (rule exE [OF homSU])
     show "continuous_on S (f \<circ> h)"
       by (metis continuous_on_compose continuous_on_subset f h funcset_image)
   qed (use f h in force)
   then have "homotopic_with_canon (\<lambda>x. True) T U ((f \<circ> h) \<circ> k) ((\<lambda>x. c) \<circ> k)"
     by (rule homotopic_with_compose_continuous_right [where X=S]) (use k in auto)
   moreover have "homotopic_with_canon (\<lambda>x. True) T U (f \<circ> id) (f \<circ> (h \<circ> k))"
     by (rule homotopic_with_compose_continuous_left [where Y=T])
        (use f in \<open>auto simp: hom homotopic_with_symD\<close>)
   ultimately show ?thesis
     using that homotopic_with_trans by (fastforce simp: o_def)
 qed
 
 lemma homotopy_eqv_cohomotopic_triviality_null:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f. continuous_on S f \<and> f \<in> S \<rightarrow> U
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S U f (\<lambda>x. c))) \<longleftrightarrow>
            (\<forall>f. continuous_on T f \<and> f \<in> T \<rightarrow> U
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. c)))"
 by (rule iffI; metis assms homotopy_eqv_cohomotopic_triviality_null_imp homotopy_equivalent_space_sym)
 
 text \<open>Similar to the proof above\<close>
 lemma homotopy_eqv_homotopic_triviality_null_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on U f" "f \<in> U \<rightarrow> T"
       and homSU: "\<And>f. \<lbrakk>continuous_on U f; f \<in> U \<rightarrow> S\<rbrakk>
                       \<Longrightarrow> \<exists>c. homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. c)"
     shows "\<exists>c. homotopic_with_canon (\<lambda>x. True) U T f (\<lambda>x. c)"
 proof -
   obtain h k where h: "continuous_on S h" "h \<in> S \<rightarrow> T"
                and k: "continuous_on T k" "k \<in> T \<rightarrow> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (force simp: homotopy_equivalent_space_def image_subset_iff_funcset)
   obtain c::'a where "homotopic_with_canon (\<lambda>x. True) U S (k \<circ> f) (\<lambda>x. c)"
   proof (rule exE [OF homSU [of "k \<circ> f"]])
     show "continuous_on U (k \<circ> f)"
       using continuous_on_compose continuous_on_subset f k by (metis funcset_image)
   qed (use f k in force)
   then have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> (k \<circ> f)) (h \<circ> (\<lambda>x. c))"
     by (rule homotopic_with_compose_continuous_left [where Y=S]) (use h in auto)
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (id \<circ> f) ((h \<circ> k) \<circ> f)"
     by (rule homotopic_with_compose_continuous_right [where X=T])
        (use f in \<open>auto simp: hom homotopic_with_symD\<close>)
   ultimately show ?thesis
     using homotopic_with_trans by (fastforce simp: o_def)
 qed
 
 lemma homotopy_eqv_homotopic_triviality_null:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f. continuous_on U f \<and> f \<in> U \<rightarrow> S
                   \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. c))) \<longleftrightarrow>
            (\<forall>f. continuous_on U f \<and> f \<in> U \<rightarrow> T
                   \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) U T f (\<lambda>x. c)))"
 by (rule iffI; metis assms homotopy_eqv_homotopic_triviality_null_imp homotopy_equivalent_space_sym)
 
 lemma homotopy_eqv_contractible_sets:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
   assumes "contractible S" "contractible T" "S = {} \<longleftrightarrow> T = {}"
     shows "S homotopy_eqv T"
 proof (cases "S = {}")
   case True with assms show ?thesis
     using homeomorphic_imp_homotopy_eqv by fastforce
 next
   case False
   with assms obtain a b where "a \<in> S" "b \<in> T"
     by auto
   then show ?thesis
     unfolding homotopy_equivalent_space_def
     apply (rule_tac x="\<lambda>x. b" in exI, rule_tac x="\<lambda>x. a" in exI)
     apply (intro assms conjI continuous_on_id' homotopic_into_contractible; force)
     done
 qed
 
 lemma homotopy_eqv_empty1 [simp]:
   fixes S :: "'a::real_normed_vector set"
   shows "S homotopy_eqv ({}::'b::real_normed_vector set) \<longleftrightarrow> S = {}" (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis continuous_map_subtopology_eu empty_iff equalityI homotopy_equivalent_space_def image_subset_iff subsetI)
 qed (use homeomorphic_imp_homotopy_eqv in force)
 
 lemma homotopy_eqv_empty2 [simp]:
   fixes S :: "'a::real_normed_vector set"
   shows "({}::'b::real_normed_vector set) homotopy_eqv S \<longleftrightarrow> S = {}"
   using homotopy_equivalent_space_sym homotopy_eqv_empty1 by blast
 
 lemma homotopy_eqv_contractibility:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "S homotopy_eqv T \<Longrightarrow> (contractible S \<longleftrightarrow> contractible T)"
   by (meson contractible_space_top_of_set homotopy_equivalent_space_contractibility)
 
 lemma homotopy_eqv_sing:
   fixes S :: "'a::real_normed_vector set" and a :: "'b::real_normed_vector"
   shows "S homotopy_eqv {a} \<longleftrightarrow> S \<noteq> {} \<and> contractible S"
   by (metis contractible_sing empty_not_insert homotopy_eqv_contractibility homotopy_eqv_contractible_sets homotopy_eqv_empty2)
 
 lemma homeomorphic_contractible_eq:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "S homeomorphic T \<Longrightarrow> (contractible S \<longleftrightarrow> contractible T)"
 by (simp add: homeomorphic_imp_homotopy_eqv homotopy_eqv_contractibility)
 
 lemma homeomorphic_contractible:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "\<lbrakk>contractible S; S homeomorphic T\<rbrakk> \<Longrightarrow> contractible T"
   by (metis homeomorphic_contractible_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Misc other results\<close>
 
 lemma bounded_connected_Compl_real:
   fixes S :: "real set"
   assumes "bounded S" and conn: "connected(- S)"
     shows "S = {}"
 proof -
   obtain a b where "S \<subseteq> box a b"
     by (meson assms bounded_subset_box_symmetric)
   then have "a \<notin> S" "b \<notin> S"
     by auto
   then have "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> x \<in> - S"
     by (meson Compl_iff conn connected_iff_interval)
   then show ?thesis
     using \<open>S \<subseteq> box a b\<close> by auto
 qed
 
 corollary bounded_path_connected_Compl_real:
   fixes S :: "real set"
   assumes "bounded S" "path_connected(- S)" shows "S = {}"
   by (simp add: assms bounded_connected_Compl_real path_connected_imp_connected)
 
 lemma bounded_connected_Compl_1:
   fixes S :: "'a::{euclidean_space} set"
   assumes "bounded S" and conn: "connected(- S)" and 1: "DIM('a) = 1"
     shows "S = {}"
 proof -
   have "DIM('a) = DIM(real)"
     by (simp add: "1")
   then obtain f::"'a \<Rightarrow> real" and g
   where "linear f" "\<And>x. norm(f x) = norm x" and fg: "\<And>x. g(f x) = x" "\<And>y. f(g y) = y"
     by (rule isomorphisms_UNIV_UNIV) blast
   with \<open>bounded S\<close> have "bounded (f ` S)"
     using bounded_linear_image linear_linear by blast
   have "bij f" by (metis fg bijI')
   have "connected (f ` (-S))"
     using connected_linear_image assms \<open>linear f\<close> by blast
   moreover have "f ` (-S) = - (f ` S)"
     by (simp add: \<open>bij f\<close> bij_image_Compl_eq)
   finally have "connected (- (f ` S))"
     by simp
   then have "f ` S = {}"
     using \<open>bounded (f ` S)\<close> bounded_connected_Compl_real by blast
   then show ?thesis
     by blast
 qed
 
 lemma connected_card_eq_iff_nontrivial:
   fixes S :: "'a::metric_space set"
   shows "connected S \<Longrightarrow> uncountable S \<longleftrightarrow> \<not>(\<exists>a. S \<subseteq> {a})"
   by (metis connected_uncountable finite.emptyI finite.insertI rev_finite_subset singleton_iff subsetI uncountable_infinite)
 
 lemma connected_finite_iff_sing:
   fixes S :: "'a::metric_space set"
   assumes "connected S"
   shows "finite S \<longleftrightarrow> S = {} \<or> (\<exists>a. S = {a})" 
   using assms connected_uncountable countable_finite by blast
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open> Some simple positive connection theorems\<close>
 
 proposition path_connected_convex_diff_countable:
   fixes U :: "'a::euclidean_space set"
   assumes "convex U" "\<not> collinear U" "countable S"
     shows "path_connected(U - S)"
 proof (clarsimp simp: path_connected_def)
   fix a b
   assume "a \<in> U" "a \<notin> S" "b \<in> U" "b \<notin> S"
   let ?m = "midpoint a b"
   show "\<exists>g. path g \<and> path_image g \<subseteq> U - S \<and> pathstart g = a \<and> pathfinish g = b"
   proof (cases "a = b")
     case True
     then show ?thesis
       by (metis DiffI \<open>a \<in> U\<close> \<open>a \<notin> S\<close> path_component_def path_component_refl)
   next
     case False
     then have "a \<noteq> ?m" "b \<noteq> ?m"
       using midpoint_eq_endpoint by fastforce+
     have "?m \<in> U"
       using \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>convex U\<close> convex_contains_segment by force
     obtain c where "c \<in> U" and nc_abc: "\<not> collinear {a,b,c}"
       by (metis False \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>\<not> collinear U\<close> collinear_triples insert_absorb)
     have ncoll_mca: "\<not> collinear {?m,c,a}"
       by (metis (full_types) \<open>a \<noteq> ?m\<close> collinear_3_trans collinear_midpoint insert_commute nc_abc)
     have ncoll_mcb: "\<not> collinear {?m,c,b}"
       by (metis (full_types) \<open>b \<noteq> ?m\<close> collinear_3_trans collinear_midpoint insert_commute nc_abc)
     have "c \<noteq> ?m"
       by (metis collinear_midpoint insert_commute nc_abc)
     then have "closed_segment ?m c \<subseteq> U"
       by (simp add: \<open>c \<in> U\<close> \<open>?m \<in> U\<close> \<open>convex U\<close> closed_segment_subset)
     then obtain z where z: "z \<in> closed_segment ?m c"
                     and disjS: "(closed_segment a z \<union> closed_segment z b) \<inter> S = {}"
     proof -
       have False if "closed_segment ?m c \<subseteq> {z. (closed_segment a z \<union> closed_segment z b) \<inter> S \<noteq> {}}"
       proof -
         have closb: "closed_segment ?m c \<subseteq>
                  {z \<in> closed_segment ?m c. closed_segment a z \<inter> S \<noteq> {}} \<union> {z \<in> closed_segment ?m c. closed_segment z b \<inter> S \<noteq> {}}"
           using that by blast
         have *: "countable {z \<in> closed_segment ?m c. closed_segment z u \<inter> S \<noteq> {}}"
           if "u \<in> U" "u \<notin> S" and ncoll: "\<not> collinear {?m, c, u}" for u
         proof -
           have **: False if x1: "x1 \<in> closed_segment ?m c" and x2: "x2 \<in> closed_segment ?m c"
                             and "x1 \<noteq> x2" "x1 \<noteq> u"
                             and w: "w \<in> closed_segment x1 u" "w \<in> closed_segment x2 u"
                             and "w \<in> S" for x1 x2 w
           proof -
             have "x1 \<in> affine hull {?m,c}" "x2 \<in> affine hull {?m,c}"
               using segment_as_ball x1 x2 by auto
             then have coll_x1: "collinear {x1, ?m, c}" and coll_x2: "collinear {?m, c, x2}"
               by (simp_all add: affine_hull_3_imp_collinear) (metis affine_hull_3_imp_collinear insert_commute)
             have "\<not> collinear {x1, u, x2}"
             proof
               assume "collinear {x1, u, x2}"
               then have "collinear {?m, c, u}"
                 by (metis (full_types) \<open>c \<noteq> ?m\<close> coll_x1 coll_x2 collinear_3_trans insert_commute ncoll \<open>x1 \<noteq> x2\<close>)
               with ncoll show False ..
             qed
             then have "closed_segment x1 u \<inter> closed_segment u x2 = {u}"
               by (blast intro!: Int_closed_segment)
             then have "w = u"
               using closed_segment_commute w by auto
             show ?thesis
               using \<open>u \<notin> S\<close> \<open>w = u\<close> that(7) by auto
           qed
           then have disj: "disjoint ((\<Union>z\<in>closed_segment ?m c. {closed_segment z u \<inter> S}))"
             by (fastforce simp: pairwise_def disjnt_def)
           have cou: "countable ((\<Union>z \<in> closed_segment ?m c. {closed_segment z u \<inter> S}) - {{}})"
             apply (rule pairwise_disjnt_countable_Union [OF _ pairwise_subset [OF disj]])
              apply (rule countable_subset [OF _ \<open>countable S\<close>], auto)
             done
           define f where "f \<equiv> \<lambda>X. (THE z. z \<in> closed_segment ?m c \<and> X = closed_segment z u \<inter> S)"
           show ?thesis
           proof (rule countable_subset [OF _ countable_image [OF cou, where f=f]], clarify)
             fix x
             assume x: "x \<in> closed_segment ?m c" "closed_segment x u \<inter> S \<noteq> {}"
             show "x \<in> f ` ((\<Union>z\<in>closed_segment ?m c. {closed_segment z u \<inter> S}) - {{}})"
             proof (rule_tac x="closed_segment x u \<inter> S" in image_eqI)
               show "x = f (closed_segment x u \<inter> S)"
                 unfolding f_def 
                 by (rule the_equality [symmetric]) (use x in \<open>auto dest: **\<close>)
             qed (use x in auto)
           qed
         qed
         have "uncountable (closed_segment ?m c)"
           by (metis \<open>c \<noteq> ?m\<close> uncountable_closed_segment)
         then show False
           using closb * [OF \<open>a \<in> U\<close> \<open>a \<notin> S\<close> ncoll_mca] * [OF \<open>b \<in> U\<close> \<open>b \<notin> S\<close> ncoll_mcb]
           by (simp add: closed_segment_commute countable_subset)
       qed
       then show ?thesis
         by (force intro: that)
     qed
     show ?thesis
     proof (intro exI conjI)
       have "path_image (linepath a z +++ linepath z b) \<subseteq> U"
         by (metis \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>closed_segment ?m c \<subseteq> U\<close> z \<open>convex U\<close> closed_segment_subset contra_subsetD path_image_linepath subset_path_image_join)
       with disjS show "path_image (linepath a z +++ linepath z b) \<subseteq> U - S"
         by (force simp: path_image_join)
     qed auto
   qed
 qed
 
 
 corollary connected_convex_diff_countable:
   fixes U :: "'a::euclidean_space set"
   assumes "convex U" "\<not> collinear U" "countable S"
   shows "connected(U - S)"
   by (simp add: assms path_connected_convex_diff_countable path_connected_imp_connected)
 
 lemma path_connected_punctured_convex:
   assumes "convex S" and aff: "aff_dim S \<noteq> 1"
     shows "path_connected(S - {a})"
 proof -
   consider "aff_dim S = -1" | "aff_dim S = 0" | "aff_dim S \<ge> 2"
     using assms aff_dim_geq [of S] by linarith
   then show ?thesis
   proof cases
     assume "aff_dim S = -1"
     then show ?thesis
       by (metis aff_dim_empty empty_Diff path_connected_empty)
   next
     assume "aff_dim S = 0"
     then show ?thesis
       by (metis aff_dim_eq_0 Diff_cancel Diff_empty Diff_insert0 convex_empty convex_imp_path_connected path_connected_singleton singletonD)
   next
     assume ge2: "aff_dim S \<ge> 2"
     then have "\<not> collinear S"
     proof (clarsimp simp: collinear_affine_hull)
       fix u v
       assume "S \<subseteq> affine hull {u, v}"
       then have "aff_dim S \<le> aff_dim {u, v}"
         by (metis (no_types) aff_dim_affine_hull aff_dim_subset)
       with ge2 show False
         by (metis (no_types) aff_dim_2 antisym aff not_numeral_le_zero one_le_numeral order_trans)
     qed
     moreover have "countable {a}"
       by simp
     ultimately show ?thesis
       by (metis path_connected_convex_diff_countable [OF \<open>convex S\<close>])
   qed
 qed
 
 lemma connected_punctured_convex:
   shows "\<lbrakk>convex S; aff_dim S \<noteq> 1\<rbrakk> \<Longrightarrow> connected(S - {a})"
   using path_connected_imp_connected path_connected_punctured_convex by blast
 
 lemma path_connected_complement_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "countable S"
   shows "path_connected(- S)"
 proof -
   have "\<not> collinear (UNIV::'a set)"
     using assms by (auto simp: collinear_aff_dim [of "UNIV :: 'a set"])
   then have "path_connected(UNIV - S)"
     by (simp add: \<open>countable S\<close> path_connected_convex_diff_countable)
   then show ?thesis
     by (simp add: Compl_eq_Diff_UNIV)
 qed
 
 proposition path_connected_openin_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "connected S" and ope: "openin (top_of_set (affine hull S)) S"
       and "\<not> collinear S" "countable T"
     shows "path_connected(S - T)"
 proof (clarsimp simp: path_connected_component)
   fix x y
   assume xy: "x \<in> S" "x \<notin> T" "y \<in> S" "y \<notin> T"
   show "path_component (S - T) x y"
   proof (rule connected_equivalence_relation_gen [OF \<open>connected S\<close>, where P = "\<lambda>x. x \<notin> T"])
     show "\<exists>z. z \<in> U \<and> z \<notin> T" if opeU: "openin (top_of_set S) U" and "x \<in> U" for U x
     proof -
       have "openin (top_of_set (affine hull S)) U"
         using opeU ope openin_trans by blast
       with \<open>x \<in> U\<close> obtain r where Usub: "U \<subseteq> affine hull S" and "r > 0"
                               and subU: "ball x r \<inter> affine hull S \<subseteq> U"
         by (auto simp: openin_contains_ball)
       with \<open>x \<in> U\<close> have x: "x \<in> ball x r \<inter> affine hull S"
         by auto
       have "\<not> S \<subseteq> {x}"
         using \<open>\<not> collinear S\<close>  collinear_subset by blast
       then obtain x' where "x' \<noteq> x" "x' \<in> S"
         by blast
       obtain y where y: "y \<noteq> x" "y \<in> ball x r \<inter> affine hull S"
       proof
         show "x + (r / 2 / norm(x' - x)) *\<^sub>R (x' - x) \<noteq> x"
           using \<open>x' \<noteq> x\<close> \<open>r > 0\<close> by auto
         show "x + (r / 2 / norm (x' - x)) *\<^sub>R (x' - x) \<in> ball x r \<inter> affine hull S"
           using \<open>x' \<noteq> x\<close> \<open>r > 0\<close> \<open>x' \<in> S\<close> x
           by (simp add: dist_norm mem_affine_3_minus hull_inc)
       qed
       have "convex (ball x r \<inter> affine hull S)"
         by (simp add: affine_imp_convex convex_Int)
       with x y subU have "uncountable U"
         by (meson countable_subset uncountable_convex)
       then have "\<not> U \<subseteq> T"
         using \<open>countable T\<close> countable_subset by blast
       then show ?thesis by blast
     qed
     show "\<exists>U. openin (top_of_set S) U \<and> x \<in> U \<and>
               (\<forall>x\<in>U. \<forall>y\<in>U. x \<notin> T \<and> y \<notin> T \<longrightarrow> path_component (S - T) x y)"
           if "x \<in> S" for x
     proof -
       obtain r where Ssub: "S \<subseteq> affine hull S" and "r > 0"
                  and subS: "ball x r \<inter> affine hull S \<subseteq> S"
         using ope \<open>x \<in> S\<close> by (auto simp: openin_contains_ball)
       then have conv: "convex (ball x r \<inter> affine hull S)"
         by (simp add: affine_imp_convex convex_Int)
       have "\<not> aff_dim (affine hull S) \<le> 1"
         using \<open>\<not> collinear S\<close> collinear_aff_dim by auto
       then have "\<not> aff_dim (ball x r \<inter> affine hull S) \<le> 1"
         by (metis (no_types, opaque_lifting) aff_dim_convex_Int_open IntI open_ball \<open>0 < r\<close> aff_dim_affine_hull affine_affine_hull affine_imp_convex centre_in_ball empty_iff hull_subset inf_commute subsetCE that)
       then have "\<not> collinear (ball x r \<inter> affine hull S)"
         by (simp add: collinear_aff_dim)
       then have *: "path_connected ((ball x r \<inter> affine hull S) - T)"
         by (rule path_connected_convex_diff_countable [OF conv _ \<open>countable T\<close>])
       have ST: "ball x r \<inter> affine hull S - T \<subseteq> S - T"
         using subS by auto
       show ?thesis
       proof (intro exI conjI)
         show "x \<in> ball x r \<inter> affine hull S"
           using \<open>x \<in> S\<close> \<open>r > 0\<close> by (simp add: hull_inc)
         have "openin (top_of_set (affine hull S)) (ball x r \<inter> affine hull S)"
           by (subst inf.commute) (simp add: openin_Int_open)
         then show "openin (top_of_set S) (ball x r \<inter> affine hull S)"
           by (rule openin_subset_trans [OF _ subS Ssub])
       qed (use * path_component_trans in \<open>auto simp: path_connected_component path_component_of_subset [OF ST]\<close>)
     qed
   qed (use xy path_component_trans in auto)
 qed
 
 corollary connected_openin_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "connected S" and ope: "openin (top_of_set (affine hull S)) S"
       and "\<not> collinear S" "countable T"
     shows "connected(S - T)"
   by (metis path_connected_imp_connected path_connected_openin_diff_countable [OF assms])
 
 corollary path_connected_open_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "open S" "connected S" "countable T"
   shows "path_connected(S - T)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp)
 next
   case False
   show ?thesis
   proof (rule path_connected_openin_diff_countable)
     show "openin (top_of_set (affine hull S)) S"
       by (simp add: assms hull_subset open_subset)
     show "\<not> collinear S"
       using assms False by (simp add: collinear_aff_dim aff_dim_open)
   qed (simp_all add: assms)
 qed
 
 corollary connected_open_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "open S" "connected S" "countable T"
   shows "connected(S - T)"
 by (simp add: assms path_connected_imp_connected path_connected_open_diff_countable)
 
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Self-homeomorphisms shuffling points about\<close>
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>The theorem \<open>homeomorphism_moving_points_exists\<close>\<close>
 
 lemma homeomorphism_moving_point_1:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and u: "u \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                     "f a = u" "\<And>x. x \<in> sphere a r \<Longrightarrow> f x = x"
 proof -
   have nou: "norm (u - a) < r" and "u \<in> T"
     using u by (auto simp: dist_norm norm_minus_commute)
   then have "0 < r"
     by (metis DiffD1 Diff_Diff_Int ball_eq_empty centre_in_ball not_le u)
   define f where "f \<equiv> \<lambda>x. (1 - norm(x - a) / r) *\<^sub>R (u - a) + x"
   have *: "False" if eq: "x + (norm y / r) *\<^sub>R u = y + (norm x / r) *\<^sub>R u"
                   and nou: "norm u < r" and yx: "norm y < norm x" for x y and u::'a
   proof -
     have "x = y + (norm x / r - (norm y / r)) *\<^sub>R u"
       using eq by (simp add: algebra_simps)
     then have "norm x = norm (y + ((norm x - norm y) / r) *\<^sub>R u)"
       by (metis diff_divide_distrib)
     also have "\<dots> \<le> norm y + norm(((norm x - norm y) / r) *\<^sub>R u)"
       using norm_triangle_ineq by blast
     also have "\<dots> = norm y + (norm x - norm y) * (norm u / r)"
       using yx \<open>r > 0\<close>
       by (simp add: field_split_simps)
     also have "\<dots> < norm y + (norm x - norm y) * 1"
     proof (subst add_less_cancel_left)
       show "(norm x - norm y) * (norm u / r) < (norm x - norm y) * 1"
       proof (rule mult_strict_left_mono)
         show "norm u / r < 1"
           using \<open>0 < r\<close> divide_less_eq_1_pos nou by blast
       qed (simp add: yx)
     qed
     also have "\<dots> = norm x"
       by simp
     finally show False by simp
   qed
   have "inj f"
     unfolding f_def
   proof (clarsimp simp: inj_on_def)
     fix x y
     assume "(1 - norm (x - a) / r) *\<^sub>R (u - a) + x =
             (1 - norm (y - a) / r) *\<^sub>R (u - a) + y"
     then have eq: "(x - a) + (norm (y - a) / r) *\<^sub>R (u - a) = (y - a) + (norm (x - a) / r) *\<^sub>R (u - a)"
       by (auto simp: algebra_simps)
     show "x=y"
     proof (cases "norm (x - a) = norm (y - a)")
       case True
       then show ?thesis
         using eq by auto
     next
       case False
       then consider "norm (x - a) < norm (y - a)" | "norm (x - a) > norm (y - a)"
         by linarith
       then have "False"
       proof cases
         case 1 show False
           using * [OF _ nou 1] eq by simp
       next
         case 2 with * [OF eq nou] show False
           by auto
       qed
       then show "x=y" ..
     qed
   qed
   then have inj_onf: "inj_on f (cball a r \<inter> T)"
     using inj_on_Int by fastforce
   have contf: "continuous_on (cball a r \<inter> T) f"
     unfolding f_def using \<open>0 < r\<close>  by (intro continuous_intros) blast
   have fim: "f ` (cball a r \<inter> T) = cball a r \<inter> T"
   proof
     have *: "norm (y + (1 - norm y / r) *\<^sub>R u) \<le> r" if "norm y \<le> r" "norm u < r" for y u::'a
     proof -
       have "norm (y + (1 - norm y / r) *\<^sub>R u) \<le> norm y + norm((1 - norm y / r) *\<^sub>R u)"
         using norm_triangle_ineq by blast
       also have "\<dots> = norm y + abs(1 - norm y / r) * norm u"
         by simp
       also have "\<dots> \<le> r"
       proof -
         have "(r - norm u) * (r - norm y) \<ge> 0"
           using that by auto
         then have "r * norm u + r * norm y \<le> r * r + norm u * norm y"
           by (simp add: algebra_simps)
         then show ?thesis
         using that \<open>0 < r\<close> by (simp add: abs_if field_simps)
       qed
       finally show ?thesis .
     qed
     have "f ` (cball a r) \<subseteq> cball a r"
       using * nou
       apply (clarsimp simp: dist_norm norm_minus_commute f_def)
       by (metis diff_add_eq diff_diff_add diff_diff_eq2 norm_minus_commute)
     moreover have "f ` T \<subseteq> T"
       unfolding f_def using \<open>affine T\<close> \<open>a \<in> T\<close> \<open>u \<in> T\<close>
       by (force simp: add.commute mem_affine_3_minus)
     ultimately show "f ` (cball a r \<inter> T) \<subseteq> cball a r \<inter> T"
       by blast
   next
     show "cball a r \<inter> T \<subseteq> f ` (cball a r \<inter> T)"
     proof (clarsimp simp: dist_norm norm_minus_commute)
       fix x
       assume x: "norm (x - a) \<le> r" and "x \<in> T"
       have "\<exists>v \<in> {0..1}. ((1 - v) * r - norm ((x - a) - v *\<^sub>R (u - a))) \<bullet> 1 = 0"
         by (rule ivt_decreasing_component_on_1) (auto simp: x continuous_intros)
       then obtain v where "0 \<le> v" "v \<le> 1"
         and v: "(1 - v) * r = norm ((x - a) - v *\<^sub>R (u - a))"
         by auto
       then have n: "norm (a - (x - v *\<^sub>R (u - a))) = r - r * v"
         by (simp add: field_simps norm_minus_commute)
       show "x \<in> f ` (cball a r \<inter> T)"
       proof (rule image_eqI)
         show "x = f (x - v *\<^sub>R (u - a))"
           using \<open>r > 0\<close> v by (simp add: f_def) (simp add: field_simps)
         have "x - v *\<^sub>R (u - a) \<in> cball a r"
           using \<open>r > 0\<close>\<open>0 \<le> v\<close>
           by (simp add: dist_norm n)
         moreover have "x - v *\<^sub>R (u - a) \<in> T"
           by (simp add: f_def \<open>u \<in> T\<close> \<open>x \<in> T\<close> assms mem_affine_3_minus2)
         ultimately show "x - v *\<^sub>R (u - a) \<in> cball a r \<inter> T"
           by blast
       qed
     qed
   qed
   have "compact (cball a r \<inter> T)"
     by (simp add: affine_closed compact_Int_closed \<open>affine T\<close>)
   then obtain g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
     by (metis homeomorphism_compact [OF _ contf fim inj_onf])
   then show thesis
     apply (rule_tac f=f in that)
     using \<open>r > 0\<close> by (simp_all add: f_def dist_norm norm_minus_commute)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point_2:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and u: "u \<in> ball a r \<inter> T" and v: "v \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                     "f u = v" "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> f x = x"
 proof -
   have "0 < r"
     by (metis DiffD1 Diff_Diff_Int ball_eq_empty centre_in_ball not_le u)
   obtain f1 g1 where hom1: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f1 g1"
                  and "f1 a = u" and f1: "\<And>x. x \<in> sphere a r \<Longrightarrow> f1 x = x"
     using homeomorphism_moving_point_1 [OF \<open>affine T\<close> \<open>a \<in> T\<close> u] by blast
   obtain f2 g2 where hom2: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f2 g2"
                  and "f2 a = v" and f2: "\<And>x. x \<in> sphere a r \<Longrightarrow> f2 x = x"
     using homeomorphism_moving_point_1 [OF \<open>affine T\<close> \<open>a \<in> T\<close> v] by blast
   show ?thesis
   proof
     show "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) (f2 \<circ> g1) (f1 \<circ> g2)"
       by (metis homeomorphism_compose homeomorphism_symD hom1 hom2)
     have "g1 u = a"
       using \<open>0 < r\<close> \<open>f1 a = u\<close> assms hom1 homeomorphism_apply1 by fastforce
     then show "(f2 \<circ> g1) u = v"
       by (simp add: \<open>f2 a = v\<close>)
     show "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> (f2 \<circ> g1) x = x"
       using f1 f2 hom1 homeomorphism_apply1 by fastforce
   qed
 qed
 
 
 corollary\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point_3:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and ST: "ball a r \<inter> T \<subseteq> S" "S \<subseteq> T"
       and u: "u \<in> ball a r \<inter> T" and v: "v \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism S S f g"
                     "f u = v" "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> ball a r \<inter> T"
 proof -
   obtain f g where hom: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                and "f u = v" and fid: "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> f x = x"
     using homeomorphism_moving_point_2 [OF \<open>affine T\<close> \<open>a \<in> T\<close> u v] by blast
   have gid: "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> g x = x"
     using fid hom homeomorphism_apply1 by fastforce
   define ff where "ff \<equiv> \<lambda>x. if x \<in> ball a r \<inter> T then f x else x"
   define gg where "gg \<equiv> \<lambda>x. if x \<in> ball a r \<inter> T then g x else x"
   show ?thesis
   proof
     show "homeomorphism S S ff gg"
     proof (rule homeomorphismI)
       have "continuous_on ((cball a r \<inter> T) \<union> (T - ball a r)) ff"
         unfolding ff_def
         using homeomorphism_cont1 [OF hom] 
         by (intro continuous_on_cases) (auto simp: affine_closed \<open>affine T\<close> fid)
       then show "continuous_on S ff"
         by (rule continuous_on_subset) (use ST in auto)
       have "continuous_on ((cball a r \<inter> T) \<union> (T - ball a r)) gg"
         unfolding gg_def
         using homeomorphism_cont2 [OF hom] 
         by (intro continuous_on_cases) (auto simp: affine_closed \<open>affine T\<close> gid)
       then show "continuous_on S gg"
         by (rule continuous_on_subset) (use ST in auto)
       show "ff ` S \<subseteq> S"
       proof (clarsimp simp: ff_def)
         fix x
         assume "x \<in> S" and x: "dist a x < r" and "x \<in> T"
         then have "f x \<in> cball a r \<inter> T"
           using homeomorphism_image1 [OF hom] by force
         then show "f x \<in> S"
           using ST(1) \<open>x \<in> T\<close> gid hom homeomorphism_def x by fastforce
       qed
       show "gg ` S \<subseteq> S"
       proof (clarsimp simp: gg_def)
         fix x
         assume "x \<in> S" and x: "dist a x < r" and "x \<in> T"
         then have "g x \<in> cball a r \<inter> T"
           using homeomorphism_image2 [OF hom] by force
         then have "g x \<in> ball a r"
           using homeomorphism_apply2 [OF hom]
             by (metis Diff_Diff_Int Diff_iff  \<open>x \<in> T\<close> cball_def fid le_less mem_Collect_eq mem_ball mem_sphere x)
         then show "g x \<in> S"
           using ST(1) \<open>g x \<in> cball a r \<inter> T\<close> by force
         qed
       show "\<And>x. x \<in> S \<Longrightarrow> gg (ff x) = x"
         unfolding ff_def gg_def
         using homeomorphism_apply1 [OF hom] homeomorphism_image1 [OF hom]
         by simp (metis Int_iff homeomorphism_apply1 [OF hom] fid image_eqI less_eq_real_def mem_cball mem_sphere)
       show "\<And>x. x \<in> S \<Longrightarrow> ff (gg x) = x"
         unfolding ff_def gg_def
         using homeomorphism_apply2 [OF hom] homeomorphism_image2 [OF hom]
         by simp (metis Int_iff fid image_eqI less_eq_real_def mem_cball mem_sphere)
     qed
     show "ff u = v"
       using u by (auto simp: ff_def \<open>f u = v\<close>)
     show "{x. \<not> (ff x = x \<and> gg x = x)} \<subseteq> ball a r \<inter> T"
       by (auto simp: ff_def gg_def)
   qed
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point:
   fixes a :: "'a::euclidean_space"
   assumes ope: "openin (top_of_set (affine hull S)) S"
       and "S \<subseteq> T"
       and TS: "T \<subseteq> affine hull S"
       and S: "connected S" "a \<in> S" "b \<in> S"
   obtains f g where "homeomorphism T T f g" "f a = b"
                     "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
                     "bounded {x. \<not> (f x = x \<and> g x = x)}"
 proof -
   have 1: "\<exists>h k. homeomorphism T T h k \<and> h (f d) = d \<and>
               {x. \<not> (h x = x \<and> k x = x)} \<subseteq> S \<and> bounded {x. \<not> (h x = x \<and> k x = x)}"
         if "d \<in> S" "f d \<in> S" and homfg: "homeomorphism T T f g"
         and S: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
         and bo: "bounded {x. \<not> (f x = x \<and> g x = x)}" for d f g
   proof (intro exI conjI)
     show homgf: "homeomorphism T T g f"
       by (metis homeomorphism_symD homfg)
     then show "g (f d) = d"
       by (meson \<open>S \<subseteq> T\<close> homeomorphism_def subsetD \<open>d \<in> S\<close>)
     show "{x. \<not> (g x = x \<and> f x = x)} \<subseteq> S"
       using S by blast
     show "bounded {x. \<not> (g x = x \<and> f x = x)}"
       using bo by (simp add: conj_commute)
   qed
   have 2: "\<exists>f g. homeomorphism T T f g \<and> f x = f2 (f1 x) \<and>
                  {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
              if "x \<in> S" "f1 x \<in> S" "f2 (f1 x) \<in> S"
                 and hom: "homeomorphism T T f1 g1" "homeomorphism T T f2 g2"
                 and sub: "{x. \<not> (f1 x = x \<and> g1 x = x)} \<subseteq> S"   "{x. \<not> (f2 x = x \<and> g2 x = x)} \<subseteq> S"
                 and bo: "bounded {x. \<not> (f1 x = x \<and> g1 x = x)}"  "bounded {x. \<not> (f2 x = x \<and> g2 x = x)}"
              for x f1 f2 g1 g2
   proof (intro exI conjI)
     show homgf: "homeomorphism T T (f2 \<circ> f1) (g1 \<circ> g2)"
       by (metis homeomorphism_compose hom)
     then show "(f2 \<circ> f1) x = f2 (f1 x)"
       by force
     show "{x. \<not> ((f2 \<circ> f1) x = x \<and> (g1 \<circ> g2) x = x)} \<subseteq> S"
       using sub by force
     have "bounded ({x. \<not>(f1 x = x \<and> g1 x = x)} \<union> {x. \<not>(f2 x = x \<and> g2 x = x)})"
       using bo by simp
     then show "bounded {x. \<not> ((f2 \<circ> f1) x = x \<and> (g1 \<circ> g2) x = x)}"
       by (rule bounded_subset) auto
   qed
   have 3: "\<exists>U. openin (top_of_set S) U \<and>
               d \<in> U \<and>
               (\<forall>x\<in>U.
                   \<exists>f g. homeomorphism T T f g \<and> f d = x \<and>
                         {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and>
                         bounded {x. \<not> (f x = x \<and> g x = x)})"
            if "d \<in> S" for d
   proof -
     obtain r where "r > 0" and r: "ball d r \<inter> affine hull S \<subseteq> S"
       by (metis \<open>d \<in> S\<close> ope openin_contains_ball)
     have *: "\<exists>f g. homeomorphism T T f g \<and> f d = e \<and>
                    {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and>
                    bounded {x. \<not> (f x = x \<and> g x = x)}" if "e \<in> S" "e \<in> ball d r" for e
       apply (rule homeomorphism_moving_point_3 [of "affine hull S" d r T d e])
       using r \<open>S \<subseteq> T\<close> TS that 
             apply (auto simp: \<open>d \<in> S\<close> \<open>0 < r\<close> hull_inc)
       using bounded_subset by blast
     show ?thesis
       by (rule_tac x="S \<inter> ball d r" in exI) (fastforce simp: openin_open_Int \<open>0 < r\<close> that intro: *)
   qed
   have "\<exists>f g. homeomorphism T T f g \<and> f a = b \<and>
               {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
     by (rule connected_equivalence_relation [OF S]; blast intro: 1 2 3)
   then show ?thesis
     using that by auto
 qed
 
 
 lemma homeomorphism_moving_points_exists_gen:
   assumes K: "finite K" "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
              "pairwise (\<lambda>i j. (x i \<noteq> x j) \<and> (y i \<noteq> y j)) K"
       and "2 \<le> aff_dim S"
       and ope: "openin (top_of_set (affine hull S)) S"
       and "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   shows "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(x i) = y i) \<and>
                {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
   using assms
 proof (induction K)
   case empty
   then show ?case
     by (force simp: homeomorphism_ident)
 next
   case (insert i K)
   then have xney: "\<And>j. \<lbrakk>j \<in> K; j \<noteq> i\<rbrakk> \<Longrightarrow> x i \<noteq> x j \<and> y i \<noteq> y j"
        and pw: "pairwise (\<lambda>i j. x i \<noteq> x j \<and> y i \<noteq> y j) K"
        and "x i \<in> S" "y i \<in> S"
        and xyS: "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
     by (simp_all add: pairwise_insert)
   obtain f g where homfg: "homeomorphism T T f g" and feq: "\<And>i. i \<in> K \<Longrightarrow> f(x i) = y i"
                and fg_sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
                and bo_fg: "bounded {x. \<not> (f x = x \<and> g x = x)}"
     using insert.IH [OF xyS pw] insert.prems by (blast intro: that)
   then have "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(x i) = y i) \<and>
                    {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
     using insert by blast
   have aff_eq: "affine hull (S - y ` K) = affine hull S"
   proof (rule affine_hull_Diff [OF ope])
     show "finite (y ` K)"
       by (simp add: insert.hyps(1))
     show "y ` K \<subset> S"
       using \<open>y i \<in> S\<close> insert.hyps(2) xney xyS by fastforce
   qed
   have f_in_S: "f x \<in> S" if "x \<in> S" for x
     using homfg fg_sub homeomorphism_apply1 \<open>S \<subseteq> T\<close>
   proof -
     have "(f (f x) \<noteq> f x \<or> g (f x) \<noteq> f x) \<or> f x \<in> S"
       by (metis \<open>S \<subseteq> T\<close> homfg subsetD homeomorphism_apply1 that)
     then show ?thesis
       using fg_sub by force
   qed
   obtain h k where homhk: "homeomorphism T T h k" and heq: "h (f (x i)) = y i"
                and hk_sub: "{x. \<not> (h x = x \<and> k x = x)} \<subseteq> S - y ` K"
                and bo_hk:  "bounded {x. \<not> (h x = x \<and> k x = x)}"
   proof (rule homeomorphism_moving_point [of "S - y`K" T "f(x i)" "y i"])
     show "openin (top_of_set (affine hull (S - y ` K))) (S - y ` K)"
       by (simp add: aff_eq openin_diff finite_imp_closedin image_subset_iff hull_inc insert xyS)
     show "S - y ` K \<subseteq> T"
       using \<open>S \<subseteq> T\<close> by auto
     show "T \<subseteq> affine hull (S - y ` K)"
       using insert by (simp add: aff_eq)
     show "connected (S - y ` K)"
     proof (rule connected_openin_diff_countable [OF \<open>connected S\<close> ope])
       show "\<not> collinear S"
         using collinear_aff_dim \<open>2 \<le> aff_dim S\<close> by force
       show "countable (y ` K)"
         using countable_finite insert.hyps(1) by blast
     qed
     have "\<And>k. \<lbrakk>f (x i) = y k; k \<in> K\<rbrakk> \<Longrightarrow> False"
         by (metis feq homfg \<open>x i \<in> S\<close> homeomorphism_def \<open>S \<subseteq> T\<close> \<open>i \<notin> K\<close> subsetCE xney xyS)
     then show "f (x i) \<in> S - y ` K"
       by (auto simp: f_in_S \<open>x i \<in> S\<close>)
     show "y i \<in> S - y ` K"
       using insert.hyps xney by (auto simp: \<open>y i \<in> S\<close>)
   qed blast
   show ?case
   proof (intro exI conjI)
     show "homeomorphism T T (h \<circ> f) (g \<circ> k)"
       using homfg homhk homeomorphism_compose by blast
     show "\<forall>i \<in> insert i K. (h \<circ> f) (x i) = y i"
       using feq hk_sub by (auto simp: heq)
     show "{x. \<not> ((h \<circ> f) x = x \<and> (g \<circ> k) x = x)} \<subseteq> S"
       using fg_sub hk_sub by force
     have "bounded ({x. \<not>(f x = x \<and> g x = x)} \<union> {x. \<not>(h x = x \<and> k x = x)})"
       using bo_fg bo_hk bounded_Un by blast
     then show "bounded {x. \<not> ((h \<circ> f) x = x \<and> (g \<circ> k) x = x)}"
       by (rule bounded_subset) auto
   qed
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_points_exists:
   fixes S :: "'a::euclidean_space set"
   assumes 2: "2 \<le> DIM('a)" "open S" "connected S" "S \<subseteq> T" "finite K"
       and KS: "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
       and pw: "pairwise (\<lambda>i j. (x i \<noteq> x j) \<and> (y i \<noteq> y j)) K"
       and S: "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   obtains f g where "homeomorphism T T f g" "\<And>i. i \<in> K \<Longrightarrow> f(x i) = y i"
                     "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S" "bounded {x. (\<not> (f x = x \<and> g x = x))}"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using KS homeomorphism_ident that by fastforce
 next
   case False
   then have affS: "affine hull S = UNIV"
     by (simp add: affine_hull_open \<open>open S\<close>)
   then have ope: "openin (top_of_set (affine hull S)) S"
     using \<open>open S\<close> open_openin by auto
   have "2 \<le> DIM('a)" by (rule 2)
   also have "\<dots> = aff_dim (UNIV :: 'a set)"
     by simp
   also have "\<dots> \<le> aff_dim S"
     by (metis aff_dim_UNIV aff_dim_affine_hull aff_dim_le_DIM affS)
   finally have "2 \<le> aff_dim S"
     by linarith
   then show ?thesis
     using homeomorphism_moving_points_exists_gen [OF \<open>finite K\<close> KS pw _ ope S] that by fastforce
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>The theorem \<open>homeomorphism_grouping_points_exists\<close>\<close>
 
 lemma homeomorphism_grouping_point_1:
   fixes a::real and c::real
   assumes "a < b" "c < d"
   obtains f g where "homeomorphism (cbox a b) (cbox c d) f g" "f a = c" "f b = d"
 proof -
   define f where "f \<equiv> \<lambda>x. ((d - c) / (b - a)) * x + (c - a * ((d - c) / (b - a)))"
   have "\<exists>g. homeomorphism (cbox a b) (cbox c d) f g"
   proof (rule homeomorphism_compact)
     show "continuous_on (cbox a b) f"
       unfolding f_def by (intro continuous_intros)
     have "f ` {a..b} = {c..d}"
       unfolding f_def image_affinity_atLeastAtMost
       using assms sum_sqs_eq by (auto simp: field_split_simps)
     then show "f ` cbox a b = cbox c d"
       by auto
     show "inj_on f (cbox a b)"
       unfolding f_def inj_on_def using assms by auto
   qed auto
   then obtain g where "homeomorphism (cbox a b) (cbox c d) f g" ..
   then show ?thesis
   proof
     show "f a = c"
       by (simp add: f_def)
     show "f b = d"
       using assms sum_sqs_eq [of a b] by (auto simp: f_def field_split_simps)
   qed
 qed
 
 lemma homeomorphism_grouping_point_2:
   fixes a::real and w::real
   assumes hom_ab: "homeomorphism (cbox a b) (cbox u v) f1 g1"
       and hom_bc: "homeomorphism (cbox b c) (cbox v w) f2 g2"
       and "b \<in> cbox a c" "v \<in> cbox u w"
       and eq: "f1 a = u" "f1 b = v" "f2 b = v" "f2 c = w"
  obtains f g where "homeomorphism (cbox a c) (cbox u w) f g" "f a = u" "f c = w"
                    "\<And>x. x \<in> cbox a b \<Longrightarrow> f x = f1 x" "\<And>x. x \<in> cbox b c \<Longrightarrow> f x = f2 x"
 proof -
   have le: "a \<le> b" "b \<le> c" "u \<le> v" "v \<le> w"
     using assms by simp_all
   then have ac: "cbox a c = cbox a b \<union> cbox b c" and uw: "cbox u w = cbox u v \<union> cbox v w"
     by auto
   define f where "f \<equiv> \<lambda>x. if x \<le> b then f1 x else f2 x"
   have "\<exists>g. homeomorphism (cbox a c) (cbox u w) f g"
   proof (rule homeomorphism_compact)
     have cf1: "continuous_on (cbox a b) f1"
       using hom_ab homeomorphism_cont1 by blast
     have cf2: "continuous_on (cbox b c) f2"
       using hom_bc homeomorphism_cont1 by blast
     show "continuous_on (cbox a c) f"
       unfolding f_def using le eq
       by (force intro: continuous_on_cases_le [OF continuous_on_subset [OF cf1] continuous_on_subset [OF cf2]])
     have "f ` cbox a b = f1 ` cbox a b" "f ` cbox b c = f2 ` cbox b c"
       unfolding f_def using eq by force+
     then show "f ` cbox a c = cbox u w"
       unfolding ac uw image_Un by (metis hom_ab hom_bc homeomorphism_def)
     have neq12: "f1 x \<noteq> f2 y" if x: "a \<le> x" "x \<le> b" and y: "b < y" "y \<le> c" for x y
     proof -
       have "f1 x \<in> cbox u v"
         by (metis hom_ab homeomorphism_def image_eqI mem_box_real(2) x)
       moreover have "f2 y \<in> cbox v w"
         by (metis (full_types) hom_bc homeomorphism_def image_subset_iff mem_box_real(2) not_le not_less_iff_gr_or_eq order_refl y)
       moreover have "f2 y \<noteq> f2 b"
         by (metis cancel_comm_monoid_add_class.diff_cancel diff_gt_0_iff_gt hom_bc homeomorphism_def le(2) less_imp_le less_numeral_extra(3) mem_box_real(2) order_refl y)
       ultimately show ?thesis
         using le eq by simp
     qed
     have "inj_on f1 (cbox a b)"
       by (metis (full_types) hom_ab homeomorphism_def inj_onI)
     moreover have "inj_on f2 (cbox b c)"
       by (metis (full_types) hom_bc homeomorphism_def inj_onI)
     ultimately show "inj_on f (cbox a c)"
       apply (simp (no_asm) add: inj_on_def)
       apply (simp add: f_def inj_on_eq_iff)
       using neq12 by force
   qed auto
   then obtain g where "homeomorphism (cbox a c) (cbox u w) f g" ..
   then show ?thesis
     using eq f_def le that by force
 qed
 
 lemma homeomorphism_grouping_point_3:
   fixes a::real
   assumes cbox_sub: "cbox c d \<subseteq> box a b" "cbox u v \<subseteq> box a b"
       and box_ne: "box c d \<noteq> {}" "box u v \<noteq> {}"
   obtains f g where "homeomorphism (cbox a b) (cbox a b) f g" "f a = a" "f b = b"
                     "\<And>x. x \<in> cbox c d \<Longrightarrow> f x \<in> cbox u v"
 proof -
   have less: "a < c" "a < u" "d < b" "v < b" "c < d" "u < v" "cbox c d \<noteq> {}"
     using assms
     by (simp_all add: cbox_sub subset_eq)
   obtain f1 g1 where 1: "homeomorphism (cbox a c) (cbox a u) f1 g1"
                    and f1_eq: "f1 a = a" "f1 c = u"
     using homeomorphism_grouping_point_1 [OF \<open>a < c\<close> \<open>a < u\<close>] .
   obtain f2 g2 where 2: "homeomorphism (cbox c d) (cbox u v) f2 g2"
                    and f2_eq: "f2 c = u" "f2 d = v"
     using homeomorphism_grouping_point_1 [OF \<open>c < d\<close> \<open>u < v\<close>] .
   obtain f3 g3 where 3: "homeomorphism (cbox d b) (cbox v b) f3 g3"
                    and f3_eq: "f3 d = v" "f3 b = b"
     using homeomorphism_grouping_point_1 [OF \<open>d < b\<close> \<open>v < b\<close>] .
   obtain f4 g4 where 4: "homeomorphism (cbox a d) (cbox a v) f4 g4" and "f4 a = a" "f4 d = v"
                  and f4_eq: "\<And>x. x \<in> cbox a c \<Longrightarrow> f4 x = f1 x" "\<And>x. x \<in> cbox c d \<Longrightarrow> f4 x = f2 x"
     using homeomorphism_grouping_point_2 [OF 1 2] less  by (auto simp: f1_eq f2_eq)
   obtain f g where fg: "homeomorphism (cbox a b) (cbox a b) f g" "f a = a" "f b = b"
                and f_eq: "\<And>x. x \<in> cbox a d \<Longrightarrow> f x = f4 x" "\<And>x. x \<in> cbox d b \<Longrightarrow> f x = f3 x"
     using homeomorphism_grouping_point_2 [OF 4 3] less by (auto simp: f4_eq f3_eq f2_eq f1_eq)
   show ?thesis
   proof (rule that [OF fg])
     show "f x \<in> cbox u v" if "x \<in> cbox c d" for x 
       using that f4_eq f_eq homeomorphism_image1 [OF 2]
       by (metis atLeastAtMost_iff box_real(2) image_eqI less(1) less_eq_real_def order_trans)
   qed
 qed
 
 
 lemma homeomorphism_grouping_point_4:
   fixes T :: "real set"
   assumes "open U" "open S" "connected S" "U \<noteq> {}" "finite K" "K \<subseteq> S" "U \<subseteq> S" "S \<subseteq> T"
   obtains f g where "homeomorphism T T f g"
                     "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}"
 proof -
   obtain c d where "box c d \<noteq> {}" "cbox c d \<subseteq> U"
   proof -
     obtain u where "u \<in> U"
       using \<open>U \<noteq> {}\<close> by blast
     then obtain e where "e > 0" "cball u e \<subseteq> U"
       using \<open>open U\<close> open_contains_cball by blast
     then show ?thesis
       by (rule_tac c=u and d="u+e" in that) (auto simp: dist_norm subset_iff)
   qed
   have "compact K"
     by (simp add: \<open>finite K\<close> finite_imp_compact)
   obtain a b where "box a b \<noteq> {}" "K \<subseteq> cbox a b" "cbox a b \<subseteq> S"
   proof (cases "K = {}")
     case True then show ?thesis
       using \<open>box c d \<noteq> {}\<close> \<open>cbox c d \<subseteq> U\<close> \<open>U \<subseteq> S\<close> that by blast
   next
     case False
     then obtain a b where "a \<in> K" "b \<in> K"
             and a: "\<And>x. x \<in> K \<Longrightarrow> a \<le> x" and b: "\<And>x. x \<in> K \<Longrightarrow> x \<le> b"
       using compact_attains_inf compact_attains_sup by (metis \<open>compact K\<close>)+
     obtain e where "e > 0" "cball b e \<subseteq> S"
       using \<open>open S\<close> open_contains_cball
       by (metis \<open>b \<in> K\<close> \<open>K \<subseteq> S\<close> subsetD)
     show ?thesis
     proof
       show "box a (b + e) \<noteq> {}"
         using \<open>0 < e\<close> \<open>b \<in> K\<close> a by force
       show "K \<subseteq> cbox a (b + e)"
         using \<open>0 < e\<close> a b by fastforce
       have "a \<in> S"
         using \<open>a \<in> K\<close> assms(6) by blast
       have "b + e \<in> S"
         using \<open>0 < e\<close> \<open>cball b e \<subseteq> S\<close>  by (force simp: dist_norm)
       show "cbox a (b + e) \<subseteq> S"
         using \<open>a \<in> S\<close> \<open>b + e \<in> S\<close> \<open>connected S\<close> connected_contains_Icc by auto
     qed
   qed
   obtain w z where "cbox w z \<subseteq> S" and sub_wz: "cbox a b \<union> cbox c d \<subseteq> box w z"
   proof -
     have "a \<in> S" "b \<in> S"
       using \<open>box a b \<noteq> {}\<close> \<open>cbox a b \<subseteq> S\<close> by auto
     moreover have "c \<in> S" "d \<in> S"
       using \<open>box c d \<noteq> {}\<close> \<open>cbox c d \<subseteq> U\<close> \<open>U \<subseteq> S\<close> by force+
     ultimately have "min a c \<in> S" "max b d \<in> S"
       by linarith+
     then obtain e1 e2 where "e1 > 0" "cball (min a c) e1 \<subseteq> S" "e2 > 0" "cball (max b d) e2 \<subseteq> S"
       using \<open>open S\<close> open_contains_cball by metis
     then have *: "min a c - e1 \<in> S" "max b d + e2 \<in> S"
       by (auto simp: dist_norm)
     show ?thesis
     proof
       show "cbox (min a c - e1) (max b d+ e2) \<subseteq> S"
         using * \<open>connected S\<close> connected_contains_Icc by auto
       show "cbox a b \<union> cbox c d \<subseteq> box (min a c - e1) (max b d + e2)"
         using \<open>0 < e1\<close> \<open>0 < e2\<close> by auto
     qed
   qed
   then
   obtain f g where hom: "homeomorphism (cbox w z) (cbox w z) f g"
                and "f w = w" "f z = z"
                and fin: "\<And>x. x \<in> cbox a b \<Longrightarrow> f x \<in> cbox c d"
     using homeomorphism_grouping_point_3 [of a b w z c d]
     using \<open>box a b \<noteq> {}\<close> \<open>box c d \<noteq> {}\<close> by blast
   have contfg: "continuous_on (cbox w z) f" "continuous_on (cbox w z) g"
     using hom homeomorphism_def by blast+
   define f' where "f' \<equiv> \<lambda>x. if x \<in> cbox w z then f x else x"
   define g' where "g' \<equiv> \<lambda>x. if x \<in> cbox w z then g x else x"
   show ?thesis
   proof
     have T: "cbox w z \<union> (T - box w z) = T"
       using \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> by auto
     show "homeomorphism T T f' g'"
     proof
       have clo: "closedin (top_of_set (cbox w z \<union> (T - box w z))) (T - box w z)"
         by (metis Diff_Diff_Int Diff_subset T closedin_def open_box openin_open_Int topspace_euclidean_subtopology)
       have "\<And>x. \<lbrakk>w \<le> x \<and> x \<le> z; w < x \<longrightarrow> \<not> x < z\<rbrakk> \<Longrightarrow> f x = x"
         using \<open>f w = w\<close> \<open>f z = z\<close> by auto
       moreover have "\<And>x. \<lbrakk>w \<le> x \<and> x \<le> z; w < x \<longrightarrow> \<not> x < z\<rbrakk> \<Longrightarrow> g x = x"
         using \<open>f w = w\<close> \<open>f z = z\<close> hom homeomorphism_apply1 by fastforce
       ultimately
       have "continuous_on (cbox w z \<union> (T - box w z)) f'" "continuous_on (cbox w z \<union> (T - box w z)) g'"
         unfolding f'_def g'_def
         by (intro continuous_on_cases_local contfg continuous_on_id clo; auto simp: closed_subset)+
       then show "continuous_on T f'" "continuous_on T g'"
         by (simp_all only: T)
       show "f' ` T \<subseteq> T"
         unfolding f'_def
         by clarsimp (metis \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> subsetD hom homeomorphism_def imageI mem_box_real(2))
       show "g' ` T \<subseteq> T"
         unfolding g'_def
         by clarsimp (metis \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> subsetD hom homeomorphism_def imageI mem_box_real(2))
       show "\<And>x. x \<in> T \<Longrightarrow> g' (f' x) = x"
         unfolding f'_def g'_def
         using homeomorphism_apply1 [OF hom]  homeomorphism_image1 [OF hom] by fastforce
       show "\<And>y. y \<in> T \<Longrightarrow> f' (g' y) = y"
         unfolding f'_def g'_def
         using homeomorphism_apply2 [OF hom]  homeomorphism_image2 [OF hom] by fastforce
     qed
     show "\<And>x. x \<in> K \<Longrightarrow> f' x \<in> U"
       using fin sub_wz \<open>K \<subseteq> cbox a b\<close> \<open>cbox c d \<subseteq> U\<close> by (force simp: f'_def)
     show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> S"
       using \<open>cbox w z \<subseteq> S\<close> by (auto simp: f'_def g'_def)
     show "bounded {x. \<not> (f' x = x \<and> g' x = x)}"
     proof (rule bounded_subset [of "cbox w z"])
       show "bounded (cbox w z)"
         using bounded_cbox by blast
       show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> cbox w z"
         by (auto simp: f'_def g'_def)
     qed
   qed
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_grouping_points_exists:
   fixes S :: "'a::euclidean_space set"
   assumes "open U" "open S" "connected S" "U \<noteq> {}" "finite K" "K \<subseteq> S" "U \<subseteq> S" "S \<subseteq> T"
   obtains f g where "homeomorphism T T f g" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}" "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U"
 proof (cases "2 \<le> DIM('a)")
   case True
   have TS: "T \<subseteq> affine hull S"
     using affine_hull_open assms by blast
   have "infinite U"
     using \<open>open U\<close> \<open>U \<noteq> {}\<close> finite_imp_not_open by blast
   then obtain P where "P \<subseteq> U" "finite P" "card K = card P"
     using infinite_arbitrarily_large by metis
   then obtain \<gamma> where \<gamma>: "bij_betw \<gamma> K P"
     using \<open>finite K\<close> finite_same_card_bij by blast
   obtain f g where "homeomorphism T T f g" "\<And>i. i \<in> K \<Longrightarrow> f (id i) = \<gamma> i" "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S" "bounded {x. \<not> (f x = x \<and> g x = x)}"
   proof (rule homeomorphism_moving_points_exists [OF True \<open>open S\<close> \<open>connected S\<close> \<open>S \<subseteq> T\<close> \<open>finite K\<close>])
     show "\<And>i. i \<in> K \<Longrightarrow> id i \<in> S \<and> \<gamma> i \<in> S"
       using \<open>P \<subseteq> U\<close> \<open>bij_betw \<gamma> K P\<close> \<open>K \<subseteq> S\<close> \<open>U \<subseteq> S\<close> bij_betwE by blast
     show "pairwise (\<lambda>i j. id i \<noteq> id j \<and> \<gamma> i \<noteq> \<gamma> j) K"
       using \<gamma> by (auto simp: pairwise_def bij_betw_def inj_on_def)
   qed (use affine_hull_open assms that in auto)
   then show ?thesis
     using \<gamma> \<open>P \<subseteq> U\<close> bij_betwE by (fastforce simp: intro!: that)
 next
   case False
   with DIM_positive have "DIM('a) = 1"
     by (simp add: dual_order.antisym)
   then obtain h::"'a \<Rightarrow>real" and j
   where "linear h" "linear j"
     and noh: "\<And>x. norm(h x) = norm x" and noj: "\<And>y. norm(j y) = norm y"
     and hj:  "\<And>x. j(h x) = x" "\<And>y. h(j y) = y"
     and ranh: "surj h"
     using isomorphisms_UNIV_UNIV
     by (metis (mono_tags, opaque_lifting) DIM_real UNIV_eq_I range_eqI)
   obtain f g where hom: "homeomorphism (h ` T) (h ` T) f g"
                and f: "\<And>x. x \<in> h ` K \<Longrightarrow> f x \<in> h ` U"
                and sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> h ` S"
                and bou: "bounded {x. \<not> (f x = x \<and> g x = x)}"
     apply (rule homeomorphism_grouping_point_4 [of "h ` U" "h ` S" "h ` K" "h ` T"])
     by (simp_all add: assms image_mono  \<open>linear h\<close> open_surjective_linear_image connected_linear_image ranh)
   have jf: "j (f (h x)) = x \<longleftrightarrow> f (h x) = h x" for x
     by (metis hj)
   have jg: "j (g (h x)) = x \<longleftrightarrow> g (h x) = h x" for x
     by (metis hj)
   have cont_hj: "continuous_on X h"  "continuous_on Y j" for X Y
     by (simp_all add: \<open>linear h\<close> \<open>linear j\<close> linear_linear linear_continuous_on)
   show ?thesis
   proof
     show "homeomorphism T T (j \<circ> f \<circ> h) (j \<circ> g \<circ> h)"
     proof
       show "continuous_on T (j \<circ> f \<circ> h)" "continuous_on T (j \<circ> g \<circ> h)"
         using hom homeomorphism_def
         by (blast intro: continuous_on_compose cont_hj)+
       show "(j \<circ> f \<circ> h) ` T \<subseteq> T" "(j \<circ> g \<circ> h) ` T \<subseteq> T"
         by auto (metis (mono_tags, opaque_lifting) hj(1) hom homeomorphism_def imageE imageI)+
       show "\<And>x. x \<in> T \<Longrightarrow> (j \<circ> g \<circ> h) ((j \<circ> f \<circ> h) x) = x"
         using hj hom homeomorphism_apply1 by fastforce
       show "\<And>y. y \<in> T \<Longrightarrow> (j \<circ> f \<circ> h) ((j \<circ> g \<circ> h) y) = y"
         using hj hom homeomorphism_apply2 by fastforce
     qed
     show "{x. \<not> ((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)} \<subseteq> S"
     proof (clarsimp simp: jf jg hj)
       show "f (h x) = h x \<longrightarrow> g (h x) \<noteq> h x \<Longrightarrow> x \<in> S" for x
         using sub [THEN subsetD, of "h x"] hj by simp (metis imageE)
     qed
     have "bounded (j ` {x. (\<not> (f x = x \<and> g x = x))})"
       by (rule bounded_linear_image [OF bou]) (use \<open>linear j\<close> linear_conv_bounded_linear in auto)
     moreover
     have *: "{x. \<not>((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)} = j ` {x. (\<not> (f x = x \<and> g x = x))}"
       using hj by (auto simp: jf jg image_iff, metis+)
     ultimately show "bounded {x. \<not> ((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)}"
       by metis
     show "\<And>x. x \<in> K \<Longrightarrow> (j \<circ> f \<circ> h) x \<in> U"
       using f hj by fastforce
   qed
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_grouping_points_exists_gen:
   fixes S :: "'a::euclidean_space set"
   assumes opeU: "openin (top_of_set S) U"
       and opeS: "openin (top_of_set (affine hull S)) S"
       and "U \<noteq> {}" "finite K" "K \<subseteq> S" and S: "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   obtains f g where "homeomorphism T T f g" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}" "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U"
 proof (cases "2 \<le> aff_dim S")
   case True
   have opeU': "openin (top_of_set (affine hull S)) U"
     using opeS opeU openin_trans by blast
   obtain u where "u \<in> U" "u \<in> S"
     using \<open>U \<noteq> {}\<close> opeU openin_imp_subset by fastforce+
   have "infinite U"
   proof (rule infinite_openin [OF opeU \<open>u \<in> U\<close>])
     show "u islimpt S"
       using True \<open>u \<in> S\<close> assms(8) connected_imp_perfect_aff_dim by fastforce
   qed
   then obtain P where "P \<subseteq> U" "finite P" "card K = card P"
     using infinite_arbitrarily_large by metis
   then obtain \<gamma> where \<gamma>: "bij_betw \<gamma> K P"
     using \<open>finite K\<close> finite_same_card_bij by blast
   have "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(id i) = \<gamma> i) \<and>
                {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
   proof (rule homeomorphism_moving_points_exists_gen [OF \<open>finite K\<close> _ _ True opeS S])
     show "\<And>i. i \<in> K \<Longrightarrow> id i \<in> S \<and> \<gamma> i \<in> S"
       by (metis id_apply opeU openin_contains_cball subsetCE \<open>P \<subseteq> U\<close> \<open>bij_betw \<gamma> K P\<close> \<open>K \<subseteq> S\<close> bij_betwE)
     show "pairwise (\<lambda>i j. id i \<noteq> id j \<and> \<gamma> i \<noteq> \<gamma> j) K"
       using \<gamma> by (auto simp: pairwise_def bij_betw_def inj_on_def)
   qed
   then show ?thesis
     using \<gamma> \<open>P \<subseteq> U\<close> bij_betwE by (fastforce simp: intro!: that)
 next
   case False
   with aff_dim_geq [of S] consider "aff_dim S = -1" | "aff_dim S = 0" | "aff_dim S = 1" by linarith
   then show ?thesis
   proof cases
     assume "aff_dim S = -1"
     then have "S = {}"
       using aff_dim_empty by blast
     then have "False"
       using \<open>U \<noteq> {}\<close> \<open>K \<subseteq> S\<close> openin_imp_subset [OF opeU] by blast
     then show ?thesis ..
   next
     assume "aff_dim S = 0"
     then obtain a where "S = {a}"
       using aff_dim_eq_0 by blast
     then have "K \<subseteq> U"
       using \<open>U \<noteq> {}\<close> \<open>K \<subseteq> S\<close> openin_imp_subset [OF opeU] by blast
     show ?thesis
       using \<open>K \<subseteq> U\<close> by (intro that [of id id]) (auto intro: homeomorphismI)
   next
     assume "aff_dim S = 1"
     then have "affine hull S homeomorphic (UNIV :: real set)"
       by (auto simp: homeomorphic_affine_sets)
     then obtain h::"'a\<Rightarrow>real" and j where homhj: "homeomorphism (affine hull S) UNIV h j"
       using homeomorphic_def by blast
     then have h: "\<And>x. x \<in> affine hull S \<Longrightarrow> j(h(x)) = x" and j: "\<And>y. j y \<in> affine hull S \<and> h(j y) = y"
       by (auto simp: homeomorphism_def)
     have connh: "connected (h ` S)"
       by (meson Topological_Spaces.connected_continuous_image \<open>connected S\<close> homeomorphism_cont1 homeomorphism_of_subsets homhj hull_subset top_greatest)
     have hUS: "h ` U \<subseteq> h ` S"
       by (meson homeomorphism_imp_open_map homeomorphism_of_subsets homhj hull_subset opeS opeU open_UNIV openin_open_eq)
     have opn: "openin (top_of_set (affine hull S)) U \<Longrightarrow> open (h ` U)" for U
       using homeomorphism_imp_open_map [OF homhj]  by simp
     have "open (h ` U)" "open (h ` S)"
       by (auto intro: opeS opeU openin_trans opn)
     then obtain f g where hom: "homeomorphism (h ` T) (h ` T) f g"
                  and f: "\<And>x. x \<in> h ` K \<Longrightarrow> f x \<in> h ` U"
                  and sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> h ` S"
                  and bou: "bounded {x. \<not> (f x = x \<and> g x = x)}"
       apply (rule homeomorphism_grouping_points_exists [of "h ` U" "h ` S" "h ` K" "h ` T"])
       using assms by (auto simp: connh hUS)
     have jf: "\<And>x. x \<in> affine hull S \<Longrightarrow> j (f (h x)) = x \<longleftrightarrow> f (h x) = h x"
       by (metis h j)
     have jg: "\<And>x. x \<in> affine hull S \<Longrightarrow> j (g (h x)) = x \<longleftrightarrow> g (h x) = h x"
       by (metis h j)
     have cont_hj: "continuous_on T h"  "continuous_on Y j" for Y
     proof (rule continuous_on_subset [OF _ \<open>T \<subseteq> affine hull S\<close>])
       show "continuous_on (affine hull S) h"
         using homeomorphism_def homhj by blast
     qed (meson continuous_on_subset homeomorphism_def homhj top_greatest)
     define f' where "f' \<equiv> \<lambda>x. if x \<in> affine hull S then (j \<circ> f \<circ> h) x else x"
     define g' where "g' \<equiv> \<lambda>x. if x \<in> affine hull S then (j \<circ> g \<circ> h) x else x"
     show ?thesis
     proof
       show "homeomorphism T T f' g'"
       proof
         have "continuous_on T (j \<circ> f \<circ> h)"
           using hom homeomorphism_def by (intro continuous_on_compose cont_hj) blast
         then show "continuous_on T f'"
           apply (rule continuous_on_eq)
           using \<open>T \<subseteq> affine hull S\<close> f'_def by auto
         have "continuous_on T (j \<circ> g \<circ> h)"
           using hom homeomorphism_def by (intro continuous_on_compose cont_hj) blast
         then show "continuous_on T g'"
           apply (rule continuous_on_eq)
           using \<open>T \<subseteq> affine hull S\<close> g'_def by auto
         show "f' ` T \<subseteq> T"
         proof (clarsimp simp: f'_def)
           fix x assume "x \<in> T"
           then have "f (h x) \<in> h ` T"
             by (metis (no_types) hom homeomorphism_def image_subset_iff subset_refl)
           then show "j (f (h x)) \<in> T"
             using \<open>T \<subseteq> affine hull S\<close> h by auto
         qed
         show "g' ` T \<subseteq> T"
         proof (clarsimp simp: g'_def)
           fix x assume "x \<in> T"
           then have "g (h x) \<in> h ` T"
             by (metis (no_types) hom homeomorphism_def image_subset_iff subset_refl)
           then show "j (g (h x)) \<in> T"
             using \<open>T \<subseteq> affine hull S\<close> h by auto
         qed
         show "\<And>x. x \<in> T \<Longrightarrow> g' (f' x) = x"
           using h j hom homeomorphism_apply1 by (fastforce simp: f'_def g'_def)
         show "\<And>y. y \<in> T \<Longrightarrow> f' (g' y) = y"
           using h j hom homeomorphism_apply2 by (fastforce simp: f'_def g'_def)
       qed
     next
       have \<section>: "\<And>x y. \<lbrakk>x \<in> affine hull S; h x = h y; y \<in> S\<rbrakk> \<Longrightarrow> x \<in> S"
         by (metis h hull_inc)
       show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> S"
         using sub by (simp add: f'_def g'_def jf jg) (force elim: \<section>)
     next
       have "compact (j ` closure {x. \<not> (f x = x \<and> g x = x)})"
         using bou by (auto simp: compact_continuous_image cont_hj)
       then have "bounded (j ` {x. \<not> (f x = x \<and> g x = x)})"
         by (rule bounded_closure_image [OF compact_imp_bounded])
       moreover
       have *: "{x \<in> affine hull S. j (f (h x)) \<noteq> x \<or> j (g (h x)) \<noteq> x} = j ` {x. (\<not> (f x = x \<and> g x = x))}"
         using h j by (auto simp: image_iff; metis)
       ultimately have "bounded {x \<in> affine hull S. j (f (h x)) \<noteq> x \<or> j (g (h x)) \<noteq> x}"
         by metis
       then show "bounded {x. \<not> (f' x = x \<and> g' x = x)}"
         by (simp add: f'_def g'_def Collect_mono bounded_subset)
     next
       show "f' x \<in> U" if "x \<in> K" for x
       proof -
         have "U \<subseteq> S"
           using opeU openin_imp_subset by blast
         then have "j (f (h x)) \<in> U"
           using f h hull_subset that by fastforce
         then show "f' x \<in> U"
           using \<open>K \<subseteq> S\<close> S f'_def that by auto
       qed
     qed
   qed
 qed
 
 
 subsection\<open>Nullhomotopic mappings\<close>
 
 text\<open> A mapping out of a sphere is nullhomotopic iff it extends to the ball.
 This even works out in the degenerate cases when the radius is \<open>\<le>\<close> 0, and
 we also don't need to explicitly assume continuity since it's already implicit
 in both sides of the equivalence.\<close>
 
 lemma nullhomotopic_from_lemma:
   assumes contg: "continuous_on (cball a r - {a}) g"
       and fa: "\<And>e. 0 < e
                \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>x. x \<noteq> a \<and> norm(x - a) < d \<longrightarrow> norm(g x - f a) < e)"
       and r: "\<And>x. x \<in> cball a r \<and> x \<noteq> a \<Longrightarrow> f x = g x"
     shows "continuous_on (cball a r) f"
 proof (clarsimp simp: continuous_on_eq_continuous_within Ball_def)
   fix x
   assume x: "dist a x \<le> r"
   show "continuous (at x within cball a r) f"
   proof (cases "x=a")
     case True
     then show ?thesis
       by (metis continuous_within_eps_delta fa dist_norm dist_self r)
   next
     case False
     show ?thesis
     proof (rule continuous_transform_within [where f=g and d = "norm(x-a)"])
       have "\<exists>d>0. \<forall>x'\<in>cball a r.
                       dist x' x < d \<longrightarrow> dist (g x') (g x) < e" if "e>0" for e
       proof -
         obtain d where "d > 0"
            and d: "\<And>x'. \<lbrakk>dist x' a \<le> r; x' \<noteq> a; dist x' x < d\<rbrakk> \<Longrightarrow>
                                  dist (g x') (g x) < e"
           using contg False x \<open>e>0\<close>
           unfolding continuous_on_iff by (fastforce simp: dist_commute intro: that)
         show ?thesis
           using \<open>d > 0\<close> \<open>x \<noteq> a\<close>
           by (rule_tac x="min d (norm(x - a))" in exI)
              (auto simp: dist_commute dist_norm [symmetric]  intro!: d)
       qed
       then show "continuous (at x within cball a r) g"
         using contg False by (auto simp: continuous_within_eps_delta)
       show "0 < norm (x - a)"
         using False by force
       show "x \<in> cball a r"
         by (simp add: x)
       show "\<And>x'. \<lbrakk>x' \<in> cball a r; dist x' x < norm (x - a)\<rbrakk>
         \<Longrightarrow> g x' = f x'"
         by (metis dist_commute dist_norm less_le r)
     qed
   qed
 qed
 
 proposition nullhomotopic_from_sphere_extension:
   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   shows  "(\<exists>c. homotopic_with_canon (\<lambda>x. True) (sphere a r) S f (\<lambda>x. c)) \<longleftrightarrow>
           (\<exists>g. continuous_on (cball a r) g \<and> g ` (cball a r) \<subseteq> S \<and>
                (\<forall>x \<in> sphere a r. g x = f x))"
          (is "?lhs = ?rhs")
 proof (cases r "0::real" rule: linorder_cases)
   case less
   then show ?thesis
     by (simp add: homotopic_on_emptyI)
 next
   case equal
   show ?thesis
   proof
     assume L: ?lhs
     with equal have [simp]: "f a \<in> S"
       using homotopic_with_imp_subset1 by fastforce
     obtain h:: "real \<times> 'M \<Rightarrow> 'a" 
       where h: "continuous_on ({0..1} \<times> {a}) h" "h ` ({0..1} \<times> {a}) \<subseteq> S" "h (0, a) = f a"    
       using L equal by (auto simp: homotopic_with)
     then have "continuous_on (cball a r) (\<lambda>x. h (0, a))" "(\<lambda>x. h (0, a)) ` cball a r \<subseteq> S"
       by (auto simp: equal)
     then show ?rhs
       using h(3) local.equal by force
   next
     assume ?rhs
     then show ?lhs
       using equal continuous_on_const by (force simp: homotopic_with)
   qed
 next
   case greater
   let ?P = "continuous_on {x. norm(x - a) = r} f \<and> f ` {x. norm(x - a) = r} \<subseteq> S"
   have ?P if ?lhs using that
   proof
     fix c
     assume c: "homotopic_with_canon (\<lambda>x. True) (sphere a r) S f (\<lambda>x. c)"
     then have contf: "continuous_on (sphere a r) f" 
       by (metis homotopic_with_imp_continuous)
     moreover have fim: "f ` sphere a r \<subseteq> S"
       by (meson continuous_map_subtopology_eu c homotopic_with_imp_continuous_maps)
     show ?P
       using contf fim by (auto simp: sphere_def dist_norm norm_minus_commute)
   qed
   moreover have ?P if ?rhs using that
   proof
     fix g
     assume g: "continuous_on (cball a r) g \<and> g ` cball a r \<subseteq> S \<and> (\<forall>xa\<in>sphere a r. g xa = f xa)"
     then have "f ` {x. norm (x - a) = r} \<subseteq> S"
       using sphere_cball [of a r] unfolding image_subset_iff sphere_def
       by (metis dist_commute dist_norm mem_Collect_eq subset_eq)
     with g show ?P
       by (auto simp: dist_norm norm_minus_commute elim!: continuous_on_eq [OF continuous_on_subset])
   qed
   moreover have ?thesis if ?P
   proof
     assume ?lhs
     then obtain c where "homotopic_with_canon (\<lambda>x. True) (sphere a r) S (\<lambda>x. c) f"
       using homotopic_with_sym by blast
     then obtain h where conth: "continuous_on ({0..1::real} \<times> sphere a r) h"
                     and him: "h ` ({0..1} \<times> sphere a r) \<subseteq> S"
                     and h: "\<And>x. h(0, x) = c" "\<And>x. h(1, x) = f x"
       by (auto simp: homotopic_with_def)
     obtain b1::'M where "b1 \<in> Basis"
       using SOME_Basis by auto
     have "c \<in> h ` ({0..1} \<times> sphere a r)"
     proof
       show "c = h (0, a + r *\<^sub>R b1)"
         by (simp add: h)
       show "(0, a + r *\<^sub>R b1) \<in> {0..1::real} \<times> sphere a r"
         using greater \<open>b1 \<in> Basis\<close> by (auto simp: dist_norm)
     qed
     then have "c \<in> S"
       using him by blast
     have uconth: "uniformly_continuous_on ({0..1::real} \<times> (sphere a r)) h"
       by (force intro: compact_Times conth compact_uniformly_continuous)
     let ?g = "\<lambda>x. h (norm (x - a)/r,
                      a + (if x = a then r *\<^sub>R b1 else (r / norm(x - a)) *\<^sub>R (x - a)))"
     let ?g' = "\<lambda>x. h (norm (x - a)/r, a + (r / norm(x - a)) *\<^sub>R (x - a))"
     show ?rhs
     proof (intro exI conjI)
       have "continuous_on (cball a r - {a}) ?g'"
         using greater
         by (force simp: dist_norm norm_minus_commute intro: continuous_on_compose2 [OF conth] continuous_intros)
       then show "continuous_on (cball a r) ?g"
       proof (rule nullhomotopic_from_lemma)
         show "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> norm (?g' x - ?g a) < e" if "0 < e" for e
         proof -
           obtain d where "0 < d"
              and d: "\<And>x x'. \<lbrakk>x \<in> {0..1} \<times> sphere a r; x' \<in> {0..1} \<times> sphere a r; norm ( x' - x) < d\<rbrakk>
                         \<Longrightarrow> norm (h x' - h x) < e"
             using uniformly_continuous_onE [OF uconth \<open>0 < e\<close>] by (auto simp: dist_norm)
           have *: "norm (h (norm (x - a) / r,
                          a + (r / norm (x - a)) *\<^sub>R (x - a)) - h (0, a + r *\<^sub>R b1)) < e" (is  "norm (?ha - ?hb) < e")
                    if "x \<noteq> a" "norm (x - a) < r" "norm (x - a) < d * r" for x
           proof -
             have "norm (?ha - ?hb) = norm (?ha - h (0, a + (r / norm (x - a)) *\<^sub>R (x - a)))"
               by (simp add: h)
             also have "\<dots> < e"
               using greater \<open>0 < d\<close> \<open>b1 \<in> Basis\<close> that
               by (intro d) (simp_all add: dist_norm, simp add: field_simps) 
             finally show ?thesis .
           qed
           show ?thesis
             using greater \<open>0 < d\<close> 
             by (rule_tac x = "min r (d * r)" in exI) (auto simp: *)
         qed
         show "\<And>x. x \<in> cball a r \<and> x \<noteq> a \<Longrightarrow> ?g x = ?g' x"
           by auto
       qed
     next
       show "?g ` cball a r \<subseteq> S"
         using greater him \<open>c \<in> S\<close>
         by (force simp: h dist_norm norm_minus_commute)
     next
       show "\<forall>x\<in>sphere a r. ?g x = f x"
         using greater by (auto simp: h dist_norm norm_minus_commute)
     qed
   next
     assume ?rhs
     then obtain g where contg: "continuous_on (cball a r) g"
                     and gim: "g ` cball a r \<subseteq> S"
                     and gf: "\<forall>x \<in> sphere a r. g x = f x"
       by auto
     let ?h = "\<lambda>y. g (a + (fst y) *\<^sub>R (snd y - a))"
     have "continuous_on ({0..1} \<times> sphere a r) ?h"
     proof (rule continuous_on_compose2 [OF contg])
       show "continuous_on ({0..1} \<times> sphere a r) (\<lambda>x. a + fst x *\<^sub>R (snd x - a))"
         by (intro continuous_intros)
       qed (auto simp: dist_norm norm_minus_commute mult_left_le_one_le)
     moreover
     have "?h ` ({0..1} \<times> sphere a r) \<subseteq> S"
       by (auto simp: dist_norm norm_minus_commute mult_left_le_one_le gim [THEN subsetD])
     moreover
     have "\<forall>x\<in>sphere a r. ?h (0, x) = g a" "\<forall>x\<in>sphere a r. ?h (1, x) = f x"
       by (auto simp: dist_norm norm_minus_commute mult_left_le_one_le gf)
     ultimately have "homotopic_with_canon (\<lambda>x. True) (sphere a r) S (\<lambda>x. g a) f"
       by (auto simp: homotopic_with)
     then show ?lhs
       using homotopic_with_symD by blast
   qed
   ultimately
   show ?thesis by meson
 qed 
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Path_Connected.thy b/src/HOL/Analysis/Path_Connected.thy
--- a/src/HOL/Analysis/Path_Connected.thy
+++ b/src/HOL/Analysis/Path_Connected.thy
@@ -1,4066 +1,4096 @@
 (*  Title:      HOL/Analysis/Path_Connected.thy
     Authors:    LC Paulson and Robert Himmelmann (TU Muenchen), based on material from HOL Light
 *)
 
 section \<open>Path-Connectedness\<close>
 
 theory Path_Connected
 imports
   Starlike
   T1_Spaces
 begin
 
 subsection \<open>Paths and Arcs\<close>
 
 definition\<^marker>\<open>tag important\<close> path :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> bool"
   where "path g \<equiv> continuous_on {0..1} g"
 
 definition\<^marker>\<open>tag important\<close> pathstart :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a"
   where "pathstart g \<equiv> g 0"
 
 definition\<^marker>\<open>tag important\<close> pathfinish :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a"
   where "pathfinish g \<equiv> g 1"
 
 definition\<^marker>\<open>tag important\<close> path_image :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a set"
   where "path_image g \<equiv> g ` {0 .. 1}"
 
 definition\<^marker>\<open>tag important\<close> reversepath :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> real \<Rightarrow> 'a"
   where "reversepath g \<equiv> (\<lambda>x. g(1 - x))"
 
 definition\<^marker>\<open>tag important\<close> joinpaths :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> real \<Rightarrow> 'a"
     (infixr "+++" 75)
   where "g1 +++ g2 \<equiv> (\<lambda>x. if x \<le> 1/2 then g1 (2 * x) else g2 (2 * x - 1))"
 
 definition\<^marker>\<open>tag important\<close> loop_free :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> bool"
   where "loop_free g \<equiv> \<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. g x = g y \<longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
 
 definition\<^marker>\<open>tag important\<close> simple_path :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> bool"
   where "simple_path g \<equiv> path g \<and> loop_free g"
 
 definition\<^marker>\<open>tag important\<close> arc :: "(real \<Rightarrow> 'a :: topological_space) \<Rightarrow> bool"
   where "arc g \<equiv> path g \<and> inj_on g {0..1}"
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Invariance theorems\<close>
 
 lemma path_eq: "path p \<Longrightarrow> (\<And>t. t \<in> {0..1} \<Longrightarrow> p t = q t) \<Longrightarrow> path q"
   using continuous_on_eq path_def by blast
 
 lemma path_continuous_image: "path g \<Longrightarrow> continuous_on (path_image g) f \<Longrightarrow> path(f \<circ> g)"
   unfolding path_def path_image_def
   using continuous_on_compose by blast
 
 lemma path_translation_eq:
   fixes g :: "real \<Rightarrow> 'a :: real_normed_vector"
   shows "path((\<lambda>x. a + x) \<circ> g) = path g"
   using continuous_on_translation_eq path_def by blast
 
 lemma path_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
    assumes "linear f" "inj f"
      shows "path(f \<circ> g) = path g"
 proof -
   from linear_injective_left_inverse [OF assms]
   obtain h where h: "linear h" "h \<circ> f = id"
     by blast
   with assms show ?thesis
     by (metis comp_assoc id_comp linear_continuous_on linear_linear path_continuous_image)
 qed
 
 lemma pathstart_translation: "pathstart((\<lambda>x. a + x) \<circ> g) = a + pathstart g"
   by (simp add: pathstart_def)
 
 lemma pathstart_linear_image_eq: "linear f \<Longrightarrow> pathstart(f \<circ> g) = f(pathstart g)"
   by (simp add: pathstart_def)
 
 lemma pathfinish_translation: "pathfinish((\<lambda>x. a + x) \<circ> g) = a + pathfinish g"
   by (simp add: pathfinish_def)
 
 lemma pathfinish_linear_image: "linear f \<Longrightarrow> pathfinish(f \<circ> g) = f(pathfinish g)"
   by (simp add: pathfinish_def)
 
 lemma path_image_translation: "path_image((\<lambda>x. a + x) \<circ> g) = (\<lambda>x. a + x) ` (path_image g)"
   by (simp add: image_comp path_image_def)
 
 lemma path_image_linear_image: "linear f \<Longrightarrow> path_image(f \<circ> g) = f ` (path_image g)"
   by (simp add: image_comp path_image_def)
 
 lemma reversepath_translation: "reversepath((\<lambda>x. a + x) \<circ> g) = (\<lambda>x. a + x) \<circ> reversepath g"
   by (rule ext) (simp add: reversepath_def)
 
 lemma reversepath_linear_image: "linear f \<Longrightarrow> reversepath(f \<circ> g) = f \<circ> reversepath g"
   by (rule ext) (simp add: reversepath_def)
 
 lemma joinpaths_translation:
     "((\<lambda>x. a + x) \<circ> g1) +++ ((\<lambda>x. a + x) \<circ> g2) = (\<lambda>x. a + x) \<circ> (g1 +++ g2)"
   by (rule ext) (simp add: joinpaths_def)
 
 lemma joinpaths_linear_image: "linear f \<Longrightarrow> (f \<circ> g1) +++ (f \<circ> g2) = f \<circ> (g1 +++ g2)"
   by (rule ext) (simp add: joinpaths_def)
 
 lemma loop_free_translation_eq:
   fixes g :: "real \<Rightarrow> 'a::euclidean_space"
   shows "loop_free((\<lambda>x. a + x) \<circ> g) = loop_free g"
   by (simp add: loop_free_def)
 
 lemma simple_path_translation_eq:
   fixes g :: "real \<Rightarrow> 'a::euclidean_space"
   shows "simple_path((\<lambda>x. a + x) \<circ> g) = simple_path g"
   by (simp add: simple_path_def loop_free_translation_eq path_translation_eq)
 
 lemma loop_free_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "loop_free(f \<circ> g) = loop_free g"
   using assms inj_on_eq_iff [of f] by (auto simp: loop_free_def)
 
 lemma simple_path_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "simple_path(f \<circ> g) = simple_path g"
   using assms
   by (simp add: loop_free_linear_image_eq path_linear_image_eq simple_path_def)
 
+lemma simple_pathI [intro?]:
+  assumes "path p"
+  assumes "\<And>x y. 0 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> p x = p y \<Longrightarrow> x = 0 \<and> y = 1"
+  shows   "simple_path p"
+  unfolding simple_path_def loop_free_def
+proof (intro ballI conjI impI)
+  fix x y assume "x \<in> {0..1}" "y \<in> {0..1}" "p x = p y"
+  thus "x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
+    by (metis assms(2) atLeastAtMost_iff linorder_less_linear)
+qed fact+
+
+lemma arcD: "arc p \<Longrightarrow> p x = p y \<Longrightarrow> x \<in> {0..1} \<Longrightarrow> y \<in> {0..1} \<Longrightarrow> x = y"
+  by (auto simp: arc_def inj_on_def)
+
 lemma arc_translation_eq:
   fixes g :: "real \<Rightarrow> 'a::euclidean_space"
   shows "arc((\<lambda>x. a + x) \<circ> g) \<longleftrightarrow> arc g"
   by (auto simp: arc_def inj_on_def path_translation_eq)
 
 lemma arc_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
    assumes "linear f" "inj f"
      shows  "arc(f \<circ> g) = arc g"
   using assms inj_on_eq_iff [of f]
   by (auto simp: arc_def inj_on_def path_linear_image_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Basic lemmas about paths\<close>
 
 lemma path_of_real: "path complex_of_real" 
   unfolding path_def by (intro continuous_intros)
 
 lemma path_const: "path (\<lambda>t. a)" for a::"'a::real_normed_vector"
   unfolding path_def by (intro continuous_intros)
 
 lemma path_minus: "path g \<Longrightarrow> path (\<lambda>t. - g t)" for g::"real\<Rightarrow>'a::real_normed_vector"
   unfolding path_def by (intro continuous_intros)
 
 lemma path_add: "\<lbrakk>path f; path g\<rbrakk> \<Longrightarrow> path (\<lambda>t. f t + g t)" for f::"real\<Rightarrow>'a::real_normed_vector"
   unfolding path_def by (intro continuous_intros)
 
 lemma path_diff: "\<lbrakk>path f; path g\<rbrakk> \<Longrightarrow> path (\<lambda>t. f t - g t)" for f::"real\<Rightarrow>'a::real_normed_vector"
   unfolding path_def by (intro continuous_intros)
 
 lemma path_mult: "\<lbrakk>path f; path g\<rbrakk> \<Longrightarrow> path (\<lambda>t. f t * g t)" for f::"real\<Rightarrow>'a::real_normed_field"
   unfolding path_def by (intro continuous_intros)
 
 lemma pathin_iff_path_real [simp]: "pathin euclideanreal g \<longleftrightarrow> path g"
   by (simp add: pathin_def path_def)
 
 lemma continuous_on_path: "path f \<Longrightarrow> t \<subseteq> {0..1} \<Longrightarrow> continuous_on t f"
   using continuous_on_subset path_def by blast
 
 lemma inj_on_imp_loop_free: "inj_on g {0..1} \<Longrightarrow> loop_free g"
   by (simp add: inj_onD loop_free_def)
 
 lemma arc_imp_simple_path: "arc g \<Longrightarrow> simple_path g"
   by (simp add: arc_def inj_on_imp_loop_free simple_path_def)
 
 lemma arc_imp_path: "arc g \<Longrightarrow> path g"
   using arc_def by blast
 
 lemma arc_imp_inj_on: "arc g \<Longrightarrow> inj_on g {0..1}"
   by (auto simp: arc_def)
 
 lemma simple_path_imp_path: "simple_path g \<Longrightarrow> path g"
   using simple_path_def by blast
 
 lemma loop_free_cases: "loop_free g \<Longrightarrow> inj_on g {0..1} \<or> pathfinish g = pathstart g"
   by (force simp: inj_on_def loop_free_def pathfinish_def pathstart_def)
 
 lemma simple_path_cases: "simple_path g \<Longrightarrow> arc g \<or> pathfinish g = pathstart g"
   using arc_def loop_free_cases simple_path_def by blast
 
 lemma simple_path_imp_arc: "simple_path g \<Longrightarrow> pathfinish g \<noteq> pathstart g \<Longrightarrow> arc g"
   using simple_path_cases by auto
 
 lemma arc_distinct_ends: "arc g \<Longrightarrow> pathfinish g \<noteq> pathstart g"
   unfolding arc_def inj_on_def pathfinish_def pathstart_def
   by fastforce
 
 lemma arc_simple_path: "arc g \<longleftrightarrow> simple_path g \<and> pathfinish g \<noteq> pathstart g"
   using arc_distinct_ends arc_imp_simple_path simple_path_cases by blast
 
 lemma simple_path_eq_arc: "pathfinish g \<noteq> pathstart g \<Longrightarrow> (simple_path g = arc g)"
   by (simp add: arc_simple_path)
 
 lemma path_image_const [simp]: "path_image (\<lambda>t. a) = {a}"
   by (force simp: path_image_def)
 
 lemma path_image_nonempty [simp]: "path_image g \<noteq> {}"
   unfolding path_image_def image_is_empty box_eq_empty
   by auto
 
 lemma pathstart_in_path_image[intro]: "pathstart g \<in> path_image g"
   unfolding pathstart_def path_image_def
   by auto
 
 lemma pathfinish_in_path_image[intro]: "pathfinish g \<in> path_image g"
   unfolding pathfinish_def path_image_def
   by auto
 
 lemma connected_path_image[intro]: "path g \<Longrightarrow> connected (path_image g)"
   unfolding path_def path_image_def
   using connected_continuous_image connected_Icc by blast
 
 lemma compact_path_image[intro]: "path g \<Longrightarrow> compact (path_image g)"
   unfolding path_def path_image_def
   using compact_continuous_image connected_Icc by blast
 
 lemma reversepath_reversepath[simp]: "reversepath (reversepath g) = g"
   unfolding reversepath_def
   by auto
 
 lemma pathstart_reversepath[simp]: "pathstart (reversepath g) = pathfinish g"
   unfolding pathstart_def reversepath_def pathfinish_def
   by auto
 
 lemma pathfinish_reversepath[simp]: "pathfinish (reversepath g) = pathstart g"
   unfolding pathstart_def reversepath_def pathfinish_def
   by auto
 
 lemma reversepath_o: "reversepath g = g \<circ> (-)1"
   by (auto simp: reversepath_def)
 
 lemma pathstart_join[simp]: "pathstart (g1 +++ g2) = pathstart g1"
   unfolding pathstart_def joinpaths_def pathfinish_def
   by auto
 
 lemma pathfinish_join[simp]: "pathfinish (g1 +++ g2) = pathfinish g2"
   unfolding pathstart_def joinpaths_def pathfinish_def
   by auto
 
 lemma path_image_reversepath[simp]: "path_image (reversepath g) = path_image g"
   by (metis cancel_comm_monoid_add_class.diff_cancel diff_zero image_comp 
       image_diff_atLeastAtMost path_image_def reversepath_o)
 
 lemma path_reversepath [simp]: "path (reversepath g) \<longleftrightarrow> path g"
   by (metis continuous_on_compose continuous_on_op_minus image_comp image_ident path_def path_image_def path_image_reversepath reversepath_o reversepath_reversepath)
 
 lemma arc_reversepath:
   assumes "arc g" shows "arc(reversepath g)"
 proof -
   have injg: "inj_on g {0..1}"
     using assms
     by (simp add: arc_def)
   have **: "\<And>x y::real. 1-x = 1-y \<Longrightarrow> x = y"
     by simp
   show ?thesis
     using assms  by (clarsimp simp: arc_def intro!: inj_onI) (simp add: inj_onD reversepath_def **)
 qed
 
 lemma loop_free_reversepath:
   assumes "loop_free g" shows "loop_free(reversepath g)"
   using assms by (simp add: reversepath_def loop_free_def Ball_def) (smt (verit))
 
 lemma simple_path_reversepath: "simple_path g \<Longrightarrow> simple_path (reversepath g)"
   by (simp add: loop_free_reversepath simple_path_def)
 
 lemmas reversepath_simps =
   path_reversepath path_image_reversepath pathstart_reversepath pathfinish_reversepath
 
 lemma path_join[simp]:
   assumes "pathfinish g1 = pathstart g2"
   shows "path (g1 +++ g2) \<longleftrightarrow> path g1 \<and> path g2"
   unfolding path_def pathfinish_def pathstart_def
 proof safe
   assume cont: "continuous_on {0..1} (g1 +++ g2)"
   have g1: "continuous_on {0..1} g1 \<longleftrightarrow> continuous_on {0..1} ((g1 +++ g2) \<circ> (\<lambda>x. x / 2))"
     by (intro continuous_on_cong refl) (auto simp: joinpaths_def)
   have g2: "continuous_on {0..1} g2 \<longleftrightarrow> continuous_on {0..1} ((g1 +++ g2) \<circ> (\<lambda>x. x / 2 + 1/2))"
     using assms
     by (intro continuous_on_cong refl) (auto simp: joinpaths_def pathfinish_def pathstart_def)
   show "continuous_on {0..1} g1" and "continuous_on {0..1} g2"
     unfolding g1 g2
     by (auto intro!: continuous_intros continuous_on_subset[OF cont] simp del: o_apply)
 next
   assume g1g2: "continuous_on {0..1} g1" "continuous_on {0..1} g2"
   have 01: "{0 .. 1} = {0..1/2} \<union> {1/2 .. 1::real}"
     by auto
   {
     fix x :: real
     assume "0 \<le> x" and "x \<le> 1"
     then have "x \<in> (\<lambda>x. x * 2) ` {0..1 / 2}"
       by (intro image_eqI[where x="x/2"]) auto
   }
   note 1 = this
   {
     fix x :: real
     assume "0 \<le> x" and "x \<le> 1"
     then have "x \<in> (\<lambda>x. x * 2 - 1) ` {1 / 2..1}"
       by (intro image_eqI[where x="x/2 + 1/2"]) auto
   }
   note 2 = this
   show "continuous_on {0..1} (g1 +++ g2)"
     using assms
     unfolding joinpaths_def 01
     apply (intro continuous_on_cases closed_atLeastAtMost g1g2[THEN continuous_on_compose2] continuous_intros)
     apply (auto simp: field_simps pathfinish_def pathstart_def intro!: 1 2)
     done
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Path Images\<close>
 
 lemma bounded_path_image: "path g \<Longrightarrow> bounded(path_image g)"
   by (simp add: compact_imp_bounded compact_path_image)
 
 lemma closed_path_image:
   fixes g :: "real \<Rightarrow> 'a::t2_space"
   shows "path g \<Longrightarrow> closed(path_image g)"
   by (metis compact_path_image compact_imp_closed)
 
 lemma connected_simple_path_image: "simple_path g \<Longrightarrow> connected(path_image g)"
   by (metis connected_path_image simple_path_imp_path)
 
 lemma compact_simple_path_image: "simple_path g \<Longrightarrow> compact(path_image g)"
   by (metis compact_path_image simple_path_imp_path)
 
 lemma bounded_simple_path_image: "simple_path g \<Longrightarrow> bounded(path_image g)"
   by (metis bounded_path_image simple_path_imp_path)
 
 lemma closed_simple_path_image:
   fixes g :: "real \<Rightarrow> 'a::t2_space"
   shows "simple_path g \<Longrightarrow> closed(path_image g)"
   by (metis closed_path_image simple_path_imp_path)
 
 lemma connected_arc_image: "arc g \<Longrightarrow> connected(path_image g)"
   by (metis connected_path_image arc_imp_path)
 
 lemma compact_arc_image: "arc g \<Longrightarrow> compact(path_image g)"
   by (metis compact_path_image arc_imp_path)
 
 lemma bounded_arc_image: "arc g \<Longrightarrow> bounded(path_image g)"
   by (metis bounded_path_image arc_imp_path)
 
 lemma closed_arc_image:
   fixes g :: "real \<Rightarrow> 'a::t2_space"
   shows "arc g \<Longrightarrow> closed(path_image g)"
   by (metis closed_path_image arc_imp_path)
 
 lemma path_image_join_subset: "path_image (g1 +++ g2) \<subseteq> path_image g1 \<union> path_image g2"
   unfolding path_image_def joinpaths_def
   by auto
 
 lemma subset_path_image_join:
   assumes "path_image g1 \<subseteq> S" and "path_image g2 \<subseteq> S"
   shows "path_image (g1 +++ g2) \<subseteq> S"
   using path_image_join_subset[of g1 g2] and assms
   by auto
 
 lemma path_image_join:
   assumes "pathfinish g1 = pathstart g2"
   shows "path_image(g1 +++ g2) = path_image g1 \<union> path_image g2"
 proof -
   have "path_image g1 \<subseteq> path_image (g1 +++ g2)"
   proof (clarsimp simp: path_image_def joinpaths_def)
     fix u::real
     assume "0 \<le> u" "u \<le> 1"
     then show "g1 u \<in> (\<lambda>x. g1 (2 * x)) ` ({0..1} \<inter> {x. x * 2 \<le> 1})"
       by (rule_tac x="u/2" in image_eqI) auto
   qed
   moreover 
   have \<section>: "g2 u \<in> (\<lambda>x. g2 (2 * x - 1)) ` ({0..1} \<inter> {x. \<not> x * 2 \<le> 1})" 
     if "0 < u" "u \<le> 1" for u
     using that assms
     by (rule_tac x="(u+1)/2" in image_eqI) (auto simp: field_simps pathfinish_def pathstart_def)
   have "g2 0 \<in> (\<lambda>x. g1 (2 * x)) ` ({0..1} \<inter> {x. x * 2 \<le> 1})"
     using assms
     by (rule_tac x="1/2" in image_eqI) (auto simp: pathfinish_def pathstart_def)
   then have "path_image g2 \<subseteq> path_image (g1 +++ g2)"
     by (auto simp: path_image_def joinpaths_def intro!: \<section>)
   ultimately show ?thesis
     using path_image_join_subset by blast
 qed
 
 lemma not_in_path_image_join:
   assumes "x \<notin> path_image g1" and "x \<notin> path_image g2"
   shows "x \<notin> path_image (g1 +++ g2)"
   using assms and path_image_join_subset[of g1 g2]
   by auto
 
 lemma pathstart_compose: "pathstart(f \<circ> p) = f(pathstart p)"
   by (simp add: pathstart_def)
 
 lemma pathfinish_compose: "pathfinish(f \<circ> p) = f(pathfinish p)"
   by (simp add: pathfinish_def)
 
 lemma path_image_compose: "path_image (f \<circ> p) = f ` (path_image p)"
   by (simp add: image_comp path_image_def)
 
 lemma path_compose_join: "f \<circ> (p +++ q) = (f \<circ> p) +++ (f \<circ> q)"
   by (rule ext) (simp add: joinpaths_def)
 
 lemma path_compose_reversepath: "f \<circ> reversepath p = reversepath(f \<circ> p)"
   by (rule ext) (simp add: reversepath_def)
 
 lemma joinpaths_eq:
   "(\<And>t. t \<in> {0..1} \<Longrightarrow> p t = p' t) \<Longrightarrow>
    (\<And>t. t \<in> {0..1} \<Longrightarrow> q t = q' t)
    \<Longrightarrow>  t \<in> {0..1} \<Longrightarrow> (p +++ q) t = (p' +++ q') t"
   by (auto simp: joinpaths_def)
 
 lemma loop_free_inj_on: "loop_free g \<Longrightarrow> inj_on g {0<..<1}"
   by (force simp: inj_on_def loop_free_def)
 
 lemma simple_path_inj_on: "simple_path g \<Longrightarrow> inj_on g {0<..<1}"
   using loop_free_inj_on simple_path_def by auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Simple paths with the endpoints removed\<close>
 
 lemma simple_path_endless:
   assumes "simple_path c"
   shows "path_image c - {pathstart c,pathfinish c} = c ` {0<..<1}" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     using less_eq_real_def by (auto simp: path_image_def pathstart_def pathfinish_def)
   show "?rhs \<subseteq> ?lhs"
     using assms 
     apply (simp add: image_subset_iff path_image_def pathstart_def pathfinish_def simple_path_def loop_free_def Ball_def)
     by (smt (verit))
 qed
 
 lemma connected_simple_path_endless:
   assumes "simple_path c"
   shows "connected(path_image c - {pathstart c,pathfinish c})"
 proof -
   have "continuous_on {0<..<1} c"
     using assms by (simp add: simple_path_def continuous_on_path path_def subset_iff)
   then have "connected (c ` {0<..<1})"
     using connected_Ioo connected_continuous_image by blast
   then show ?thesis
     using assms by (simp add: simple_path_endless)
 qed
 
 lemma nonempty_simple_path_endless:
     "simple_path c \<Longrightarrow> path_image c - {pathstart c,pathfinish c} \<noteq> {}"
   by (simp add: simple_path_endless)
 
 lemma simple_path_continuous_image:
   assumes "simple_path f" "continuous_on (path_image f) g" "inj_on g (path_image f)"
   shows   "simple_path (g \<circ> f)"
   unfolding simple_path_def
 proof
   show "path (g \<circ> f)"
     using assms unfolding simple_path_def by (intro path_continuous_image) auto
   from assms have [simp]: "g (f x) = g (f y) \<longleftrightarrow> f x = f y" if "x \<in> {0..1}" "y \<in> {0..1}" for x y
     unfolding inj_on_def path_image_def using that by fastforce
   show "loop_free (g \<circ> f)"
     using assms(1) by (auto simp: loop_free_def simple_path_def)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>The operations on paths\<close>
 
 lemma path_image_subset_reversepath: "path_image(reversepath g) \<le> path_image g"
   by simp
 
 lemma path_imp_reversepath: "path g \<Longrightarrow> path(reversepath g)"
   by simp
 
 lemma half_bounded_equal: "1 \<le> x * 2 \<Longrightarrow> x * 2 \<le> 1 \<longleftrightarrow> x = (1/2::real)"
   by simp
 
 lemma continuous_on_joinpaths:
   assumes "continuous_on {0..1} g1" "continuous_on {0..1} g2" "pathfinish g1 = pathstart g2"
     shows "continuous_on {0..1} (g1 +++ g2)"
   using assms path_def path_join by blast
 
 lemma path_join_imp: "\<lbrakk>path g1; path g2; pathfinish g1 = pathstart g2\<rbrakk> \<Longrightarrow> path(g1 +++ g2)"
   by simp
 
 lemma arc_join:
   assumes "arc g1" "arc g2"
           "pathfinish g1 = pathstart g2"
           "path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g2}"
     shows "arc(g1 +++ g2)"
 proof -
   have injg1: "inj_on g1 {0..1}" and injg2: "inj_on g2 {0..1}" 
      and g11: "g1 1 = g2 0" and sb: "g1 ` {0..1} \<inter> g2 ` {0..1} \<subseteq> {g2 0}"
     using assms
     by (auto simp: arc_def pathfinish_def pathstart_def path_image_def)
   { fix x and y::real
     assume xy: "g2 (2 * x - 1) = g1 (2 * y)" "x \<le> 1" "0 \<le> y" " y * 2 \<le> 1" "\<not> x * 2 \<le> 1"
     then have "g1 (2 * y) = g2 0"
       using sb by force
     then have False
       using xy inj_onD injg2 by fastforce
    } note * = this
   have "inj_on (g1 +++ g2) {0..1}"
     using inj_onD [OF injg1] inj_onD [OF injg2] *
     by (simp add: inj_on_def joinpaths_def Ball_def) (smt (verit))
   then show ?thesis
     using arc_def assms path_join_imp by blast
 qed
 
 lemma simple_path_join_loop:
   assumes "arc g1" "arc g2"
           "pathfinish g1 = pathstart g2"  "pathfinish g2 = pathstart g1"
           "path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g1, pathstart g2}"
         shows "simple_path(g1 +++ g2)"
 proof -
   have injg1: "inj_on g1 {0..1}" and injg2: "inj_on g2 {0..1}"
     using assms by (auto simp add: arc_def)
   have g12: "g1 1 = g2 0"
    and g21: "g2 1 = g1 0"
    and sb:  "g1 ` {0..1} \<inter> g2 ` {0..1} \<subseteq> {g1 0, g2 0}"
     using assms
     by (simp_all add: arc_def pathfinish_def pathstart_def path_image_def)
   { fix x and y::real
     assume g2_eq: "g2 (2 * x - 1) = g1 (2 * y)"
       and xyI: "x \<noteq> 1 \<or> y \<noteq> 0"
       and xy: "x \<le> 1" "0 \<le> y" " y * 2 \<le> 1" "\<not> x * 2 \<le> 1" 
     then consider "g1 (2 * y) = g1 0" | "g1 (2 * y) = g2 0"
       using sb by force
     then have False
     proof cases
       case 1
       then have "y = 0"
         using xy g2_eq by (auto dest!: inj_onD [OF injg1])
       then show ?thesis
         using xy g2_eq xyI by (auto dest: inj_onD [OF injg2] simp flip: g21)
     next
       case 2
       then have "2*x = 1"
         using g2_eq g12 inj_onD [OF injg2] atLeastAtMost_iff xy(1) xy(4) by fastforce
       with xy show False by auto
     qed
   } note * = this 
   have "loop_free(g1 +++ g2)"
     using inj_onD [OF injg1] inj_onD [OF injg2] *
     by (simp add: loop_free_def joinpaths_def Ball_def) (smt (verit))
   then show ?thesis
     by (simp add: arc_imp_path assms simple_path_def)
 qed
 
 lemma reversepath_joinpaths:
     "pathfinish g1 = pathstart g2 \<Longrightarrow> reversepath(g1 +++ g2) = reversepath g2 +++ reversepath g1"
   unfolding reversepath_def pathfinish_def pathstart_def joinpaths_def
   by (rule ext) (auto simp: mult.commute)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Some reversed and "if and only if" versions of joining theorems\<close>
 
 lemma path_join_path_ends:
   fixes g1 :: "real \<Rightarrow> 'a::metric_space"
   assumes "path(g1 +++ g2)" "path g2"
     shows "pathfinish g1 = pathstart g2"
 proof (rule ccontr)
   define e where "e = dist (g1 1) (g2 0)"
   assume Neg: "pathfinish g1 \<noteq> pathstart g2"
   then have "0 < dist (pathfinish g1) (pathstart g2)"
     by auto
   then have "e > 0"
     by (metis e_def pathfinish_def pathstart_def)
   then have "\<forall>e>0. \<exists>d>0. \<forall>x'\<in>{0..1}. dist x' 0 < d \<longrightarrow> dist (g2 x') (g2 0) < e"
     using \<open>path g2\<close> atLeastAtMost_iff zero_le_one unfolding path_def continuous_on_iff
     by blast
   then obtain d1 where "d1 > 0"
        and d1: "\<And>x'. \<lbrakk>x'\<in>{0..1}; norm x' < d1\<rbrakk> \<Longrightarrow> dist (g2 x') (g2 0) < e/2"
     by (metis \<open>0 < e\<close> half_gt_zero_iff norm_conv_dist)
   obtain d2 where "d2 > 0"
        and d2: "\<And>x'. \<lbrakk>x'\<in>{0..1}; dist x' (1/2) < d2\<rbrakk>
                       \<Longrightarrow> dist ((g1 +++ g2) x') (g1 1) < e/2"
     using assms(1) \<open>e > 0\<close> unfolding path_def continuous_on_iff
     apply (drule_tac x="1/2" in bspec, simp)
     apply (drule_tac x="e/2" in spec, force simp: joinpaths_def)
     done
   have int01_1: "min (1/2) (min d1 d2) / 2 \<in> {0..1}"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def)
   have dist1: "norm (min (1 / 2) (min d1 d2) / 2) < d1"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def dist_norm)
   have int01_2: "1/2 + min (1/2) (min d1 d2) / 4 \<in> {0..1}"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def)
   have dist2: "dist (1 / 2 + min (1 / 2) (min d1 d2) / 4) (1 / 2) < d2"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def dist_norm)
   have [simp]: "\<not> min (1 / 2) (min d1 d2) \<le> 0"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def)
   have "dist (g2 (min (1 / 2) (min d1 d2) / 2)) (g1 1) < e/2"
        "dist (g2 (min (1 / 2) (min d1 d2) / 2)) (g2 0) < e/2"
     using d1 [OF int01_1 dist1] d2 [OF int01_2 dist2] by (simp_all add: joinpaths_def)
   then have "dist (g1 1) (g2 0) < e/2 + e/2"
     using dist_triangle_half_r e_def by blast
   then show False
     by (simp add: e_def [symmetric])
 qed
 
 lemma path_join_eq [simp]:
   fixes g1 :: "real \<Rightarrow> 'a::metric_space"
   assumes "path g1" "path g2"
     shows "path(g1 +++ g2) \<longleftrightarrow> pathfinish g1 = pathstart g2"
   using assms by (metis path_join_path_ends path_join_imp)
 
 lemma simple_path_joinE:
   assumes "simple_path(g1 +++ g2)" and "pathfinish g1 = pathstart g2"
   obtains "arc g1" "arc g2"
           "path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g1, pathstart g2}"
 proof -
   have *: "\<And>x y. \<lbrakk>0 \<le> x; x \<le> 1; 0 \<le> y; y \<le> 1; (g1 +++ g2) x = (g1 +++ g2) y\<rbrakk>
                \<Longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
     using assms by (simp add: simple_path_def loop_free_def)
   have "path g1"
     using assms path_join simple_path_imp_path by blast
   moreover have "inj_on g1 {0..1}"
   proof (clarsimp simp: inj_on_def)
     fix x y
     assume "g1 x = g1 y" "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1"
     then show "x = y"
       using * [of "x/2" "y/2"] by (simp add: joinpaths_def split_ifs)
   qed
   ultimately have "arc g1"
     using assms  by (simp add: arc_def)
   have [simp]: "g2 0 = g1 1"
     using assms by (metis pathfinish_def pathstart_def)
   have "path g2"
     using assms path_join simple_path_imp_path by blast
   moreover have "inj_on g2 {0..1}"
   proof (clarsimp simp: inj_on_def)
     fix x y
     assume "g2 x = g2 y" "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1"
     then show "x = y"
       using * [of "(x+1) / 2" "(y+1) / 2"]
       by (force simp: joinpaths_def split_ifs field_split_simps)
   qed
   ultimately have "arc g2"
     using assms  by (simp add: arc_def)
   have "g2 y = g1 0 \<or> g2 y = g1 1"
        if "g1 x = g2 y" "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1" for x y
       using * [of "x / 2" "(y + 1) / 2"] that
       by (auto simp: joinpaths_def split_ifs field_split_simps)
   then have "path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g1, pathstart g2}"
     by (fastforce simp: pathstart_def pathfinish_def path_image_def)
   with \<open>arc g1\<close> \<open>arc g2\<close> show ?thesis using that by blast
 qed
 
 lemma simple_path_join_loop_eq:
   assumes "pathfinish g2 = pathstart g1" "pathfinish g1 = pathstart g2"
   shows "simple_path(g1 +++ g2) \<longleftrightarrow>
              arc g1 \<and> arc g2 \<and> path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g1, pathstart g2}"
   by (metis assms simple_path_joinE simple_path_join_loop)
 
 lemma arc_join_eq:
   assumes "pathfinish g1 = pathstart g2"
     shows "arc(g1 +++ g2) \<longleftrightarrow>
            arc g1 \<and> arc g2 \<and> path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g2}"
            (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs 
     using reversepath_simps assms
     by (smt (verit, best) Int_commute arc_reversepath arc_simple_path in_mono insertE pathstart_join 
           reversepath_joinpaths simple_path_joinE subsetI)
 next
   assume ?rhs then show ?lhs
     using assms
     by (fastforce simp: pathfinish_def pathstart_def intro!: arc_join)
 qed
 
 lemma arc_join_eq_alt:
   "pathfinish g1 = pathstart g2
    \<Longrightarrow> arc(g1 +++ g2) \<longleftrightarrow> arc g1 \<and> arc g2 \<and> path_image g1 \<inter> path_image g2 = {pathstart g2}"
   using pathfinish_in_path_image by (fastforce simp: arc_join_eq)
 
 
+subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Symmetry and loops\<close>
+
+lemma path_sym:
+  "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> path(p +++ q) \<longleftrightarrow> path(q +++ p)"
+  by auto
+
+lemma simple_path_sym:
+  "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk>
+     \<Longrightarrow> simple_path(p +++ q) \<longleftrightarrow> simple_path(q +++ p)"
+  by (metis (full_types) inf_commute insert_commute simple_path_joinE simple_path_join_loop)
+
+lemma path_image_sym:
+  "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk>
+     \<Longrightarrow> path_image(p +++ q) = path_image(q +++ p)"
+  by (simp add: path_image_join sup_commute)
+
+lemma simple_path_joinI:
+  assumes "arc p1" "arc p2" "pathfinish p1 = pathstart p2"
+  assumes "path_image p1 \<inter> path_image p2 
+        \<subseteq> insert (pathstart p2) (if pathstart p1 = pathfinish p2 then {pathstart p1} else {})"
+  shows   "simple_path (p1 +++ p2)"
+  by (smt (verit, best) Int_commute arc_imp_simple_path arc_join assms insert_commute simple_path_join_loop simple_path_sym)
+
+lemma simple_path_join3I:
+  assumes "arc p1" "arc p2" "arc p3"
+  assumes "path_image p1 \<inter> path_image p2 \<subseteq> {pathstart p2}"
+  assumes "path_image p2 \<inter> path_image p3 \<subseteq> {pathstart p3}"
+  assumes "path_image p1 \<inter> path_image p3 \<subseteq> {pathstart p1} \<inter> {pathfinish p3}"
+  assumes "pathfinish p1 = pathstart p2" "pathfinish p2 = pathstart p3"
+  shows   "simple_path (p1 +++ p2 +++ p3)"
+  using assms by (intro simple_path_joinI arc_join) (auto simp: path_image_join)
+
 subsection\<^marker>\<open>tag unimportant\<close>\<open>The joining of paths is associative\<close>
 
 lemma path_assoc:
   "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart r\<rbrakk>
      \<Longrightarrow> path(p +++ (q +++ r)) \<longleftrightarrow> path((p +++ q) +++ r)"
   by simp
 
 lemma simple_path_assoc:
   assumes "pathfinish p = pathstart q" "pathfinish q = pathstart r"
     shows "simple_path (p +++ (q +++ r)) \<longleftrightarrow> simple_path ((p +++ q) +++ r)"
 proof (cases "pathstart p = pathfinish r")
   case True show ?thesis
   proof
     assume "simple_path (p +++ q +++ r)"
     with assms True show "simple_path ((p +++ q) +++ r)"
       by (fastforce simp add: simple_path_join_loop_eq arc_join_eq path_image_join
                     dest: arc_distinct_ends [of r])
   next
     assume 0: "simple_path ((p +++ q) +++ r)"
     with assms True have q: "pathfinish r \<notin> path_image q"
       using arc_distinct_ends
       by (fastforce simp add: simple_path_join_loop_eq arc_join_eq path_image_join)
     have "pathstart r \<notin> path_image p"
       using assms
       by (metis 0 IntI arc_distinct_ends arc_join_eq_alt empty_iff insert_iff
               pathfinish_in_path_image pathfinish_join simple_path_joinE)
     with assms 0 q True show "simple_path (p +++ q +++ r)"
       by (auto simp: simple_path_join_loop_eq arc_join_eq path_image_join
                dest!: subsetD [OF _ IntI])
   qed
 next
   case False
   { fix x :: 'a
     assume a: "path_image p \<inter> path_image q \<subseteq> {pathstart q}"
               "(path_image p \<union> path_image q) \<inter> path_image r \<subseteq> {pathstart r}"
               "x \<in> path_image p" "x \<in> path_image r"
     have "pathstart r \<in> path_image q"
       by (metis assms(2) pathfinish_in_path_image)
     with a have "x = pathstart q"
       by blast
   }
   with False assms show ?thesis
     by (auto simp: simple_path_eq_arc simple_path_join_loop_eq arc_join_eq path_image_join)
 qed
 
 lemma arc_assoc:
      "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart r\<rbrakk>
       \<Longrightarrow> arc(p +++ (q +++ r)) \<longleftrightarrow> arc((p +++ q) +++ r)"
 by (simp add: arc_simple_path simple_path_assoc)
 
-subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Symmetry and loops\<close>
-
-lemma path_sym:
-  "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> path(p +++ q) \<longleftrightarrow> path(q +++ p)"
-  by auto
-
-lemma simple_path_sym:
-  "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk>
-     \<Longrightarrow> simple_path(p +++ q) \<longleftrightarrow> simple_path(q +++ p)"
-  by (metis (full_types) inf_commute insert_commute simple_path_joinE simple_path_join_loop)
-
-lemma path_image_sym:
-  "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk>
-     \<Longrightarrow> path_image(p +++ q) = path_image(q +++ p)"
-  by (simp add: path_image_join sup_commute)
-
 
 subsection\<open>Subpath\<close>
 
 definition\<^marker>\<open>tag important\<close> subpath :: "real \<Rightarrow> real \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> real \<Rightarrow> 'a::real_normed_vector"
   where "subpath a b g \<equiv> \<lambda>x. g((b - a) * x + a)"
 
 lemma path_image_subpath_gen:
   fixes g :: "_ \<Rightarrow> 'a::real_normed_vector"
   shows "path_image(subpath u v g) = g ` (closed_segment u v)"
   by (auto simp add: closed_segment_real_eq path_image_def subpath_def)
 
 lemma path_image_subpath:
   fixes g :: "real \<Rightarrow> 'a::real_normed_vector"
   shows "path_image(subpath u v g) = (if u \<le> v then g ` {u..v} else g ` {v..u})"
   by (simp add: path_image_subpath_gen closed_segment_eq_real_ivl)
 
 lemma path_image_subpath_commute:
   fixes g :: "real \<Rightarrow> 'a::real_normed_vector"
   shows "path_image(subpath u v g) = path_image(subpath v u g)"
   by (simp add: path_image_subpath_gen closed_segment_eq_real_ivl)
 
 lemma path_subpath [simp]:
   fixes g :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "path g" "u \<in> {0..1}" "v \<in> {0..1}"
     shows "path(subpath u v g)"
 proof -
   have "continuous_on {u..v} g" "continuous_on {v..u} g"
     using assms continuous_on_path by fastforce+
   then have "continuous_on {0..1} (g \<circ> (\<lambda>x. ((v-u) * x+ u)))"
     by (intro continuous_intros; simp add: image_affinity_atLeastAtMost [where c=u])
   then show ?thesis
     by (simp add: path_def subpath_def)
 qed
 
 lemma pathstart_subpath [simp]: "pathstart(subpath u v g) = g(u)"
   by (simp add: pathstart_def subpath_def)
 
 lemma pathfinish_subpath [simp]: "pathfinish(subpath u v g) = g(v)"
   by (simp add: pathfinish_def subpath_def)
 
 lemma subpath_trivial [simp]: "subpath 0 1 g = g"
   by (simp add: subpath_def)
 
 lemma subpath_reversepath: "subpath 1 0 g = reversepath g"
   by (simp add: reversepath_def subpath_def)
 
 lemma reversepath_subpath: "reversepath(subpath u v g) = subpath v u g"
   by (simp add: reversepath_def subpath_def algebra_simps)
 
 lemma subpath_translation: "subpath u v ((\<lambda>x. a + x) \<circ> g) = (\<lambda>x. a + x) \<circ> subpath u v g"
   by (rule ext) (simp add: subpath_def)
 
 lemma subpath_image: "subpath u v (f \<circ> g) = f \<circ> subpath u v g"
   by (rule ext) (simp add: subpath_def)
 
 lemma affine_ineq:
   fixes x :: "'a::linordered_idom"
   assumes "x \<le> 1" "v \<le> u"
     shows "v + x * u \<le> u + x * v"
 proof -
   have "(1-x)*(u-v) \<ge> 0"
     using assms by auto
   then show ?thesis
     by (simp add: algebra_simps)
 qed
 
 lemma sum_le_prod1:
   fixes a::real shows "\<lbrakk>a \<le> 1; b \<le> 1\<rbrakk> \<Longrightarrow> a + b \<le> 1 + a * b"
   by (metis add.commute affine_ineq mult.right_neutral)
 
 lemma simple_path_subpath_eq:
   "simple_path(subpath u v g) \<longleftrightarrow>
      path(subpath u v g) \<and> u\<noteq>v \<and>
      (\<forall>x y. x \<in> closed_segment u v \<and> y \<in> closed_segment u v \<and> g x = g y
                 \<longrightarrow> x = y \<or> x = u \<and> y = v \<or> x = v \<and> y = u)"
     (is "?lhs = ?rhs")
 proof 
   assume ?lhs
   then have p: "path (\<lambda>x. g ((v - u) * x + u))"
         and sim: "(\<And>x y. \<lbrakk>x\<in>{0..1}; y\<in>{0..1}; g ((v - u) * x + u) = g ((v - u) * y + u)\<rbrakk>
                   \<Longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0)"
     by (auto simp: simple_path_def loop_free_def subpath_def)
   { fix x y
     assume "x \<in> closed_segment u v" "y \<in> closed_segment u v" "g x = g y"
     then have "x = y \<or> x = u \<and> y = v \<or> x = v \<and> y = u"
       using sim [of "(x-u)/(v-u)" "(y-u)/(v-u)"] p
       by (auto split: if_split_asm simp add: closed_segment_real_eq image_affinity_atLeastAtMost)
         (simp_all add: field_split_simps)
   } moreover
   have "path(subpath u v g) \<and> u\<noteq>v"
     using sim [of "1/3" "2/3"] p
     by (auto simp: subpath_def)
   ultimately show ?rhs
     by metis
 next
   assume ?rhs
   then
   have d1: "\<And>x y. \<lbrakk>g x = g y; u \<le> x; x \<le> v; u \<le> y; y \<le> v\<rbrakk> \<Longrightarrow> x = y \<or> x = u \<and> y = v \<or> x = v \<and> y = u"
    and d2: "\<And>x y. \<lbrakk>g x = g y; v \<le> x; x \<le> u; v \<le> y; y \<le> u\<rbrakk> \<Longrightarrow> x = y \<or> x = u \<and> y = v \<or> x = v \<and> y = u"
    and ne: "u < v \<or> v < u"
    and psp: "path (subpath u v g)"
     by (auto simp: closed_segment_real_eq image_affinity_atLeastAtMost)
   have [simp]: "\<And>x. u + x * v = v + x * u \<longleftrightarrow> u=v \<or> x=1"
     by algebra
   show ?lhs using psp ne
     unfolding simple_path_def loop_free_def subpath_def
     by (fastforce simp add: algebra_simps affine_ineq mult_left_mono crossproduct_eq dest: d1 d2)
 qed
 
 lemma arc_subpath_eq:
   "arc(subpath u v g) \<longleftrightarrow> path(subpath u v g) \<and> u\<noteq>v \<and> inj_on g (closed_segment u v)"
   by (smt (verit, best) arc_simple_path closed_segment_commute ends_in_segment(2) inj_on_def pathfinish_subpath pathstart_subpath simple_path_subpath_eq)
 
 
 lemma simple_path_subpath:
   assumes "simple_path g" "u \<in> {0..1}" "v \<in> {0..1}" "u \<noteq> v"
   shows "simple_path(subpath u v g)"
   using assms
   unfolding simple_path_subpath_eq
   by (force simp:  simple_path_def loop_free_def closed_segment_real_eq image_affinity_atLeastAtMost)
 
 lemma arc_simple_path_subpath:
     "\<lbrakk>simple_path g; u \<in> {0..1}; v \<in> {0..1}; g u \<noteq> g v\<rbrakk> \<Longrightarrow> arc(subpath u v g)"
   by (force intro: simple_path_subpath simple_path_imp_arc)
 
 lemma arc_subpath_arc:
     "\<lbrakk>arc g; u \<in> {0..1}; v \<in> {0..1}; u \<noteq> v\<rbrakk> \<Longrightarrow> arc(subpath u v g)"
   by (meson arc_def arc_imp_simple_path arc_simple_path_subpath inj_onD)
 
 lemma arc_simple_path_subpath_interior:
     "\<lbrakk>simple_path g; u \<in> {0..1}; v \<in> {0..1}; u \<noteq> v; \<bar>u-v\<bar> < 1\<rbrakk> \<Longrightarrow> arc(subpath u v g)"
   by (force simp: simple_path_def loop_free_def intro: arc_simple_path_subpath)
 
 lemma path_image_subpath_subset:
     "\<lbrakk>u \<in> {0..1}; v \<in> {0..1}\<rbrakk> \<Longrightarrow> path_image(subpath u v g) \<subseteq> path_image g"
   by (metis atLeastAtMost_iff atLeastatMost_subset_iff path_image_def path_image_subpath subset_image_iff)
 
 lemma join_subpaths_middle: "subpath (0) ((1 / 2)) p +++ subpath ((1 / 2)) 1 p = p"
   by (rule ext) (simp add: joinpaths_def subpath_def field_split_simps)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>There is a subpath to the frontier\<close>
 
 lemma subpath_to_frontier_explicit:
     fixes S :: "'a::metric_space set"
     assumes g: "path g" and "pathfinish g \<notin> S"
     obtains u where "0 \<le> u" "u \<le> 1"
                 "\<And>x. 0 \<le> x \<and> x < u \<Longrightarrow> g x \<in> interior S"
                 "(g u \<notin> interior S)" "(u = 0 \<or> g u \<in> closure S)"
 proof -
   have gcon: "continuous_on {0..1} g"     
     using g by (simp add: path_def)
   moreover have "bounded ({u. g u \<in> closure (- S)} \<inter> {0..1})"
     using compact_eq_bounded_closed by fastforce
   ultimately have com: "compact ({0..1} \<inter> {u. g u \<in> closure (- S)})"
     using closed_vimage_Int
     by (metis (full_types) Int_commute closed_atLeastAtMost closed_closure compact_eq_bounded_closed vimage_def)
   have "1 \<in> {u. g u \<in> closure (- S)}"
     using assms by (simp add: pathfinish_def closure_def)
   then have dis: "{0..1} \<inter> {u. g u \<in> closure (- S)} \<noteq> {}"
     using atLeastAtMost_iff zero_le_one by blast
   then obtain u where "0 \<le> u" "u \<le> 1" and gu: "g u \<in> closure (- S)"
                   and umin: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1; g t \<in> closure (- S)\<rbrakk> \<Longrightarrow> u \<le> t"
     using compact_attains_inf [OF com dis] by fastforce
   then have umin': "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1; t < u\<rbrakk> \<Longrightarrow>  g t \<in> S"
     using closure_def by fastforce
   have \<section>: "g u \<in> closure S" if "u \<noteq> 0"
   proof -
     have "u > 0" using that \<open>0 \<le> u\<close> by auto
     { fix e::real assume "e > 0"
       obtain d where "d>0" and d: "\<And>x'. \<lbrakk>x' \<in> {0..1}; dist x' u \<le> d\<rbrakk> \<Longrightarrow> dist (g x') (g u) < e"
         using continuous_onE [OF gcon _ \<open>e > 0\<close>] \<open>0 \<le> _\<close> \<open>_ \<le> 1\<close> atLeastAtMost_iff by auto
       have *: "dist (max 0 (u - d / 2)) u \<le> d"
         using \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> \<open>d > 0\<close> by (simp add: dist_real_def)
       have "\<exists>y\<in>S. dist y (g u) < e"
         using \<open>0 < u\<close> \<open>u \<le> 1\<close> \<open>d > 0\<close>
         by (force intro: d [OF _ *] umin')
     }
     then show ?thesis
       by (simp add: frontier_def closure_approachable)
   qed
   show ?thesis
   proof
     show "\<And>x. 0 \<le> x \<and> x < u \<Longrightarrow> g x \<in> interior S"
       using \<open>u \<le> 1\<close> interior_closure umin by fastforce
     show "g u \<notin> interior S"
       by (simp add: gu interior_closure)
   qed (use \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> \<section> in auto)
 qed
 
 lemma subpath_to_frontier_strong:
     assumes g: "path g" and "pathfinish g \<notin> S"
     obtains u where "0 \<le> u" "u \<le> 1" "g u \<notin> interior S"
                     "u = 0 \<or> (\<forall>x. 0 \<le> x \<and> x < 1 \<longrightarrow> subpath 0 u g x \<in> interior S)  \<and>  g u \<in> closure S"
 proof -
   obtain u where "0 \<le> u" "u \<le> 1"
              and gxin: "\<And>x. 0 \<le> x \<and> x < u \<Longrightarrow> g x \<in> interior S"
              and gunot: "(g u \<notin> interior S)" and u0: "(u = 0 \<or> g u \<in> closure S)"
     using subpath_to_frontier_explicit [OF assms] by blast
   show ?thesis
   proof
     show "g u \<notin> interior S"
       using gunot by blast
   qed (use \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> u0 in \<open>(force simp: subpath_def gxin)+\<close>)
 qed
 
 lemma subpath_to_frontier:
     assumes g: "path g" and g0: "pathstart g \<in> closure S" and g1: "pathfinish g \<notin> S"
     obtains u where "0 \<le> u" "u \<le> 1" "g u \<in> frontier S" "path_image(subpath 0 u g) - {g u} \<subseteq> interior S"
 proof -
   obtain u where "0 \<le> u" "u \<le> 1"
              and notin: "g u \<notin> interior S"
              and disj: "u = 0 \<or>
                         (\<forall>x. 0 \<le> x \<and> x < 1 \<longrightarrow> subpath 0 u g x \<in> interior S) \<and> g u \<in> closure S"
                        (is "_ \<or> ?P")
     using subpath_to_frontier_strong [OF g g1] by blast
   show ?thesis
   proof
     show "g u \<in> frontier S"
       by (metis DiffI disj frontier_def g0 notin pathstart_def)
     show "path_image (subpath 0 u g) - {g u} \<subseteq> interior S"
       using disj
     proof
       assume "u = 0"
       then show ?thesis
         by (simp add: path_image_subpath)
     next
       assume P: ?P
       show ?thesis
       proof (clarsimp simp add: path_image_subpath_gen)
         fix y
         assume y: "y \<in> closed_segment 0 u" "g y \<notin> interior S"
         with \<open>0 \<le> u\<close> have "0 \<le> y" "y \<le> u" 
           by (auto simp: closed_segment_eq_real_ivl split: if_split_asm)
         then have "y=u \<or> subpath 0 u g (y/u) \<in> interior S"
           using P less_eq_real_def by force
         then show "g y = g u"
           using y by (auto simp: subpath_def split: if_split_asm)
       qed
     qed
   qed (use \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> in auto)
 qed
 
 lemma exists_path_subpath_to_frontier:
     fixes S :: "'a::real_normed_vector set"
     assumes "path g" "pathstart g \<in> closure S" "pathfinish g \<notin> S"
     obtains h where "path h" "pathstart h = pathstart g" "path_image h \<subseteq> path_image g"
                     "path_image h - {pathfinish h} \<subseteq> interior S"
                     "pathfinish h \<in> frontier S"
 proof -
   obtain u where u: "0 \<le> u" "u \<le> 1" "g u \<in> frontier S" "(path_image(subpath 0 u g) - {g u}) \<subseteq> interior S"
     using subpath_to_frontier [OF assms] by blast
   show ?thesis
   proof
     show "path_image (subpath 0 u g) \<subseteq> path_image g"
       by (simp add: path_image_subpath_subset u)
     show "pathstart (subpath 0 u g) = pathstart g"
       by (metis pathstart_def pathstart_subpath)
   qed (use assms u in \<open>auto simp: path_image_subpath\<close>)
 qed
 
 lemma exists_path_subpath_to_frontier_closed:
     fixes S :: "'a::real_normed_vector set"
     assumes S: "closed S" and g: "path g" and g0: "pathstart g \<in> S" and g1: "pathfinish g \<notin> S"
     obtains h where "path h" "pathstart h = pathstart g" "path_image h \<subseteq> path_image g \<inter> S"
                     "pathfinish h \<in> frontier S"
   by (smt (verit, del_insts) Diff_iff Int_iff S closure_closed exists_path_subpath_to_frontier 
       frontier_def g g0 g1 interior_subset singletonD subset_eq)
 
 
 subsection \<open>Shift Path to Start at Some Given Point\<close>
 
 definition\<^marker>\<open>tag important\<close> shiftpath :: "real \<Rightarrow> (real \<Rightarrow> 'a::topological_space) \<Rightarrow> real \<Rightarrow> 'a"
   where "shiftpath a f = (\<lambda>x. if (a + x) \<le> 1 then f (a + x) else f (a + x - 1))"
 
 lemma shiftpath_alt_def: "shiftpath a f = (\<lambda>x. if x \<le> 1-a then f (a + x) else f (a + x - 1))"
   by (auto simp: shiftpath_def)
 
 lemma pathstart_shiftpath: "a \<le> 1 \<Longrightarrow> pathstart (shiftpath a g) = g a"
   unfolding pathstart_def shiftpath_def by auto
 
 lemma pathfinish_shiftpath:
   assumes "0 \<le> a"
     and "pathfinish g = pathstart g"
   shows "pathfinish (shiftpath a g) = g a"
   using assms
   unfolding pathstart_def pathfinish_def shiftpath_def
   by auto
 
 lemma endpoints_shiftpath:
   assumes "pathfinish g = pathstart g"
     and "a \<in> {0 .. 1}"
   shows "pathfinish (shiftpath a g) = g a"
     and "pathstart (shiftpath a g) = g a"
   using assms
   by (simp_all add: pathstart_shiftpath pathfinish_shiftpath)
 
 lemma closed_shiftpath:
   assumes "pathfinish g = pathstart g"
     and "a \<in> {0..1}"
   shows "pathfinish (shiftpath a g) = pathstart (shiftpath a g)"
   using endpoints_shiftpath[OF assms]
   by auto
 
 lemma path_shiftpath:
   assumes "path g"
     and "pathfinish g = pathstart g"
     and "a \<in> {0..1}"
   shows "path (shiftpath a g)"
 proof -
   have *: "{0 .. 1} = {0 .. 1-a} \<union> {1-a .. 1}"
     using assms(3) by auto
   have **: "\<And>x. x + a = 1 \<Longrightarrow> g (x + a - 1) = g (x + a)"
     by (smt (verit, best) assms(2) pathfinish_def pathstart_def)
   show ?thesis
     unfolding path_def shiftpath_def *
   proof (rule continuous_on_closed_Un)
     have contg: "continuous_on {0..1} g"
       using \<open>path g\<close> path_def by blast
     show "continuous_on {0..1-a} (\<lambda>x. if a + x \<le> 1 then g (a + x) else g (a + x - 1))"
     proof (rule continuous_on_eq)
       show "continuous_on {0..1-a} (g \<circ> (+) a)"
         by (intro continuous_intros continuous_on_subset [OF contg]) (use \<open>a \<in> {0..1}\<close> in auto)
     qed auto
     show "continuous_on {1-a..1} (\<lambda>x. if a + x \<le> 1 then g (a + x) else g (a + x - 1))"
     proof (rule continuous_on_eq)
       show "continuous_on {1-a..1} (g \<circ> (+) (a - 1))"
         by (intro continuous_intros continuous_on_subset [OF contg]) (use \<open>a \<in> {0..1}\<close> in auto)
     qed (auto simp: "**" add.commute add_diff_eq)
   qed auto
 qed
 
 lemma shiftpath_shiftpath:
   assumes "pathfinish g = pathstart g"
     and "a \<in> {0..1}"
     and "x \<in> {0..1}"
   shows "shiftpath (1 - a) (shiftpath a g) x = g x"
   using assms
   unfolding pathfinish_def pathstart_def shiftpath_def
   by auto
 
 lemma path_image_shiftpath:
   assumes a: "a \<in> {0..1}"
     and "pathfinish g = pathstart g"
   shows "path_image (shiftpath a g) = path_image g"
 proof -
   { fix x
     assume g: "g 1 = g 0" "x \<in> {0..1::real}" and gne: "\<And>y. y\<in>{0..1} \<inter> {x. \<not> a + x \<le> 1} \<Longrightarrow> g x \<noteq> g (a + y - 1)"
     then have "\<exists>y\<in>{0..1} \<inter> {x. a + x \<le> 1}. g x = g (a + y)"
     proof (cases "a \<le> x")
       case False
       then show ?thesis
         apply (rule_tac x="1 + x - a" in bexI)
         using g gne[of "1 + x - a"] a by (force simp: field_simps)+
     next
       case True
       then show ?thesis
         using g a  by (rule_tac x="x - a" in bexI) (auto simp: field_simps)
     qed
   }
   then show ?thesis
     using assms
     unfolding shiftpath_def path_image_def pathfinish_def pathstart_def
     by (auto simp: image_iff)
 qed
 
 lemma loop_free_shiftpath:
   assumes "loop_free g" "pathfinish g = pathstart g" and a: "0 \<le> a" "a \<le> 1"
     shows "loop_free (shiftpath a g)"
   unfolding loop_free_def
 proof (intro conjI impI ballI)
   show "x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
     if "x \<in> {0..1}" "y \<in> {0..1}" "shiftpath a g x = shiftpath a g y" for x y
     using that a assms unfolding shiftpath_def loop_free_def
     by (smt (verit, ccfv_threshold) atLeastAtMost_iff)
 qed
 
 lemma simple_path_shiftpath:
   assumes "simple_path g" "pathfinish g = pathstart g" and a: "0 \<le> a" "a \<le> 1"
   shows "simple_path (shiftpath a g)"
   using assms loop_free_shiftpath path_shiftpath simple_path_def by fastforce
 
 
 subsection \<open>Straight-Line Paths\<close>
 
 definition\<^marker>\<open>tag important\<close> linepath :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> real \<Rightarrow> 'a"
   where "linepath a b = (\<lambda>x. (1 - x) *\<^sub>R a + x *\<^sub>R b)"
 
 lemma pathstart_linepath[simp]: "pathstart (linepath a b) = a"
   unfolding pathstart_def linepath_def
   by auto
 
 lemma pathfinish_linepath[simp]: "pathfinish (linepath a b) = b"
   unfolding pathfinish_def linepath_def
   by auto
 
 lemma linepath_inner: "linepath a b x \<bullet> v = linepath (a \<bullet> v) (b \<bullet> v) x"
   by (simp add: linepath_def algebra_simps)
 
 lemma Re_linepath': "Re (linepath a b x) = linepath (Re a) (Re b) x"
   by (simp add: linepath_def)
 
 lemma Im_linepath': "Im (linepath a b x) = linepath (Im a) (Im b) x"
   by (simp add: linepath_def)
 
 lemma linepath_0': "linepath a b 0 = a"
   by (simp add: linepath_def)
 
 lemma linepath_1': "linepath a b 1 = b"
   by (simp add: linepath_def)
 
 lemma continuous_linepath_at[intro]: "continuous (at x) (linepath a b)"
   unfolding linepath_def
   by (intro continuous_intros)
 
 lemma continuous_on_linepath [intro,continuous_intros]: "continuous_on s (linepath a b)"
   using continuous_linepath_at
   by (auto intro!: continuous_at_imp_continuous_on)
 
 lemma path_linepath[iff]: "path (linepath a b)"
   unfolding path_def
   by (rule continuous_on_linepath)
 
 lemma path_image_linepath[simp]: "path_image (linepath a b) = closed_segment a b"
   unfolding path_image_def segment linepath_def
   by auto
 
 lemma reversepath_linepath[simp]: "reversepath (linepath a b) = linepath b a"
   unfolding reversepath_def linepath_def
   by auto
 
 lemma linepath_0 [simp]: "linepath 0 b x = x *\<^sub>R b"
   by (simp add: linepath_def)
 
 lemma linepath_cnj: "cnj (linepath a b x) = linepath (cnj a) (cnj b) x"
   by (simp add: linepath_def)
 
 lemma arc_linepath:
   assumes "a \<noteq> b" shows [simp]: "arc (linepath a b)"
 proof -
   {
     fix x y :: "real"
     assume "x *\<^sub>R b + y *\<^sub>R a = x *\<^sub>R a + y *\<^sub>R b"
     then have "(x - y) *\<^sub>R a = (x - y) *\<^sub>R b"
       by (simp add: algebra_simps)
     with assms have "x = y"
       by simp
   }
   then show ?thesis
     unfolding arc_def inj_on_def
     by (fastforce simp: algebra_simps linepath_def)
 qed
 
 lemma simple_path_linepath[intro]: "a \<noteq> b \<Longrightarrow> simple_path (linepath a b)"
   by (simp add: arc_imp_simple_path)
 
 lemma linepath_trivial [simp]: "linepath a a x = a"
   by (simp add: linepath_def real_vector.scale_left_diff_distrib)
 
 lemma linepath_refl: "linepath a a = (\<lambda>x. a)"
   by auto
 
 lemma subpath_refl: "subpath a a g = linepath (g a) (g a)"
   by (simp add: subpath_def linepath_def algebra_simps)
 
 lemma linepath_of_real: "(linepath (of_real a) (of_real b) x) = of_real ((1 - x)*a + x*b)"
   by (simp add: scaleR_conv_of_real linepath_def)
 
 lemma of_real_linepath: "of_real (linepath a b x) = linepath (of_real a) (of_real b) x"
   by (metis linepath_of_real mult.right_neutral of_real_def real_scaleR_def)
 
 lemma inj_on_linepath:
   assumes "a \<noteq> b" shows "inj_on (linepath a b) {0..1}"
   using arc_imp_inj_on arc_linepath assms by blast
 
 lemma linepath_le_1:
   fixes a::"'a::linordered_idom" shows "\<lbrakk>a \<le> 1; b \<le> 1; 0 \<le> u; u \<le> 1\<rbrakk> \<Longrightarrow> (1 - u) * a + u * b \<le> 1"
   using mult_left_le [of a "1-u"] mult_left_le [of b u] by auto
 
 lemma linepath_in_path:
   shows "x \<in> {0..1} \<Longrightarrow> linepath a b x \<in> closed_segment a b"
   by (auto simp: segment linepath_def)
 
 lemma linepath_image_01: "linepath a b ` {0..1} = closed_segment a b"
   by (auto simp: segment linepath_def)
 
 lemma linepath_in_convex_hull:
   fixes x::real
   assumes "a \<in> convex hull S"
     and "b \<in> convex hull S"
     and "0\<le>x" "x\<le>1"
   shows "linepath a b x \<in> convex hull S"
   by (meson assms atLeastAtMost_iff convex_contains_segment convex_convex_hull linepath_in_path subset_eq)
 
 lemma Re_linepath: "Re(linepath (of_real a) (of_real b) x) = (1 - x)*a + x*b"
   by (simp add: linepath_def)
 
 lemma Im_linepath: "Im(linepath (of_real a) (of_real b) x) = 0"
   by (simp add: linepath_def)
 
 lemma bounded_linear_linepath:
   assumes "bounded_linear f"
   shows   "f (linepath a b x) = linepath (f a) (f b) x"
 proof -
   interpret f: bounded_linear f by fact
   show ?thesis by (simp add: linepath_def f.add f.scale)
 qed
 
 lemma bounded_linear_linepath':
   assumes "bounded_linear f"
   shows   "f \<circ> linepath a b = linepath (f a) (f b)"
   using bounded_linear_linepath[OF assms] by (simp add: fun_eq_iff)
 
 lemma linepath_cnj': "cnj \<circ> linepath a b = linepath (cnj a) (cnj b)"
   by (simp add: linepath_def fun_eq_iff)
 
 lemma differentiable_linepath [intro]: "linepath a b differentiable at x within A"
   by (auto simp: linepath_def)
 
 lemma has_vector_derivative_linepath_within:
     "(linepath a b has_vector_derivative (b - a)) (at x within S)"
   by (force intro: derivative_eq_intros simp add: linepath_def has_vector_derivative_def algebra_simps)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Segments via convex hulls\<close>
 
 lemma segments_subset_convex_hull:
     "closed_segment a b \<subseteq> (convex hull {a,b,c})"
     "closed_segment a c \<subseteq> (convex hull {a,b,c})"
     "closed_segment b c \<subseteq> (convex hull {a,b,c})"
     "closed_segment b a \<subseteq> (convex hull {a,b,c})"
     "closed_segment c a \<subseteq> (convex hull {a,b,c})"
     "closed_segment c b \<subseteq> (convex hull {a,b,c})"
 by (auto simp: segment_convex_hull linepath_of_real  elim!: rev_subsetD [OF _ hull_mono])
 
 lemma midpoints_in_convex_hull:
   assumes "x \<in> convex hull s" "y \<in> convex hull s"
     shows "midpoint x y \<in> convex hull s"
   using assms closed_segment_subset_convex_hull csegment_midpoint_subset by blast
 
 lemma not_in_interior_convex_hull_3:
   fixes a :: "complex"
   shows "a \<notin> interior(convex hull {a,b,c})"
         "b \<notin> interior(convex hull {a,b,c})"
         "c \<notin> interior(convex hull {a,b,c})"
   by (auto simp: card_insert_le_m1 not_in_interior_convex_hull)
 
 lemma midpoint_in_closed_segment [simp]: "midpoint a b \<in> closed_segment a b"
   using midpoints_in_convex_hull segment_convex_hull by blast
 
 lemma midpoint_in_open_segment [simp]: "midpoint a b \<in> open_segment a b \<longleftrightarrow> a \<noteq> b"
   by (simp add: open_segment_def)
 
 lemma continuous_IVT_local_extremum:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes contf: "continuous_on (closed_segment a b) f"
       and ab: "a \<noteq> b" "f a = f b"
   obtains z where "z \<in> open_segment a b"
                   "(\<forall>w \<in> closed_segment a b. (f w) \<le> (f z)) \<or>
                    (\<forall>w \<in> closed_segment a b. (f z) \<le> (f w))"
 proof -
   obtain c where "c \<in> closed_segment a b" and c: "\<And>y. y \<in> closed_segment a b \<Longrightarrow> f y \<le> f c"
     using continuous_attains_sup [of "closed_segment a b" f] contf by auto
   moreover
   obtain d where "d \<in> closed_segment a b" and d: "\<And>y. y \<in> closed_segment a b \<Longrightarrow> f d \<le> f y"
     using continuous_attains_inf [of "closed_segment a b" f] contf by auto
   ultimately show ?thesis
     by (smt (verit) UnE ab closed_segment_eq_open empty_iff insert_iff midpoint_in_open_segment that)
 qed
 
 text\<open>An injective map into R is also an open map w.r.T. the universe, and conversely. \<close>
 proposition injective_eq_1d_open_map_UNIV:
   fixes f :: "real \<Rightarrow> real"
   assumes contf: "continuous_on S f" and S: "is_interval S"
     shows "inj_on f S \<longleftrightarrow> (\<forall>T. open T \<and> T \<subseteq> S \<longrightarrow> open(f ` T))"
           (is "?lhs = ?rhs")
 proof safe
   fix T
   assume injf: ?lhs and "open T" and "T \<subseteq> S"
   have "\<exists>U. open U \<and> f x \<in> U \<and> U \<subseteq> f ` T" if "x \<in> T" for x
   proof -
     obtain \<delta> where "\<delta> > 0" and \<delta>: "cball x \<delta> \<subseteq> T"
       using \<open>open T\<close> \<open>x \<in> T\<close> open_contains_cball_eq by blast
     show ?thesis
     proof (intro exI conjI)
       have "closed_segment (x-\<delta>) (x+\<delta>) = {x-\<delta>..x+\<delta>}"
         using \<open>0 < \<delta>\<close> by (auto simp: closed_segment_eq_real_ivl)
       also have "\<dots> \<subseteq> S"
         using \<delta> \<open>T \<subseteq> S\<close> by (auto simp: dist_norm subset_eq)
       finally have "f ` (open_segment (x-\<delta>) (x+\<delta>)) = open_segment (f (x-\<delta>)) (f (x+\<delta>))"
         using continuous_injective_image_open_segment_1
         by (metis continuous_on_subset [OF contf] inj_on_subset [OF injf])
       then show "open (f ` {x-\<delta><..<x+\<delta>})"
         using \<open>0 < \<delta>\<close> by (simp add: open_segment_eq_real_ivl)
       show "f x \<in> f ` {x - \<delta><..<x + \<delta>}"
         by (auto simp: \<open>\<delta> > 0\<close>)
       show "f ` {x - \<delta><..<x + \<delta>} \<subseteq> f ` T"
         using \<delta> by (auto simp: dist_norm subset_iff)
     qed
   qed
   with open_subopen show "open (f ` T)"
     by blast
 next
   assume R: ?rhs
   have False if xy: "x \<in> S" "y \<in> S" and "f x = f y" "x \<noteq> y" for x y
   proof -
     have "open (f ` open_segment x y)"
       using R
       by (metis S convex_contains_open_segment is_interval_convex open_greaterThanLessThan open_segment_eq_real_ivl xy)
     moreover
     have "continuous_on (closed_segment x y) f"
       by (meson S closed_segment_subset contf continuous_on_subset is_interval_convex that)
     then obtain \<xi> where "\<xi> \<in> open_segment x y"
                     and \<xi>: "(\<forall>w \<in> closed_segment x y. (f w) \<le> (f \<xi>)) \<or>
                             (\<forall>w \<in> closed_segment x y. (f \<xi>) \<le> (f w))"
       using continuous_IVT_local_extremum [of x y f] \<open>f x = f y\<close> \<open>x \<noteq> y\<close> by blast
     ultimately obtain e where "e>0" and e: "\<And>u. dist u (f \<xi>) < e \<Longrightarrow> u \<in> f ` open_segment x y"
       using open_dist by (metis image_eqI)
     have fin: "f \<xi> + (e/2) \<in> f ` open_segment x y" "f \<xi> - (e/2) \<in> f ` open_segment x y"
       using e [of "f \<xi> + (e/2)"] e [of "f \<xi> - (e/2)"] \<open>e > 0\<close> by (auto simp: dist_norm)
     show ?thesis
       using \<xi> \<open>0 < e\<close> fin open_closed_segment by fastforce
   qed
   then show ?lhs
     by (force simp: inj_on_def)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Bounding a point away from a path\<close>
 
 lemma not_on_path_ball:
   fixes g :: "real \<Rightarrow> 'a::heine_borel"
   assumes "path g"
     and z: "z \<notin> path_image g"
   shows "\<exists>e > 0. ball z e \<inter> path_image g = {}"
 proof -
   have "closed (path_image g)"
     by (simp add: \<open>path g\<close> closed_path_image)
   then obtain a where "a \<in> path_image g" "\<forall>y \<in> path_image g. dist z a \<le> dist z y"
     by (auto intro: distance_attains_inf[OF _ path_image_nonempty, of g z])
   then show ?thesis
     by (rule_tac x="dist z a" in exI) (use dist_commute z in auto)
 qed
 
 lemma not_on_path_cball:
   fixes g :: "real \<Rightarrow> 'a::heine_borel"
   assumes "path g"
     and "z \<notin> path_image g"
   shows "\<exists>e>0. cball z e \<inter> (path_image g) = {}"
   by (smt (verit, ccfv_threshold) open_ball assms centre_in_ball inf.orderE inf_assoc
       inf_bot_right not_on_path_ball open_contains_cball_eq)
 
 subsection \<open>Path component\<close>
 
 text \<open>Original formalization by Tom Hales\<close>
 
 definition\<^marker>\<open>tag important\<close> "path_component S x y \<equiv>
   (\<exists>g. path g \<and> path_image g \<subseteq> S \<and> pathstart g = x \<and> pathfinish g = y)"
 
 abbreviation\<^marker>\<open>tag important\<close>
   "path_component_set S x \<equiv> Collect (path_component S x)"
 
 lemmas path_defs = path_def pathstart_def pathfinish_def path_image_def path_component_def
 
 lemma path_component_mem:
   assumes "path_component S x y"
   shows "x \<in> S" and "y \<in> S"
   using assms
   unfolding path_defs
   by auto
 
 lemma path_component_refl:
   assumes "x \<in> S"
   shows "path_component S x x"
   using assms
   unfolding path_defs
   by (metis (full_types) assms continuous_on_const image_subset_iff path_image_def)
 
 lemma path_component_refl_eq: "path_component S x x \<longleftrightarrow> x \<in> S"
   by (auto intro!: path_component_mem path_component_refl)
 
 lemma path_component_sym: "path_component S x y \<Longrightarrow> path_component S y x"
   unfolding path_component_def
   by (metis (no_types) path_image_reversepath path_reversepath pathfinish_reversepath pathstart_reversepath)
 
 lemma path_component_trans:
   assumes "path_component S x y" and "path_component S y z"
   shows "path_component S x z"
   using assms
   unfolding path_component_def
   by (metis path_join pathfinish_join pathstart_join subset_path_image_join)
 
 lemma path_component_of_subset: "S \<subseteq> T \<Longrightarrow> path_component S x y \<Longrightarrow> path_component T x y"
   unfolding path_component_def by auto
 
 lemma path_component_linepath:
     fixes S :: "'a::real_normed_vector set"
     shows "closed_segment a b \<subseteq> S \<Longrightarrow> path_component S a b"
   unfolding path_component_def by fastforce
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Path components as sets\<close>
 
 lemma path_component_set:
   "path_component_set S x =
     {y. (\<exists>g. path g \<and> path_image g \<subseteq> S \<and> pathstart g = x \<and> pathfinish g = y)}"
   by (auto simp: path_component_def)
 
 lemma path_component_subset: "path_component_set S x \<subseteq> S"
   by (auto simp: path_component_mem(2))
 
 lemma path_component_eq_empty: "path_component_set S x = {} \<longleftrightarrow> x \<notin> S"
   using path_component_mem path_component_refl_eq
     by fastforce
 
 lemma path_component_mono:
      "S \<subseteq> T \<Longrightarrow> (path_component_set S x) \<subseteq> (path_component_set T x)"
   by (simp add: Collect_mono path_component_of_subset)
 
 lemma path_component_eq:
    "y \<in> path_component_set S x \<Longrightarrow> path_component_set S y = path_component_set S x"
 by (metis (no_types, lifting) Collect_cong mem_Collect_eq path_component_sym path_component_trans)
 
 
 subsection \<open>Path connectedness of a space\<close>
 
 definition\<^marker>\<open>tag important\<close> "path_connected S \<longleftrightarrow>
   (\<forall>x\<in>S. \<forall>y\<in>S. \<exists>g. path g \<and> path_image g \<subseteq> S \<and> pathstart g = x \<and> pathfinish g = y)"
 
 lemma path_connectedin_iff_path_connected_real [simp]:
      "path_connectedin euclideanreal S \<longleftrightarrow> path_connected S"
   by (simp add: path_connectedin path_connected_def path_defs image_subset_iff_funcset) 
 
 lemma path_connected_component: "path_connected S \<longleftrightarrow> (\<forall>x\<in>S. \<forall>y\<in>S. path_component S x y)"
   unfolding path_connected_def path_component_def by auto
 
 lemma path_connected_component_set: "path_connected S \<longleftrightarrow> (\<forall>x\<in>S. path_component_set S x = S)"
   unfolding path_connected_component path_component_subset
   using path_component_mem by blast
 
 lemma path_component_maximal:
      "\<lbrakk>x \<in> T; path_connected T; T \<subseteq> S\<rbrakk> \<Longrightarrow> T \<subseteq> (path_component_set S x)"
   by (metis path_component_mono path_connected_component_set)
 
 lemma convex_imp_path_connected:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S"
   shows "path_connected S"
   unfolding path_connected_def
   using assms convex_contains_segment by fastforce
 
 lemma path_connected_UNIV [iff]: "path_connected (UNIV :: 'a::real_normed_vector set)"
   by (simp add: convex_imp_path_connected)
 
 lemma path_component_UNIV: "path_component_set UNIV x = (UNIV :: 'a::real_normed_vector set)"
   using path_connected_component_set by auto
 
 lemma path_connected_imp_connected:
   assumes "path_connected S"
   shows "connected S"
 proof (rule connectedI)
   fix e1 e2
   assume as: "open e1" "open e2" "S \<subseteq> e1 \<union> e2" "e1 \<inter> e2 \<inter> S = {}" "e1 \<inter> S \<noteq> {}" "e2 \<inter> S \<noteq> {}"
   then obtain x1 x2 where obt:"x1 \<in> e1 \<inter> S" "x2 \<in> e2 \<inter> S"
     by auto
   then obtain g where g: "path g" "path_image g \<subseteq> S" and pg: "pathstart g = x1" "pathfinish g = x2"
     using assms[unfolded path_connected_def,rule_format,of x1 x2] by auto
   have *: "connected {0..1::real}"
     by (auto intro!: convex_connected)
   have "{0..1} \<subseteq> {x \<in> {0..1}. g x \<in> e1} \<union> {x \<in> {0..1}. g x \<in> e2}"
     using as(3) g(2)[unfolded path_defs] by blast
   moreover have "{x \<in> {0..1}. g x \<in> e1} \<inter> {x \<in> {0..1}. g x \<in> e2} = {}"
     using as(4) g(2)[unfolded path_defs]
     unfolding subset_eq
     by auto
   moreover have "{x \<in> {0..1}. g x \<in> e1} \<noteq> {} \<and> {x \<in> {0..1}. g x \<in> e2} \<noteq> {}"
     by (smt (verit, ccfv_threshold) IntE atLeastAtMost_iff empty_iff pg mem_Collect_eq obt pathfinish_def pathstart_def)
   ultimately show False
     using *[unfolded connected_local not_ex, rule_format,
       of "{0..1} \<inter> g -` e1" "{0..1} \<inter> g -` e2"]
     using continuous_openin_preimage_gen[OF g(1)[unfolded path_def] as(1)]
     using continuous_openin_preimage_gen[OF g(1)[unfolded path_def] as(2)]
     by auto
 qed
 
 lemma open_path_component:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open (path_component_set S x)"
   unfolding open_contains_ball
   by (metis assms centre_in_ball convex_ball convex_imp_path_connected equals0D openE 
       path_component_eq path_component_eq_empty path_component_maximal)
 
 lemma open_non_path_component:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open (S - path_component_set S x)"
   unfolding open_contains_ball
 proof
   fix y
   assume y: "y \<in> S - path_component_set S x"
   then obtain e where e: "e > 0" "ball y e \<subseteq> S"
     using assms openE by auto
   show "\<exists>e>0. ball y e \<subseteq> S - path_component_set S x"
   proof (intro exI conjI subsetI DiffI notI)
     show "\<And>x. x \<in> ball y e \<Longrightarrow> x \<in> S"
       using e by blast
     show False if "z \<in> ball y e" "z \<in> path_component_set S x" for z
       by (metis (no_types, lifting) Diff_iff centre_in_ball convex_ball convex_imp_path_connected  
           path_component_eq path_component_maximal subsetD that y e)
   qed (use e in auto)
 qed
 
 lemma connected_open_path_connected:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
     and "connected S"
   shows "path_connected S"
   unfolding path_connected_component_set
 proof (rule, rule, rule path_component_subset, rule)
   fix x y
   assume "x \<in> S" and "y \<in> S"
   show "y \<in> path_component_set S x"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     moreover have "path_component_set S x \<inter> S \<noteq> {}"
       using \<open>x \<in> S\<close> path_component_eq_empty path_component_subset[of S x]
       by auto
     ultimately
     show False
       using \<open>y \<in> S\<close> open_non_path_component[OF \<open>open S\<close>] open_path_component[OF \<open>open S\<close>]
       using \<open>connected S\<close>[unfolded connected_def not_ex, rule_format,
         of "path_component_set S x" "S - path_component_set S x"]
       by auto
   qed
 qed
 
 lemma path_connected_continuous_image:
   assumes contf: "continuous_on S f"
     and "path_connected S"
   shows "path_connected (f ` S)"
   unfolding path_connected_def
 proof clarsimp
   fix x y 
   assume x: "x \<in> S" and y: "y \<in> S" 
   with \<open>path_connected S\<close> 
   show "\<exists>g. path g \<and> path_image g \<subseteq> f ` S \<and> pathstart g = f x \<and> pathfinish g = f y"
     unfolding path_defs path_connected_def
     using continuous_on_subset[OF contf]
     by (smt (verit, ccfv_threshold) continuous_on_compose2 image_eqI image_subset_iff)
 qed
 
 lemma path_connected_translationI:
   fixes a :: "'a :: topological_group_add"
   assumes "path_connected S" shows "path_connected ((\<lambda>x. a + x) ` S)"
   by (intro path_connected_continuous_image assms continuous_intros)
 
 lemma path_connected_translation:
   fixes a :: "'a :: topological_group_add"
   shows "path_connected ((\<lambda>x. a + x) ` S) = path_connected S"
 proof -
   have "\<forall>x y. (+) (x::'a) ` (+) (0 - x) ` y = y"
     by (simp add: image_image)
   then show ?thesis
     by (metis (no_types) path_connected_translationI)
 qed
 
 lemma path_connected_segment [simp]:
     fixes a :: "'a::real_normed_vector"
     shows "path_connected (closed_segment a b)"
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_open_segment [simp]:
     fixes a :: "'a::real_normed_vector"
     shows "path_connected (open_segment a b)"
   by (simp add: convex_imp_path_connected)
 
 lemma homeomorphic_path_connectedness:
   "S homeomorphic T \<Longrightarrow> path_connected S \<longleftrightarrow> path_connected T"
   unfolding homeomorphic_def homeomorphism_def by (metis path_connected_continuous_image)
 
 lemma path_connected_empty [simp]: "path_connected {}"
   unfolding path_connected_def by auto
 
 lemma path_connected_singleton [simp]: "path_connected {a}"
   unfolding path_connected_def pathstart_def pathfinish_def path_image_def
   using path_def by fastforce
 
 lemma path_connected_Un:
   assumes "path_connected S"
     and "path_connected T"
     and "S \<inter> T \<noteq> {}"
   shows "path_connected (S \<union> T)"
   unfolding path_connected_component
 proof (intro ballI)
   fix x y
   assume x: "x \<in> S \<union> T" and y: "y \<in> S \<union> T"
   from assms obtain z where z: "z \<in> S" "z \<in> T"
     by auto
   with x y show "path_component (S \<union> T) x y"
     by (smt (verit) assms(1,2) in_mono mem_Collect_eq path_component_eq path_component_maximal 
         sup.bounded_iff sup.cobounded2 sup_ge1)
 qed
 
 lemma path_connected_UNION:
   assumes "\<And>i. i \<in> A \<Longrightarrow> path_connected (S i)"
     and "\<And>i. i \<in> A \<Longrightarrow> z \<in> S i"
   shows "path_connected (\<Union>i\<in>A. S i)"
   unfolding path_connected_component
 proof clarify
   fix x i y j
   assume *: "i \<in> A" "x \<in> S i" "j \<in> A" "y \<in> S j"
   then have "path_component (S i) x z" and "path_component (S j) z y"
     using assms by (simp_all add: path_connected_component)
   then have "path_component (\<Union>i\<in>A. S i) x z" and "path_component (\<Union>i\<in>A. S i) z y"
     using *(1,3) by (meson SUP_upper path_component_of_subset)+
   then show "path_component (\<Union>i\<in>A. S i) x y"
     by (rule path_component_trans)
 qed
 
 lemma path_component_path_image_pathstart:
   assumes p: "path p" and x: "x \<in> path_image p"
   shows "path_component (path_image p) (pathstart p) x"
 proof -
   obtain y where x: "x = p y" and y: "0 \<le> y" "y \<le> 1"
     using x by (auto simp: path_image_def)
   show ?thesis
     unfolding path_component_def 
   proof (intro exI conjI)
     have "continuous_on ((*) y ` {0..1}) p"
       by (simp add: continuous_on_path image_mult_atLeastAtMost_if p y)
     then have "continuous_on {0..1} (p \<circ> ((*) y))"
       using continuous_on_compose continuous_on_mult_const by blast
     then show "path (\<lambda>u. p (y * u))"
       by (simp add: path_def)
     show "path_image (\<lambda>u. p (y * u)) \<subseteq> path_image p"
       using y mult_le_one by (fastforce simp: path_image_def image_iff)
   qed (auto simp: pathstart_def pathfinish_def x)
 qed
 
 lemma path_connected_path_image: "path p \<Longrightarrow> path_connected(path_image p)"
   unfolding path_connected_component
   by (meson path_component_path_image_pathstart path_component_sym path_component_trans)
 
 lemma path_connected_path_component [simp]:
   "path_connected (path_component_set S x)"
   by (smt (verit) mem_Collect_eq path_component_def path_component_eq path_component_maximal 
       path_connected_component path_connected_path_image pathstart_in_path_image)
 
 lemma path_component: 
   "path_component S x y \<longleftrightarrow> (\<exists>t. path_connected t \<and> t \<subseteq> S \<and> x \<in> t \<and> y \<in> t)"
     (is "?lhs = ?rhs")
 proof 
   assume ?lhs then show ?rhs
     by (metis path_component_def path_connected_path_image pathfinish_in_path_image pathstart_in_path_image)
 next
   assume ?rhs then show ?lhs
     by (meson path_component_of_subset path_connected_component)
 qed
 
 lemma path_component_path_component [simp]:
    "path_component_set (path_component_set S x) x = path_component_set S x"
   by (metis (full_types) mem_Collect_eq path_component_eq_empty path_component_refl path_connected_component_set path_connected_path_component)
 
 lemma path_component_subset_connected_component:
    "(path_component_set S x) \<subseteq> (connected_component_set S x)"
 proof (cases "x \<in> S")
   case True show ?thesis
     by (simp add: True connected_component_maximal path_component_refl path_component_subset path_connected_imp_connected)
 next
   case False then show ?thesis
     using path_component_eq_empty by auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Lemmas about path-connectedness\<close>
 
 lemma path_connected_linear_image:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "path_connected S" "bounded_linear f"
   shows "path_connected(f ` S)"
   by (auto simp: linear_continuous_on assms path_connected_continuous_image)
 
 lemma is_interval_path_connected: "is_interval S \<Longrightarrow> path_connected S"
   by (simp add: convex_imp_path_connected is_interval_convex)
 
 lemma path_connected_Ioi[simp]: "path_connected {a<..}" for a :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Ici[simp]: "path_connected {a..}" for a :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Iio[simp]: "path_connected {..<a}" for a :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Iic[simp]: "path_connected {..a}" for a :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Ioo[simp]: "path_connected {a<..<b}" for a b :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Ioc[simp]: "path_connected {a<..b}" for a b :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Ico[simp]: "path_connected {a..<b}" for a b :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connectedin_path_image:
   assumes "pathin X g" shows "path_connectedin X (g ` ({0..1}))"
   unfolding pathin_def
 proof (rule path_connectedin_continuous_map_image)
   show "continuous_map (subtopology euclideanreal {0..1}) X g"
     using assms pathin_def by blast
 qed (auto simp: is_interval_1 is_interval_path_connected)
 
 lemma path_connected_space_subconnected:
      "path_connected_space X \<longleftrightarrow>
       (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. \<exists>S. path_connectedin X S \<and> x \<in> S \<and> y \<in> S)"
   by (metis path_connectedin path_connectedin_topspace path_connected_space_def)
 
 
 lemma connectedin_path_image: "pathin X g \<Longrightarrow> connectedin X (g ` ({0..1}))"
   by (simp add: path_connectedin_imp_connectedin path_connectedin_path_image)
 
 lemma compactin_path_image: "pathin X g \<Longrightarrow> compactin X (g ` ({0..1}))"
   unfolding pathin_def
   by (rule image_compactin [of "top_of_set {0..1}"]) auto
 
 lemma linear_homeomorphism_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
   obtains g where "homeomorphism (f ` S) S g f"
 proof -
   obtain g where "linear g" "g \<circ> f = id"
     using assms linear_injective_left_inverse by blast
   then have "homeomorphism (f ` S) S g f"
     using assms unfolding homeomorphism_def
     by (auto simp: eq_id_iff [symmetric] image_comp linear_conv_bounded_linear linear_continuous_on)
   then show thesis ..
 qed
 
 lemma linear_homeomorphic_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
   shows "S homeomorphic f ` S"
   by (meson homeomorphic_def homeomorphic_sym linear_homeomorphism_image [OF assms])
 
 lemma path_connected_Times:
   assumes "path_connected s" "path_connected t"
     shows "path_connected (s \<times> t)"
 proof (simp add: path_connected_def Sigma_def, clarify)
   fix x1 y1 x2 y2
   assume "x1 \<in> s" "y1 \<in> t" "x2 \<in> s" "y2 \<in> t"
   obtain g where "path g" and g: "path_image g \<subseteq> s" and gs: "pathstart g = x1" and gf: "pathfinish g = x2"
     using \<open>x1 \<in> s\<close> \<open>x2 \<in> s\<close> assms by (force simp: path_connected_def)
   obtain h where "path h" and h: "path_image h \<subseteq> t" and hs: "pathstart h = y1" and hf: "pathfinish h = y2"
     using \<open>y1 \<in> t\<close> \<open>y2 \<in> t\<close> assms by (force simp: path_connected_def)
   have "path (\<lambda>z. (x1, h z))"
     using \<open>path h\<close>
     unfolding path_def
     by (intro continuous_intros continuous_on_compose2 [where g = "Pair _"]; force)
   moreover have "path (\<lambda>z. (g z, y2))"
     using \<open>path g\<close>
     unfolding path_def
     by (intro continuous_intros continuous_on_compose2 [where g = "Pair _"]; force)
   ultimately have 1: "path ((\<lambda>z. (x1, h z)) +++ (\<lambda>z. (g z, y2)))"
     by (metis hf gs path_join_imp pathstart_def pathfinish_def)
   have "path_image ((\<lambda>z. (x1, h z)) +++ (\<lambda>z. (g z, y2))) \<subseteq> path_image (\<lambda>z. (x1, h z)) \<union> path_image (\<lambda>z. (g z, y2))"
     by (rule Path_Connected.path_image_join_subset)
   also have "\<dots> \<subseteq> (\<Union>x\<in>s. \<Union>x1\<in>t. {(x, x1)})"
     using g h \<open>x1 \<in> s\<close> \<open>y2 \<in> t\<close> by (force simp: path_image_def)
   finally have 2: "path_image ((\<lambda>z. (x1, h z)) +++ (\<lambda>z. (g z, y2))) \<subseteq> (\<Union>x\<in>s. \<Union>x1\<in>t. {(x, x1)})" .
   show "\<exists>g. path g \<and> path_image g \<subseteq> (\<Union>x\<in>s. \<Union>x1\<in>t. {(x, x1)}) \<and>
             pathstart g = (x1, y1) \<and> pathfinish g = (x2, y2)"
     using 1 2 gf hs
     by (metis (no_types, lifting) pathfinish_def pathfinish_join pathstart_def pathstart_join)
 qed
 
 lemma is_interval_path_connected_1:
   fixes s :: "real set"
   shows "is_interval s \<longleftrightarrow> path_connected s"
   using is_interval_connected_1 is_interval_path_connected path_connected_imp_connected by blast
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Path components\<close>
 
 lemma Union_path_component [simp]:
    "Union {path_component_set S x |x. x \<in> S} = S"
   using path_component_subset path_component_refl by blast
 
 lemma path_component_disjoint:
    "disjnt (path_component_set S a) (path_component_set S b) \<longleftrightarrow>
     (a \<notin> path_component_set S b)"
   unfolding disjnt_iff
   using path_component_sym path_component_trans by blast
 
 lemma path_component_eq_eq:
    "path_component S x = path_component S y \<longleftrightarrow>
         (x \<notin> S) \<and> (y \<notin> S) \<or> x \<in> S \<and> y \<in> S \<and> path_component S x y"
     (is "?lhs = ?rhs")
 proof 
   assume ?lhs then show ?rhs
     by (metis (no_types) path_component_mem(1) path_component_refl)
 next
   assume ?rhs then show ?lhs
   proof
     assume "x \<notin> S \<and> y \<notin> S" then show ?lhs
       by (metis Collect_empty_eq_bot path_component_eq_empty)
   next
     assume S: "x \<in> S \<and> y \<in> S \<and> path_component S x y" show ?lhs
       by (rule ext) (metis S path_component_trans path_component_sym)
   qed
 qed
 
 lemma path_component_unique:
   assumes "x \<in> C" "C \<subseteq> S" "path_connected C"
           "\<And>C'. \<lbrakk>x \<in> C'; C' \<subseteq> S; path_connected C'\<rbrakk> \<Longrightarrow> C' \<subseteq> C"
         shows "path_component_set S x = C"
   by (smt (verit, best) Collect_cong assms path_component path_component_of_subset path_connected_component_set)
 
 lemma path_component_intermediate_subset:
   "path_component_set U a \<subseteq> T \<and> T \<subseteq> U
         \<Longrightarrow> path_component_set T a = path_component_set U a"
   by (metis (no_types) path_component_mono path_component_path_component subset_antisym)
 
 lemma complement_path_component_Union:
   fixes x :: "'a :: topological_space"
   shows "S - path_component_set S x =
          \<Union>({path_component_set S y| y. y \<in> S} - {path_component_set S x})"
 proof -
   have *: "(\<And>x. x \<in> S - {a} \<Longrightarrow> disjnt a x) \<Longrightarrow> \<Union>S - a = \<Union>(S - {a})"
     for a::"'a set" and S
     by (auto simp: disjnt_def)
   have "\<And>y. y \<in> {path_component_set S x |x. x \<in> S} - {path_component_set S x}
             \<Longrightarrow> disjnt (path_component_set S x) y"
     using path_component_disjoint path_component_eq by fastforce
   then have "\<Union>{path_component_set S x |x. x \<in> S} - path_component_set S x =
              \<Union>({path_component_set S y |y. y \<in> S} - {path_component_set S x})"
     by (meson *)
   then show ?thesis by simp
 qed
 
 
 subsection\<open>Path components\<close>
 
 definition path_component_of
   where "path_component_of X x y \<equiv> \<exists>g. pathin X g \<and> g 0 = x \<and> g 1 = y"
 
 abbreviation path_component_of_set
   where "path_component_of_set X x \<equiv> Collect (path_component_of X x)"
 
 definition path_components_of :: "'a topology \<Rightarrow> 'a set set"
   where "path_components_of X \<equiv> path_component_of_set X ` topspace X"
 
 lemma pathin_canon_iff: "pathin (top_of_set T) g \<longleftrightarrow> path g \<and> g \<in> {0..1} \<rightarrow> T"
   by (simp add: path_def pathin_def image_subset_iff_funcset)
 
 lemma path_component_of_canon_iff [simp]:
   "path_component_of (top_of_set T) a b \<longleftrightarrow> path_component T a b"
   by (simp add: path_component_of_def pathin_canon_iff path_defs image_subset_iff_funcset)
 
 lemma path_component_in_topspace:
    "path_component_of X x y \<Longrightarrow> x \<in> topspace X \<and> y \<in> topspace X"
   by (auto simp: path_component_of_def pathin_def continuous_map_def)
 
 lemma path_component_of_refl:
    "path_component_of X x x \<longleftrightarrow> x \<in> topspace X"
   by (metis path_component_in_topspace path_component_of_def pathin_const)
 
 lemma path_component_of_sym:
   assumes "path_component_of X x y"
   shows "path_component_of X y x"
   using assms
   apply (clarsimp simp: path_component_of_def pathin_def)
   apply (rule_tac x="g \<circ> (\<lambda>t. 1 - t)" in exI)
   apply (auto intro!: continuous_map_compose simp: continuous_map_in_subtopology continuous_on_op_minus)
   done
 
 lemma path_component_of_sym_iff:
    "path_component_of X x y \<longleftrightarrow> path_component_of X y x"
   by (metis path_component_of_sym)
 
 lemma continuous_map_cases_le:
   assumes contp: "continuous_map X euclideanreal p"
     and contq: "continuous_map X euclideanreal q"
     and contf: "continuous_map (subtopology X {x. x \<in> topspace X \<and> p x \<le> q x}) Y f"
     and contg: "continuous_map (subtopology X {x. x \<in> topspace X \<and> q x \<le> p x}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x = q x\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x \<le> q x then f x else g x)"
 proof -
   have "continuous_map X Y (\<lambda>x. if q x - p x \<in> {0..} then f x else g x)"
   proof (rule continuous_map_cases_function)
     show "continuous_map X euclideanreal (\<lambda>x. q x - p x)"
       by (intro contp contq continuous_intros)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of {0..}}) Y f"
       by (simp add: contf)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of (topspace euclideanreal - {0..})}) Y g"
       by (simp add: contg flip: Compl_eq_Diff_UNIV)
   qed (auto simp: fg)
   then show ?thesis
     by simp
 qed
 
 lemma continuous_map_cases_lt:
   assumes contp: "continuous_map X euclideanreal p"
     and contq: "continuous_map X euclideanreal q"
     and contf: "continuous_map (subtopology X {x. x \<in> topspace X \<and> p x \<le> q x}) Y f"
     and contg: "continuous_map (subtopology X {x. x \<in> topspace X \<and> q x \<le> p x}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x = q x\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x < q x then f x else g x)"
 proof -
   have "continuous_map X Y (\<lambda>x. if q x - p x \<in> {0<..} then f x else g x)"
   proof (rule continuous_map_cases_function)
     show "continuous_map X euclideanreal (\<lambda>x. q x - p x)"
       by (intro contp contq continuous_intros)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of {0<..}}) Y f"
       by (simp add: contf)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of (topspace euclideanreal - {0<..})}) Y g"
       by (simp add: contg flip: Compl_eq_Diff_UNIV)
   qed (auto simp: fg)
   then show ?thesis
     by simp
 qed
 
 lemma path_component_of_trans:
   assumes "path_component_of X x y" and "path_component_of X y z"
   shows "path_component_of X x z"
   unfolding path_component_of_def pathin_def
 proof -
   let ?T01 = "top_of_set {0..1::real}"
   obtain g1 g2 where g1: "continuous_map ?T01 X g1" "x = g1 0" "y = g1 1"
     and g2: "continuous_map ?T01 X g2" "g2 0 = g1 1" "z = g2 1"
     using assms unfolding path_component_of_def pathin_def by blast
   let ?g = "\<lambda>x. if x \<le> 1/2 then (g1 \<circ> (\<lambda>t. 2 * t)) x else (g2 \<circ> (\<lambda>t. 2 * t -1)) x"
   show "\<exists>g. continuous_map ?T01 X g \<and> g 0 = x \<and> g 1 = z"
   proof (intro exI conjI)
     show "continuous_map (subtopology euclideanreal {0..1}) X ?g"
     proof (intro continuous_map_cases_le continuous_map_compose, force, force)
       show "continuous_map (subtopology ?T01 {x \<in> topspace ?T01. x \<le> 1/2}) ?T01 ((*) 2)"
         by (auto simp: continuous_map_in_subtopology continuous_map_from_subtopology)
       have "continuous_map
              (subtopology (top_of_set {0..1}) {x. 0 \<le> x \<and> x \<le> 1 \<and> 1 \<le> x * 2})
              euclideanreal (\<lambda>t. 2 * t - 1)"
         by (intro continuous_intros) (force intro: continuous_map_from_subtopology)
       then show "continuous_map (subtopology ?T01 {x \<in> topspace ?T01. 1/2 \<le> x}) ?T01 (\<lambda>t. 2 * t - 1)"
         by (force simp: continuous_map_in_subtopology)
       show "(g1 \<circ> (*) 2) x = (g2 \<circ> (\<lambda>t. 2 * t - 1)) x" if "x \<in> topspace ?T01" "x = 1/2" for x
         using that by (simp add: g2(2) mult.commute continuous_map_from_subtopology)
     qed (auto simp: g1 g2)
   qed (auto simp: g1 g2)
 qed
 
 lemma path_component_of_mono:
    "\<lbrakk>path_component_of (subtopology X S) x y; S \<subseteq> T\<rbrakk> \<Longrightarrow> path_component_of (subtopology X T) x y"
   unfolding path_component_of_def
   by (metis subsetD pathin_subtopology)
 
 lemma path_component_of:
   "path_component_of X x y \<longleftrightarrow> (\<exists>T. path_connectedin X T \<and> x \<in> T \<and> y \<in> T)"
     (is "?lhs = ?rhs")
 proof 
   assume ?lhs then show ?rhs
     by (metis atLeastAtMost_iff image_eqI order_refl path_component_of_def path_connectedin_path_image zero_le_one)
 next
   assume ?rhs then show ?lhs
     by (metis path_component_of_def path_connectedin)
 qed
 
 lemma path_component_of_set:
    "path_component_of X x y \<longleftrightarrow> (\<exists>g. pathin X g \<and> g 0 = x \<and> g 1 = y)"
   by (auto simp: path_component_of_def)
 
 lemma path_component_of_subset_topspace:
    "Collect(path_component_of X x) \<subseteq> topspace X"
   using path_component_in_topspace by fastforce
 
 lemma path_component_of_eq_empty:
    "Collect(path_component_of X x) = {} \<longleftrightarrow> (x \<notin> topspace X)"
   using path_component_in_topspace path_component_of_refl by fastforce
 
 lemma path_connected_space_iff_path_component:
    "path_connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. path_component_of X x y)"
   by (simp add: path_component_of path_connected_space_subconnected)
 
 lemma path_connected_space_imp_path_component_of:
    "\<lbrakk>path_connected_space X; a \<in> topspace X; b \<in> topspace X\<rbrakk>
         \<Longrightarrow> path_component_of X a b"
   by (simp add: path_connected_space_iff_path_component)
 
 lemma path_connected_space_path_component_set:
    "path_connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. Collect(path_component_of X x) = topspace X)"
   using path_component_of_subset_topspace path_connected_space_iff_path_component by fastforce
 
 lemma path_component_of_maximal:
    "\<lbrakk>path_connectedin X s; x \<in> s\<rbrakk> \<Longrightarrow> s \<subseteq> Collect(path_component_of X x)"
   using path_component_of by fastforce
 
 lemma path_component_of_equiv:
    "path_component_of X x y \<longleftrightarrow> x \<in> topspace X \<and> y \<in> topspace X \<and> path_component_of X x = path_component_of X y"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding fun_eq_iff path_component_in_topspace
     by (metis path_component_in_topspace path_component_of_sym path_component_of_trans)
 qed (simp add: path_component_of_refl)
 
 lemma path_component_of_disjoint:
      "disjnt (Collect (path_component_of X x)) (Collect (path_component_of X y)) \<longleftrightarrow>
       ~(path_component_of X x y)"
   by (force simp: disjnt_def path_component_of_eq_empty path_component_of_equiv)
 
 lemma path_component_of_eq:
    "path_component_of X x = path_component_of X y \<longleftrightarrow>
         (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
         x \<in> topspace X \<and> y \<in> topspace X \<and> path_component_of X x y"
   by (metis Collect_empty_eq_bot path_component_of_eq_empty path_component_of_equiv)
 
 lemma path_component_of_aux:
   "path_component_of X x y
         \<Longrightarrow> path_component_of (subtopology X (Collect (path_component_of X x))) x y"
     by (meson path_component_of path_component_of_maximal path_connectedin_subtopology)
 
 lemma path_connectedin_path_component_of:
   "path_connectedin X (Collect (path_component_of X x))"
 proof -
   have "topspace (subtopology X (path_component_of_set X x)) = path_component_of_set X x"
     by (meson path_component_of_subset_topspace topspace_subtopology_subset)
   then have "path_connected_space (subtopology X (path_component_of_set X x))"
     by (metis mem_Collect_eq path_component_of_aux path_component_of_equiv path_connected_space_iff_path_component)
   then show ?thesis
     by (simp add: path_component_of_subset_topspace path_connectedin_def)
 qed
 
 lemma path_connectedin_euclidean [simp]:
    "path_connectedin euclidean S \<longleftrightarrow> path_connected S"
   by (auto simp: path_connectedin_def path_connected_space_iff_path_component path_connected_component)
 
 lemma path_connected_space_euclidean_subtopology [simp]:
    "path_connected_space(subtopology euclidean S) \<longleftrightarrow> path_connected S"
   using path_connectedin_topspace by force
 
 lemma Union_path_components_of:
      "\<Union>(path_components_of X) = topspace X"
   by (auto simp: path_components_of_def path_component_of_equiv)
 
 lemma path_components_of_maximal:
    "\<lbrakk>C \<in> path_components_of X; path_connectedin X S; ~disjnt C S\<rbrakk> \<Longrightarrow> S \<subseteq> C"
   by (smt (verit, ccfv_SIG) disjnt_iff imageE mem_Collect_eq path_component_of_equiv 
       path_component_of_maximal path_components_of_def)
 
 lemma pairwise_disjoint_path_components_of:
      "pairwise disjnt (path_components_of X)"
   by (auto simp: path_components_of_def pairwise_def path_component_of_disjoint path_component_of_equiv)
 
 lemma complement_path_components_of_Union:
    "C \<in> path_components_of X \<Longrightarrow> topspace X - C = \<Union>(path_components_of X - {C})"
   by (metis Union_path_components_of bot.extremum ccpo_Sup_singleton diff_Union_pairwise_disjoint 
         insert_subsetI pairwise_disjoint_path_components_of)
 
 lemma nonempty_path_components_of:
   assumes "C \<in> path_components_of X" shows "C \<noteq> {}"
   by (metis assms imageE path_component_of_eq_empty path_components_of_def)
 
 lemma path_components_of_subset: "C \<in> path_components_of X \<Longrightarrow> C \<subseteq> topspace X"
   by (auto simp: path_components_of_def path_component_of_equiv)
 
 lemma path_connectedin_path_components_of:
    "C \<in> path_components_of X \<Longrightarrow> path_connectedin X C"
   by (auto simp: path_components_of_def path_connectedin_path_component_of)
 
 lemma path_component_in_path_components_of:
   "Collect (path_component_of X a) \<in> path_components_of X \<longleftrightarrow> a \<in> topspace X"
   by (metis imageI nonempty_path_components_of path_component_of_eq_empty path_components_of_def)
 
 lemma path_connectedin_Union:
   assumes \<A>: "\<And>S. S \<in> \<A> \<Longrightarrow> path_connectedin X S" and "\<Inter>\<A> \<noteq> {}"
   shows "path_connectedin X (\<Union>\<A>)"
 proof -
   obtain a where "\<And>S. S \<in> \<A> \<Longrightarrow> a \<in> S"
     using assms by blast
   then have "\<And>x. x \<in> topspace (subtopology X (\<Union>\<A>)) \<Longrightarrow> path_component_of (subtopology X (\<Union>\<A>)) a x"
     unfolding topspace_subtopology path_component_of
     by (metis (full_types) IntD2 Union_iff Union_upper \<A> path_connectedin_subtopology)
   then show ?thesis
     using \<A> unfolding path_connectedin_def
     by (metis Sup_le_iff path_component_of_equiv path_connected_space_iff_path_component)
 qed
 
 lemma path_connectedin_Un:
    "\<lbrakk>path_connectedin X S; path_connectedin X T; S \<inter> T \<noteq> {}\<rbrakk>
     \<Longrightarrow> path_connectedin X (S \<union> T)"
   by (blast intro: path_connectedin_Union [of "{S,T}", simplified])
 
 lemma path_connected_space_iff_components_eq:
   "path_connected_space X \<longleftrightarrow>
     (\<forall>C \<in> path_components_of X. \<forall>C' \<in> path_components_of X. C = C')"
   unfolding path_components_of_def
 proof (intro iffI ballI)
   assume "\<forall>C \<in> path_component_of_set X ` topspace X.
              \<forall>C' \<in> path_component_of_set X ` topspace X. C = C'"
   then show "path_connected_space X"
     using path_component_of_refl path_connected_space_iff_path_component by fastforce
 qed (auto simp: path_connected_space_path_component_set)
 
 lemma path_components_of_eq_empty:
    "path_components_of X = {} \<longleftrightarrow> X = trivial_topology"
   by (metis image_is_empty path_components_of_def subtopology_eq_discrete_topology_empty)
 
 lemma path_components_of_empty_space:
    "path_components_of trivial_topology = {}"
   by (simp add: path_components_of_eq_empty)
 
 lemma path_components_of_subset_singleton:
   "path_components_of X \<subseteq> {S} \<longleftrightarrow>
         path_connected_space X \<and> (topspace X = {} \<or> topspace X = S)"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (auto simp: path_components_of_empty_space path_connected_space_topspace_empty)
 next
   case False
   have "(path_components_of X = {S}) \<longleftrightarrow> (path_connected_space X \<and> topspace X = S)"
     by (metis False Set.set_insert ex_in_conv insert_iff path_component_in_path_components_of 
         path_connected_space_iff_components_eq path_connected_space_path_component_set)
   with False show ?thesis
     by (simp add: path_components_of_eq_empty subset_singleton_iff)
 qed
 
 lemma path_connected_space_iff_components_subset_singleton:
    "path_connected_space X \<longleftrightarrow> (\<exists>a. path_components_of X \<subseteq> {a})"
   by (simp add: path_components_of_subset_singleton)
 
 lemma path_components_of_eq_singleton:
    "path_components_of X = {S} \<longleftrightarrow> path_connected_space X \<and> topspace X \<noteq> {} \<and> S = topspace X"
   by (metis cSup_singleton insert_not_empty path_components_of_subset_singleton subset_singleton_iff)
 
 lemma path_components_of_path_connected_space:
    "path_connected_space X \<Longrightarrow> path_components_of X = (if topspace X = {} then {} else {topspace X})"
   by (simp add: path_components_of_eq_empty path_components_of_eq_singleton)
 
 lemma path_component_subset_connected_component_of:
    "path_component_of_set X x \<subseteq> connected_component_of_set X x"
 proof (cases "x \<in> topspace X")
   case True
   then show ?thesis
     by (simp add: connected_component_of_maximal path_component_of_refl path_connectedin_imp_connectedin path_connectedin_path_component_of)
 next
   case False
   then show ?thesis
     using path_component_of_eq_empty by fastforce
 qed
 
 lemma exists_path_component_of_superset:
   assumes S: "path_connectedin X S" and ne: "topspace X \<noteq> {}"
   obtains C where "C \<in> path_components_of X" "S \<subseteq> C"
     by (metis S ne ex_in_conv path_component_in_path_components_of path_component_of_maximal path_component_of_subset_topspace subset_eq that)
 
 lemma path_component_of_eq_overlap:
    "path_component_of X x = path_component_of X y \<longleftrightarrow>
       (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
       Collect (path_component_of X x) \<inter> Collect (path_component_of X y) \<noteq> {}"
   by (metis disjnt_def empty_iff inf_bot_right mem_Collect_eq path_component_of_disjoint path_component_of_eq path_component_of_eq_empty)
 
 lemma path_component_of_nonoverlap:
    "Collect (path_component_of X x) \<inter> Collect (path_component_of X y) = {} \<longleftrightarrow>
     (x \<notin> topspace X) \<or> (y \<notin> topspace X) \<or>
     path_component_of X x \<noteq> path_component_of X y"
   by (metis inf.idem path_component_of_eq_empty path_component_of_eq_overlap)
 
 lemma path_component_of_overlap:
    "Collect (path_component_of X x) \<inter> Collect (path_component_of X y) \<noteq> {} \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> path_component_of X x = path_component_of X y"
   by (meson path_component_of_nonoverlap)
 
 lemma path_components_of_disjoint:
      "\<lbrakk>C \<in> path_components_of X; C' \<in> path_components_of X\<rbrakk> \<Longrightarrow> disjnt C C' \<longleftrightarrow> C \<noteq> C'"
   by (auto simp: path_components_of_def path_component_of_disjoint path_component_of_equiv)
 
 lemma path_components_of_overlap:
     "\<lbrakk>C \<in> path_components_of X; C' \<in> path_components_of X\<rbrakk> \<Longrightarrow> C \<inter> C' \<noteq> {} \<longleftrightarrow> C = C'"
   by (auto simp: path_components_of_def path_component_of_equiv)
 
 lemma path_component_of_unique:
    "\<lbrakk>x \<in> C; path_connectedin X C; \<And>C'. \<lbrakk>x \<in> C'; path_connectedin X C'\<rbrakk> \<Longrightarrow> C' \<subseteq> C\<rbrakk>
         \<Longrightarrow> Collect (path_component_of X x) = C"
   by (meson subsetD eq_iff path_component_of_maximal path_connectedin_path_component_of)
 
 lemma path_component_of_discrete_topology [simp]:
   "Collect (path_component_of (discrete_topology U) x) = (if x \<in> U then {x} else {})"
 proof -
   have "\<And>C'. \<lbrakk>x \<in> C'; path_connectedin (discrete_topology U) C'\<rbrakk> \<Longrightarrow> C' \<subseteq> {x}"
     by (metis path_connectedin_discrete_topology subsetD singletonD)
   then have "x \<in> U \<Longrightarrow> Collect (path_component_of (discrete_topology U) x) = {x}"
     by (simp add: path_component_of_unique)
   then show ?thesis
     using path_component_in_topspace by fastforce
 qed
 
 lemma path_component_of_discrete_topology_iff [simp]:
   "path_component_of (discrete_topology U) x y \<longleftrightarrow> x \<in> U \<and> y=x"
   by (metis empty_iff insertI1 mem_Collect_eq path_component_of_discrete_topology singletonD)
 
 lemma path_components_of_discrete_topology [simp]:
    "path_components_of (discrete_topology U) = (\<lambda>x. {x}) ` U"
   by (auto simp: path_components_of_def image_def fun_eq_iff)
 
 lemma homeomorphic_map_path_component_of:
   assumes f: "homeomorphic_map X Y f" and x: "x \<in> topspace X"
   shows "Collect (path_component_of Y (f x)) = f ` Collect(path_component_of X x)"
 proof -
   obtain g where g: "homeomorphic_maps X Y f g"
     using f homeomorphic_map_maps by blast
   show ?thesis
   proof
     have "Collect (path_component_of Y (f x)) \<subseteq> topspace Y"
       by (simp add: path_component_of_subset_topspace)
     moreover have "g ` Collect(path_component_of Y (f x)) \<subseteq> Collect (path_component_of X (g (f x)))"
       using f g x unfolding homeomorphic_maps_def
       by (metis image_Collect_subsetI image_eqI mem_Collect_eq path_component_of_equiv path_component_of_maximal 
           path_connectedin_continuous_map_image path_connectedin_path_component_of)
     ultimately show "Collect (path_component_of Y (f x)) \<subseteq> f ` Collect (path_component_of X x)"
       using g x unfolding homeomorphic_maps_def continuous_map_def image_iff subset_iff
       by metis
     show "f ` Collect (path_component_of X x) \<subseteq> Collect (path_component_of Y (f x))"
     proof (rule path_component_of_maximal)
       show "path_connectedin Y (f ` Collect (path_component_of X x))"
         by (meson f homeomorphic_map_path_connectedness_eq path_connectedin_path_component_of)
     qed (simp add: path_component_of_refl x)
   qed
 qed
 
 lemma homeomorphic_map_path_components_of:
   assumes "homeomorphic_map X Y f"
   shows "path_components_of Y = (image f) ` (path_components_of X)"
   unfolding path_components_of_def homeomorphic_imp_surjective_map [OF assms, symmetric]
   using assms homeomorphic_map_path_component_of by fastforce
 
 
 subsection\<open>Paths and path-connectedness\<close>
 
 lemma path_connected_space_quotient_map_image:
    "\<lbrakk>quotient_map X Y q; path_connected_space X\<rbrakk> \<Longrightarrow> path_connected_space Y"
   by (metis path_connectedin_continuous_map_image path_connectedin_topspace quotient_imp_continuous_map quotient_imp_surjective_map)
 
 lemma path_connected_space_retraction_map_image:
    "\<lbrakk>retraction_map X Y r; path_connected_space X\<rbrakk> \<Longrightarrow> path_connected_space Y"
   using path_connected_space_quotient_map_image retraction_imp_quotient_map by blast
 
 lemma path_connected_space_prod_topology:
   "path_connected_space(prod_topology X Y) \<longleftrightarrow>
         topspace(prod_topology X Y) = {} \<or> path_connected_space X \<and> path_connected_space Y"
 proof (cases "topspace(prod_topology X Y) = {}")
   case True
   then show ?thesis
     using path_connected_space_topspace_empty by force
 next
   case False
   have "path_connected_space (prod_topology X Y)" 
     if X: "path_connected_space X" and Y: "path_connected_space Y"
   proof (clarsimp simp: path_connected_space_def)
     fix x y x' y'
     assume "x \<in> topspace X" and "y \<in> topspace Y" and "x' \<in> topspace X" and "y' \<in> topspace Y"
     obtain f where "pathin X f" "f 0 = x" "f 1 = x'"
       by (meson X \<open>x \<in> topspace X\<close> \<open>x' \<in> topspace X\<close> path_connected_space_def)
     obtain g where "pathin Y g" "g 0 = y" "g 1 = y'"
       by (meson Y \<open>y \<in> topspace Y\<close> \<open>y' \<in> topspace Y\<close> path_connected_space_def)
     show "\<exists>h. pathin (prod_topology X Y) h \<and> h 0 = (x,y) \<and> h 1 = (x',y')"
     proof (intro exI conjI)
       show "pathin (prod_topology X Y) (\<lambda>t. (f t, g t))"
         using \<open>pathin X f\<close> \<open>pathin Y g\<close> by (simp add: continuous_map_paired pathin_def)
       show "(\<lambda>t. (f t, g t)) 0 = (x, y)"
         using \<open>f 0 = x\<close> \<open>g 0 = y\<close> by blast
       show "(\<lambda>t. (f t, g t)) 1 = (x', y')"
         using \<open>f 1 = x'\<close> \<open>g 1 = y'\<close> by blast
     qed
   qed
   then show ?thesis
     by (metis False path_connected_space_quotient_map_image prod_topology_trivial1 prod_topology_trivial2 
         quotient_map_fst quotient_map_snd topspace_discrete_topology)
 qed
 
 lemma path_connectedin_Times:
    "path_connectedin (prod_topology X Y) (S \<times> T) \<longleftrightarrow>
         S = {} \<or> T = {} \<or> path_connectedin X S \<and> path_connectedin Y T"
   by (auto simp add: path_connectedin_def subtopology_Times path_connected_space_prod_topology)
 
 
 subsection\<open>Path components\<close>
 
 lemma path_component_of_subtopology_eq:
   "path_component_of (subtopology X U) x = path_component_of X x \<longleftrightarrow> path_component_of_set X x \<subseteq> U"  
   (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (metis path_connectedin_path_component_of path_connectedin_subtopology)
 next
   show "?rhs \<Longrightarrow> ?lhs"
     unfolding fun_eq_iff
     by (metis path_connectedin_subtopology path_component_of path_component_of_aux path_component_of_mono)
 qed
 
 lemma path_components_of_subtopology:
   assumes "C \<in> path_components_of X" "C \<subseteq> U"
   shows "C \<in> path_components_of (subtopology X U)"
   using assms path_component_of_refl path_component_of_subtopology_eq topspace_subtopology
   by (smt (verit) imageE path_component_in_path_components_of path_components_of_def)
 
 lemma path_imp_connected_component_of:
    "path_component_of X x y \<Longrightarrow> connected_component_of X x y"
   by (metis in_mono mem_Collect_eq path_component_subset_connected_component_of)
 
 lemma finite_path_components_of_finite:
    "finite(topspace X) \<Longrightarrow> finite(path_components_of X)"
   by (simp add: Union_path_components_of finite_UnionD)
 
 lemma path_component_of_continuous_image:
   "\<lbrakk>continuous_map X X' f; path_component_of X x y\<rbrakk> \<Longrightarrow> path_component_of X' (f x) (f y)"
   by (meson image_eqI path_component_of path_connectedin_continuous_map_image)
 
 lemma path_component_of_pair [simp]:
    "path_component_of_set (prod_topology X Y) (x,y) =
     path_component_of_set X x \<times> path_component_of_set Y y"   (is "?lhs = ?rhs")
 proof (cases "?lhs = {}")
   case True
   then show ?thesis
     by (metis Sigma_empty1 Sigma_empty2 mem_Sigma_iff path_component_of_eq_empty topspace_prod_topology) 
 next
   case False
   then have "path_component_of X x x" "path_component_of Y y y"
     using path_component_of_eq_empty path_component_of_refl by fastforce+
   moreover
   have "path_connectedin (prod_topology X Y) (path_component_of_set X x \<times> path_component_of_set Y y)"
     by (metis path_connectedin_Times path_connectedin_path_component_of)
   moreover have "path_component_of X x a" "path_component_of Y y b"
     if "(x, y) \<in> C'" "(a,b) \<in> C'" and "path_connectedin (prod_topology X Y) C'" for C' a b
     by (smt (verit, best) that continuous_map_fst continuous_map_snd fst_conv snd_conv path_component_of path_component_of_continuous_image)+
   ultimately show ?thesis
     by (intro path_component_of_unique) auto
 qed
 
 lemma path_components_of_prod_topology:
    "path_components_of (prod_topology X Y) =
     (\<lambda>(C,D). C \<times> D) ` (path_components_of X \<times> path_components_of Y)"
   by (force simp add: image_iff path_components_of_def)
 
 lemma path_components_of_prod_topology':
    "path_components_of (prod_topology X Y) =
     {C \<times> D |C D. C \<in> path_components_of X \<and> D \<in> path_components_of Y}"
   by (auto simp: path_components_of_prod_topology)
 
 lemma path_component_of_product_topology:
    "path_component_of_set (product_topology X I) f =
     (if f \<in> extensional I then PiE I (\<lambda>i. path_component_of_set (X i) (f i)) else {})"
     (is "?lhs = ?rhs")
 proof (cases "path_component_of_set (product_topology X I) f = {}")
   case True
   then show ?thesis
     by (smt (verit) PiE_eq_empty_iff PiE_iff path_component_of_eq_empty topspace_product_topology)
 next
   case False
   then have [simp]: "f \<in> extensional I"
     by (auto simp: path_component_of_eq_empty PiE_iff path_component_of_equiv)
   show ?thesis
   proof (intro path_component_of_unique)
     show "f \<in> ?rhs"
       using False path_component_of_eq_empty path_component_of_refl by force
     show "path_connectedin (product_topology X I) (if f \<in> extensional I then \<Pi>\<^sub>E i\<in>I. path_component_of_set (X i) (f i) else {})"
       by (simp add: path_connectedin_PiE path_connectedin_path_component_of)
     fix C'
     assume "f \<in> C'" and C': "path_connectedin (product_topology X I) C'" 
     show "C' \<subseteq> ?rhs"
     proof -
       have "C' \<subseteq> extensional I"
         using PiE_def C' path_connectedin_subset_topspace by fastforce
       with \<open>f \<in> C'\<close> C' show ?thesis
         apply (clarsimp simp: PiE_iff subset_iff)
         by (smt (verit, ccfv_threshold) continuous_map_product_projection path_component_of path_component_of_continuous_image)
     qed   
   qed
 qed
 
 lemma path_components_of_product_topology:
   "path_components_of (product_topology X I) =
     {PiE I B |B. \<forall>i \<in> I. B i \<in> path_components_of(X i)}"  (is "?lhs=?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     unfolding path_components_of_def image_subset_iff
     by (smt (verit) image_iff mem_Collect_eq path_component_of_product_topology topspace_product_topology_alt)
 next
   show "?rhs \<subseteq> ?lhs"
   proof
     fix F
     assume "F \<in> ?rhs"
     then obtain B where B: "F = Pi\<^sub>E I B"
       and "\<forall>i\<in>I. \<exists>x\<in>topspace (X i). B i = path_component_of_set (X i) x"
       by (force simp add: path_components_of_def image_iff)
     then obtain f where ftop: "\<And>i. i \<in> I \<Longrightarrow> f i \<in> topspace (X i)"
       and BF: "\<And>i. i \<in> I \<Longrightarrow> B i = path_component_of_set (X i) (f i)"
       by metis
     then have "F = path_component_of_set (product_topology X I) (restrict f I)"
       by (metis (mono_tags, lifting) B PiE_cong path_component_of_product_topology restrict_apply' restrict_extensional)
     then show "F \<in> ?lhs"
       by (simp add: ftop path_component_in_path_components_of)
   qed
 qed
 
 subsection \<open>Sphere is path-connected\<close>
 
 lemma path_connected_punctured_universe:
   assumes "2 \<le> DIM('a::euclidean_space)"
   shows "path_connected (- {a::'a})"
 proof -
   let ?A = "{x::'a. \<exists>i\<in>Basis. x \<bullet> i < a \<bullet> i}"
   let ?B = "{x::'a. \<exists>i\<in>Basis. a \<bullet> i < x \<bullet> i}"
 
   have A: "path_connected ?A"
     unfolding Collect_bex_eq
   proof (rule path_connected_UNION)
     fix i :: 'a
     assume "i \<in> Basis"
     then show "(\<Sum>i\<in>Basis. (a \<bullet> i - 1)*\<^sub>R i) \<in> {x::'a. x \<bullet> i < a \<bullet> i}"
       by simp
     show "path_connected {x. x \<bullet> i < a \<bullet> i}"
       using convex_imp_path_connected [OF convex_halfspace_lt, of i "a \<bullet> i"]
       by (simp add: inner_commute)
   qed
   have B: "path_connected ?B"
     unfolding Collect_bex_eq
   proof (rule path_connected_UNION)
     fix i :: 'a
     assume "i \<in> Basis"
     then show "(\<Sum>i\<in>Basis. (a \<bullet> i + 1) *\<^sub>R i) \<in> {x::'a. a \<bullet> i < x \<bullet> i}"
       by simp
     show "path_connected {x. a \<bullet> i < x \<bullet> i}"
       using convex_imp_path_connected [OF convex_halfspace_gt, of "a \<bullet> i" i]
       by (simp add: inner_commute)
   qed
   obtain S :: "'a set" where "S \<subseteq> Basis" and "card S = Suc (Suc 0)"
     using obtain_subset_with_card_n[OF assms] by (force simp add: eval_nat_numeral)
   then obtain b0 b1 :: 'a where "b0 \<in> Basis" and "b1 \<in> Basis" and "b0 \<noteq> b1"
     unfolding card_Suc_eq by auto
   then have "a + b0 - b1 \<in> ?A \<inter> ?B"
     by (auto simp: inner_simps inner_Basis)
   then have "?A \<inter> ?B \<noteq> {}"
     by fast
   with A B have "path_connected (?A \<union> ?B)"
     by (rule path_connected_Un)
   also have "?A \<union> ?B = {x. \<exists>i\<in>Basis. x \<bullet> i \<noteq> a \<bullet> i}"
     unfolding neq_iff bex_disj_distrib Collect_disj_eq ..
   also have "\<dots> = {x. x \<noteq> a}"
     unfolding euclidean_eq_iff [where 'a='a]
     by (simp add: Bex_def)
   also have "\<dots> = - {a}"
     by auto
   finally show ?thesis .
 qed
 
 corollary connected_punctured_universe:
   "2 \<le> DIM('N::euclidean_space) \<Longrightarrow> connected(- {a::'N})"
   by (simp add: path_connected_punctured_universe path_connected_imp_connected)
 
 proposition path_connected_sphere:
   fixes a :: "'a :: euclidean_space"
   assumes "2 \<le> DIM('a)"
   shows "path_connected(sphere a r)"
 proof (cases r "0::real" rule: linorder_cases)
   case greater
   then have eq: "(sphere (0::'a) r) = (\<lambda>x. (r / norm x) *\<^sub>R x) ` (- {0::'a})"
     by (force simp: image_iff split: if_split_asm)
   have "continuous_on (- {0::'a}) (\<lambda>x. (r / norm x) *\<^sub>R x)"
     by (intro continuous_intros) auto
   then have "path_connected ((\<lambda>x. (r / norm x) *\<^sub>R x) ` (- {0::'a}))"
     by (intro path_connected_continuous_image path_connected_punctured_universe assms)
   with eq have "path_connected((+) a ` (sphere (0::'a) r))"
     by (simp add: path_connected_translation)
   then show ?thesis
     by (metis add.right_neutral sphere_translation)
 qed auto
 
 lemma connected_sphere:
     fixes a :: "'a :: euclidean_space"
     assumes "2 \<le> DIM('a)"
       shows "connected(sphere a r)"
   using path_connected_sphere [OF assms]
   by (simp add: path_connected_imp_connected)
 
 
 corollary path_connected_complement_bounded_convex:
     fixes S :: "'a :: euclidean_space set"
     assumes "bounded S" "convex S" and 2: "2 \<le> DIM('a)"
     shows "path_connected (- S)"
 proof (cases "S = {}")
   case True then show ?thesis
     using convex_imp_path_connected by auto
 next
   case False
   then obtain a where "a \<in> S" by auto
   have \<section> [rule_format]: "\<forall>y\<in>S. \<forall>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> (1 - u) *\<^sub>R a + u *\<^sub>R y \<in> S"
     using \<open>convex S\<close> \<open>a \<in> S\<close> by (simp add: convex_alt)
   { fix x y assume "x \<notin> S" "y \<notin> S"
     then have "x \<noteq> a" "y \<noteq> a" using \<open>a \<in> S\<close> by auto
     then have bxy: "bounded(insert x (insert y S))"
       by (simp add: \<open>bounded S\<close>)
     then obtain B::real where B: "0 < B" and Bx: "norm (a - x) < B" and By: "norm (a - y) < B"
                           and "S \<subseteq> ball a B"
       using bounded_subset_ballD [OF bxy, of a] by (auto simp: dist_norm)
     define C where "C = B / norm(x - a)"
     let ?Cxa = "a + C *\<^sub>R (x - a)"
     { fix u
       assume u: "(1 - u) *\<^sub>R x + u *\<^sub>R ?Cxa \<in> S" and "0 \<le> u" "u \<le> 1"
       have CC: "1 \<le> 1 + (C - 1) * u"
         using \<open>x \<noteq> a\<close> \<open>0 \<le> u\<close> Bx
         by (auto simp add: C_def norm_minus_commute)
       have *: "\<And>v. (1 - u) *\<^sub>R x + u *\<^sub>R (a + v *\<^sub>R (x - a)) = a + (1 + (v - 1) * u) *\<^sub>R (x - a)"
         by (simp add: algebra_simps)
       have "a + ((1 / (1 + C * u - u)) *\<^sub>R x + ((u / (1 + C * u - u)) *\<^sub>R a + (C * u / (1 + C * u - u)) *\<^sub>R x)) =
             (1 + (u / (1 + C * u - u))) *\<^sub>R a + ((1 / (1 + C * u - u)) + (C * u / (1 + C * u - u))) *\<^sub>R x"
         by (simp add: algebra_simps)
       also have "\<dots> = (1 + (u / (1 + C * u - u))) *\<^sub>R a + (1 + (u / (1 + C * u - u))) *\<^sub>R x"
         using CC by (simp add: field_simps)
       also have "\<dots> = x + (1 + (u / (1 + C * u - u))) *\<^sub>R a + (u / (1 + C * u - u)) *\<^sub>R x"
         by (simp add: algebra_simps)
       also have "\<dots> = x + ((1 / (1 + C * u - u)) *\<^sub>R a +
               ((u / (1 + C * u - u)) *\<^sub>R x + (C * u / (1 + C * u - u)) *\<^sub>R a))"
         using CC by (simp add: field_simps) (simp add: add_divide_distrib scaleR_add_left)
       finally have xeq: "(1 - 1 / (1 + (C - 1) * u)) *\<^sub>R a + (1 / (1 + (C - 1) * u)) *\<^sub>R (a + (1 + (C - 1) * u) *\<^sub>R (x - a)) = x"
         by (simp add: algebra_simps)
       have False
         using \<section> [of "a + (1 + (C - 1) * u) *\<^sub>R (x - a)" "1 / (1 + (C - 1) * u)"]
         using u \<open>x \<noteq> a\<close> \<open>x \<notin> S\<close> \<open>0 \<le> u\<close> CC
         by (auto simp: xeq *)
     }
     then have pcx: "path_component (- S) x ?Cxa"
       by (force simp: closed_segment_def intro!: path_component_linepath)
     define D where "D = B / norm(y - a)"  \<comment> \<open>massive duplication with the proof above\<close>
     let ?Dya = "a + D *\<^sub>R (y - a)"
     { fix u
       assume u: "(1 - u) *\<^sub>R y + u *\<^sub>R ?Dya \<in> S" and "0 \<le> u" "u \<le> 1"
       have DD: "1 \<le> 1 + (D - 1) * u"
         using \<open>y \<noteq> a\<close> \<open>0 \<le> u\<close> By
         by (auto simp add: D_def norm_minus_commute)
       have *: "\<And>v. (1 - u) *\<^sub>R y + u *\<^sub>R (a + v *\<^sub>R (y - a)) = a + (1 + (v - 1) * u) *\<^sub>R (y - a)"
         by (simp add: algebra_simps)
       have "a + ((1 / (1 + D * u - u)) *\<^sub>R y + ((u / (1 + D * u - u)) *\<^sub>R a + (D * u / (1 + D * u - u)) *\<^sub>R y)) =
             (1 + (u / (1 + D * u - u))) *\<^sub>R a + ((1 / (1 + D * u - u)) + (D * u / (1 + D * u - u))) *\<^sub>R y"
         by (simp add: algebra_simps)
       also have "\<dots> = (1 + (u / (1 + D * u - u))) *\<^sub>R a + (1 + (u / (1 + D * u - u))) *\<^sub>R y"
         using DD by (simp add: field_simps)
       also have "\<dots> = y + (1 + (u / (1 + D * u - u))) *\<^sub>R a + (u / (1 + D * u - u)) *\<^sub>R y"
         by (simp add: algebra_simps)
       also have "\<dots> = y + ((1 / (1 + D * u - u)) *\<^sub>R a +
               ((u / (1 + D * u - u)) *\<^sub>R y + (D * u / (1 + D * u - u)) *\<^sub>R a))"
         using DD by (simp add: field_simps) (simp add: add_divide_distrib scaleR_add_left)
       finally have xeq: "(1 - 1 / (1 + (D - 1) * u)) *\<^sub>R a + (1 / (1 + (D - 1) * u)) *\<^sub>R (a + (1 + (D - 1) * u) *\<^sub>R (y - a)) = y"
         by (simp add: algebra_simps)
       have False
         using \<section> [of "a + (1 + (D - 1) * u) *\<^sub>R (y - a)" "1 / (1 + (D - 1) * u)"]
         using u \<open>y \<noteq> a\<close> \<open>y \<notin> S\<close> \<open>0 \<le> u\<close> DD
         by (auto simp: xeq *)
     }
     then have pdy: "path_component (- S) y ?Dya"
       by (force simp: closed_segment_def intro!: path_component_linepath)
     have pyx: "path_component (- S) ?Dya ?Cxa"
     proof (rule path_component_of_subset)
       show "sphere a B \<subseteq> - S"
         using \<open>S \<subseteq> ball a B\<close> by (force simp: ball_def dist_norm norm_minus_commute)
       have aB: "?Dya \<in> sphere a B" "?Cxa \<in> sphere a B"
         using \<open>x \<noteq> a\<close> using \<open>y \<noteq> a\<close> B by (auto simp: dist_norm C_def D_def)
       then show "path_component (sphere a B) ?Dya ?Cxa"
         using path_connected_sphere [OF 2] path_connected_component by blast
     qed
     have "path_component (- S) x y"
       by (metis path_component_trans path_component_sym pcx pdy pyx)
   }
   then show ?thesis
     by (auto simp: path_connected_component)
 qed
 
 lemma connected_complement_bounded_convex:
     fixes S :: "'a :: euclidean_space set"
     assumes "bounded S" "convex S" "2 \<le> DIM('a)"
       shows  "connected (- S)"
   using path_connected_complement_bounded_convex [OF assms] path_connected_imp_connected by blast
 
 lemma connected_diff_ball:
     fixes S :: "'a :: euclidean_space set"
     assumes "connected S" "cball a r \<subseteq> S" "2 \<le> DIM('a)"
       shows "connected (S - ball a r)"
 proof (rule connected_diff_open_from_closed [OF ball_subset_cball])
   show "connected (cball a r - ball a r)"
     using assms connected_sphere by (auto simp: cball_diff_eq_sphere)
 qed (auto simp: assms dist_norm)
 
 proposition connected_open_delete:
   assumes "open S" "connected S" and 2: "2 \<le> DIM('N::euclidean_space)"
     shows "connected(S - {a::'N})"
 proof (cases "a \<in> S")
   case True
   with \<open>open S\<close> obtain \<epsilon> where "\<epsilon> > 0" and \<epsilon>: "cball a \<epsilon> \<subseteq> S"
     using open_contains_cball_eq by blast
   define b where "b \<equiv> a + \<epsilon> *\<^sub>R (SOME i. i \<in> Basis)"
   have "dist a b = \<epsilon>"
     by (simp add: b_def dist_norm SOME_Basis \<open>0 < \<epsilon>\<close> less_imp_le)
   with \<epsilon> have "b \<in> \<Inter>{S - ball a r |r. 0 < r \<and> r < \<epsilon>}"
     by auto
   then have nonemp: "(\<Inter>{S - ball a r |r. 0 < r \<and> r < \<epsilon>}) = {} \<Longrightarrow> False"
     by auto
   have con: "\<And>r. r < \<epsilon> \<Longrightarrow> connected (S - ball a r)"
     using \<epsilon> by (force intro: connected_diff_ball [OF \<open>connected S\<close> _ 2])
   have "x \<in> \<Union>{S - ball a r |r. 0 < r \<and> r < \<epsilon>}" if "x \<in> S - {a}" for x
      using that \<open>0 < \<epsilon>\<close> 
      by (intro UnionI [of "S - ball a (min \<epsilon> (dist a x) / 2)"]) auto
   then have "S - {a} = \<Union>{S - ball a r | r. 0 < r \<and> r < \<epsilon>}"
     by auto
   then show ?thesis
     by (auto intro: connected_Union con dest!: nonemp)
 next
   case False then show ?thesis
     by (simp add: \<open>connected S\<close>)
 qed
 
 corollary path_connected_open_delete:
   assumes "open S" "connected S" and 2: "2 \<le> DIM('N::euclidean_space)"
   shows "path_connected(S - {a::'N})"
   by (simp add: assms connected_open_delete connected_open_path_connected open_delete)
 
 corollary path_connected_punctured_ball:
   "2 \<le> DIM('N::euclidean_space) \<Longrightarrow> path_connected(ball a r - {a::'N})"
   by (simp add: path_connected_open_delete)
 
 corollary connected_punctured_ball:
   "2 \<le> DIM('N::euclidean_space) \<Longrightarrow> connected(ball a r - {a::'N})"
   by (simp add: connected_open_delete)
 
 corollary connected_open_delete_finite:
   fixes S T::"'a::euclidean_space set"
   assumes S: "open S" "connected S" and 2: "2 \<le> DIM('a)" and "finite T"
   shows "connected(S - T)"
   using \<open>finite T\<close> S
 proof (induct T)
   case empty
   show ?case using \<open>connected S\<close> by simp
 next
   case (insert x T)
   then have "connected (S-T)" 
     by auto
   moreover have "open (S - T)" 
     using finite_imp_closed[OF \<open>finite T\<close>] \<open>open S\<close> by auto
   ultimately have "connected (S - T - {x})" 
     using connected_open_delete[OF _ _ 2] by auto
   thus ?case by (metis Diff_insert)
 qed
 
 lemma sphere_1D_doubleton_zero:
   assumes 1: "DIM('a) = 1" and "r > 0"
   obtains x y::"'a::euclidean_space"
     where "sphere 0 r = {x,y} \<and> dist x y = 2*r"
 proof -
   obtain b::'a where b: "Basis = {b}"
     using 1 card_1_singletonE by blast
   show ?thesis
   proof (intro that conjI)
     have "x = norm x *\<^sub>R b \<or> x = - norm x *\<^sub>R b" if "r = norm x" for x
     proof -
       have xb: "(x \<bullet> b) *\<^sub>R b = x"
         using euclidean_representation [of x, unfolded b] by force
       then have "norm ((x \<bullet> b) *\<^sub>R b) = norm x"
         by simp
       with b have "\<bar>x \<bullet> b\<bar> = norm x"
         using norm_Basis by (simp add: b)
       with xb show ?thesis
         by (metis (mono_tags, opaque_lifting) abs_eq_iff abs_norm_cancel)
     qed
     with \<open>r > 0\<close> b show "sphere 0 r = {r *\<^sub>R b, - r *\<^sub>R b}"
       by (force simp: sphere_def dist_norm)
     have "dist (r *\<^sub>R b) (- r *\<^sub>R b) = norm (r *\<^sub>R b + r *\<^sub>R b)"
       by (simp add: dist_norm)
     also have "\<dots> = norm ((2*r) *\<^sub>R b)"
       by (metis mult_2 scaleR_add_left)
     also have "\<dots> = 2*r"
       using \<open>r > 0\<close> b norm_Basis by fastforce
     finally show "dist (r *\<^sub>R b) (- r *\<^sub>R b) = 2*r" .
   qed
 qed
 
 lemma sphere_1D_doubleton:
   fixes a :: "'a :: euclidean_space"
   assumes "DIM('a) = 1" and "r > 0"
   obtains x y where "sphere a r = {x,y} \<and> dist x y = 2*r"
   using sphere_1D_doubleton_zero [OF assms] dist_add_cancel image_empty image_insert
   by (metis (no_types, opaque_lifting) add.right_neutral sphere_translation)
 
 lemma psubset_sphere_Compl_connected:
   fixes S :: "'a::euclidean_space set"
   assumes S: "S \<subset> sphere a r" and "0 < r" and 2: "2 \<le> DIM('a)"
   shows "connected(- S)"
 proof -
   have "S \<subseteq> sphere a r"
     using S by blast
   obtain b where "dist a b = r" and "b \<notin> S"
     using S mem_sphere by blast
   have CS: "- S = {x. dist a x \<le> r \<and> (x \<notin> S)} \<union> {x. r \<le> dist a x \<and> (x \<notin> S)}"
     by auto
   have "{x. dist a x \<le> r \<and> x \<notin> S} \<inter> {x. r \<le> dist a x \<and> x \<notin> S} \<noteq> {}"
     using \<open>b \<notin> S\<close> \<open>dist a b = r\<close> by blast
   moreover have "connected {x. dist a x \<le> r \<and> x \<notin> S}"
     using assms
     by (force intro: connected_intermediate_closure [of "ball a r"])
   moreover have "connected {x. r \<le> dist a x \<and> x \<notin> S}"
   proof (rule connected_intermediate_closure [of "- cball a r"])
     show "{x. r \<le> dist a x \<and> x \<notin> S} \<subseteq> closure (- cball a r)"
       using interior_closure by (force intro: connected_complement_bounded_convex)
   qed (use assms connected_complement_bounded_convex in auto)
   ultimately show ?thesis
     by (simp add: CS connected_Un)
 qed
 
 
 subsection\<open>Every annulus is a connected set\<close>
 
 lemma path_connected_2DIM_I:
   fixes a :: "'N::euclidean_space"
   assumes 2: "2 \<le> DIM('N)" and pc: "path_connected {r. 0 \<le> r \<and> P r}"
   shows "path_connected {x. P(norm(x - a))}"
 proof -
   have "{x. P(norm(x - a))} = (+) a ` {x. P(norm x)}"
     by force
   moreover have "path_connected {x::'N. P(norm x)}"
   proof -
     let ?D = "{x. 0 \<le> x \<and> P x} \<times> sphere (0::'N) 1"
     have "x \<in> (\<lambda>z. fst z *\<^sub>R snd z) ` ?D"
       if "P (norm x)" for x::'N
     proof (cases "x=0")
       case True
       with that show ?thesis
         apply (simp add: image_iff)
         by (metis (no_types) mem_sphere_0 order_refl vector_choose_size zero_le_one)
     next
       case False
       with that show ?thesis
         by (rule_tac x="(norm x, x /\<^sub>R norm x)" in image_eqI) auto
     qed
     then have *: "{x::'N. P(norm x)} =  (\<lambda>z. fst z *\<^sub>R snd z) ` ?D"
       by auto
     have "continuous_on ?D (\<lambda>z:: real\<times>'N. fst z *\<^sub>R snd z)"
       by (intro continuous_intros)
     moreover have "path_connected ?D"
       by (metis path_connected_Times [OF pc] path_connected_sphere 2)
     ultimately show ?thesis
       by (simp add: "*" path_connected_continuous_image)
   qed
   ultimately show ?thesis
     using path_connected_translation by metis
 qed
 
 proposition path_connected_annulus:
   fixes a :: "'N::euclidean_space"
   assumes "2 \<le> DIM('N)"
   shows "path_connected {x. r1 < norm(x - a) \<and> norm(x - a) < r2}"
         "path_connected {x. r1 < norm(x - a) \<and> norm(x - a) \<le> r2}"
         "path_connected {x. r1 \<le> norm(x - a) \<and> norm(x - a) < r2}"
         "path_connected {x. r1 \<le> norm(x - a) \<and> norm(x - a) \<le> r2}"
   by (auto simp: is_interval_def intro!: is_interval_convex convex_imp_path_connected path_connected_2DIM_I [OF assms])
 
 proposition connected_annulus:
   fixes a :: "'N::euclidean_space"
   assumes "2 \<le> DIM('N::euclidean_space)"
   shows "connected {x. r1 < norm(x - a) \<and> norm(x - a) < r2}"
         "connected {x. r1 < norm(x - a) \<and> norm(x - a) \<le> r2}"
         "connected {x. r1 \<le> norm(x - a) \<and> norm(x - a) < r2}"
         "connected {x. r1 \<le> norm(x - a) \<and> norm(x - a) \<le> r2}"
   by (auto simp: path_connected_annulus [OF assms] path_connected_imp_connected)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Relations between components and path components\<close>
 
 lemma open_connected_component:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open (connected_component_set S x)"
 proof (clarsimp simp: open_contains_ball)
   fix y
   assume xy: "connected_component S x y"
   then obtain e where "e>0" "ball y e \<subseteq> S"
     using assms connected_component_in openE by blast
   then show "\<exists>e>0. ball y e  \<subseteq> connected_component_set S x"
     by (metis xy centre_in_ball connected_ball connected_component_eq_eq connected_component_in connected_component_maximal)
 qed
 
 corollary open_components:
     fixes S :: "'a::real_normed_vector set"
     shows "\<lbrakk>open u; S \<in> components u\<rbrakk> \<Longrightarrow> open S"
   by (simp add: components_iff) (metis open_connected_component)
 
 lemma in_closure_connected_component:
   fixes S :: "'a::real_normed_vector set"
   assumes x: "x \<in> S" and S: "open S"
   shows "x \<in> closure (connected_component_set S y) \<longleftrightarrow>  x \<in> connected_component_set S y"
 proof -
   have "x islimpt connected_component_set S y \<Longrightarrow> connected_component S y x"
     by (metis (no_types, lifting) S connected_component_eq connected_component_refl islimptE mem_Collect_eq open_connected_component x)
   then show ?thesis
     by (auto simp: closure_def)
 qed
 
 lemma connected_disjoint_Union_open_pick:
   assumes "pairwise disjnt B"
           "\<And>S. S \<in> A \<Longrightarrow> connected S \<and> S \<noteq> {}"
           "\<And>S. S \<in> B \<Longrightarrow> open S"
           "\<Union>A \<subseteq> \<Union>B"
           "S \<in> A"
   obtains T where "T \<in> B" "S \<subseteq> T" "S \<inter> \<Union>(B - {T}) = {}"
 proof -
   have "S \<subseteq> \<Union>B" "connected S" "S \<noteq> {}"
     using assms \<open>S \<in> A\<close> by blast+
   then obtain T where "T \<in> B" "S \<inter> T \<noteq> {}"
     by (metis Sup_inf_eq_bot_iff inf.absorb_iff2 inf_commute)
   have 1: "open T" by (simp add: \<open>T \<in> B\<close> assms)
   have 2: "open (\<Union>(B-{T}))" using assms by blast
   have 3: "S \<subseteq> T \<union> \<Union>(B - {T})" using \<open>S \<subseteq> \<Union>B\<close> by blast
   have "T \<inter> \<Union>(B - {T}) = {}" using \<open>T \<in> B\<close> \<open>pairwise disjnt B\<close>
     by (auto simp: pairwise_def disjnt_def)
   then have 4: "T \<inter> \<Union>(B - {T}) \<inter> S = {}" by auto
   from connectedD [OF \<open>connected S\<close> 1 2 4 3]
   have "S \<inter> \<Union>(B-{T}) = {}"
     by (auto simp: Int_commute \<open>S \<inter> T \<noteq> {}\<close>)
   with \<open>T \<in> B\<close> 3 that show ?thesis
     by (metis IntI UnE empty_iff subsetD subsetI)
 qed
 
 lemma connected_disjoint_Union_open_subset:
   assumes A: "pairwise disjnt A" and B: "pairwise disjnt B"
       and SA: "\<And>S. S \<in> A \<Longrightarrow> open S \<and> connected S \<and> S \<noteq> {}"
       and SB: "\<And>S. S \<in> B \<Longrightarrow> open S \<and> connected S \<and> S \<noteq> {}"
       and eq [simp]: "\<Union>A = \<Union>B"
     shows "A \<subseteq> B"
 proof
   fix S
   assume "S \<in> A"
   obtain T where "T \<in> B" "S \<subseteq> T" "S \<inter> \<Union>(B - {T}) = {}"
     using SA SB \<open>S \<in> A\<close> connected_disjoint_Union_open_pick [OF B, of A] eq order_refl by blast
   moreover obtain S' where "S' \<in> A" "T \<subseteq> S'" "T \<inter> \<Union>(A - {S'}) = {}"
     using SA SB \<open>T \<in> B\<close> connected_disjoint_Union_open_pick [OF A, of B] eq order_refl by blast
   ultimately have "S' = S"
     by (metis A Int_subset_iff SA \<open>S \<in> A\<close> disjnt_def inf.orderE pairwise_def)
   with \<open>T \<subseteq> S'\<close> have "T \<subseteq> S" by simp
   with \<open>S \<subseteq> T\<close> have "S = T" by blast
   with \<open>T \<in> B\<close> show "S \<in> B" by simp
 qed
 
 lemma connected_disjoint_Union_open_unique:
   assumes A: "pairwise disjnt A" and B: "pairwise disjnt B"
       and SA: "\<And>S. S \<in> A \<Longrightarrow> open S \<and> connected S \<and> S \<noteq> {}"
       and SB: "\<And>S. S \<in> B \<Longrightarrow> open S \<and> connected S \<and> S \<noteq> {}"
       and eq [simp]: "\<Union>A = \<Union>B"
     shows "A = B"
 by (metis subset_antisym connected_disjoint_Union_open_subset assms)
 
 proposition components_open_unique:
  fixes S :: "'a::real_normed_vector set"
   assumes "pairwise disjnt A" "\<Union>A = S"
           "\<And>X. X \<in> A \<Longrightarrow> open X \<and> connected X \<and> X \<noteq> {}"
     shows "components S = A"
 proof -
   have "open S" using assms by blast
   show ?thesis
   proof (rule connected_disjoint_Union_open_unique)
     show "disjoint (components S)"
       by (simp add: components_eq disjnt_def pairwise_def)
   qed (use \<open>open S\<close> in \<open>simp_all add: assms open_components in_components_connected in_components_nonempty\<close>)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Existence of unbounded components\<close>
 
 lemma cobounded_unbounded_component:
     fixes S :: "'a :: euclidean_space set"
     assumes "bounded (-S)"
       shows "\<exists>x. x \<in> S \<and> \<not> bounded (connected_component_set S x)"
 proof -
   obtain i::'a where i: "i \<in> Basis"
     using nonempty_Basis by blast
   obtain B where B: "B>0" "-S \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF assms, of 0] by auto
   then have *: "\<And>x. B \<le> norm x \<Longrightarrow> x \<in> S"
     by (force simp: ball_def dist_norm)
   have unbounded_inner: "\<not> bounded {x. inner i x \<ge> B}"
   proof (clarsimp simp: bounded_def dist_norm)
     fix e x
     show "\<exists>y. B \<le> i \<bullet> y \<and> \<not> norm (x - y) \<le> e"
       using i
       by (rule_tac x="x + (max B e + 1 + \<bar>i \<bullet> x\<bar>) *\<^sub>R i" in exI) (auto simp: inner_right_distrib)
   qed
   have \<section>: "\<And>x. B \<le> i \<bullet> x \<Longrightarrow> x \<in> S"
     using * Basis_le_norm [OF i] by (metis abs_ge_self inner_commute order_trans)
   have "{x. B \<le> i \<bullet> x} \<subseteq> connected_component_set S (B *\<^sub>R i)"
     by (intro connected_component_maximal) (auto simp: i intro: convex_connected convex_halfspace_ge [of B] \<section>)
   then have "\<not> bounded (connected_component_set S (B *\<^sub>R i))"
     using bounded_subset unbounded_inner by blast
   moreover have "B *\<^sub>R i \<in> S"
     by (rule *) (simp add: norm_Basis [OF i])
   ultimately show ?thesis
     by blast
 qed
 
 lemma cobounded_unique_unbounded_component:
     fixes S :: "'a :: euclidean_space set"
     assumes bs: "bounded (-S)" and "2 \<le> DIM('a)"
         and bo: "\<not> bounded(connected_component_set S x)"
                 "\<not> bounded(connected_component_set S y)"
       shows "connected_component_set S x = connected_component_set S y"
 proof -
   obtain i::'a where i: "i \<in> Basis"
     using nonempty_Basis by blast
   obtain B where "B>0" and B: "-S \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF bs, of 0] by auto
   then have *: "\<And>x. B \<le> norm x \<Longrightarrow> x \<in> S"
     by (force simp: ball_def dist_norm)
   obtain x' y' where x': "connected_component S x x'" "norm x' > B"
   and  y': "connected_component S y y'" "norm y' > B"
     using \<open>B>0\<close> bo bounded_pos by (metis linorder_not_le mem_Collect_eq) 
   have x'y': "connected_component S x' y'"
     unfolding connected_component_def
   proof (intro exI conjI)
     show "connected (- ball 0 B :: 'a set)"
       using assms by (auto intro: connected_complement_bounded_convex)
   qed (use x' y' dist_norm * in auto)
   show ?thesis
       using x' y' x'y'
       by (metis connected_component_eq mem_Collect_eq)
 qed
 
 lemma cobounded_unbounded_components:
     fixes S :: "'a :: euclidean_space set"
     shows "bounded (-S) \<Longrightarrow> \<exists>c. c \<in> components S \<and> \<not>bounded c"
   by (metis cobounded_unbounded_component components_def imageI)
 
 lemma cobounded_unique_unbounded_components:
     fixes S :: "'a :: euclidean_space set"
     shows  "\<lbrakk>bounded (- S); c \<in> components S; \<not> bounded c; c' \<in> components S; \<not> bounded c'; 2 \<le> DIM('a)\<rbrakk> \<Longrightarrow> c' = c"
   unfolding components_iff
   by (metis cobounded_unique_unbounded_component)
 
 lemma cobounded_has_bounded_component:
   fixes S :: "'a :: euclidean_space set"
   assumes "bounded (- S)" "\<not> connected S" "2 \<le> DIM('a)"
   obtains C where "C \<in> components S" "bounded C"
   by (meson cobounded_unique_unbounded_components connected_eq_connected_components_eq assms)
 
 
 subsection\<open>The \<open>inside\<close> and \<open>outside\<close> of a Set\<close>
 
 text\<^marker>\<open>tag important\<close>\<open>The inside comprises the points in a bounded connected component of the set's complement.
   The outside comprises the points in unbounded connected component of the complement.\<close>
 
 definition\<^marker>\<open>tag important\<close> inside where
   "inside S \<equiv> {x. (x \<notin> S) \<and> bounded(connected_component_set ( - S) x)}"
 
 definition\<^marker>\<open>tag important\<close> outside where
   "outside S \<equiv> -S \<inter> {x. \<not> bounded(connected_component_set (- S) x)}"
 
 lemma outside: "outside S = {x. \<not> bounded(connected_component_set (- S) x)}"
   by (auto simp: outside_def) (metis Compl_iff bounded_empty connected_component_eq_empty)
 
 lemma inside_no_overlap [simp]: "inside S \<inter> S = {}"
   by (auto simp: inside_def)
 
 lemma outside_no_overlap [simp]:
    "outside S \<inter> S = {}"
   by (auto simp: outside_def)
 
 lemma inside_Int_outside [simp]: "inside S \<inter> outside S = {}"
   by (auto simp: inside_def outside_def)
 
 lemma inside_Un_outside [simp]: "inside S \<union> outside S = (- S)"
   by (auto simp: inside_def outside_def)
 
 lemma inside_eq_outside:
    "inside S = outside S \<longleftrightarrow> S = UNIV"
   by (auto simp: inside_def outside_def)
 
 lemma inside_outside: "inside S = (- (S \<union> outside S))"
   by (force simp: inside_def outside)
 
 lemma outside_inside: "outside S = (- (S \<union> inside S))"
   by (auto simp: inside_outside) (metis IntI equals0D outside_no_overlap)
 
 lemma union_with_inside: "S \<union> inside S = - outside S"
   by (auto simp: inside_outside) (simp add: outside_inside)
 
 lemma union_with_outside: "S \<union> outside S = - inside S"
   by (simp add: inside_outside)
 
 lemma outside_mono: "S \<subseteq> T \<Longrightarrow> outside T \<subseteq> outside S"
   by (auto simp: outside bounded_subset connected_component_mono)
 
 lemma inside_mono: "S \<subseteq> T \<Longrightarrow> inside S - T \<subseteq> inside T"
   by (auto simp: inside_def bounded_subset connected_component_mono)
 
 lemma segment_bound_lemma:
   fixes u::real
   assumes "x \<ge> B" "y \<ge> B" "0 \<le> u" "u \<le> 1"
   shows "(1 - u) * x + u * y \<ge> B"
   by (smt (verit) assms convex_bound_le ge_iff_diff_ge_0 minus_add_distrib 
       mult_minus_right neg_le_iff_le)
 
 lemma cobounded_outside:
   fixes S :: "'a :: real_normed_vector set"
   assumes "bounded S" shows "bounded (- outside S)"
 proof -
   obtain B where B: "B>0" "S \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF assms, of 0] by auto
   { fix x::'a and C::real
     assume Bno: "B \<le> norm x" and C: "0 < C"
     have "\<exists>y. connected_component (- S) x y \<and> norm y > C"
     proof (cases "x = 0")
       case True with B Bno show ?thesis by force
     next
       case False 
       have "closed_segment x (((B + C) / norm x) *\<^sub>R x) \<subseteq> - ball 0 B"
       proof
         fix w
         assume "w \<in> closed_segment x (((B + C) / norm x) *\<^sub>R x)"
         then obtain u where
           w: "w = (1 - u + u * (B + C) / norm x) *\<^sub>R x" "0 \<le> u" "u \<le> 1"
           by (auto simp add: closed_segment_def real_vector_class.scaleR_add_left [symmetric])
         with False B C have "B \<le> (1 - u) * norm x + u * (B + C)"
           using segment_bound_lemma [of B "norm x" "B + C" u] Bno
           by simp
         with False B C show "w \<in> - ball 0 B"
           using distrib_right [of _ _ "norm x"]
           by (simp add: ball_def w not_less)
       qed
       also have "... \<subseteq> -S"
         by (simp add: B)
       finally have "\<exists>T. connected T \<and> T \<subseteq> - S \<and> x \<in> T \<and> ((B + C) / norm x) *\<^sub>R x \<in> T"
         by (rule_tac x="closed_segment x (((B+C)/norm x) *\<^sub>R x)" in exI) simp
       with False B
       show ?thesis
         by (rule_tac x="((B+C)/norm x) *\<^sub>R x" in exI) (simp add: connected_component_def)
     qed
   }
   then show ?thesis
     apply (simp add: outside_def assms)
     apply (rule bounded_subset [OF bounded_ball [of 0 B]])
     apply (force simp: dist_norm not_less bounded_pos)
     done
 qed
 
 lemma unbounded_outside:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "bounded S \<Longrightarrow> \<not> bounded(outside S)"
   using cobounded_imp_unbounded cobounded_outside by blast
 
 lemma bounded_inside:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "bounded S \<Longrightarrow> bounded(inside S)"
   by (simp add: bounded_Int cobounded_outside inside_outside)
 
 lemma connected_outside:
     fixes S :: "'a::euclidean_space set"
     assumes "bounded S" "2 \<le> DIM('a)"
     shows "connected(outside S)"
   apply (clarsimp simp add: connected_iff_connected_component outside)
   apply (rule_tac S="connected_component_set (- S) x" in connected_component_of_subset)
   apply (metis (no_types) assms cobounded_unbounded_component cobounded_unique_unbounded_component connected_component_eq_eq connected_component_idemp double_complement mem_Collect_eq)
   by (simp add: Collect_mono connected_component_eq)
 
 lemma outside_connected_component_lt:
   "outside S = {x. \<forall>B. \<exists>y. B < norm(y) \<and> connected_component (- S) x y}"
 proof -
   have "\<And>x B. x \<in> outside S \<Longrightarrow> \<exists>y. B < norm y \<and> connected_component (- S) x y"
     by (metis boundedI linorder_not_less mem_Collect_eq outside)
   moreover
   have "\<And>x. \<forall>B. \<exists>y. B < norm y \<and> connected_component (- S) x y \<Longrightarrow> x \<in> outside S"
     by (metis bounded_pos linorder_not_less mem_Collect_eq outside)
   ultimately show ?thesis by auto
 qed
 
 lemma outside_connected_component_le:
   "outside S = {x. \<forall>B. \<exists>y. B \<le> norm(y) \<and> connected_component (- S) x y}"
   apply (simp add: outside_connected_component_lt Set.set_eq_iff)
   by (meson gt_ex leD le_less_linear less_imp_le order.trans)
 
 lemma not_outside_connected_component_lt:
     fixes S :: "'a::euclidean_space set"
     assumes S: "bounded S" and "2 \<le> DIM('a)"
       shows "- (outside S) = {x. \<forall>B. \<exists>y. B < norm(y) \<and> \<not> connected_component (- S) x y}"
 proof -
   obtain B::real where B: "0 < B" and Bno: "\<And>x. x \<in> S \<Longrightarrow> norm x \<le> B"
     using S [simplified bounded_pos] by auto
   have cyz: "connected_component (- S) y z" 
     if yz: "B < norm z" "B < norm y" for y::'a and z::'a
   proof -
     have "connected_component (- cball 0 B) y z"
       using assms yz
       by (force simp: dist_norm intro: connected_componentI [OF _ subset_refl] connected_complement_bounded_convex)
     then show ?thesis
       by (metis connected_component_of_subset Bno Compl_anti_mono mem_cball_0 subset_iff)
   qed
   show ?thesis
     apply (auto simp: outside bounded_pos)
     apply (metis Compl_iff bounded_iff cobounded_imp_unbounded mem_Collect_eq not_le)
     by (metis B connected_component_trans cyz not_le)
 qed
 
 lemma not_outside_connected_component_le:
   fixes S :: "'a::euclidean_space set"
   assumes S: "bounded S"  "2 \<le> DIM('a)"
   shows "- (outside S) = {x. \<forall>B. \<exists>y. B \<le> norm(y) \<and> \<not> connected_component (- S) x y}"
   unfolding not_outside_connected_component_lt [OF assms]
   by (metis (no_types, opaque_lifting) dual_order.strict_trans1 gt_ex pinf(8))
 
 lemma inside_connected_component_lt:
     fixes S :: "'a::euclidean_space set"
     assumes S: "bounded S"  "2 \<le> DIM('a)"
       shows "inside S = {x. (x \<notin> S) \<and> (\<forall>B. \<exists>y. B < norm(y) \<and> \<not> connected_component (- S) x y)}"
   by (auto simp: inside_outside not_outside_connected_component_lt [OF assms])
 
 lemma inside_connected_component_le:
     fixes S :: "'a::euclidean_space set"
     assumes S: "bounded S"  "2 \<le> DIM('a)"
       shows "inside S = {x. (x \<notin> S) \<and> (\<forall>B. \<exists>y. B \<le> norm(y) \<and> \<not> connected_component (- S) x y)}"
   by (auto simp: inside_outside not_outside_connected_component_le [OF assms])
 
 lemma inside_subset:
   assumes "connected U" and "\<not> bounded U" and "T \<union> U = - S"
   shows "inside S \<subseteq> T"
   using bounded_subset [of "connected_component_set (- S) _" U] assms
   by (metis (no_types, lifting) ComplI Un_iff connected_component_maximal inside_def mem_Collect_eq subsetI)
 
 lemma frontier_not_empty:
   fixes S :: "'a :: real_normed_vector set"
   shows "\<lbrakk>S \<noteq> {}; S \<noteq> UNIV\<rbrakk> \<Longrightarrow> frontier S \<noteq> {}"
     using connected_Int_frontier [of UNIV S] by auto
 
 lemma frontier_eq_empty:
   fixes S :: "'a :: real_normed_vector set"
   shows "frontier S = {} \<longleftrightarrow> S = {} \<or> S = UNIV"
 using frontier_UNIV frontier_empty frontier_not_empty by blast
 
 lemma frontier_of_connected_component_subset:
   fixes S :: "'a::real_normed_vector set"
   shows "frontier(connected_component_set S x) \<subseteq> frontier S"
 proof -
   { fix y
     assume y1: "y \<in> closure (connected_component_set S x)"
        and y2: "y \<notin> interior (connected_component_set S x)"
     have "y \<in> closure S"
       using y1 closure_mono connected_component_subset by blast
     moreover have "z \<in> interior (connected_component_set S x)"
           if "0 < e" "ball y e \<subseteq> interior S" "dist y z < e" for e z
     proof -
       have "ball y e \<subseteq> connected_component_set S y"
         using connected_component_maximal that interior_subset 
         by (metis centre_in_ball connected_ball subset_trans)
       then show ?thesis
         using y1 apply (simp add: closure_approachable open_contains_ball_eq [OF open_interior])
         by (metis connected_component_eq dist_commute mem_Collect_eq mem_ball mem_interior subsetD \<open>0 < e\<close> y2)
     qed
     then have "y \<notin> interior S"
       using y2 by (force simp: open_contains_ball_eq [OF open_interior])
     ultimately have "y \<in> frontier S"
       by (auto simp: frontier_def)
   }
   then show ?thesis by (auto simp: frontier_def)
 qed
 
 lemma frontier_Union_subset_closure:
   fixes F :: "'a::real_normed_vector set set"
   shows "frontier(\<Union>F) \<subseteq> closure(\<Union>t \<in> F. frontier t)"
 proof -
   have "\<exists>y\<in>F. \<exists>y\<in>frontier y. dist y x < e"
        if "T \<in> F" "y \<in> T" "dist y x < e"
           "x \<notin> interior (\<Union>F)" "0 < e" for x y e T
   proof (cases "x \<in> T")
     case True with that show ?thesis
       by (metis Diff_iff Sup_upper closure_subset contra_subsetD dist_self frontier_def interior_mono)
   next
     case False
     have \<section>: "closed_segment x y \<inter> T \<noteq> {}" "closed_segment x y - T \<noteq> {}"
       using \<open>y \<in> T\<close> False by blast+
     obtain c where "c \<in> closed_segment x y" "c \<in> frontier T"
        using False connected_Int_frontier [OF connected_segment \<section>] by auto
      with that show ?thesis
        by (smt (verit) dist_norm segment_bound1)
   qed
   then show ?thesis
     by (fastforce simp add: frontier_def closure_approachable)
 qed
 
 lemma frontier_Union_subset:
   fixes F :: "'a::real_normed_vector set set"
   shows "finite F \<Longrightarrow> frontier(\<Union>F) \<subseteq> (\<Union>t \<in> F. frontier t)"
   by (metis closed_UN closure_closed frontier_Union_subset_closure frontier_closed)
 
 lemma frontier_of_components_subset:
   fixes S :: "'a::real_normed_vector set"
   shows "C \<in> components S \<Longrightarrow> frontier C \<subseteq> frontier S"
   by (metis Path_Connected.frontier_of_connected_component_subset components_iff)
 
 lemma frontier_of_components_closed_complement:
   fixes S :: "'a::real_normed_vector set"
   shows "\<lbrakk>closed S; C \<in> components (- S)\<rbrakk> \<Longrightarrow> frontier C \<subseteq> S"
   using frontier_complement frontier_of_components_subset frontier_subset_eq by blast
 
 lemma frontier_minimal_separating_closed:
   fixes S :: "'a::real_normed_vector set"
   assumes "closed S"
       and nconn: "\<not> connected(- S)"
       and C: "C \<in> components (- S)"
       and conn: "\<And>T. \<lbrakk>closed T; T \<subset> S\<rbrakk> \<Longrightarrow> connected(- T)"
     shows "frontier C = S"
 proof (rule ccontr)
   assume "frontier C \<noteq> S"
   then have "frontier C \<subset> S"
     using frontier_of_components_closed_complement [OF \<open>closed S\<close> C] by blast
   then have "connected(- (frontier C))"
     by (simp add: conn)
   have "\<not> connected(- (frontier C))"
     unfolding connected_def not_not
   proof (intro exI conjI)
     show "open C"
       using C \<open>closed S\<close> open_components by blast
     show "open (- closure C)"
       by blast
     show "C \<inter> - closure C \<inter> - frontier C = {}"
       using closure_subset by blast
     show "C \<inter> - frontier C \<noteq> {}"
       using C \<open>open C\<close> components_eq frontier_disjoint_eq by fastforce
     show "- frontier C \<subseteq> C \<union> - closure C"
       by (simp add: \<open>open C\<close> closed_Compl frontier_closures)
     then show "- closure C \<inter> - frontier C \<noteq> {}"
       by (metis C Compl_Diff_eq Un_Int_eq(4) Un_commute \<open>frontier C \<subset> S\<close> \<open>open C\<close> compl_le_compl_iff frontier_def in_components_subset interior_eq leD sup_bot.right_neutral)
   qed
   then show False
     using \<open>connected (- frontier C)\<close> by blast
 qed
 
 lemma connected_component_UNIV [simp]:
   fixes x :: "'a::real_normed_vector"
   shows "connected_component_set UNIV x = UNIV"
   using connected_iff_eq_connected_component_set [of "UNIV::'a set"] connected_UNIV
   by auto
 
 lemma connected_component_eq_UNIV:
     fixes x :: "'a::real_normed_vector"
     shows "connected_component_set s x = UNIV \<longleftrightarrow> s = UNIV"
   using connected_component_in connected_component_UNIV by blast
 
 lemma components_UNIV [simp]: "components UNIV = {UNIV :: 'a::real_normed_vector set}"
   by (auto simp: components_eq_sing_iff)
 
 lemma interior_inside_frontier:
     fixes S :: "'a::real_normed_vector set"
     assumes "bounded S"
       shows "interior S \<subseteq> inside (frontier S)"
 proof -
   { fix x y
     assume x: "x \<in> interior S" and y: "y \<notin> S"
        and cc: "connected_component (- frontier S) x y"
     have "connected_component_set (- frontier S) x \<inter> frontier S \<noteq> {}"
     proof (rule connected_Int_frontier; simp add: set_eq_iff)
       show "\<exists>u. connected_component (- frontier S) x u \<and> u \<in> S"
         by (meson cc connected_component_in connected_component_refl_eq interior_subset subsetD x)
       show "\<exists>u. connected_component (- frontier S) x u \<and> u \<notin> S"
         using y cc by blast
     qed
     then have "bounded (connected_component_set (- frontier S) x)"
       using connected_component_in by auto
   }
   then show ?thesis
     using bounded_subset [OF assms]
     by (metis (no_types, lifting) Diff_iff frontier_def inside_def mem_Collect_eq subsetI)
 qed
 
 lemma inside_empty [simp]: "inside {} = ({} :: 'a :: {real_normed_vector, perfect_space} set)"
   by (simp add: inside_def)
 
 lemma outside_empty [simp]: "outside {} = (UNIV :: 'a :: {real_normed_vector, perfect_space} set)"
   using inside_empty inside_Un_outside by blast
 
 lemma inside_same_component:
    "\<lbrakk>connected_component (- S) x y; x \<in> inside S\<rbrakk> \<Longrightarrow> y \<in> inside S"
   using connected_component_eq connected_component_in
   by (fastforce simp add: inside_def)
 
 lemma outside_same_component:
    "\<lbrakk>connected_component (- S) x y; x \<in> outside S\<rbrakk> \<Longrightarrow> y \<in> outside S"
   using connected_component_eq connected_component_in
   by (fastforce simp add: outside_def)
 
 lemma convex_in_outside:
   fixes S :: "'a :: {real_normed_vector, perfect_space} set"
   assumes S: "convex S" and z: "z \<notin> S"
     shows "z \<in> outside S"
 proof (cases "S={}")
   case True then show ?thesis by simp
 next
   case False then obtain a where "a \<in> S" by blast
   with z have zna: "z \<noteq> a" by auto
   { assume "bounded (connected_component_set (- S) z)"
     with bounded_pos_less obtain B where "B>0" and B: "\<And>x. connected_component (- S) z x \<Longrightarrow> norm x < B"
       by (metis mem_Collect_eq)
     define C where "C = (B + 1 + norm z) / norm (z-a)"
     have "C > 0"
       using \<open>0 < B\<close> zna by (simp add: C_def field_split_simps add_strict_increasing)
     have "\<bar>norm (z + C *\<^sub>R (z-a)) - norm (C *\<^sub>R (z-a))\<bar> \<le> norm z"
       by (metis add_diff_cancel norm_triangle_ineq3)
     moreover have "norm (C *\<^sub>R (z-a)) > norm z + B"
       using zna \<open>B>0\<close> by (simp add: C_def le_max_iff_disj)
     ultimately have C: "norm (z + C *\<^sub>R (z-a)) > B" by linarith
     { fix u::real
       assume u: "0\<le>u" "u\<le>1" and ins: "(1 - u) *\<^sub>R z + u *\<^sub>R (z + C *\<^sub>R (z - a)) \<in> S"
       then have Cpos: "1 + u * C > 0"
         by (meson \<open>0 < C\<close> add_pos_nonneg less_eq_real_def zero_le_mult_iff zero_less_one)
       then have *: "(1 / (1 + u * C)) *\<^sub>R z + (u * C / (1 + u * C)) *\<^sub>R z = z"
         by (simp add: scaleR_add_left [symmetric] field_split_simps)
       then have False
         using convexD_alt [OF S \<open>a \<in> S\<close> ins, of "1/(u*C + 1)"] \<open>C>0\<close> \<open>z \<notin> S\<close> Cpos u
         by (simp add: * field_split_simps)
     } note contra = this
     have "connected_component (- S) z (z + C *\<^sub>R (z-a))"
     proof (rule connected_componentI [OF connected_segment])
       show "closed_segment z (z + C *\<^sub>R (z - a)) \<subseteq> - S"
         using contra by (force simp add: closed_segment_def)
     qed auto
     then have False
       using zna B [of "z + C *\<^sub>R (z-a)"] C
       by (auto simp: field_split_simps max_mult_distrib_right)
   }
   then show ?thesis
     by (auto simp: outside_def z)
 qed
 
 lemma outside_convex:
   fixes S :: "'a :: {real_normed_vector, perfect_space} set"
   assumes "convex S"
     shows "outside S = - S"
   by (metis ComplD assms convex_in_outside equalityI inside_Un_outside subsetI sup.cobounded2)
 
 lemma outside_singleton [simp]:
   fixes x :: "'a :: {real_normed_vector, perfect_space}"
   shows "outside {x} = -{x}"
   by (auto simp: outside_convex)
 
 lemma inside_convex:
   fixes S :: "'a :: {real_normed_vector, perfect_space} set"
   shows "convex S \<Longrightarrow> inside S = {}"
   by (simp add: inside_outside outside_convex)
 
 lemma inside_singleton [simp]:
   fixes x :: "'a :: {real_normed_vector, perfect_space}"
   shows "inside {x} = {}"
   by (auto simp: inside_convex)
 
 lemma outside_subset_convex:
   fixes S :: "'a :: {real_normed_vector, perfect_space} set"
   shows "\<lbrakk>convex T; S \<subseteq> T\<rbrakk> \<Longrightarrow> - T \<subseteq> outside S"
   using outside_convex outside_mono by blast
 
 lemma outside_Un_outside_Un:
   fixes S :: "'a::real_normed_vector set"
   assumes "S \<inter> outside(T \<union> U) = {}"
   shows "outside(T \<union> U) \<subseteq> outside(T \<union> S)"
 proof
   fix x
   assume x: "x \<in> outside (T \<union> U)"
   have "Y \<subseteq> - S" if "connected Y" "Y \<subseteq> - T" "Y \<subseteq> - U" "x \<in> Y" "u \<in> Y" for u Y
   proof -
     have "Y \<subseteq> connected_component_set (- (T \<union> U)) x"
       by (simp add: connected_component_maximal that)
     also have "\<dots> \<subseteq> outside(T \<union> U)"
       by (metis (mono_tags, lifting) Collect_mono mem_Collect_eq outside outside_same_component x)
     finally have "Y \<subseteq> outside(T \<union> U)" .
     with assms show ?thesis by auto
   qed
   with x show "x \<in> outside (T \<union> S)"
     by (simp add: outside_connected_component_lt connected_component_def) meson
 qed
 
 lemma outside_frontier_misses_closure:
     fixes S :: "'a::real_normed_vector set"
     assumes "bounded S"
     shows  "outside(frontier S) \<subseteq> - closure S"
   using assms frontier_def interior_inside_frontier outside_inside by fastforce
 
 lemma outside_frontier_eq_complement_closure:
   fixes S :: "'a :: {real_normed_vector, perfect_space} set"
     assumes "bounded S" "convex S"
       shows "outside(frontier S) = - closure S"
 by (metis Diff_subset assms convex_closure frontier_def outside_frontier_misses_closure
           outside_subset_convex subset_antisym)
 
 lemma inside_frontier_eq_interior:
      fixes S :: "'a :: {real_normed_vector, perfect_space} set"
      shows "\<lbrakk>bounded S; convex S\<rbrakk> \<Longrightarrow> inside(frontier S) = interior S"
   unfolding inside_outside outside_frontier_eq_complement_closure
   using closure_subset interior_subset by (auto simp: frontier_def)
 
 lemma open_inside:
     fixes S :: "'a::real_normed_vector set"
     assumes "closed S"
       shows "open (inside S)"
 proof -
   { fix x assume x: "x \<in> inside S"
     have "open (connected_component_set (- S) x)"
       using assms open_connected_component by blast
     then obtain e where e: "e>0" and e: "\<And>y. dist y x < e \<longrightarrow> connected_component (- S) x y"
       using dist_not_less_zero
       apply (simp add: open_dist)
       by (metis (no_types, lifting) Compl_iff connected_component_refl_eq inside_def mem_Collect_eq x)
     then have "\<exists>e>0. ball x e \<subseteq> inside S"
       by (metis e dist_commute inside_same_component mem_ball subsetI x)
   }
   then show ?thesis
     by (simp add: open_contains_ball)
 qed
 
 lemma open_outside:
     fixes S :: "'a::real_normed_vector set"
     assumes "closed S"
       shows "open (outside S)"
 proof -
   { fix x assume x: "x \<in> outside S"
     have "open (connected_component_set (- S) x)"
       using assms open_connected_component by blast
     then obtain e where e: "e>0" and e: "\<And>y. dist y x < e \<longrightarrow> connected_component (- S) x y"
       using dist_not_less_zero x
       by (auto simp add: open_dist outside_def intro: connected_component_refl)
     then have "\<exists>e>0. ball x e \<subseteq> outside S"
       by (metis e dist_commute outside_same_component mem_ball subsetI x)
   }
   then show ?thesis
     by (simp add: open_contains_ball)
 qed
 
 lemma closure_inside_subset:
   fixes S :: "'a::real_normed_vector set"
   assumes "closed S"
   shows "closure(inside S) \<subseteq> S \<union> inside S"
   by (metis assms closure_minimal open_closed open_outside sup.cobounded2 union_with_inside)
 
 lemma frontier_inside_subset:
     fixes S :: "'a::real_normed_vector set"
     assumes "closed S"
       shows "frontier(inside S) \<subseteq> S"
   using assms closure_inside_subset frontier_closures frontier_disjoint_eq open_inside by fastforce
 
 lemma closure_outside_subset:
     fixes S :: "'a::real_normed_vector set"
     assumes "closed S"
       shows "closure(outside S) \<subseteq> S \<union> outside S"
   by (metis assms closed_open closure_minimal inside_outside open_inside sup_ge2)
 
 lemma closed_path_image_Un_inside:
   fixes g :: "real \<Rightarrow> 'a :: real_normed_vector"
   assumes "path g"
   shows   "closed (path_image g \<union> inside (path_image g))"
   by (simp add: assms closed_Compl closed_path_image open_outside union_with_inside)
 
 lemma frontier_outside_subset:
   fixes S :: "'a::real_normed_vector set"
   assumes "closed S"
   shows "frontier(outside S) \<subseteq> S"
   unfolding frontier_def
   by (metis Diff_subset_conv assms closure_outside_subset interior_eq open_outside sup_aci(1))
 
 lemma inside_complement_unbounded_connected_empty:
      "\<lbrakk>connected (- S); \<not> bounded (- S)\<rbrakk> \<Longrightarrow> inside S = {}"
   using inside_subset by blast
 
 lemma inside_bounded_complement_connected_empty:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "\<lbrakk>connected (- S); bounded S\<rbrakk> \<Longrightarrow> inside S = {}"
   by (metis inside_complement_unbounded_connected_empty cobounded_imp_unbounded)
 
 lemma inside_inside:
     assumes "S \<subseteq> inside T"
     shows "inside S - T \<subseteq> inside T"
 unfolding inside_def
 proof clarify
   fix x
   assume x: "x \<notin> T" "x \<notin> S" and bo: "bounded (connected_component_set (- S) x)"
   show "bounded (connected_component_set (- T) x)"
   proof (cases "S \<inter> connected_component_set (- T) x = {}")
     case True then show ?thesis
       by (metis bounded_subset [OF bo] compl_le_compl_iff connected_component_idemp connected_component_mono disjoint_eq_subset_Compl double_compl)
   next
     case False 
     then obtain y where y: "y  \<in> S" "y \<in> connected_component_set (- T) x"
       by (meson disjoint_iff)
     then have "bounded (connected_component_set (- T) y)"
       using assms [unfolded inside_def] by blast
     with y show ?thesis
       by (metis connected_component_eq)
   qed
 qed
 
 lemma inside_inside_subset: "inside(inside S) \<subseteq> S"
   using inside_inside union_with_outside by fastforce
 
 lemma inside_outside_intersect_connected:
       "\<lbrakk>connected T; inside S \<inter> T \<noteq> {}; outside S \<inter> T \<noteq> {}\<rbrakk> \<Longrightarrow> S \<inter> T \<noteq> {}"
   apply (simp add: inside_def outside_def ex_in_conv [symmetric] disjoint_eq_subset_Compl, clarify)
   by (metis compl_le_swap1 connected_componentI connected_component_eq mem_Collect_eq)
 
 lemma outside_bounded_nonempty:
   fixes S :: "'a :: {real_normed_vector, perfect_space} set"
   assumes "bounded S" shows "outside S \<noteq> {}"
   using assms unbounded_outside by force
 
 lemma outside_compact_in_open:
     fixes S :: "'a :: {real_normed_vector,perfect_space} set"
     assumes S: "compact S" and T: "open T" and "S \<subseteq> T" "T \<noteq> {}"
       shows "outside S \<inter> T \<noteq> {}"
 proof -
   have "outside S \<noteq> {}"
     by (simp add: compact_imp_bounded outside_bounded_nonempty S)
   with assms obtain a b where a: "a \<in> outside S" and b: "b \<in> T" by auto
   show ?thesis
   proof (cases "a \<in> T")
     case True with a show ?thesis by blast
   next
     case False
       have front: "frontier T \<subseteq> - S"
         using \<open>S \<subseteq> T\<close> frontier_disjoint_eq T by auto
       { fix \<gamma>
         assume "path \<gamma>" and pimg_sbs: "path_image \<gamma> - {pathfinish \<gamma>} \<subseteq> interior (- T)"
            and pf: "pathfinish \<gamma> \<in> frontier T" and ps: "pathstart \<gamma> = a"
         define c where "c = pathfinish \<gamma>"
         have "c \<in> -S" unfolding c_def using front pf by blast
         moreover have "open (-S)" using S compact_imp_closed by blast
         ultimately obtain \<epsilon>::real where "\<epsilon> > 0" and \<epsilon>: "cball c \<epsilon> \<subseteq> -S"
           using open_contains_cball[of "-S"] S by blast
         then obtain d where "d \<in> T" and d: "dist d c < \<epsilon>"
           using closure_approachable [of c T] pf unfolding c_def
           by (metis Diff_iff frontier_def)
         then have "d \<in> -S" using \<epsilon>
           using dist_commute by (metis contra_subsetD mem_cball not_le not_less_iff_gr_or_eq)
         have pimg_sbs_cos: "path_image \<gamma> \<subseteq> -S"
           using \<open>c \<in> - S\<close> \<open>S \<subseteq> T\<close> c_def interior_subset pimg_sbs by fastforce
         have "closed_segment c d \<le> cball c \<epsilon>"
           by (metis \<open>0 < \<epsilon>\<close> centre_in_cball closed_segment_subset convex_cball d dist_commute less_eq_real_def mem_cball)
         with \<epsilon> have "closed_segment c d \<subseteq> -S" by blast
         moreover have con_gcd: "connected (path_image \<gamma> \<union> closed_segment c d)"
           by (rule connected_Un) (auto simp: c_def \<open>path \<gamma>\<close> connected_path_image)
         ultimately have "connected_component (- S) a d"
           unfolding connected_component_def using pimg_sbs_cos ps by blast
         then have "outside S \<inter> T \<noteq> {}"
           using outside_same_component [OF _ a]  by (metis IntI \<open>d \<in> T\<close> empty_iff)
       } note * = this
       have pal: "pathstart (linepath a b) \<in> closure (- T)"
         by (auto simp: False closure_def)
       show ?thesis
         by (rule exists_path_subpath_to_frontier [OF path_linepath pal _ *]) (auto simp: b)
   qed
 qed
 
 lemma inside_inside_compact_connected:
     fixes S :: "'a :: euclidean_space set"
     assumes S: "closed S" and T: "compact T" and "connected T" "S \<subseteq> inside T"
       shows "inside S \<subseteq> inside T"
 proof (cases "inside T = {}")
   case True with assms show ?thesis by auto
 next
   case False
   consider "DIM('a) = 1" | "DIM('a) \<ge> 2"
     using antisym not_less_eq_eq by fastforce
   then show ?thesis
   proof cases
     case 1 then show ?thesis
              using connected_convex_1_gen assms False inside_convex by blast
   next
     case 2
     have "bounded S"
       using assms by (meson bounded_inside bounded_subset compact_imp_bounded)
     then have coms: "compact S"
       by (simp add: S compact_eq_bounded_closed)
     then have bst: "bounded (S \<union> T)"
       by (simp add: compact_imp_bounded T)
     then obtain r where "0 < r" and r: "S \<union> T \<subseteq> ball 0 r"
       using bounded_subset_ballD by blast
     have outst: "outside S \<inter> outside T \<noteq> {}"
       by (metis bounded_Un bounded_subset bst cobounded_outside disjoint_eq_subset_Compl unbounded_outside)
     have "S \<inter> T = {}" using assms
       by (metis disjoint_iff_not_equal inside_no_overlap subsetCE)
     moreover have "outside S \<inter> inside T \<noteq> {}"
       by (meson False assms(4) compact_eq_bounded_closed coms open_inside outside_compact_in_open T)
     ultimately have "inside S \<inter> T = {}"
       using inside_outside_intersect_connected [OF \<open>connected T\<close>, of S]
       by (metis "2" compact_eq_bounded_closed coms connected_outside inf.commute inside_outside_intersect_connected outst)
     then show ?thesis
       using inside_inside [OF \<open>S \<subseteq> inside T\<close>] by blast
   qed
 qed
 
 lemma connected_with_inside:
     fixes S :: "'a :: real_normed_vector set"
     assumes S: "closed S" and cons: "connected S"
       shows "connected(S \<union> inside S)"
 proof (cases "S \<union> inside S = UNIV")
   case True with assms show ?thesis by auto
 next
   case False
   then obtain b where b: "b \<notin> S" "b \<notin> inside S" by blast
   have *: "\<exists>y T. y \<in> S \<and> connected T \<and> a \<in> T \<and> y \<in> T \<and> T \<subseteq> (S \<union> inside S)" 
     if "a \<in> S \<union> inside S" for a
     using that 
   proof
     assume "a \<in> S" then show ?thesis
       using cons by blast
   next
     assume a: "a \<in> inside S"
     then have ain: "a \<in> closure (inside S)"
       by (simp add: closure_def)
     obtain h where h: "path h" "pathstart h = a" 
                    "path_image h - {pathfinish h} \<subseteq> interior (inside S)"
                    "pathfinish h \<in> frontier (inside S)"
       using ain b
       by (metis exists_path_subpath_to_frontier path_linepath pathfinish_linepath pathstart_linepath)
     moreover
     have h1S: "pathfinish h \<in> S"  
       using S h frontier_inside_subset by blast
     moreover 
     have "path_image h \<subseteq> S \<union> inside S"
       using IntD1 S h1S h interior_eq open_inside by fastforce
     ultimately show ?thesis by blast
   qed
   show ?thesis
     apply (simp add: connected_iff_connected_component)
     apply (clarsimp simp add: connected_component_def dest!: *)
     subgoal for x y u u' T t'
       by (rule_tac x = "S \<union> T \<union> t'" in exI) (auto intro!: connected_Un cons)
     done
 qed
 
 text\<open>The proof is virtually the same as that above.\<close>
 lemma connected_with_outside:
     fixes S :: "'a :: real_normed_vector set"
     assumes S: "closed S" and cons: "connected S"
       shows "connected(S \<union> outside S)"
 proof (cases "S \<union> outside S = UNIV")
   case True with assms show ?thesis by auto
 next
   case False
   then obtain b where b: "b \<notin> S" "b \<notin> outside S" by blast
   have *: "\<exists>y T. y \<in> S \<and> connected T \<and> a \<in> T \<and> y \<in> T \<and> T \<subseteq> (S \<union> outside S)" if "a \<in> (S \<union> outside S)" for a
   using that proof
     assume "a \<in> S" then show ?thesis
       by (rule_tac x=a in exI, rule_tac x="{a}" in exI, simp)
   next
     assume a: "a \<in> outside S"
     then have ain: "a \<in> closure (outside S)"
       by (simp add: closure_def)
     obtain h where h: "path h" "pathstart h = a" 
                    "path_image h - {pathfinish h} \<subseteq> interior (outside S)"
                    "pathfinish h \<in> frontier (outside S)"
       using ain b
       by (metis exists_path_subpath_to_frontier path_linepath pathfinish_linepath pathstart_linepath)
     moreover 
     have h1S: "pathfinish h \<in> S"
       using S frontier_outside_subset h(4) by blast
     moreover 
     have "path_image h \<subseteq> S \<union> outside S"
       using IntD1 S h1S h interior_eq open_outside by fastforce
     ultimately show ?thesis
       by blast
   qed
   show ?thesis
     apply (simp add: connected_iff_connected_component)
     apply (clarsimp simp add: connected_component_def dest!: *)
     subgoal for x y u u' T t'
       by (rule_tac x="(S \<union> T \<union> t')" in exI) (auto intro!: connected_Un cons)
     done
 qed
 
 lemma inside_inside_eq_empty [simp]:
     fixes S :: "'a :: {real_normed_vector, perfect_space} set"
     assumes S: "closed S" and cons: "connected S"
     shows "inside (inside S) = {}"
 proof -
   have "connected (- inside S)"
     by (metis S connected_with_outside cons union_with_outside)
   then show ?thesis
     by (metis bounded_Un inside_complement_unbounded_connected_empty unbounded_outside union_with_outside)
 qed
 
 lemma inside_in_components:
      "inside S \<in> components (- S) \<longleftrightarrow> connected(inside S) \<and> inside S \<noteq> {}" (is "?lhs = ?rhs")
 proof 
   assume R: ?rhs
   then have "\<And>x. \<lbrakk>x \<in> S; x \<in> inside S\<rbrakk> \<Longrightarrow> \<not> connected (inside S)"
     by (simp add: inside_outside)
   with R show ?lhs
     unfolding in_components_maximal
     by (auto intro: inside_same_component connected_componentI)
 qed (simp add: in_components_maximal)
 
 text\<open>The proof is like that above.\<close>
 lemma outside_in_components:
      "outside S \<in> components (- S) \<longleftrightarrow> connected(outside S) \<and> outside S \<noteq> {}" (is "?lhs = ?rhs")
 proof 
   assume R: ?rhs
   then have "\<And>x. \<lbrakk>x \<in> S; x \<in> outside S\<rbrakk> \<Longrightarrow> \<not> connected (outside S)"
     by (meson disjoint_iff outside_no_overlap)
   with R show ?lhs
     unfolding in_components_maximal
     by (auto intro: outside_same_component connected_componentI)
 qed (simp add: in_components_maximal)
 
 lemma bounded_unique_outside:
   fixes S :: "'a :: euclidean_space set"
   assumes "bounded S" "DIM('a) \<ge> 2"
   shows "(c \<in> components (- S) \<and> \<not> bounded c) \<longleftrightarrow> c = outside S" 
   using assms
   by (metis cobounded_unique_unbounded_components connected_outside double_compl outside_bounded_nonempty
       outside_in_components unbounded_outside)
 
 
 subsection\<open>Condition for an open map's image to contain a ball\<close>
 
 proposition ball_subset_open_map_image:
   fixes f :: "'a::heine_borel \<Rightarrow> 'b :: {real_normed_vector,heine_borel}"
   assumes contf: "continuous_on (closure S) f"
       and oint: "open (f ` interior S)"
       and le_no: "\<And>z. z \<in> frontier S \<Longrightarrow> r \<le> norm(f z - f a)"
       and "bounded S" "a \<in> S" "0 < r"
     shows "ball (f a) r \<subseteq> f ` S"
 proof (cases "f ` S = UNIV")
   case True then show ?thesis by simp
 next
   case False
   then have "closed (frontier (f ` S))" "frontier (f ` S) \<noteq> {}"
     using \<open>a \<in> S\<close> by (auto simp: frontier_eq_empty)
   then obtain w where w: "w \<in> frontier (f ` S)"
     and dw_le: "\<And>y. y \<in> frontier (f ` S) \<Longrightarrow> norm (f a - w) \<le> norm (f a - y)"
     by (auto simp add: dist_norm intro: distance_attains_inf [of "frontier(f ` S)" "f a"])
   then obtain \<xi> where \<xi>: "\<And>n. \<xi> n \<in> f ` S" and tendsw: "\<xi> \<longlonglongrightarrow> w"
     by (metis Diff_iff frontier_def closure_sequential)
     then have "\<And>n. \<exists>x \<in> S. \<xi> n = f x" by force
     then obtain z where zs: "\<And>n. z n \<in> S" and fz: "\<And>n. \<xi> n = f (z n)"
       by metis
     then obtain y K where y: "y \<in> closure S" and "strict_mono (K :: nat \<Rightarrow> nat)" 
                       and Klim: "(z \<circ> K) \<longlonglongrightarrow> y"
       using \<open>bounded S\<close>
       unfolding compact_closure [symmetric] compact_def by (meson closure_subset subset_iff)
     then have ftendsw: "((\<lambda>n. f (z n)) \<circ> K) \<longlonglongrightarrow> w"
       by (metis LIMSEQ_subseq_LIMSEQ fun.map_cong0 fz tendsw)
     have zKs: "\<And>n. (z \<circ> K) n \<in> S" by (simp add: zs)
     have fz: "f \<circ> z = \<xi>"  "(\<lambda>n. f (z n)) = \<xi>"
       using fz by auto
     then have "(\<xi> \<circ> K) \<longlonglongrightarrow> f y"
       by (metis (no_types) Klim zKs y contf comp_assoc continuous_on_closure_sequentially)
     with fz have wy: "w = f y" using fz LIMSEQ_unique ftendsw by auto
     have "r \<le> norm (f y - f a)"
     proof (rule le_no)
       show "y \<in> frontier S"
         using w wy oint by (force simp: imageI image_mono interiorI interior_subset frontier_def y)
     qed
     then have "\<And>y. \<lbrakk>norm (f a - y) < r; y \<in> frontier (f ` S)\<rbrakk> \<Longrightarrow> False"
       by (metis dw_le norm_minus_commute not_less order_trans wy)
     then have "ball (f a) r \<inter> frontier (f ` S) = {}"
       by (metis disjoint_iff_not_equal dist_norm mem_ball)
     moreover
     have "ball (f a) r \<inter> f ` S \<noteq> {}"
       using \<open>a \<in> S\<close> \<open>0 < r\<close> centre_in_ball by blast
     ultimately show ?thesis
       by (meson connected_Int_frontier connected_ball diff_shunt_var)
 qed
 
 
 subsubsection\<open>Special characterizations of classes of functions into and out of R.\<close>
 
 lemma Hausdorff_space_euclidean [simp]: "Hausdorff_space (euclidean :: 'a::metric_space topology)"
 proof -
   have "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> disjnt U V"
     if "x \<noteq> y" for x y :: 'a
   proof (intro exI conjI)
     let ?r = "dist x y / 2"
     have [simp]: "?r > 0"
       by (simp add: that)
     show "open (ball x ?r)" "open (ball y ?r)" "x \<in> (ball x ?r)" "y \<in> (ball y ?r)"
       by (auto simp add: that)
     show "disjnt (ball x ?r) (ball y ?r)"
       unfolding disjnt_def by (simp add: disjoint_ballI)
   qed
   then show ?thesis
     by (simp add: Hausdorff_space_def)
 qed
 
 proposition embedding_map_into_euclideanreal:
   assumes "path_connected_space X"
   shows "embedding_map X euclideanreal f \<longleftrightarrow>
          continuous_map X euclideanreal f \<and> inj_on f (topspace X)"
   proof safe
   show "continuous_map X euclideanreal f"
     if "embedding_map X euclideanreal f"
     using continuous_map_in_subtopology homeomorphic_imp_continuous_map that
     unfolding embedding_map_def by blast
   show "inj_on f (topspace X)"
     if "embedding_map X euclideanreal f"
     using that homeomorphic_imp_injective_map
     unfolding embedding_map_def by blast
   show "embedding_map X euclideanreal f"
     if cont: "continuous_map X euclideanreal f" and inj: "inj_on f (topspace X)"
   proof -
     obtain g where gf: "\<And>x. x \<in> topspace X \<Longrightarrow> g (f x) = x"
       using inv_into_f_f [OF inj] by auto
     show ?thesis
       unfolding embedding_map_def homeomorphic_map_maps homeomorphic_maps_def
     proof (intro exI conjI)
       show "continuous_map X (top_of_set (f ` topspace X)) f"
         by (simp add: cont continuous_map_in_subtopology)
       let ?S = "f ` topspace X"
       have eq: "{x \<in> ?S. g x \<in> U} = f ` U" if "openin X U" for U
         using openin_subset [OF that] by (auto simp: gf)
       have 1: "g ` ?S \<subseteq> topspace X"
         using eq by blast
       have "openin (top_of_set ?S) {x \<in> ?S. g x \<in> T}"
         if "openin X T" for T
       proof -
         have "T \<subseteq> topspace X"
           by (simp add: openin_subset that)
         have RR: "\<forall>x \<in> ?S \<inter> g -` T. \<exists>d>0. \<forall>x' \<in> ?S \<inter> ball x d. g x' \<in> T"
         proof (clarsimp simp add: gf)
           have pcS: "path_connectedin euclidean ?S"
             using assms cont path_connectedin_continuous_map_image path_connectedin_topspace by blast
           show "\<exists>d>0. \<forall>x'\<in>f ` topspace X \<inter> ball (f x) d. g x' \<in> T"
             if "x \<in> T" for x
           proof -
             have x: "x \<in> topspace X"
               using \<open>T \<subseteq> topspace X\<close> \<open>x \<in> T\<close> by blast
             obtain u v d where "0 < d" "u \<in> topspace X" "v \<in> topspace X"
                          and sub_fuv: "?S \<inter> {f x - d .. f x + d} \<subseteq> {f u..f v}"
             proof (cases "\<exists>u \<in> topspace X. f u < f x")
               case True
               then obtain u where u: "u \<in> topspace X" "f u < f x" ..
               show ?thesis
               proof (cases "\<exists>v \<in> topspace X. f x < f v")
                 case True
                 then obtain v where v: "v \<in> topspace X" "f x < f v" ..
                 show ?thesis
                 proof
                   let ?d = "min (f x - f u) (f v - f x)"
                   show "0 < ?d"
                     by (simp add: \<open>f u < f x\<close> \<open>f x < f v\<close>)
                   show "f ` topspace X \<inter> {f x - ?d..f x + ?d} \<subseteq> {f u..f v}"
                     by fastforce
                 qed (auto simp: u v)
               next
                 case False
                 show ?thesis
                 proof
                   let ?d = "f x - f u"
                   show "0 < ?d"
                     by (simp add: u)
                   show "f ` topspace X \<inter> {f x - ?d..f x + ?d} \<subseteq> {f u..f x}"
                     using x u False by auto
                 qed (auto simp: x u)
               qed
             next
               case False
               note no_u = False
               show ?thesis
               proof (cases "\<exists>v \<in> topspace X. f x < f v")
                 case True
                 then obtain v where v: "v \<in> topspace X" "f x < f v" ..
                 show ?thesis
                 proof
                   let ?d = "f v - f x"
                   show "0 < ?d"
                     by (simp add: v)
                   show "f ` topspace X \<inter> {f x - ?d..f x + ?d} \<subseteq> {f x..f v}"
                     using False by auto
                 qed (auto simp: x v)
               next
                 case False
                 show ?thesis
                 proof
                   show "f ` topspace X \<inter> {f x - 1..f x + 1} \<subseteq> {f x..f x}"
                     using False no_u by fastforce
                 qed (auto simp: x)
               qed
             qed
             then obtain h where "pathin X h" "h 0 = u" "h 1 = v"
               using assms unfolding path_connected_space_def by blast
             obtain C where "compactin X C" "connectedin X C" "u \<in> C" "v \<in> C"
             proof
               show "compactin X (h ` {0..1})"
                 using that by (simp add: \<open>pathin X h\<close> compactin_path_image)
               show "connectedin X (h ` {0..1})"
                 using \<open>pathin X h\<close> connectedin_path_image by blast
             qed (use \<open>h 0 = u\<close> \<open>h 1 = v\<close> in auto)
             have "continuous_map (subtopology euclideanreal (?S \<inter> {f x - d .. f x + d})) (subtopology X C) g"
             proof (rule continuous_inverse_map)
               show "compact_space (subtopology X C)"
                 using \<open>compactin X C\<close> compactin_subspace by blast
               show "continuous_map (subtopology X C) euclideanreal f"
                 by (simp add: cont continuous_map_from_subtopology)
               have "{f u .. f v} \<subseteq> f ` topspace (subtopology X C)"
               proof (rule connected_contains_Icc)
                 show "connected (f ` topspace (subtopology X C))"
                   using connectedin_continuous_map_image [OF cont]
                   by (simp add: \<open>compactin X C\<close> \<open>connectedin X C\<close> compactin_subset_topspace inf_absorb2)
                 show "f u \<in> f ` topspace (subtopology X C)"
                   by (simp add: \<open>u \<in> C\<close> \<open>u \<in> topspace X\<close>)
                 show "f v \<in> f ` topspace (subtopology X C)"
                   by (simp add: \<open>v \<in> C\<close> \<open>v \<in> topspace X\<close>)
               qed
               then show "f ` topspace X \<inter> {f x - d..f x + d} \<subseteq> f ` topspace (subtopology X C)"
                 using sub_fuv by blast
             qed (auto simp: gf)
             then have contg: "continuous_map (subtopology euclideanreal (?S \<inter> {f x - d .. f x + d})) X g"
               using continuous_map_in_subtopology by blast
             have "\<exists>e>0. \<forall>x \<in> ?S \<inter> {f x - d .. f x + d} \<inter> ball (f x) e. g x \<in> T"
               using openin_continuous_map_preimage [OF contg \<open>openin X T\<close>] x \<open>x \<in> T\<close> \<open>0 < d\<close>
               unfolding openin_euclidean_subtopology_iff
               by (force simp: gf dist_commute)
             then obtain e where "e > 0 \<and> (\<forall>x\<in>f ` topspace X \<inter> {f x - d..f x + d} \<inter> ball (f x) e. g x \<in> T)"
               by metis
             with \<open>0 < d\<close> have "min d e > 0" "\<forall>u. u \<in> topspace X \<longrightarrow> \<bar>f x - f u\<bar> < min d e \<longrightarrow> u \<in> T"
               using dist_real_def gf by force+
             then show ?thesis
               by (metis (full_types) Int_iff dist_real_def image_iff mem_ball gf)
           qed
         qed
         then obtain d where d: "\<And>r. r \<in> ?S \<inter> g -` T \<Longrightarrow>
                 d r > 0 \<and> (\<forall>x \<in> ?S \<inter> ball r (d r). g x \<in> T)"
           by metis
         show ?thesis
           unfolding openin_subtopology
         proof (intro exI conjI)
           show "{x \<in> ?S. g x \<in> T} = (\<Union>r \<in> ?S \<inter> g -` T. ball r (d r)) \<inter> f ` topspace X"
             using d by (auto simp: gf)
         qed auto
       qed
       then show "continuous_map (top_of_set ?S) X g"
         by (simp add: "1" continuous_map)
     qed (auto simp: gf)
   qed
 qed
 
 subsubsection \<open>An injective function into R is a homeomorphism and so an open map.\<close>
 
 lemma injective_into_1d_eq_homeomorphism:
   fixes f :: "'a::topological_space \<Rightarrow> real"
   assumes f: "continuous_on S f" and S: "path_connected S"
   shows "inj_on f S \<longleftrightarrow> (\<exists>g. homeomorphism S (f ` S) f g)"
 proof
   show "\<exists>g. homeomorphism S (f ` S) f g"
     if "inj_on f S"
   proof -
     have "embedding_map (top_of_set S) euclideanreal f"
       using that embedding_map_into_euclideanreal [of "top_of_set S" f] assms by auto
     then show ?thesis
       unfolding embedding_map_def topspace_euclidean_subtopology
       by (metis f homeomorphic_map_closedness_eq homeomorphism_injective_closed_map that)
   qed
 qed (metis homeomorphism_def inj_onI)
 
 lemma injective_into_1d_imp_open_map:
   fixes f :: "'a::topological_space \<Rightarrow> real"
   assumes "continuous_on S f" "path_connected S" "inj_on f S" "openin (subtopology euclidean S) T"
   shows "openin (subtopology euclidean (f ` S)) (f ` T)"
   using assms homeomorphism_imp_open_map injective_into_1d_eq_homeomorphism by blast
 
 lemma homeomorphism_into_1d:
   fixes f :: "'a::topological_space \<Rightarrow> real"
   assumes "path_connected S" "continuous_on S f" "f ` S = T" "inj_on f S"
   shows "\<exists>g. homeomorphism S T f g"
   using assms injective_into_1d_eq_homeomorphism by blast
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Rectangular paths\<close>
 
 definition\<^marker>\<open>tag unimportant\<close> rectpath where
   "rectpath a1 a3 = (let a2 = Complex (Re a3) (Im a1); a4 = Complex (Re a1) (Im a3)
                       in linepath a1 a2 +++ linepath a2 a3 +++ linepath a3 a4 +++ linepath a4 a1)"
 
 lemma path_rectpath [simp, intro]: "path (rectpath a b)"
   by (simp add: Let_def rectpath_def)
 
 lemma pathstart_rectpath [simp]: "pathstart (rectpath a1 a3) = a1"
   by (simp add: rectpath_def Let_def)
 
 lemma pathfinish_rectpath [simp]: "pathfinish (rectpath a1 a3) = a1"
   by (simp add: rectpath_def Let_def)
 
 lemma simple_path_rectpath [simp, intro]:
   assumes "Re a1 \<noteq> Re a3" "Im a1 \<noteq> Im a3"
   shows   "simple_path (rectpath a1 a3)"
   unfolding rectpath_def Let_def using assms
   by (intro simple_path_join_loop arc_join arc_linepath)
      (auto simp: complex_eq_iff path_image_join closed_segment_same_Re closed_segment_same_Im)
 
 lemma path_image_rectpath:
   assumes "Re a1 \<le> Re a3" "Im a1 \<le> Im a3"
   shows "path_image (rectpath a1 a3) =
            {z. Re z \<in> {Re a1, Re a3} \<and> Im z \<in> {Im a1..Im a3}} \<union>
            {z. Im z \<in> {Im a1, Im a3} \<and> Re z \<in> {Re a1..Re a3}}" (is "?lhs = ?rhs")
 proof -
   define a2 a4 where "a2 = Complex (Re a3) (Im a1)" and "a4 = Complex (Re a1) (Im a3)"
   have "?lhs = closed_segment a1 a2 \<union> closed_segment a2 a3 \<union>
                   closed_segment a4 a3 \<union> closed_segment a1 a4"
     by (simp_all add: rectpath_def Let_def path_image_join closed_segment_commute
                       a2_def a4_def Un_assoc)
   also have "\<dots> = ?rhs" using assms
     by (auto simp: rectpath_def Let_def path_image_join a2_def a4_def
           closed_segment_same_Re closed_segment_same_Im closed_segment_eq_real_ivl)
   finally show ?thesis .
 qed
 
 lemma path_image_rectpath_subset_cbox:
   assumes "Re a \<le> Re b" "Im a \<le> Im b"
   shows   "path_image (rectpath a b) \<subseteq> cbox a b"
   using assms by (auto simp: path_image_rectpath in_cbox_complex_iff)
 
 lemma path_image_rectpath_inter_box:
   assumes "Re a \<le> Re b" "Im a \<le> Im b"
   shows   "path_image (rectpath a b) \<inter> box a b = {}"
   using assms by (auto simp: path_image_rectpath in_box_complex_iff)
 
 lemma path_image_rectpath_cbox_minus_box:
   assumes "Re a \<le> Re b" "Im a \<le> Im b"
   shows   "path_image (rectpath a b) = cbox a b - box a b"
   using assms by (auto simp: path_image_rectpath in_cbox_complex_iff in_box_complex_iff)
 
 end
diff --git a/src/HOL/Analysis/Smooth_Paths.thy b/src/HOL/Analysis/Smooth_Paths.thy
--- a/src/HOL/Analysis/Smooth_Paths.thy
+++ b/src/HOL/Analysis/Smooth_Paths.thy
@@ -1,442 +1,534 @@
 (*
   Material originally from HOL Light, ported by Larry Paulson, moved here by Manuel Eberl
 *)
 section\<^marker>\<open>tag unimportant\<close> \<open>Smooth paths\<close>
 theory Smooth_Paths
-  imports
-  Retracts
+  imports Retracts
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Homeomorphisms of arc images\<close>
 
 lemma path_connected_arc_complement:
   fixes \<gamma> :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "arc \<gamma>" "2 \<le> DIM('a)"
   shows "path_connected(- path_image \<gamma>)"
 proof -
   have "path_image \<gamma> homeomorphic {0..1::real}"
     by (simp add: assms homeomorphic_arc_image_interval)
   then show ?thesis
     by (intro path_connected_complement_homeomorphic_convex_compact) (auto simp: assms)
 qed
 
 lemma connected_arc_complement:
   fixes \<gamma> :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "arc \<gamma>" "2 \<le> DIM('a)"
   shows "connected(- path_image \<gamma>)"
   by (simp add: assms path_connected_arc_complement path_connected_imp_connected)
 
 lemma inside_arc_empty:
   fixes \<gamma> :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "arc \<gamma>"
     shows "inside(path_image \<gamma>) = {}"
 proof (cases "DIM('a) = 1")
   case True
   then show ?thesis
     using assms connected_arc_image connected_convex_1_gen inside_convex by blast
 next
   case False
   then have "connected (- path_image \<gamma>)"
       by (metis DIM_ge_Suc0 One_nat_def Suc_1 antisym assms connected_arc_complement not_less_eq_eq)
     then
   show ?thesis
     by (simp add: assms bounded_arc_image inside_bounded_complement_connected_empty)
 qed
 
 lemma inside_simple_curve_imp_closed:
   fixes \<gamma> :: "real \<Rightarrow> 'a::euclidean_space"
     shows "\<lbrakk>simple_path \<gamma>; x \<in> inside(path_image \<gamma>)\<rbrakk> \<Longrightarrow> pathfinish \<gamma> = pathstart \<gamma>"
   using arc_simple_path  inside_arc_empty by blast
 
 
 subsection \<open>Piecewise differentiability of paths\<close>
 
 lemma continuous_on_joinpaths_D1:
   assumes "continuous_on {0..1} (g1 +++ g2)"
   shows "continuous_on {0..1} g1"
 proof (rule continuous_on_eq)
   have "continuous_on {0..1/2} (g1 +++ g2)"
     using assms continuous_on_subset split_01 by auto
   then show "continuous_on {0..1} (g1 +++ g2 \<circ> (*) (inverse 2))"
     by (intro continuous_intros) force
 qed (auto simp: joinpaths_def)
 
 lemma continuous_on_joinpaths_D2:
     "\<lbrakk>continuous_on {0..1} (g1 +++ g2); pathfinish g1 = pathstart g2\<rbrakk> \<Longrightarrow> continuous_on {0..1} g2"
   using path_def path_join by blast
 
 lemma piecewise_differentiable_D1:
   assumes "(g1 +++ g2) piecewise_differentiable_on {0..1}"
   shows "g1 piecewise_differentiable_on {0..1}"
 proof -
   obtain S where cont: "continuous_on {0..1} g1" and "finite S"
     and S: "\<And>x. x \<in> {0..1} - S \<Longrightarrow> g1 +++ g2 differentiable at x within {0..1}"
     using assms unfolding piecewise_differentiable_on_def
     by (blast dest!: continuous_on_joinpaths_D1)
   show ?thesis
     unfolding piecewise_differentiable_on_def
   proof (intro exI conjI ballI cont)
     show "finite (insert 1 (((*)2) ` S))"
       by (simp add: \<open>finite S\<close>)
     show "g1 differentiable at x within {0..1}" if "x \<in> {0..1} - insert 1 ((*) 2 ` S)" for x
     proof (rule_tac d="dist (x/2) (1/2)" in differentiable_transform_within)
       have "g1 +++ g2 differentiable at (x / 2) within {0..1/2}"
         by (rule differentiable_subset [OF S [of "x/2"]] | use that in force)+
       then show "g1 +++ g2 \<circ> (*) (inverse 2) differentiable at x within {0..1}"
         using image_affinity_atLeastAtMost_div [of 2 0 "0::real" 1]
         by (auto intro: differentiable_chain_within)
     qed (use that in \<open>auto simp: joinpaths_def\<close>)
   qed
 qed
 
 lemma piecewise_differentiable_D2:
   assumes "(g1 +++ g2) piecewise_differentiable_on {0..1}" and eq: "pathfinish g1 = pathstart g2"
   shows "g2 piecewise_differentiable_on {0..1}"
 proof -
   have [simp]: "g1 1 = g2 0"
     using eq by (simp add: pathfinish_def pathstart_def)
   obtain S where cont: "continuous_on {0..1} g2" and "finite S"
     and S: "\<And>x. x \<in> {0..1} - S \<Longrightarrow> g1 +++ g2 differentiable at x within {0..1}"
     using assms unfolding piecewise_differentiable_on_def
     by (blast dest!: continuous_on_joinpaths_D2)
   show ?thesis
     unfolding piecewise_differentiable_on_def
   proof (intro exI conjI ballI cont)
     show "finite (insert 0 ((\<lambda>x. 2*x-1)`S))"
       by (simp add: \<open>finite S\<close>)
     show "g2 differentiable at x within {0..1}" if "x \<in> {0..1} - insert 0 ((\<lambda>x. 2*x-1)`S)" for x
     proof (rule_tac d="dist ((x+1)/2) (1/2)" in differentiable_transform_within)
       have x2: "(x + 1) / 2 \<notin> S"
         using that
         apply (clarsimp simp: image_iff)
         by (metis add.commute add_diff_cancel_left' mult_2 field_sum_of_halves)
       have "g1 +++ g2 \<circ> (\<lambda>x. (x+1) / 2) differentiable at x within {0..1}"
         by (rule differentiable_chain_within differentiable_subset [OF S [of "(x+1)/2"]] | use x2 that in force)+
       then show "g1 +++ g2 \<circ> (\<lambda>x. (x+1) / 2) differentiable at x within {0..1}"
         by (auto intro: differentiable_chain_within)
       show "(g1 +++ g2 \<circ> (\<lambda>x. (x + 1) / 2)) x' = g2 x'" if "x' \<in> {0..1}" "dist x' x < dist ((x + 1) / 2) (1/2)" for x'
       proof -
         have [simp]: "(2*x'+2)/2 = x'+1"
           by (simp add: field_split_simps)
         show ?thesis
           using that by (auto simp: joinpaths_def)
       qed
     qed (use that in \<open>auto simp: joinpaths_def\<close>)
   qed
 qed
 
 lemma piecewise_C1_differentiable_D1:
   fixes g1 :: "real \<Rightarrow> 'a::real_normed_field"
   assumes "(g1 +++ g2) piecewise_C1_differentiable_on {0..1}"
     shows "g1 piecewise_C1_differentiable_on {0..1}"
 proof -
   obtain S where "finite S"
              and co12: "continuous_on ({0..1} - S) (\<lambda>x. vector_derivative (g1 +++ g2) (at x))"
              and g12D: "\<forall>x\<in>{0..1} - S. g1 +++ g2 differentiable at x"
     using assms  by (auto simp: piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have g1D: "g1 differentiable at x" if "x \<in> {0..1} - insert 1 ((*) 2 ` S)" for x
   proof (rule differentiable_transform_within)
     show "g1 +++ g2 \<circ> (*) (inverse 2) differentiable at x"
       using that g12D
       unfolding joinpaths_def
       by (intro differentiable_chain_at derivative_intros | force)+
     show "\<And>x'. \<lbrakk>dist x' x < dist (x/2) (1/2)\<rbrakk>
           \<Longrightarrow> (g1 +++ g2 \<circ> (*) (inverse 2)) x' = g1 x'"
       using that by (auto simp: dist_real_def joinpaths_def)
   qed (use that in \<open>auto simp: dist_real_def\<close>)
   have [simp]: "vector_derivative (g1 \<circ> (*) 2) (at (x/2)) = 2 *\<^sub>R vector_derivative g1 (at x)"
                if "x \<in> {0..1} - insert 1 ((*) 2 ` S)" for x
     apply (subst vector_derivative_chain_at)
     using that
     apply (rule derivative_eq_intros g1D | simp)+
     done
   have "continuous_on ({0..1/2} - insert (1/2) S) (\<lambda>x. vector_derivative (g1 +++ g2) (at x))"
     using co12 by (rule continuous_on_subset) force
   then have coDhalf: "continuous_on ({0..1/2} - insert (1/2) S) (\<lambda>x. vector_derivative (g1 \<circ> (*)2) (at x))"
   proof (rule continuous_on_eq [OF _ vector_derivative_at])
     show "(g1 +++ g2 has_vector_derivative vector_derivative (g1 \<circ> (*) 2) (at x)) (at x)"
       if "x \<in> {0..1/2} - insert (1/2) S" for x
     proof (rule has_vector_derivative_transform_within)
       show "(g1 \<circ> (*) 2 has_vector_derivative vector_derivative (g1 \<circ> (*) 2) (at x)) (at x)"
         using that
         by (force intro: g1D differentiable_chain_at simp: vector_derivative_works [symmetric])
       show "\<And>x'. \<lbrakk>dist x' x < dist x (1/2)\<rbrakk> \<Longrightarrow> (g1 \<circ> (*) 2) x' = (g1 +++ g2) x'"
         using that by (auto simp: dist_norm joinpaths_def)
     qed (use that in \<open>auto simp: dist_norm\<close>)
   qed
   have "continuous_on ({0..1} - insert 1 ((*) 2 ` S))
                       ((\<lambda>x. 1/2 * vector_derivative (g1 \<circ> (*)2) (at x)) \<circ> (*)(1/2))"
     using coDhalf
     apply (intro continuous_intros)
     by (simp add: scaleR_conv_of_real image_set_diff image_image)
   then have con_g1: "continuous_on ({0..1} - insert 1 ((*) 2 ` S)) (\<lambda>x. vector_derivative g1 (at x))"
     by (rule continuous_on_eq) (simp add: scaleR_conv_of_real)
   have "continuous_on {0..1} g1"
     using continuous_on_joinpaths_D1 assms piecewise_C1_differentiable_on_def by blast
   with \<open>finite S\<close> show ?thesis
     apply (clarsimp simp add: piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
     apply (rule_tac x="insert 1 (((*)2)`S)" in exI)
     apply (simp add: g1D con_g1)
   done
 qed
 
 lemma piecewise_C1_differentiable_D2:
   fixes g2 :: "real \<Rightarrow> 'a::real_normed_field"
   assumes "(g1 +++ g2) piecewise_C1_differentiable_on {0..1}" "pathfinish g1 = pathstart g2"
     shows "g2 piecewise_C1_differentiable_on {0..1}"
 proof -
   obtain S where "finite S"
              and co12: "continuous_on ({0..1} - S) (\<lambda>x. vector_derivative (g1 +++ g2) (at x))"
              and g12D: "\<forall>x\<in>{0..1} - S. g1 +++ g2 differentiable at x"
     using assms  by (auto simp: piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have g2D: "g2 differentiable at x" if "x \<in> {0..1} - insert 0 ((\<lambda>x. 2*x-1) ` S)" for x
   proof (rule differentiable_transform_within)
     show "g1 +++ g2 \<circ> (\<lambda>x. (x + 1) / 2) differentiable at x"
       using g12D that
       unfolding joinpaths_def
       apply (drule_tac x= "(x+1) / 2" in bspec, force simp: field_split_simps)
       apply (rule differentiable_chain_at derivative_intros | force)+
       done
     show "\<And>x'. dist x' x < dist ((x + 1) / 2) (1/2) \<Longrightarrow> (g1 +++ g2 \<circ> (\<lambda>x. (x + 1) / 2)) x' = g2 x'"
       using that by (auto simp: dist_real_def joinpaths_def field_simps)
     qed (use that in \<open>auto simp: dist_norm\<close>)
   have [simp]: "vector_derivative (g2 \<circ> (\<lambda>x. 2*x-1)) (at ((x+1)/2)) = 2 *\<^sub>R vector_derivative g2 (at x)"
                if "x \<in> {0..1} - insert 0 ((\<lambda>x. 2*x-1) ` S)" for x
     using that  by (auto simp: vector_derivative_chain_at field_split_simps g2D)
   have "continuous_on ({1/2..1} - insert (1/2) S) (\<lambda>x. vector_derivative (g1 +++ g2) (at x))"
     using co12 by (rule continuous_on_subset) force
   then have coDhalf: "continuous_on ({1/2..1} - insert (1/2) S) (\<lambda>x. vector_derivative (g2 \<circ> (\<lambda>x. 2*x-1)) (at x))"
   proof (rule continuous_on_eq [OF _ vector_derivative_at])
     show "(g1 +++ g2 has_vector_derivative vector_derivative (g2 \<circ> (\<lambda>x. 2 * x - 1)) (at x))
           (at x)"
       if "x \<in> {1 / 2..1} - insert (1 / 2) S" for x
     proof (rule_tac f="g2 \<circ> (\<lambda>x. 2*x-1)" and d="dist (3/4) ((x+1)/2)" in has_vector_derivative_transform_within)
       show "(g2 \<circ> (\<lambda>x. 2 * x - 1) has_vector_derivative vector_derivative (g2 \<circ> (\<lambda>x. 2 * x - 1)) (at x))
             (at x)"
         using that by (force intro: g2D differentiable_chain_at simp: vector_derivative_works [symmetric])
       show "\<And>x'. \<lbrakk>dist x' x < dist (3 / 4) ((x + 1) / 2)\<rbrakk> \<Longrightarrow> (g2 \<circ> (\<lambda>x. 2 * x - 1)) x' = (g1 +++ g2) x'"
         using that by (auto simp: dist_norm joinpaths_def add_divide_distrib)
     qed (use that in \<open>auto simp: dist_norm\<close>)
   qed
   have [simp]: "((\<lambda>x. (x+1) / 2) ` ({0..1} - insert 0 ((\<lambda>x. 2 * x - 1) ` S))) = ({1/2..1} - insert (1/2) S)"
     apply (simp add: image_set_diff inj_on_def image_image)
     apply (auto simp: image_affinity_atLeastAtMost_div add_divide_distrib)
     done
   have "continuous_on ({0..1} - insert 0 ((\<lambda>x. 2*x-1) ` S))
                       ((\<lambda>x. 1/2 * vector_derivative (g2 \<circ> (\<lambda>x. 2*x-1)) (at x)) \<circ> (\<lambda>x. (x+1)/2))"
     by (rule continuous_intros | simp add:  coDhalf)+
   then have con_g2: "continuous_on ({0..1} - insert 0 ((\<lambda>x. 2*x-1) ` S)) (\<lambda>x. vector_derivative g2 (at x))"
     by (rule continuous_on_eq) (simp add: scaleR_conv_of_real)
   have "continuous_on {0..1} g2"
     using continuous_on_joinpaths_D2 assms piecewise_C1_differentiable_on_def by blast
   with \<open>finite S\<close> show ?thesis
     by (meson C1_differentiable_on_eq con_g2 finite_imageI finite_insert g2D piecewise_C1_differentiable_on_def)
 qed
 
 
 subsection \<open>Valid paths, and their start and finish\<close>
 
 definition\<^marker>\<open>tag important\<close> valid_path :: "(real \<Rightarrow> 'a :: real_normed_vector) \<Rightarrow> bool"
   where "valid_path f \<equiv> f piecewise_C1_differentiable_on {0..1::real}"
 
 definition closed_path :: "(real \<Rightarrow> 'a :: real_normed_vector) \<Rightarrow> bool"
   where "closed_path g \<equiv> g 0 = g 1"
 
 text\<open>In particular, all results for paths apply\<close>
 
 lemma valid_path_imp_path: "valid_path g \<Longrightarrow> path g"
   by (simp add: path_def piecewise_C1_differentiable_on_def valid_path_def)
 
 lemma connected_valid_path_image: "valid_path g \<Longrightarrow> connected(path_image g)"
   by (metis connected_path_image valid_path_imp_path)
 
 lemma compact_valid_path_image: "valid_path g \<Longrightarrow> compact(path_image g)"
   by (metis compact_path_image valid_path_imp_path)
 
 lemma bounded_valid_path_image: "valid_path g \<Longrightarrow> bounded(path_image g)"
   by (metis bounded_path_image valid_path_imp_path)
 
 lemma closed_valid_path_image: "valid_path g \<Longrightarrow> closed(path_image g)"
   by (metis closed_path_image valid_path_imp_path)
 
 lemma valid_path_translation_eq: "valid_path ((+)d \<circ> p) \<longleftrightarrow> valid_path p"
   by (simp add: valid_path_def piecewise_C1_differentiable_on_translation_eq)
  
 lemma valid_path_compose:
   assumes "valid_path g"
       and der: "\<And>x. x \<in> path_image g \<Longrightarrow> f field_differentiable (at x)"
       and con: "continuous_on (path_image g) (deriv f)"
     shows "valid_path (f \<circ> g)"
 proof -
   obtain S where "finite S" and g_diff: "g C1_differentiable_on {0..1} - S"
     using \<open>valid_path g\<close> unfolding valid_path_def piecewise_C1_differentiable_on_def by auto
   have "f \<circ> g differentiable at t" when "t\<in>{0..1} - S" for t
     proof (rule differentiable_chain_at)
       show "g differentiable at t" using \<open>valid_path g\<close>
         by (meson C1_differentiable_on_eq \<open>g C1_differentiable_on {0..1} - S\<close> that)
     next
       have "g t\<in>path_image g" using that DiffD1 image_eqI path_image_def by metis
       then show "f differentiable at (g t)"
         using der[THEN field_differentiable_imp_differentiable] by auto
     qed
   moreover have "continuous_on ({0..1} - S) (\<lambda>x. vector_derivative (f \<circ> g) (at x))"
     proof (rule continuous_on_eq [where f = "\<lambda>x. vector_derivative g (at x) * deriv f (g x)"],
         rule continuous_intros)
       show "continuous_on ({0..1} - S) (\<lambda>x. vector_derivative g (at x))"
         using g_diff C1_differentiable_on_eq by auto
     next
       have "continuous_on {0..1} (\<lambda>x. deriv f (g x))"
         using continuous_on_compose[OF _ con[unfolded path_image_def],unfolded comp_def]
           \<open>valid_path g\<close> piecewise_C1_differentiable_on_def valid_path_def
         by blast
       then show "continuous_on ({0..1} - S) (\<lambda>x. deriv f (g x))"
         using continuous_on_subset by blast
     next
       show "vector_derivative g (at t) * deriv f (g t) = vector_derivative (f \<circ> g) (at t)"
           when "t \<in> {0..1} - S" for t
         by (metis C1_differentiable_on_eq DiffD1 der g_diff imageI path_image_def that 
                   vector_derivative_chain_at_general)
     qed
   ultimately have "f \<circ> g C1_differentiable_on {0..1} - S"
     using C1_differentiable_on_eq by blast
   moreover have "path (f \<circ> g)"
     using der
     by (simp add: path_continuous_image[OF valid_path_imp_path[OF \<open>valid_path g\<close>]] continuous_at_imp_continuous_on field_differentiable_imp_continuous_at)
   ultimately show ?thesis unfolding valid_path_def piecewise_C1_differentiable_on_def path_def
     using \<open>finite S\<close> by auto
 qed
   
 lemma valid_path_uminus_comp[simp]:
   fixes g::"real \<Rightarrow> 'a ::real_normed_field"
   shows "valid_path (uminus \<circ> g) \<longleftrightarrow> valid_path g"
 proof 
   show "valid_path g \<Longrightarrow> valid_path (uminus \<circ> g)" for g::"real \<Rightarrow> 'a"
     by (auto intro!: valid_path_compose derivative_intros)  
   then show "valid_path g" when "valid_path (uminus \<circ> g)"
     by (metis fun.map_comp group_add_class.minus_comp_minus id_comp that)
 qed
 
 lemma valid_path_offset[simp]:
   shows "valid_path (\<lambda>t. g t - z) \<longleftrightarrow> valid_path g"  
 proof 
   show *: "valid_path (g::real\<Rightarrow>'a) \<Longrightarrow> valid_path (\<lambda>t. g t - z)" for g z
     unfolding valid_path_def
     by (fastforce intro:derivative_intros C1_differentiable_imp_piecewise piecewise_C1_differentiable_diff)
   show "valid_path (\<lambda>t. g t - z) \<Longrightarrow> valid_path g"
     using *[of "\<lambda>t. g t - z" "-z",simplified] .
 qed
 
 lemma valid_path_imp_reverse:
   assumes "valid_path g"
     shows "valid_path(reversepath g)"
 proof -
   obtain S where "finite S" and S: "g C1_differentiable_on ({0..1} - S)"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
   then have "finite ((-) 1 ` S)"
     by auto
   moreover have "(reversepath g C1_differentiable_on ({0..1} - (-) 1 ` S))"
     unfolding reversepath_def
     apply (rule C1_differentiable_compose [of "\<lambda>x::real. 1-x" _ g, unfolded o_def])
     using S
     by (force simp: finite_vimageI inj_on_def C1_differentiable_on_eq elim!: continuous_on_subset)+
   ultimately show ?thesis using assms
     by (auto simp: valid_path_def piecewise_C1_differentiable_on_def path_def [symmetric])
 qed
 
 lemma valid_path_reversepath [simp]: "valid_path(reversepath g) \<longleftrightarrow> valid_path g"
   using valid_path_imp_reverse by force
 
 lemma valid_path_join:
   assumes "valid_path g1" "valid_path g2" "pathfinish g1 = pathstart g2"
     shows "valid_path(g1 +++ g2)"
 proof -
   have "g1 1 = g2 0"
     using assms by (auto simp: pathfinish_def pathstart_def)
   moreover have "(g1 \<circ> (\<lambda>x. 2*x)) piecewise_C1_differentiable_on {0..1/2}"
     apply (rule piecewise_C1_differentiable_compose)
     using assms
     apply (auto simp: valid_path_def piecewise_C1_differentiable_on_def continuous_on_joinpaths)
     apply (force intro: finite_vimageI [where h = "(*)2"] inj_onI)
     done
   moreover have "(g2 \<circ> (\<lambda>x. 2*x-1)) piecewise_C1_differentiable_on {1/2..1}"
     apply (rule piecewise_C1_differentiable_compose)
     using assms unfolding valid_path_def piecewise_C1_differentiable_on_def
     by (auto intro!: continuous_intros finite_vimageI [where h = "(\<lambda>x. 2*x - 1)"] inj_onI
              simp: image_affinity_atLeastAtMost_diff continuous_on_joinpaths)
   ultimately show ?thesis
     unfolding valid_path_def continuous_on_joinpaths joinpaths_def
     by (intro piecewise_C1_differentiable_cases) (auto simp: o_def)
 qed
 
 lemma valid_path_join_D1:
   fixes g1 :: "real \<Rightarrow> 'a::real_normed_field"
   shows "valid_path (g1 +++ g2) \<Longrightarrow> valid_path g1"
   unfolding valid_path_def
   by (rule piecewise_C1_differentiable_D1)
 
 lemma valid_path_join_D2:
   fixes g2 :: "real \<Rightarrow> 'a::real_normed_field"
   shows "\<lbrakk>valid_path (g1 +++ g2); pathfinish g1 = pathstart g2\<rbrakk> \<Longrightarrow> valid_path g2"
   unfolding valid_path_def
   by (rule piecewise_C1_differentiable_D2)
 
 lemma valid_path_join_eq [simp]:
   fixes g2 :: "real \<Rightarrow> 'a::real_normed_field"
   shows "pathfinish g1 = pathstart g2 \<Longrightarrow> (valid_path(g1 +++ g2) \<longleftrightarrow> valid_path g1 \<and> valid_path g2)"
   using valid_path_join_D1 valid_path_join_D2 valid_path_join by blast
 
 lemma valid_path_shiftpath [intro]:
   assumes "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "valid_path(shiftpath a g)"
   using assms
   unfolding valid_path_def shiftpath_alt_def
   apply (intro piecewise_C1_differentiable_cases)
       apply (simp_all add: add.commute)
     apply (rule piecewise_C1_differentiable_affine [of g 1 a, simplified o_def scaleR_one])
     apply (force simp: pathfinish_def pathstart_def elim: piecewise_C1_differentiable_on_subset)
    apply (rule piecewise_C1_differentiable_affine [of g 1 "a-1", simplified o_def scaleR_one algebra_simps])
    apply (auto simp: pathfinish_def pathstart_def elim: piecewise_C1_differentiable_on_subset)
   done
 
 lemma vector_derivative_linepath_within:
     "x \<in> {0..1} \<Longrightarrow> vector_derivative (linepath a b) (at x within {0..1}) = b - a"
   by (simp add: has_vector_derivative_linepath_within vector_derivative_at_within_ivl)
 
 lemma vector_derivative_linepath_at [simp]: "vector_derivative (linepath a b) (at x) = b - a"
   by (simp add: has_vector_derivative_linepath_within vector_derivative_at)
 
 lemma valid_path_linepath [iff]: "valid_path (linepath a b)"
   using C1_differentiable_on_eq piecewise_C1_differentiable_on_def valid_path_def by fastforce
 
 lemma valid_path_subpath:
   fixes g :: "real \<Rightarrow> 'a :: real_normed_vector"
   assumes "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}"
     shows "valid_path(subpath u v g)"
 proof (cases "v=u")
   case True
   then show ?thesis
     unfolding valid_path_def subpath_def
     by (force intro: C1_differentiable_on_const C1_differentiable_imp_piecewise)
 next
   case False
   let ?f = "\<lambda>x. ((v-u) * x + u)"
   have "(g \<circ> ?f) piecewise_C1_differentiable_on {0..1}"
   proof (rule piecewise_C1_differentiable_compose)
     show "?f piecewise_C1_differentiable_on {0..1}"
       by (simp add: C1_differentiable_imp_piecewise)
     have "g piecewise_C1_differentiable_on (if u \<le> v then {u..v} else {v..u})"
       using assms piecewise_C1_differentiable_on_subset valid_path_def by force
     then show "g piecewise_C1_differentiable_on ?f ` {0..1}"
       by (simp add: image_affinity_atLeastAtMost split: if_split_asm)
     show "\<And>x. finite ({0..1} \<inter> ?f -` {x})"
       using False
       by (simp add: Int_commute [of "{0..1}"] inj_on_def crossproduct_eq finite_vimage_IntI)
   qed
   then show ?thesis
     by (auto simp: o_def valid_path_def subpath_def)
 qed
 
 lemma valid_path_rectpath [simp, intro]: "valid_path (rectpath a b)"
   by (simp add: Let_def rectpath_def)
 
+lemma linear_image_valid_path:
+  fixes p :: "real \<Rightarrow> 'a :: euclidean_space"
+  assumes  "valid_path p" "linear f"
+  shows    "valid_path (f \<circ> p)"
+  unfolding valid_path_def piecewise_C1_differentiable_on_def
+proof (intro conjI)
+  from assms have "path p"
+    by (simp add: valid_path_imp_path)
+  thus "continuous_on {0..1} (f \<circ> p)"
+    unfolding o_def path_def by (intro linear_continuous_on_compose[OF _ assms(2)])
+  from assms(1) obtain S where S: "finite S" "p C1_differentiable_on {0..1} - S"
+    by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
+  from S(2) obtain p' :: "real \<Rightarrow> 'a"
+    where p': "\<And>x. x \<in> {0..1} - S \<Longrightarrow> (p has_vector_derivative p' x) (at x)"
+              "continuous_on ({0..1} - S) p'"
+    by (fastforce simp: C1_differentiable_on_def)
+
+  have "(f \<circ> p has_vector_derivative f (p' x)) (at x)" if "x \<in> {0..1} - S" for x
+    by (rule vector_derivative_diff_chain_within [OF p'(1)[OF that]]
+             linear_imp_has_derivative assms)+
+  moreover have "continuous_on ({0..1} - S) (\<lambda>x. f (p' x))"
+    by (rule linear_continuous_on_compose [OF p'(2) assms(2)])
+  ultimately have "f \<circ> p C1_differentiable_on {0..1} - S"
+    unfolding C1_differentiable_on_def by (intro exI[of _ "\<lambda>x. f (p' x)"]) fast
+  thus "\<exists>S. finite S \<and> f \<circ> p C1_differentiable_on {0..1} - S"
+    using \<open>finite S\<close> by blast
+qed
+
+lemma valid_path_times:
+  fixes \<gamma>::"real \<Rightarrow> 'a ::real_normed_field"
+  assumes "c\<noteq>0"
+  shows "valid_path ((*) c \<circ> \<gamma>) = valid_path \<gamma>"
+proof 
+  assume "valid_path ((*) c \<circ> \<gamma>)"
+  then have "valid_path ((*) (1/c) \<circ> ((*) c \<circ> \<gamma>))"
+    by (simp add: valid_path_compose)
+  then show "valid_path \<gamma>" 
+    unfolding comp_def using \<open>c\<noteq>0\<close> by auto
+next
+  assume "valid_path \<gamma>"
+  then show "valid_path ((*) c \<circ> \<gamma>)"
+    by (simp add: valid_path_compose)
+qed
+
+lemma path_compose_cnj_iff [simp]: "path (cnj \<circ> p) \<longleftrightarrow> path p"
+proof -
+  have "path (cnj \<circ> p)" if "path p" for p
+    by (intro path_continuous_image continuous_intros that)
+  from this[of p] and this[of "cnj \<circ> p"] show ?thesis
+    by (auto simp: o_def)
+qed
+
+lemma valid_path_cnj:
+  fixes g::"real \<Rightarrow> complex"
+    shows "valid_path (cnj \<circ> g) = valid_path g"
+proof
+  show valid:"valid_path (cnj \<circ> g)" if "valid_path g" for g
+  proof -
+    obtain S where "finite S" and g_diff: "g C1_differentiable_on {0..1} - S"
+      using \<open>valid_path g\<close> unfolding valid_path_def piecewise_C1_differentiable_on_def by auto
+  
+    have g_diff':"g differentiable at t" when "t\<in>{0..1} - S" for t
+      by (meson C1_differentiable_on_eq \<open>g C1_differentiable_on {0..1} - S\<close> that)
+    then have "(cnj \<circ> g) differentiable at t" when "t\<in>{0..1} - S" for t
+      using bounded_linear_cnj bounded_linear_imp_differentiable differentiable_chain_at that by blast
+    moreover have "continuous_on ({0..1} - S)
+        (\<lambda>x. vector_derivative (cnj \<circ> g) (at x))"
+    proof -
+      have "continuous_on ({0..1} - S)
+          (\<lambda>x. vector_derivative (cnj \<circ> g) (at x))
+        = continuous_on ({0..1} - S)
+          (\<lambda>x. cnj (vector_derivative g (at x)))"
+        apply (rule continuous_on_cong[OF refl])
+        unfolding comp_def using g_diff'
+        using has_vector_derivative_cnj vector_derivative_at vector_derivative_works by blast
+      also have "\<dots>"
+        apply (intro continuous_intros)
+        using C1_differentiable_on_eq g_diff by blast
+      finally show ?thesis .
+    qed
+    ultimately have "cnj \<circ> g C1_differentiable_on {0..1} - S"
+      using C1_differentiable_on_eq by blast
+    moreover have "path (cnj \<circ> g)"
+      apply (rule path_continuous_image[OF valid_path_imp_path[OF \<open>valid_path g\<close>]])
+      by (intro continuous_intros)
+    ultimately show ?thesis unfolding valid_path_def piecewise_C1_differentiable_on_def path_def
+      using \<open>finite S\<close> by auto
+  qed
+  from this[of "cnj o g"]
+  show "valid_path (cnj \<circ> g) \<Longrightarrow> valid_path g"
+    unfolding comp_def by simp
+qed
+
 end
diff --git a/src/HOL/Complex_Analysis/Contour_Integration.thy b/src/HOL/Complex_Analysis/Contour_Integration.thy
--- a/src/HOL/Complex_Analysis/Contour_Integration.thy
+++ b/src/HOL/Complex_Analysis/Contour_Integration.thy
@@ -1,1757 +1,1830 @@
 section \<open>Contour integration\<close>
 theory Contour_Integration
   imports "HOL-Analysis.Analysis"
 begin
 
 lemma lhopital_complex_simple:
   assumes "(f has_field_derivative f') (at z)"
   assumes "(g has_field_derivative g') (at z)"
   assumes "f z = 0" "g z = 0" "g' \<noteq> 0" "f' / g' = c"
   shows   "((\<lambda>w. f w / g w) \<longlongrightarrow> c) (at z)"
 proof -
   have "eventually (\<lambda>w. w \<noteq> z) (at z)"
     by (auto simp: eventually_at_filter)
   hence "eventually (\<lambda>w. ((f w - f z) / (w - z)) / ((g w - g z) / (w - z)) = f w / g w) (at z)"
     by eventually_elim (simp add: assms field_split_simps)
   moreover have "((\<lambda>w. ((f w - f z) / (w - z)) / ((g w - g z) / (w - z))) \<longlongrightarrow> f' / g') (at z)"
     by (intro tendsto_divide has_field_derivativeD assms)
   ultimately have "((\<lambda>w. f w / g w) \<longlongrightarrow> f' / g') (at z)"
     by (blast intro: Lim_transform_eventually)
   with assms show ?thesis by simp
 qed
 
 subsection\<open>Definition\<close>
 
 text\<open>
   This definition is for complex numbers only, and does not generalise to
   line integrals in a vector field
 \<close>
 
 definition\<^marker>\<open>tag important\<close> has_contour_integral :: "(complex \<Rightarrow> complex) \<Rightarrow> complex \<Rightarrow> (real \<Rightarrow> complex) \<Rightarrow> bool"
            (infixr "has'_contour'_integral" 50)
   where "(f has_contour_integral i) g \<equiv>
            ((\<lambda>x. f(g x) * vector_derivative g (at x within {0..1}))
             has_integral i) {0..1}"
 
 definition\<^marker>\<open>tag important\<close> contour_integrable_on
            (infixr "contour'_integrable'_on" 50)
   where "f contour_integrable_on g \<equiv> \<exists>i. (f has_contour_integral i) g"
 
 definition\<^marker>\<open>tag important\<close> contour_integral
   where "contour_integral g f \<equiv> SOME i. (f has_contour_integral i) g \<or> \<not> f contour_integrable_on g \<and> i=0"
 
 lemma not_integrable_contour_integral: "\<not> f contour_integrable_on g \<Longrightarrow> contour_integral g f = 0"
   unfolding contour_integrable_on_def contour_integral_def by blast
 
 lemma contour_integral_unique: "(f has_contour_integral i) g \<Longrightarrow> contour_integral g f = i"
   unfolding contour_integral_def has_contour_integral_def contour_integrable_on_def
   using has_integral_unique by blast
 
 lemma has_contour_integral_eqpath:
   "\<lbrakk>(f has_contour_integral y) p; f contour_integrable_on \<gamma>;
        contour_integral p f = contour_integral \<gamma> f\<rbrakk>
       \<Longrightarrow> (f has_contour_integral y) \<gamma>"
   using contour_integrable_on_def contour_integral_unique by auto
 
 lemma has_contour_integral_integral:
     "f contour_integrable_on i \<Longrightarrow> (f has_contour_integral (contour_integral i f)) i"
   by (metis contour_integral_unique contour_integrable_on_def)
 
 lemma has_contour_integral_unique:
     "(f has_contour_integral i) g \<Longrightarrow> (f has_contour_integral j) g \<Longrightarrow> i = j"
   using has_integral_unique
   by (auto simp: has_contour_integral_def)
 
 lemma has_contour_integral_integrable: "(f has_contour_integral i) g \<Longrightarrow> f contour_integrable_on g"
   using contour_integrable_on_def by blast
 
 text\<open>Show that we can forget about the localized derivative.\<close>
 
 lemma has_integral_localized_vector_derivative:
     "((\<lambda>x. f (g x) * vector_derivative p (at x within {a..b})) has_integral i) {a..b} \<longleftrightarrow>
      ((\<lambda>x. f (g x) * vector_derivative p (at x)) has_integral i) {a..b}"
 proof -
   have *: "{a..b} - {a,b} = interior {a..b}"
     by (simp add: atLeastAtMost_diff_ends)
   show ?thesis
     by (rule has_integral_spike_eq [of "{a,b}"]) (auto simp: at_within_interior [of _ "{a..b}"])
 qed
 
 lemma integrable_on_localized_vector_derivative:
     "(\<lambda>x. f (g x) * vector_derivative p (at x within {a..b})) integrable_on {a..b} \<longleftrightarrow>
      (\<lambda>x. f (g x) * vector_derivative p (at x)) integrable_on {a..b}"
   by (simp add: integrable_on_def has_integral_localized_vector_derivative)
 
 lemma has_contour_integral:
      "(f has_contour_integral i) g \<longleftrightarrow>
       ((\<lambda>x. f (g x) * vector_derivative g (at x)) has_integral i) {0..1}"
   by (simp add: has_integral_localized_vector_derivative has_contour_integral_def)
 
 lemma contour_integrable_on:
      "f contour_integrable_on g \<longleftrightarrow>
       (\<lambda>t. f(g t) * vector_derivative g (at t)) integrable_on {0..1}"
   by (simp add: has_contour_integral integrable_on_def contour_integrable_on_def)
 
 lemma has_contour_integral_mirror_iff:
   assumes "valid_path g"
   shows   "(f has_contour_integral I) (-g) \<longleftrightarrow> ((\<lambda>x. -f (- x)) has_contour_integral I) g"
 proof -
   from assms have "g piecewise_differentiable_on {0..1}"
     by (auto simp: valid_path_def piecewise_C1_imp_differentiable)
   then obtain S where "finite S" and S: "\<And>x. x \<in> {0..1} - S \<Longrightarrow> g differentiable at x within {0..1}"
      unfolding piecewise_differentiable_on_def by blast
   have S': "g differentiable at x" if "x \<in> {0..1} - ({0, 1} \<union> S)" for x
   proof -
     from that have "x \<in> interior {0..1}" by auto
     with S[of x] that show ?thesis by (auto simp: at_within_interior[of _ "{0..1}"])
   qed
 
   have "(f has_contour_integral I) (-g) \<longleftrightarrow>
           ((\<lambda>x. f (- g x) * vector_derivative (-g) (at x)) has_integral I) {0..1}"
     by (simp add: has_contour_integral)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>x. -f (- g x) * vector_derivative g (at x)) has_integral I) {0..1}"
     by (intro has_integral_spike_finite_eq[of "S \<union> {0, 1}"])
        (insert \<open>finite S\<close> S', auto simp: o_def fun_Compl_def)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>x. -f (-x)) has_contour_integral I) g"
     by (simp add: has_contour_integral)
   finally show ?thesis .
 qed
 
 lemma contour_integral_on_mirror_iff:
   assumes "valid_path g"
   shows   "f contour_integrable_on (-g) \<longleftrightarrow> (\<lambda>x. -f (- x)) contour_integrable_on g"
   by (auto simp: contour_integrable_on_def has_contour_integral_mirror_iff assms)
 
 lemma contour_integral_mirror:
   assumes "valid_path g"
   shows   "contour_integral (-g) f = contour_integral g (\<lambda>x. -f (- x))"
 proof (cases "f contour_integrable_on (-g)")
   case True with contour_integral_unique assms show ?thesis 
     by (auto simp: contour_integrable_on_def has_contour_integral_mirror_iff)
 next
   case False then show ?thesis
     by (simp add: assms contour_integral_on_mirror_iff not_integrable_contour_integral)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Reversing a path\<close>
 
 lemma has_contour_integral_reversepath:
   assumes "valid_path g" and f: "(f has_contour_integral i) g"
     shows "(f has_contour_integral (-i)) (reversepath g)"
 proof -
   { fix S x
     assume xs: "g C1_differentiable_on ({0..1} - S)" "x \<notin> (-) 1 ` S" "0 \<le> x" "x \<le> 1"
     have "vector_derivative (\<lambda>x. g (1 - x)) (at x within {0..1}) =
             - vector_derivative g (at (1 - x) within {0..1})"
     proof -
       obtain f' where f': "(g has_vector_derivative f') (at (1 - x))"
         using xs
         by (force simp: has_vector_derivative_def C1_differentiable_on_def)
       have "(g \<circ> (\<lambda>x. 1 - x) has_vector_derivative -1 *\<^sub>R f') (at x)"
         by (intro vector_diff_chain_within has_vector_derivative_at_within [OF f'] derivative_eq_intros | simp)+
       then have mf': "((\<lambda>x. g (1 - x)) has_vector_derivative -f') (at x)"
         by (simp add: o_def)
       show ?thesis
         using xs
         by (auto simp: vector_derivative_at_within_ivl [OF mf'] vector_derivative_at_within_ivl [OF f'])
     qed
   } note * = this
   obtain S where S: "continuous_on {0..1} g" "finite S" "g C1_differentiable_on {0..1} - S"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
   have "((\<lambda>x. - (f (g (1 - x)) * vector_derivative g (at (1 - x) within {0..1}))) has_integral -i)
        {0..1}"
     using has_integral_affinity01 [where m= "-1" and c=1, OF f [unfolded has_contour_integral_def]]
     by (simp add: has_integral_neg)
   then show ?thesis
     using S
     unfolding reversepath_def has_contour_integral_def
     by (rule_tac S = "(\<lambda>x. 1 - x) ` S" in has_integral_spike_finite) (auto simp: *)
 qed
 
 lemma contour_integrable_reversepath:
     "valid_path g \<Longrightarrow> f contour_integrable_on g \<Longrightarrow> f contour_integrable_on (reversepath g)"
   using has_contour_integral_reversepath contour_integrable_on_def by blast
 
 lemma contour_integrable_reversepath_eq:
     "valid_path g \<Longrightarrow> (f contour_integrable_on (reversepath g) \<longleftrightarrow> f contour_integrable_on g)"
   using contour_integrable_reversepath valid_path_reversepath by fastforce
 
 lemma contour_integral_reversepath:
   assumes "valid_path g"
     shows "contour_integral (reversepath g) f = - (contour_integral g f)"
 proof (cases "f contour_integrable_on g")
   case True then show ?thesis
     by (simp add: assms contour_integral_unique has_contour_integral_integral has_contour_integral_reversepath)
 next
   case False then have "\<not> f contour_integrable_on (reversepath g)"
     by (simp add: assms contour_integrable_reversepath_eq)
   with False show ?thesis by (simp add: not_integrable_contour_integral)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Joining two paths together\<close>
 
 lemma has_contour_integral_join:
   assumes "(f has_contour_integral i1) g1" "(f has_contour_integral i2) g2"
           "valid_path g1" "valid_path g2"
     shows "(f has_contour_integral (i1 + i2)) (g1 +++ g2)"
 proof -
   obtain s1 s2
     where s1: "finite s1" "\<forall>x\<in>{0..1} - s1. g1 differentiable at x"
       and s2: "finite s2" "\<forall>x\<in>{0..1} - s2. g2 differentiable at x"
     using assms
     by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have 1: "((\<lambda>x. f (g1 x) * vector_derivative g1 (at x)) has_integral i1) {0..1}"
    and 2: "((\<lambda>x. f (g2 x) * vector_derivative g2 (at x)) has_integral i2) {0..1}"
     using assms
     by (auto simp: has_contour_integral)
   have i1: "((\<lambda>x. (2*f (g1 (2*x))) * vector_derivative g1 (at (2*x))) has_integral i1) {0..1/2}"
    and i2: "((\<lambda>x. (2*f (g2 (2*x - 1))) * vector_derivative g2 (at (2*x - 1))) has_integral i2) {1/2..1}"
     using has_integral_affinity01 [OF 1, where m= 2 and c=0, THEN has_integral_cmul [where c=2]]
           has_integral_affinity01 [OF 2, where m= 2 and c="-1", THEN has_integral_cmul [where c=2]]
     by (simp_all only: image_affinity_atLeastAtMost_div_diff, simp_all add: scaleR_conv_of_real mult_ac)
   have g1: "vector_derivative (\<lambda>x. if x*2 \<le> 1 then g1 (2*x) else g2 (2*x - 1)) (at z) =
             2 *\<^sub>R vector_derivative g1 (at (z*2))"
       if "0 \<le> z" "z*2 < 1" "z*2 \<notin> s1" for z
   proof (rule vector_derivative_at [OF has_vector_derivative_transform_within])
     show "0 < \<bar>z - 1/2\<bar>"
       using that by auto
     have "((*) 2 has_vector_derivative 2) (at z)"
       by (simp add: has_vector_derivative_def has_derivative_def bounded_linear_mult_left)
     moreover have "(g1 has_vector_derivative vector_derivative g1 (at (z * 2))) (at (2 * z))"
       using s1 that by (auto simp: algebra_simps vector_derivative_works)
     ultimately
     show "((\<lambda>x. g1 (2 * x)) has_vector_derivative 2 *\<^sub>R vector_derivative g1 (at (z * 2))) (at z)"
       by (intro vector_diff_chain_at [simplified o_def])
   qed (use that in \<open>simp_all add: dist_real_def abs_if split: if_split_asm\<close>)
 
   have g2: "vector_derivative (\<lambda>x. if x*2 \<le> 1 then g1 (2*x) else g2 (2*x - 1)) (at z) =
             2 *\<^sub>R vector_derivative g2 (at (z*2 - 1))"
            if "1 < z*2" "z \<le> 1" "z*2 - 1 \<notin> s2" for z
   proof (rule vector_derivative_at [OF has_vector_derivative_transform_within])
     show "0 < \<bar>z - 1/2\<bar>"
       using that by auto
     have "((\<lambda>x. 2 * x - 1) has_vector_derivative 2) (at z)"
       by (simp add: has_vector_derivative_def has_derivative_def bounded_linear_mult_left)
     moreover have "(g2 has_vector_derivative vector_derivative g2 (at (z * 2 - 1))) (at (2 * z - 1))"
       using s2 that by (auto simp: algebra_simps vector_derivative_works)
     ultimately
     show "((\<lambda>x. g2 (2 * x - 1)) has_vector_derivative 2 *\<^sub>R vector_derivative g2 (at (z * 2 - 1))) (at z)"
       by (intro vector_diff_chain_at [simplified o_def])
   qed (use that in \<open>simp_all add: dist_real_def abs_if split: if_split_asm\<close>)
 
   have "((\<lambda>x. f ((g1 +++ g2) x) * vector_derivative (g1 +++ g2) (at x)) has_integral i1) {0..1/2}"
   proof (rule has_integral_spike_finite [OF _ _ i1])
     show "finite (insert (1/2) ((*) 2 -` s1))"
       using s1 by (force intro: finite_vimageI [where h = "(*)2"] inj_onI)
   qed (auto simp add: joinpaths_def scaleR_conv_of_real mult_ac g1)
   moreover have "((\<lambda>x. f ((g1 +++ g2) x) * vector_derivative (g1 +++ g2) (at x)) has_integral i2) {1/2..1}"
   proof (rule has_integral_spike_finite [OF _ _ i2])
     show "finite (insert (1/2) ((\<lambda>x. 2 * x - 1) -` s2))"
       using s2 by (force intro: finite_vimageI [where h = "\<lambda>x. 2*x-1"] inj_onI)
   qed (auto simp add: joinpaths_def scaleR_conv_of_real mult_ac g2)
   ultimately
   show ?thesis
     by (simp add: has_contour_integral has_integral_combine [where c = "1/2"])
 qed
 
 lemma contour_integrable_joinI:
   assumes "f contour_integrable_on g1" "f contour_integrable_on g2"
           "valid_path g1" "valid_path g2"
     shows "f contour_integrable_on (g1 +++ g2)"
   using assms
   by (meson has_contour_integral_join contour_integrable_on_def)
 
 lemma contour_integrable_joinD1:
   assumes "f contour_integrable_on (g1 +++ g2)" "valid_path g1"
     shows "f contour_integrable_on g1"
 proof -
   obtain s1
     where s1: "finite s1" "\<forall>x\<in>{0..1} - s1. g1 differentiable at x"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have "(\<lambda>x. f ((g1 +++ g2) (x/2)) * vector_derivative (g1 +++ g2) (at (x/2))) integrable_on {0..1}"
     using assms integrable_affinity [of _ 0 "1/2" "1/2" 0] integrable_on_subcbox [where a=0 and b="1/2"]
     by (fastforce simp: contour_integrable_on)
   then have *: "(\<lambda>x. (f ((g1 +++ g2) (x/2))/2) * vector_derivative (g1 +++ g2) (at (x/2))) integrable_on {0..1}"
     by (auto dest: integrable_cmul [where c="1/2"] simp: scaleR_conv_of_real)
   have g1: "vector_derivative (\<lambda>x. if x*2 \<le> 1 then g1 (2*x) else g2 (2*x - 1)) (at (z/2)) =
             2 *\<^sub>R vector_derivative g1 (at z)"
     if "0 < z" "z < 1" "z \<notin> s1" for z
   proof (rule vector_derivative_at [OF has_vector_derivative_transform_within])
     show "0 < \<bar>(z - 1)/2\<bar>"
       using that by auto
     have \<section>: "((\<lambda>x. x * 2) has_vector_derivative 2) (at (z/2))"
       using s1 by (auto simp: has_vector_derivative_def has_derivative_def bounded_linear_mult_left)
     have "(g1 has_vector_derivative vector_derivative g1 (at z)) (at z)"
       using s1 that by (auto simp: vector_derivative_works)
     then show "((\<lambda>x. g1 (2 * x)) has_vector_derivative 2 *\<^sub>R vector_derivative g1 (at z)) (at (z/2))"
       using vector_diff_chain_at [OF \<section>] by (auto simp: field_simps o_def)
   qed (use that in \<open>simp_all add: field_simps dist_real_def abs_if split: if_split_asm\<close>)
   have fin01: "finite ({0, 1} \<union> s1)"
     by (simp add: s1)
   show ?thesis
     unfolding contour_integrable_on
     by (intro integrable_spike_finite [OF fin01 _ *]) (auto simp: joinpaths_def scaleR_conv_of_real g1)
 qed
 
 lemma contour_integrable_joinD2:
   assumes "f contour_integrable_on (g1 +++ g2)" "valid_path g2"
     shows "f contour_integrable_on g2"
 proof -
   obtain s2
     where s2: "finite s2" "\<forall>x\<in>{0..1} - s2. g2 differentiable at x"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have "(\<lambda>x. f ((g1 +++ g2) (x/2 + 1/2)) * vector_derivative (g1 +++ g2) (at (x/2 + 1/2))) integrable_on {0..1}"
     using assms integrable_affinity [of _ "1/2::real" 1 "1/2" "1/2"]
                 integrable_on_subcbox [where a="1/2" and b=1]
     by (fastforce simp: contour_integrable_on image_affinity_atLeastAtMost_diff)
   then have *: "(\<lambda>x. (f ((g1 +++ g2) (x/2 + 1/2))/2) * vector_derivative (g1 +++ g2) (at (x/2 + 1/2)))
                 integrable_on {0..1}"
     by (auto dest: integrable_cmul [where c="1/2"] simp: scaleR_conv_of_real)
   have g2: "vector_derivative (\<lambda>x. if x*2 \<le> 1 then g1 (2*x) else g2 (2*x - 1)) (at (z/2+1/2)) =
             2 *\<^sub>R vector_derivative g2 (at z)"
         if "0 < z" "z < 1" "z \<notin> s2" for z
   proof (rule vector_derivative_at [OF has_vector_derivative_transform_within])
     show "0 < \<bar>z/2\<bar>"
       using that by auto
     have \<section>: "((\<lambda>x. x * 2 - 1) has_vector_derivative 2) (at ((1 + z)/2))"
       using s2 by (auto simp: has_vector_derivative_def has_derivative_def bounded_linear_mult_left)
     have "(g2 has_vector_derivative vector_derivative g2 (at z)) (at z)"
       using s2 that by (auto simp: vector_derivative_works)
     then show "((\<lambda>x. g2 (2*x - 1)) has_vector_derivative 2 *\<^sub>R vector_derivative g2 (at z)) (at (z/2 + 1/2))"
       using vector_diff_chain_at [OF \<section>] by (auto simp: field_simps o_def)
   qed (use that in \<open>simp_all add: field_simps dist_real_def abs_if split: if_split_asm\<close>)
   have fin01: "finite ({0, 1} \<union> s2)"
     by (simp add: s2)
   show ?thesis
     unfolding contour_integrable_on
     by (intro integrable_spike_finite [OF fin01 _ *]) (auto simp: joinpaths_def scaleR_conv_of_real g2)
 qed
 
 lemma contour_integrable_join [simp]:
   "\<lbrakk>valid_path g1; valid_path g2\<rbrakk>
      \<Longrightarrow> f contour_integrable_on (g1 +++ g2) \<longleftrightarrow> f contour_integrable_on g1 \<and> f contour_integrable_on g2"
   using contour_integrable_joinD1 contour_integrable_joinD2 contour_integrable_joinI by blast
 
 lemma contour_integral_join [simp]:
   "\<lbrakk>f contour_integrable_on g1; f contour_integrable_on g2; valid_path g1; valid_path g2\<rbrakk>
         \<Longrightarrow> contour_integral (g1 +++ g2) f = contour_integral g1 f + contour_integral g2 f"
   by (simp add: has_contour_integral_integral has_contour_integral_join contour_integral_unique)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Shifting the starting point of a (closed) path\<close>
 
 lemma has_contour_integral_shiftpath:
   assumes f: "(f has_contour_integral i) g" "valid_path g"
       and a: "a \<in> {0..1}"
     shows "(f has_contour_integral i) (shiftpath a g)"
 proof -
   obtain S
     where S: "finite S" and g: "\<forall>x\<in>{0..1} - S. g differentiable at x"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have *: "((\<lambda>x. f (g x) * vector_derivative g (at x)) has_integral i) {0..1}"
     using assms by (auto simp: has_contour_integral)
   then have i: "i = integral {a..1} (\<lambda>x. f (g x) * vector_derivative g (at x)) +
                     integral {0..a} (\<lambda>x. f (g x) * vector_derivative g (at x))"
     by (smt (verit, ccfv_threshold) Henstock_Kurzweil_Integration.integral_combine a add.commute atLeastAtMost_iff has_integral_iff)
   have vd1: "vector_derivative (shiftpath a g) (at x) = vector_derivative g (at (x + a))"
     if "0 \<le> x" "x + a < 1" "x \<notin> (\<lambda>x. x - a) ` S" for x
     unfolding shiftpath_def
   proof (rule vector_derivative_at [OF has_vector_derivative_transform_within])
     have "((\<lambda>x. g (x + a)) has_vector_derivative vector_derivative g (at (a + x))) (at x)"
     proof (rule vector_diff_chain_at [of _ 1, simplified o_def scaleR_one])
       show "((\<lambda>x. x + a) has_vector_derivative 1) (at x)"
         by (rule derivative_eq_intros | simp)+
       have "g differentiable at (x + a)"
         using g a that by force
       then show "(g has_vector_derivative vector_derivative g (at (a + x))) (at (x + a))"
         by (metis add.commute vector_derivative_works)
     qed
     then show "((\<lambda>x. g (a + x)) has_vector_derivative vector_derivative g (at (x + a))) (at x)"
       by (auto simp: field_simps)
     show "0 < dist (1 - a) x"
       using that by auto
   qed (use that in \<open>auto simp: dist_real_def\<close>)
 
   have vd2: "vector_derivative (shiftpath a g) (at x) = vector_derivative g (at (x + a - 1))"
     if "x \<le> 1" "1 < x + a" "x \<notin> (\<lambda>x. x - a + 1) ` S" for x
     unfolding shiftpath_def
   proof (rule vector_derivative_at [OF has_vector_derivative_transform_within])
     have "((\<lambda>x. g (x + a - 1)) has_vector_derivative vector_derivative g (at (a+x-1))) (at x)"
     proof (rule vector_diff_chain_at [of _ 1, simplified o_def scaleR_one])
       show "((\<lambda>x. x + a - 1) has_vector_derivative 1) (at x)"
         by (rule derivative_eq_intros | simp)+
       have "g differentiable at (x+a-1)"
         using g a that by force
       then show "(g has_vector_derivative vector_derivative g (at (a+x-1))) (at (x + a - 1))"
         by (metis add.commute vector_derivative_works)
     qed
     then show "((\<lambda>x. g (a + x - 1)) has_vector_derivative vector_derivative g (at (x + a - 1))) (at x)"
       by (auto simp: field_simps)
     show "0 < dist (1 - a) x"
       using that by auto
   qed (use that in \<open>auto simp: dist_real_def\<close>)
 
   have va1: "(\<lambda>x. f (g x) * vector_derivative g (at x)) integrable_on ({a..1})"
     using * a   by (fastforce intro: integrable_subinterval_real)
   have v0a: "(\<lambda>x. f (g x) * vector_derivative g (at x)) integrable_on ({0..a})"
     using * a by (force intro: integrable_subinterval_real)
   have "finite ({1 - a} \<union> (\<lambda>x. x - a) ` S)"
     using S by blast
   then have "((\<lambda>x. f (shiftpath a g x) * vector_derivative (shiftpath a g) (at x))
         has_integral integral {a..1} (\<lambda>x. f (g x) * vector_derivative g (at x)))  {0..1 - a}"
     apply (rule has_integral_spike_finite
         [where f = "\<lambda>x. f(g(a+x)) * vector_derivative g (at(a+x))"])
     subgoal
       using a by (simp add: vd1) (force simp: shiftpath_def add.commute)
     subgoal
       using has_integral_affinity [where m=1 and c=a] integrable_integral [OF va1]
       by (force simp add: add.commute)
     done
   moreover
   have "finite ({1 - a} \<union> (\<lambda>x. x - a + 1) ` S)"
     using S by blast
   then have "((\<lambda>x. f (shiftpath a g x) * vector_derivative (shiftpath a g) (at x))
              has_integral  integral {0..a} (\<lambda>x. f (g x) * vector_derivative g (at x)))  {1 - a..1}"
     apply (rule has_integral_spike_finite
         [where f = "\<lambda>x. f(g(a+x-1)) * vector_derivative g (at(a+x-1))"])
     subgoal
       using a by (simp add: vd2) (force simp: shiftpath_def add.commute)
     subgoal
       using has_integral_affinity [where m=1 and c="a-1", simplified, OF integrable_integral [OF v0a]]
       by (force simp add: algebra_simps)
     done
   ultimately show ?thesis
     using a
     by (auto simp: i has_contour_integral intro: has_integral_combine [where c = "1-a"])
 qed
 
 lemma has_contour_integral_shiftpath_D:
   assumes "(f has_contour_integral i) (shiftpath a g)"
           "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "(f has_contour_integral i) g"
 proof -
   obtain S
     where S: "finite S" and g: "\<forall>x\<in>{0..1} - S. g differentiable at x"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   { fix x
     assume x: "0 < x" "x < 1" "x \<notin> S"
     then have gx: "g differentiable at x"
       using g by auto
     have \<section>: "shiftpath (1 - a) (shiftpath a g) differentiable at x"
       using assms x
       by (intro differentiable_transform_within [OF gx, of "min x (1-x)"])
          (auto simp: dist_real_def shiftpath_shiftpath abs_if split: if_split_asm)
     have "vector_derivative g (at x within {0..1}) =
           vector_derivative (shiftpath (1 - a) (shiftpath a g)) (at x within {0..1})"
       apply (rule vector_derivative_at_within_ivl
                   [OF has_vector_derivative_transform_within_open
                       [where f = "(shiftpath (1 - a) (shiftpath a g))" and S = "{0<..<1}-S"]])
       using S assms x \<section>
       apply (auto simp: finite_imp_closed open_Diff shiftpath_shiftpath
                         at_within_interior [of _ "{0..1}"] vector_derivative_works [symmetric])
       done
   } note vd = this
   have fi: "(f has_contour_integral i) (shiftpath (1 - a) (shiftpath a g))"
     using assms  by (auto intro!: has_contour_integral_shiftpath)
   show ?thesis
     unfolding has_contour_integral_def
   proof (rule has_integral_spike_finite [of "{0,1} \<union> S", OF _ _  fi [unfolded has_contour_integral_def]])
     show "finite ({0, 1} \<union> S)"
       by (simp add: S)
   qed (use S assms vd in \<open>auto simp: shiftpath_shiftpath\<close>)
 qed
 
 lemma has_contour_integral_shiftpath_eq:
   assumes "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "(f has_contour_integral i) (shiftpath a g) \<longleftrightarrow> (f has_contour_integral i) g"
   using assms has_contour_integral_shiftpath has_contour_integral_shiftpath_D by blast
 
 lemma contour_integrable_on_shiftpath_eq:
   assumes "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
   shows "f contour_integrable_on (shiftpath a g) \<longleftrightarrow> f contour_integrable_on g"
   using assms contour_integrable_on_def has_contour_integral_shiftpath_eq by auto
 
 lemma contour_integral_shiftpath:
   assumes "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "contour_integral (shiftpath a g) f = contour_integral g f"
    using assms
    by (simp add: contour_integral_def contour_integrable_on_def has_contour_integral_shiftpath_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More about straight-line paths\<close>
 
 lemma has_contour_integral_linepath:
   shows "(f has_contour_integral i) (linepath a b) \<longleftrightarrow>
          ((\<lambda>x. f(linepath a b x) * (b - a)) has_integral i) {0..1}"
   by (simp add: has_contour_integral)
 
 lemma has_contour_integral_trivial [iff]: "(f has_contour_integral 0) (linepath a a)"
   by (simp add: has_contour_integral_linepath)
 
 lemma has_contour_integral_trivial_iff [simp]: "(f has_contour_integral i) (linepath a a) \<longleftrightarrow> i=0"
   using has_contour_integral_unique by blast
 
 lemma contour_integral_trivial [simp]: "contour_integral (linepath a a) f = 0"
   using has_contour_integral_trivial contour_integral_unique by blast
 
 
 subsection\<open>Relation to subpath construction\<close>
 
 lemma has_contour_integral_subpath_refl [iff]: "(f has_contour_integral 0) (subpath u u g)"
   by (simp add: has_contour_integral subpath_def)
 
 lemma contour_integrable_subpath_refl [iff]: "f contour_integrable_on (subpath u u g)"
   using has_contour_integral_subpath_refl contour_integrable_on_def by blast
 
 lemma contour_integral_subpath_refl [simp]: "contour_integral (subpath u u g) f = 0"
   by (simp add: contour_integral_unique)
 
 lemma has_contour_integral_subpath:
   assumes f: "f contour_integrable_on g" and g: "valid_path g"
       and uv: "u \<in> {0..1}" "v \<in> {0..1}" "u \<le> v"
     shows "(f has_contour_integral  integral {u..v} (\<lambda>x. f(g x) * vector_derivative g (at x)))
            (subpath u v g)"
 proof (cases "v=u")
   case True
   then show ?thesis
     using f   by (simp add: contour_integrable_on_def subpath_def has_contour_integral)
 next
   case False
   obtain S where S: "\<And>x. x \<in> {0..1} - S \<Longrightarrow> g differentiable at x" and fs: "finite S"
     using g unfolding piecewise_C1_differentiable_on_def C1_differentiable_on_eq valid_path_def by blast
   have \<section>: "(\<lambda>t. f (g t) * vector_derivative g (at t)) integrable_on {u..v}"
     using contour_integrable_on f integrable_on_subinterval uv by fastforce
   then have *: "((\<lambda>x. f (g ((v - u) * x + u)) * vector_derivative g (at ((v - u) * x + u)))
             has_integral (1 / (v - u)) * integral {u..v} (\<lambda>t. f (g t) * vector_derivative g (at t)))
            {0..1}"
     using uv False unfolding has_integral_integral
     apply simp
     apply (drule has_integral_affinity [where m="v-u" and c=u, simplified])
     apply (simp_all add: image_affinity_atLeastAtMost_div_diff scaleR_conv_of_real)
     apply (simp add: divide_simps)
     done
 
   have vd: "vector_derivative (\<lambda>x. g ((v-u) * x + u)) (at x) = (v-u) *\<^sub>R vector_derivative g (at ((v-u) * x + u))"
     if "x \<in> {0..1}"  "x \<notin> (\<lambda>t. (v-u) *\<^sub>R t + u) -` S" for x
   proof (rule vector_derivative_at [OF vector_diff_chain_at [simplified o_def]])
     show "((\<lambda>x. (v - u) * x + u) has_vector_derivative v - u) (at x)"
       by (intro derivative_eq_intros | simp)+
   qed (use S uv mult_left_le [of x "v-u"] that in \<open>auto simp: vector_derivative_works\<close>)
 
   have fin: "finite ((\<lambda>t. (v - u) *\<^sub>R t + u) -` S)"
     using fs by (auto simp: inj_on_def False finite_vimageI)
   show ?thesis
     unfolding subpath_def has_contour_integral
     apply (rule has_integral_spike_finite [OF fin])
     using has_integral_cmul [OF *, where c = "v-u"] fs assms
     by (auto simp: False vd scaleR_conv_of_real)
 qed
 
 lemma contour_integrable_subpath:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}"
     shows "f contour_integrable_on (subpath u v g)"
   by (smt (verit, ccfv_threshold) assms contour_integrable_on_def contour_integrable_reversepath_eq
       has_contour_integral_subpath reversepath_subpath valid_path_subpath)
 
 lemma has_integral_contour_integral_subpath:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}" "u \<le> v"
     shows "((\<lambda>x. f(g x) * vector_derivative g (at x))
             has_integral  contour_integral (subpath u v g) f) {u..v}"
           (is "(?fg has_integral _)_")
 proof -
   have "(?fg has_integral integral {u..v} ?fg) {u..v}"
     using assms contour_integrable_on integrable_on_subinterval by fastforce
   then show ?thesis
     by (metis (full_types) assms contour_integral_unique has_contour_integral_subpath)
 qed
 
 lemma contour_integral_subcontour_integral:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}" "u \<le> v"
     shows "contour_integral (subpath u v g) f =
            integral {u..v} (\<lambda>x. f(g x) * vector_derivative g (at x))"
   using assms has_contour_integral_subpath contour_integral_unique by blast
 
 lemma contour_integral_subpath_combine_less:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}" "w \<in> {0..1}"
           "u<v" "v<w"
     shows "contour_integral (subpath u v g) f + contour_integral (subpath v w g) f =
            contour_integral (subpath u w g) f"
 proof -
   have "(\<lambda>x. f (g x) * vector_derivative g (at x)) integrable_on {u..w}"
     using integrable_on_subcbox [where a=u and b=w and S = "{0..1}"] assms
     by (auto simp: contour_integrable_on)
   with assms show ?thesis
     by (auto simp: contour_integral_subcontour_integral Henstock_Kurzweil_Integration.integral_combine)
 qed
 
 lemma contour_integral_subpath_combine:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}" "w \<in> {0..1}"
     shows "contour_integral (subpath u v g) f + contour_integral (subpath v w g) f =
            contour_integral (subpath u w g) f"
 proof (cases "u\<noteq>v \<and> v\<noteq>w \<and> u\<noteq>w")
   case True
     have *: "subpath v u g = reversepath(subpath u v g) \<and>
              subpath w u g = reversepath(subpath u w g) \<and>
              subpath w v g = reversepath(subpath v w g)"
       by (auto simp: reversepath_subpath)
     have "u < v \<and> v < w \<or>
           u < w \<and> w < v \<or>
           v < u \<and> u < w \<or>
           v < w \<and> w < u \<or>
           w < u \<and> u < v \<or>
           w < v \<and> v < u"
       using True assms by linarith
     with assms show ?thesis
       using contour_integral_subpath_combine_less [of f g u v w]
             contour_integral_subpath_combine_less [of f g u w v]
             contour_integral_subpath_combine_less [of f g v u w]
             contour_integral_subpath_combine_less [of f g v w u]
             contour_integral_subpath_combine_less [of f g w u v]
             contour_integral_subpath_combine_less [of f g w v u]
       by (elim disjE) (auto simp: * contour_integral_reversepath contour_integrable_subpath
                                     valid_path_subpath algebra_simps)
 next
   case False
   with assms show ?thesis
     by (metis add.right_neutral contour_integral_reversepath contour_integral_subpath_refl diff_0 eq_diff_eq add_0 reversepath_subpath valid_path_subpath)
 qed
 
 lemma contour_integral_integral:
      "contour_integral g f = integral {0..1} (\<lambda>x. f (g x) * vector_derivative g (at x))"
   by (simp add: contour_integral_def integral_def has_contour_integral contour_integrable_on)
 
 lemma contour_integral_cong:
   assumes "g = g'" "\<And>x. x \<in> path_image g \<Longrightarrow> f x = f' x"
   shows   "contour_integral g f = contour_integral g' f'"
   unfolding contour_integral_integral using assms
   by (intro integral_cong) (auto simp: path_image_def)
 
 lemma contour_integral_spike_finite_simple_path:
   assumes "finite A" "simple_path g" "g = g'" "\<And>x. x \<in> path_image g - A \<Longrightarrow> f x = f' x"
   shows   "contour_integral g f = contour_integral g' f'"
   unfolding contour_integral_integral
 proof (rule integral_spike)
   have "finite (g -` A \<inter> {0<..<1})" using \<open>simple_path g\<close> \<open>finite A\<close>
     by (intro finite_vimage_IntI simple_path_inj_on) auto
   hence "finite ({0, 1} \<union> g -` A \<inter> {0<..<1})" by auto
   thus "negligible ({0, 1} \<union> g -` A \<inter> {0<..<1})" by (rule negligible_finite)
 next
   fix x assume "x \<in> {0..1} - ({0, 1} \<union> g -` A \<inter> {0<..<1})"
   hence "g x \<in> path_image g - A" by (auto simp: path_image_def)
   with assms show "f' (g' x) * vector_derivative g' (at x) = f (g x) * vector_derivative g (at x)" 
     by simp
 qed
 
 
 text \<open>Contour integral along a segment on the real axis\<close>
 
 lemma has_contour_integral_linepath_Reals_iff:
   fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   shows   "(f has_contour_integral I) (linepath a b) \<longleftrightarrow>
            ((\<lambda>x. f (of_real x)) has_integral I) {Re a..Re b}"
 proof -
   from assms have [simp]: "of_real (Re a) = a" "of_real (Re b) = b"
     by (simp_all add: complex_eq_iff)
   from assms have "a \<noteq> b" by auto
   have "((\<lambda>x. f (of_real x)) has_integral I) (cbox (Re a) (Re b)) \<longleftrightarrow>
           ((\<lambda>x. f (a + b * of_real x - a * of_real x)) has_integral I /\<^sub>R (Re b - Re a)) {0..1}"
     by (subst has_integral_affinity_iff [of "Re b - Re a" _ "Re a", symmetric])
        (insert assms, simp_all add: field_simps scaleR_conv_of_real)
   also have "(\<lambda>x. f (a + b * of_real x - a * of_real x)) =
                (\<lambda>x. (f (a + b * of_real x - a * of_real x) * (b - a)) /\<^sub>R (Re b - Re a))"
     using \<open>a \<noteq> b\<close> by (auto simp: field_simps fun_eq_iff scaleR_conv_of_real)
   also have "(\<dots> has_integral I /\<^sub>R (Re b - Re a)) {0..1} \<longleftrightarrow>
                ((\<lambda>x. f (linepath a b x) * (b - a)) has_integral I) {0..1}" using assms
     by (subst has_integral_cmul_iff) (auto simp: linepath_def scaleR_conv_of_real algebra_simps)
   also have "\<dots> \<longleftrightarrow> (f has_contour_integral I) (linepath a b)" unfolding has_contour_integral_def
     by (intro has_integral_cong) (simp add: vector_derivative_linepath_within)
   finally show ?thesis by simp
 qed
 
 lemma contour_integrable_linepath_Reals_iff:
   fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   shows   "(f contour_integrable_on linepath a b) \<longleftrightarrow>
              (\<lambda>x. f (of_real x)) integrable_on {Re a..Re b}"
   using has_contour_integral_linepath_Reals_iff[OF assms, of f]
   by (auto simp: contour_integrable_on_def integrable_on_def)
 
 lemma contour_integral_linepath_Reals_eq:
   fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   shows   "contour_integral (linepath a b) f = integral {Re a..Re b} (\<lambda>x. f (of_real x))"
 proof (cases "f contour_integrable_on linepath a b")
   case True
   thus ?thesis using has_contour_integral_linepath_Reals_iff[OF assms, of f]
     using has_contour_integral_integral has_contour_integral_unique by blast
 next
   case False
   thus ?thesis using contour_integrable_linepath_Reals_iff[OF assms, of f]
     by (simp add: not_integrable_contour_integral not_integrable_integral)
 qed
 
 subsection \<open>Cauchy's theorem where there's a primitive\<close>
 
 lemma contour_integral_primitive_lemma:
   fixes f :: "complex \<Rightarrow> complex" and g :: "real \<Rightarrow> complex"
   assumes "a \<le> b"
       and "\<And>x. x \<in> S \<Longrightarrow> (f has_field_derivative f' x) (at x within S)"
       and "g piecewise_differentiable_on {a..b}"  "\<And>x. x \<in> {a..b} \<Longrightarrow> g x \<in> S"
     shows "((\<lambda>x. f'(g x) * vector_derivative g (at x within {a..b}))
              has_integral (f(g b) - f(g a))) {a..b}"
 proof -
   obtain K where "finite K" and K: "\<forall>x\<in>{a..b} - K. g differentiable (at x within {a..b})" and cg: "continuous_on {a..b} g"
     using assms by (auto simp: piecewise_differentiable_on_def)
   have "continuous_on (g ` {a..b}) f"
     using assms
     by (metis field_differentiable_def field_differentiable_imp_continuous_at continuous_on_eq_continuous_within continuous_on_subset image_subset_iff)
   then have cfg: "continuous_on {a..b} (\<lambda>x. f (g x))"
     by (rule continuous_on_compose [OF cg, unfolded o_def])
   { fix x::real
     assume a: "a < x" and b: "x < b" and xk: "x \<notin> K"
     then have "g differentiable at x within {a..b}"
       using K by (simp add: differentiable_at_withinI)
     then have "(g has_vector_derivative vector_derivative g (at x within {a..b})) (at x within {a..b})"
       by (simp add: vector_derivative_works has_field_derivative_def scaleR_conv_of_real)
     then have gdiff: "(g has_derivative (\<lambda>u. u * vector_derivative g (at x within {a..b}))) (at x within {a..b})"
       by (simp add: has_vector_derivative_def scaleR_conv_of_real)
     have "(f has_field_derivative (f' (g x))) (at (g x) within g ` {a..b})"
       using assms by (metis a atLeastAtMost_iff b DERIV_subset image_subset_iff less_eq_real_def)
     then have fdiff: "(f has_derivative (*) (f' (g x))) (at (g x) within g ` {a..b})"
       by (simp add: has_field_derivative_def)
     have "((\<lambda>x. f (g x)) has_vector_derivative f' (g x) * vector_derivative g (at x within {a..b})) (at x within {a..b})"
       using diff_chain_within [OF gdiff fdiff]
       by (simp add: has_vector_derivative_def scaleR_conv_of_real o_def mult_ac)
   } then show ?thesis
     using assms cfg 
     by (force simp: at_within_Icc_at intro: fundamental_theorem_of_calculus_interior_strong [OF \<open>finite K\<close>])
 qed
 
 lemma contour_integral_primitive:
   assumes "\<And>x. x \<in> S \<Longrightarrow> (f has_field_derivative f' x) (at x within S)"
       and "valid_path g" "path_image g \<subseteq> S"
     shows "(f' has_contour_integral (f(pathfinish g) - f(pathstart g))) g"
   using assms
   apply (simp add: valid_path_def path_image_def pathfinish_def pathstart_def has_contour_integral_def)
   apply (auto intro!: piecewise_C1_imp_differentiable contour_integral_primitive_lemma [of 0 1 S])
   done
 
 corollary Cauchy_theorem_primitive:
   assumes "\<And>x. x \<in> S \<Longrightarrow> (f has_field_derivative f' x) (at x within S)"
       and "valid_path g"  "path_image g \<subseteq> S" "pathfinish g = pathstart g"
     shows "(f' has_contour_integral 0) g"
   using assms by (metis diff_self contour_integral_primitive)
 
 
 lemma contour_integrable_continuous_linepath:
   assumes "continuous_on (closed_segment a b) f"
   shows "f contour_integrable_on (linepath a b)"
 proof -
   have "continuous_on (closed_segment a b) (\<lambda>x. f x * (b - a))"
     by (rule continuous_intros | simp add: assms)+
   then have "continuous_on {0..1} (\<lambda>x. f (linepath a b x) * (b - a))"
     by (metis (no_types, lifting) continuous_on_compose continuous_on_cong continuous_on_linepath linepath_image_01 o_apply)
   then have "(\<lambda>x. f (linepath a b x) *
          vector_derivative (linepath a b)
           (at x within {0..1})) integrable_on
     {0..1}"
     by (metis (no_types, lifting) continuous_on_cong integrable_continuous_real vector_derivative_linepath_within)
   then show ?thesis
     by (simp add: contour_integrable_on_def has_contour_integral_def integrable_on_def [symmetric])
 qed
 
 lemma has_field_der_id: "((\<lambda>x. x\<^sup>2/2) has_field_derivative x) (at x)"
   by (rule has_derivative_imp_has_field_derivative)
      (rule derivative_intros | simp)+
 
 lemma contour_integral_id [simp]: "contour_integral (linepath a b) (\<lambda>y. y) = (b^2 - a^2)/2"
   using contour_integral_primitive [of UNIV "\<lambda>x. x^2/2" "\<lambda>x. x" "linepath a b"] contour_integral_unique
   by (simp add: has_field_der_id)
 
 lemma contour_integrable_on_const [iff]: "(\<lambda>x. c) contour_integrable_on (linepath a b)"
   by (simp add: contour_integrable_continuous_linepath)
 
 lemma contour_integrable_on_id [iff]: "(\<lambda>x. x) contour_integrable_on (linepath a b)"
   by (simp add: contour_integrable_continuous_linepath)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Arithmetical combining theorems\<close>
 
 lemma has_contour_integral_neg:
     "(f has_contour_integral i) g \<Longrightarrow> ((\<lambda>x. -(f x)) has_contour_integral (-i)) g"
   by (simp add: has_integral_neg has_contour_integral_def)
 
 lemma has_contour_integral_add:
     "\<lbrakk>(f1 has_contour_integral i1) g; (f2 has_contour_integral i2) g\<rbrakk>
      \<Longrightarrow> ((\<lambda>x. f1 x + f2 x) has_contour_integral (i1 + i2)) g"
   by (simp add: has_integral_add has_contour_integral_def algebra_simps)
 
 lemma has_contour_integral_diff:
   "\<lbrakk>(f1 has_contour_integral i1) g; (f2 has_contour_integral i2) g\<rbrakk>
          \<Longrightarrow> ((\<lambda>x. f1 x - f2 x) has_contour_integral (i1 - i2)) g"
   by (simp add: has_integral_diff has_contour_integral_def algebra_simps)
 
 lemma has_contour_integral_lmul:
   "(f has_contour_integral i) g \<Longrightarrow> ((\<lambda>x. c * (f x)) has_contour_integral (c*i)) g"
   by (simp add: has_contour_integral_def algebra_simps has_integral_mult_right)
 
 lemma has_contour_integral_rmul:
   "(f has_contour_integral i) g \<Longrightarrow> ((\<lambda>x. (f x) * c) has_contour_integral (i*c)) g"
   by (simp add: mult.commute has_contour_integral_lmul)
 
 lemma has_contour_integral_div:
   "(f has_contour_integral i) g \<Longrightarrow> ((\<lambda>x. f x/c) has_contour_integral (i/c)) g"
   by (simp add: field_class.field_divide_inverse) (metis has_contour_integral_rmul)
 
 lemma has_contour_integral_eq:
     "\<lbrakk>(f has_contour_integral y) p; \<And>x. x \<in> path_image p \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> (g has_contour_integral y) p"
   by (metis (mono_tags, lifting) has_contour_integral_def has_integral_eq image_eqI path_image_def)
 
 lemma has_contour_integral_bound_linepath:
   assumes "(f has_contour_integral i) (linepath a b)"
           "0 \<le> B" and B: "\<And>x. x \<in> closed_segment a b \<Longrightarrow> norm(f x) \<le> B"
     shows "norm i \<le> B * norm(b - a)"
 proof -
   have "norm i \<le> (B * norm (b - a)) * content (cbox 0 (1::real))"
   proof (rule has_integral_bound
        [of _ "\<lambda>x. f (linepath a b x) * vector_derivative (linepath a b) (at x within {0..1})"])
     show  "cmod (f (linepath a b x) * vector_derivative (linepath a b) (at x within {0..1}))
          \<le> B * cmod (b - a)"
       if "x \<in> cbox 0 1" for x::real
       using that box_real(2) norm_mult
       by (metis B linepath_in_path mult_right_mono norm_ge_zero vector_derivative_linepath_within)
   qed (use assms has_contour_integral_def in auto)
   then show ?thesis
     by (auto simp: content_real)
 qed
 
 lemma has_contour_integral_const_linepath: "((\<lambda>x. c) has_contour_integral c*(b - a))(linepath a b)"
   unfolding has_contour_integral_linepath
   by (metis content_real diff_0_right has_integral_const_real lambda_one of_real_1 scaleR_conv_of_real zero_le_one)
 
 lemma has_contour_integral_0: "((\<lambda>x. 0) has_contour_integral 0) g"
   by (simp add: has_contour_integral_def)
 
 lemma has_contour_integral_is_0:
     "(\<And>z. z \<in> path_image g \<Longrightarrow> f z = 0) \<Longrightarrow> (f has_contour_integral 0) g"
   by (rule has_contour_integral_eq [OF has_contour_integral_0]) auto
 
 lemma has_contour_integral_sum:
     "\<lbrakk>finite s; \<And>a. a \<in> s \<Longrightarrow> (f a has_contour_integral i a) p\<rbrakk>
      \<Longrightarrow> ((\<lambda>x. sum (\<lambda>a. f a x) s) has_contour_integral sum i s) p"
   by (induction s rule: finite_induct) (auto simp: has_contour_integral_0 has_contour_integral_add)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Operations on path integrals\<close>
 
 lemma contour_integral_const_linepath [simp]: "contour_integral (linepath a b) (\<lambda>x. c) = c*(b - a)"
   by (rule contour_integral_unique [OF has_contour_integral_const_linepath])
 
 lemma contour_integral_neg: "contour_integral g (\<lambda>z. -f z) = -contour_integral g f"
   by (simp add: contour_integral_integral)
 
 lemma contour_integral_add:
     "f1 contour_integrable_on g \<Longrightarrow> f2 contour_integrable_on g \<Longrightarrow> contour_integral g (\<lambda>x. f1 x + f2 x) =
                 contour_integral g f1 + contour_integral g f2"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_add)
 
 lemma contour_integral_diff:
     "f1 contour_integrable_on g \<Longrightarrow> f2 contour_integrable_on g \<Longrightarrow> contour_integral g (\<lambda>x. f1 x - f2 x) =
                 contour_integral g f1 - contour_integral g f2"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_diff)
 
 lemma contour_integral_lmul:
   shows "f contour_integrable_on g
            \<Longrightarrow> contour_integral g (\<lambda>x. c * f x) = c*contour_integral g f"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_lmul)
 
 lemma contour_integral_rmul:
   shows "f contour_integrable_on g
         \<Longrightarrow> contour_integral g (\<lambda>x. f x * c) = contour_integral g f * c"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_rmul)
 
 lemma contour_integral_div:
   shows "f contour_integrable_on g
         \<Longrightarrow> contour_integral g (\<lambda>x. f x / c) = contour_integral g f / c"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_div)
 
 lemma contour_integral_eq:
     "(\<And>x. x \<in> path_image p \<Longrightarrow> f x = g x) \<Longrightarrow> contour_integral p f = contour_integral p g"
   using contour_integral_cong contour_integral_def by fastforce
 
 lemma contour_integral_eq_0:
     "(\<And>z. z \<in> path_image g \<Longrightarrow> f z = 0) \<Longrightarrow> contour_integral g f = 0"
   by (simp add: has_contour_integral_is_0 contour_integral_unique)
 
 lemma contour_integral_bound_linepath:
   shows
     "\<lbrakk>f contour_integrable_on (linepath a b);
       0 \<le> B; \<And>x. x \<in> closed_segment a b \<Longrightarrow> norm(f x) \<le> B\<rbrakk>
      \<Longrightarrow> norm(contour_integral (linepath a b) f) \<le> B*norm(b - a)"
   by (meson has_contour_integral_bound_linepath has_contour_integral_integral)
 
 lemma contour_integral_0 [simp]: "contour_integral g (\<lambda>x. 0) = 0"
   by (simp add: contour_integral_unique has_contour_integral_0)
 
 lemma contour_integral_sum:
     "\<lbrakk>finite s; \<And>a. a \<in> s \<Longrightarrow> (f a) contour_integrable_on p\<rbrakk>
      \<Longrightarrow> contour_integral p (\<lambda>x. sum (\<lambda>a. f a x) s) = sum (\<lambda>a. contour_integral p (f a)) s"
   by (auto simp: contour_integral_unique has_contour_integral_sum has_contour_integral_integral)
 
 lemma contour_integrable_eq:
     "\<lbrakk>f contour_integrable_on p; \<And>x. x \<in> path_image p \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> g contour_integrable_on p"
   unfolding contour_integrable_on_def
   by (metis has_contour_integral_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Arithmetic theorems for path integrability\<close>
 
 lemma contour_integrable_neg:
     "f contour_integrable_on g \<Longrightarrow> (\<lambda>x. -(f x)) contour_integrable_on g"
   using has_contour_integral_neg contour_integrable_on_def by blast
 
 lemma contour_integrable_add:
     "\<lbrakk>f1 contour_integrable_on g; f2 contour_integrable_on g\<rbrakk> \<Longrightarrow> (\<lambda>x. f1 x + f2 x) contour_integrable_on g"
   using has_contour_integral_add contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_diff:
     "\<lbrakk>f1 contour_integrable_on g; f2 contour_integrable_on g\<rbrakk> \<Longrightarrow> (\<lambda>x. f1 x - f2 x) contour_integrable_on g"
   using has_contour_integral_diff contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_lmul:
     "f contour_integrable_on g \<Longrightarrow> (\<lambda>x. c * f x) contour_integrable_on g"
   using has_contour_integral_lmul contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_rmul:
     "f contour_integrable_on g \<Longrightarrow> (\<lambda>x. f x * c) contour_integrable_on g"
   using has_contour_integral_rmul contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_div:
     "f contour_integrable_on g \<Longrightarrow> (\<lambda>x. f x / c) contour_integrable_on g"
   using has_contour_integral_div contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_sum:
   "\<lbrakk>finite s; \<And>a. a \<in> s \<Longrightarrow> (f a) contour_integrable_on p\<rbrakk>
      \<Longrightarrow> (\<lambda>x. sum (\<lambda>a. f a x) s) contour_integrable_on p"
   unfolding contour_integrable_on_def by (metis has_contour_integral_sum)
 
 lemma contour_integrable_neg_iff:
   "(\<lambda>x. -f x) contour_integrable_on g \<longleftrightarrow> f contour_integrable_on g"
   using contour_integrable_neg[of f g] contour_integrable_neg[of "\<lambda>x. -f x" g] by auto
 
 lemma contour_integrable_lmul_iff:
     "c \<noteq> 0 \<Longrightarrow> (\<lambda>x. c * f x) contour_integrable_on g \<longleftrightarrow> f contour_integrable_on g"
   using contour_integrable_lmul[of f g c] contour_integrable_lmul[of "\<lambda>x. c * f x" g "inverse c"]
   by (auto simp: field_simps)
 
 lemma contour_integrable_rmul_iff:
     "c \<noteq> 0 \<Longrightarrow> (\<lambda>x. f x * c) contour_integrable_on g \<longleftrightarrow> f contour_integrable_on g"
   using contour_integrable_rmul[of f g c] contour_integrable_rmul[of "\<lambda>x. c * f x" g "inverse c"]
   by (auto simp: field_simps)
 
 lemma contour_integrable_div_iff:
     "c \<noteq> 0 \<Longrightarrow> (\<lambda>x. f x / c) contour_integrable_on g \<longleftrightarrow> f contour_integrable_on g"
   using contour_integrable_rmul_iff[of "inverse c"] by (simp add: field_simps)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Reversing a path integral\<close>
 
 lemma has_contour_integral_reverse_linepath:
     "(f has_contour_integral i) (linepath a b)
      \<Longrightarrow> (f has_contour_integral (-i)) (linepath b a)"
   using has_contour_integral_reversepath valid_path_linepath by fastforce
 
 lemma contour_integral_reverse_linepath:
     "continuous_on (closed_segment a b) f \<Longrightarrow> contour_integral (linepath a b) f = - (contour_integral(linepath b a) f)"
   using contour_integral_reversepath by fastforce
 
 
 
 text \<open>Splitting a path integral in a flat way.*)\<close>
 
 lemma has_contour_integral_split:
   assumes f: "(f has_contour_integral i) (linepath a c)" "(f has_contour_integral j) (linepath c b)"
       and k: "0 \<le> k" "k \<le> 1"
       and c: "c - a = k *\<^sub>R (b - a)"
     shows "(f has_contour_integral (i + j)) (linepath a b)"
 proof (cases "k = 0 \<or> k = 1")
   case True
   then show ?thesis
     using assms by auto
 next
   case False
   then have k: "0 < k" "k < 1" "complex_of_real k \<noteq> 1"
     using assms by auto
   have c': "c = k *\<^sub>R (b - a) + a"
     by (metis diff_add_cancel c)
   have bc: "(b - c) = (1 - k) *\<^sub>R (b - a)"
     by (simp add: algebra_simps c')
   { assume *: "((\<lambda>x. f ((1 - x) *\<^sub>R a + x *\<^sub>R c) * (c - a)) has_integral i) {0..1}"
     have "\<And>x. (x / k) *\<^sub>R a + ((k - x) / k) *\<^sub>R a = a"
       using False by (simp add: field_split_simps flip: real_vector.scale_left_distrib)
     then have "\<And>x. ((k - x) / k) *\<^sub>R a + (x / k) *\<^sub>R c = (1 - x) *\<^sub>R a + x *\<^sub>R b"
       using False by (simp add: c' algebra_simps)
     then have "((\<lambda>x. f ((1 - x) *\<^sub>R a + x *\<^sub>R b) * (b - a)) has_integral i) {0..k}"
       using k has_integral_affinity01 [OF *, of "inverse k" "0"]
       by (force dest: has_integral_cmul [where c = "inverse k"]
               simp add: divide_simps mult.commute [of _ "k"] image_affinity_atLeastAtMost c)
   } note fi = this
   { assume *: "((\<lambda>x. f ((1 - x) *\<^sub>R c + x *\<^sub>R b) * (b - c)) has_integral j) {0..1}"
     have **: "\<And>x. (((1 - x) / (1 - k)) *\<^sub>R c + ((x - k) / (1 - k)) *\<^sub>R b) = ((1 - x) *\<^sub>R a + x *\<^sub>R b)"
       using k unfolding c' scaleR_conv_of_real
       apply (simp add: divide_simps)
       apply (simp add: distrib_right distrib_left right_diff_distrib left_diff_distrib)
       done
     have "((\<lambda>x. f ((1 - x) *\<^sub>R a + x *\<^sub>R b) * (b - a)) has_integral j) {k..1}"
       using k has_integral_affinity01 [OF *, of "inverse(1 - k)" "-(k/(1 - k))"]
       apply (simp add: divide_simps mult.commute [of _ "1-k"] image_affinity_atLeastAtMost ** bc)
       apply (auto dest: has_integral_cmul [where k = "(1 - k) *\<^sub>R j" and c = "inverse (1 - k)"])
       done
   } 
   then show ?thesis
     using f k unfolding has_contour_integral_linepath
     by (simp add: linepath_def has_integral_combine [OF _ _ fi])
 qed
 
 lemma continuous_on_closed_segment_transform:
   assumes f: "continuous_on (closed_segment a b) f"
       and k: "0 \<le> k" "k \<le> 1"
       and c: "c - a = k *\<^sub>R (b - a)"
     shows "continuous_on (closed_segment a c) f"
 proof -
   have c': "c = (1 - k) *\<^sub>R a + k *\<^sub>R b"
     using c by (simp add: algebra_simps)
   have "closed_segment a c \<subseteq> closed_segment a b"
     by (metis c' ends_in_segment(1) in_segment(1) k subset_closed_segment)
   then show "continuous_on (closed_segment a c) f"
     by (rule continuous_on_subset [OF f])
 qed
 
 lemma contour_integral_split:
   assumes f: "continuous_on (closed_segment a b) f"
       and k: "0 \<le> k" "k \<le> 1"
       and c: "c - a = k *\<^sub>R (b - a)"
     shows "contour_integral(linepath a b) f = contour_integral(linepath a c) f + contour_integral(linepath c b) f"
 proof -
   have c': "c = (1 - k) *\<^sub>R a + k *\<^sub>R b"
     using c by (simp add: algebra_simps)
   have "closed_segment a c \<subseteq> closed_segment a b"
     by (metis c' ends_in_segment(1) in_segment(1) k subset_closed_segment)
   moreover have "closed_segment c b \<subseteq> closed_segment a b"
     by (metis c' ends_in_segment(2) in_segment(1) k subset_closed_segment)
   ultimately
   have *: "continuous_on (closed_segment a c) f" "continuous_on (closed_segment c b) f"
     by (auto intro: continuous_on_subset [OF f])
   show ?thesis
     by (rule contour_integral_unique) (meson "*" c contour_integrable_continuous_linepath has_contour_integral_integral has_contour_integral_split k)
 qed
 
 lemma contour_integral_split_linepath:
   assumes f: "continuous_on (closed_segment a b) f"
       and c: "c \<in> closed_segment a b"
     shows "contour_integral(linepath a b) f = contour_integral(linepath a c) f + contour_integral(linepath c b) f"
   using c by (auto simp: closed_segment_def algebra_simps intro!: contour_integral_split [OF f])
 
 
 subsection\<open>Reversing the order in a double path integral\<close>
 
 text\<open>The condition is stronger than needed but it's often true in typical situations\<close>
 
 lemma fst_im_cbox [simp]: "cbox c d \<noteq> {} \<Longrightarrow> (fst ` cbox (a,c) (b,d)) = cbox a b"
   by (auto simp: cbox_Pair_eq)
 
 lemma snd_im_cbox [simp]: "cbox a b \<noteq> {} \<Longrightarrow> (snd ` cbox (a,c) (b,d)) = cbox c d"
   by (auto simp: cbox_Pair_eq)
 
 proposition contour_integral_swap:
   assumes fcon:  "continuous_on (path_image g \<times> path_image h) (\<lambda>(y1,y2). f y1 y2)"
       and vp:    "valid_path g" "valid_path h"
       and gvcon: "continuous_on {0..1} (\<lambda>t. vector_derivative g (at t))"
       and hvcon: "continuous_on {0..1} (\<lambda>t. vector_derivative h (at t))"
   shows "contour_integral g (\<lambda>w. contour_integral h (f w)) =
          contour_integral h (\<lambda>z. contour_integral g (\<lambda>w. f w z))"
 proof -
   have gcon: "continuous_on {0..1} g" and hcon: "continuous_on {0..1} h"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
   have fgh1: "\<And>x. (\<lambda>t. f (g x) (h t)) = (\<lambda>(y1,y2). f y1 y2) \<circ> (\<lambda>t. (g x, h t))"
     by (rule ext) simp
   have fgh2: "\<And>x. (\<lambda>t. f (g t) (h x)) = (\<lambda>(y1,y2). f y1 y2) \<circ> (\<lambda>t. (g t, h x))"
     by (rule ext) simp
   have fcon_im1: "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> continuous_on ((\<lambda>t. (g x, h t)) ` {0..1}) (\<lambda>(x, y). f x y)"
     by (rule continuous_on_subset [OF fcon]) (auto simp: path_image_def)
   have fcon_im2: "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> continuous_on ((\<lambda>t. (g t, h x)) ` {0..1}) (\<lambda>(x, y). f x y)"
     by (rule continuous_on_subset [OF fcon]) (auto simp: path_image_def)
   have "continuous_on (cbox (0, 0) (1, 1::real)) ((\<lambda>x. vector_derivative g (at x)) \<circ> fst)"
        "continuous_on (cbox (0, 0) (1::real, 1)) ((\<lambda>x. vector_derivative h (at x)) \<circ> snd)"
     by (rule continuous_intros | simp add: gvcon hvcon)+
   then have gvcon': "continuous_on (cbox (0, 0) (1, 1::real)) (\<lambda>z. vector_derivative g (at (fst z)))"
        and  hvcon': "continuous_on (cbox (0, 0) (1::real, 1)) (\<lambda>x. vector_derivative h (at (snd x)))"
     by auto
   have "continuous_on ((\<lambda>x. (g (fst x), h (snd x))) ` cbox (0,0) (1,1)) (\<lambda>(y1, y2). f y1 y2)"
     by (auto simp: path_image_def intro: continuous_on_subset [OF fcon])
   then have "continuous_on (cbox (0, 0) (1, 1)) ((\<lambda>(y1, y2). f y1 y2) \<circ> (\<lambda>w. ((g \<circ> fst) w, (h \<circ> snd) w)))"
     by (intro gcon hcon continuous_intros | simp)+
   then have fgh: "continuous_on (cbox (0, 0) (1, 1)) (\<lambda>x. f (g (fst x)) (h (snd x)))"
     by auto
   have "integral {0..1} (\<lambda>x. contour_integral h (f (g x)) * vector_derivative g (at x)) =
         integral {0..1} (\<lambda>x. contour_integral h (\<lambda>y. f (g x) y * vector_derivative g (at x)))"
   proof (rule integral_cong [OF contour_integral_rmul [symmetric]])
     have "\<And>x. x \<in> {0..1} \<Longrightarrow>
          continuous_on {0..1} (\<lambda>xa. f (g x) (h xa))"
     by (subst fgh1) (rule fcon_im1 hcon continuous_intros | simp)+
     then show "\<And>x. x \<in> {0..1} \<Longrightarrow> f (g x) contour_integrable_on h"
       unfolding contour_integrable_on
       using continuous_on_mult hvcon integrable_continuous_real by blast
   qed
   also have "\<dots> = integral {0..1}
                      (\<lambda>y. contour_integral g (\<lambda>x. f x (h y) * vector_derivative h (at y)))"
     unfolding contour_integral_integral
     apply (subst integral_swap_continuous [where 'a = real and 'b = real, of 0 0 1 1, simplified])
     subgoal
       by (rule fgh gvcon' hvcon' continuous_intros | simp add: split_def)+
     subgoal
       unfolding integral_mult_left [symmetric]
       by (simp only: mult_ac)
     done
   also have "\<dots> = contour_integral h (\<lambda>z. contour_integral g (\<lambda>w. f w z))"
     unfolding contour_integral_integral integral_mult_left [symmetric]
     by (simp add: algebra_simps)
   finally show ?thesis
     by (simp add: contour_integral_integral)
 qed
 
 lemma valid_path_negatepath: "valid_path \<gamma> \<Longrightarrow> valid_path (uminus \<circ> \<gamma>)"
    unfolding o_def using piecewise_C1_differentiable_neg valid_path_def by blast
 
 lemma has_contour_integral_negatepath:
   assumes \<gamma>: "valid_path \<gamma>" and cint: "((\<lambda>z. f (- z)) has_contour_integral - i) \<gamma>"
   shows "(f has_contour_integral i) (uminus \<circ> \<gamma>)"
 proof -
   obtain S where cont: "continuous_on {0..1} \<gamma>" and "finite S" and diff: "\<gamma> C1_differentiable_on {0..1} - S"
     using \<gamma> by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
   have "((\<lambda>x. - (f (- \<gamma> x) * vector_derivative \<gamma> (at x within {0..1}))) has_integral i) {0..1}"
     using cint by (auto simp: has_contour_integral_def dest: has_integral_neg)
   then
   have "((\<lambda>x. f (- \<gamma> x) * vector_derivative (uminus \<circ> \<gamma>) (at x within {0..1})) has_integral i) {0..1}"
   proof (rule rev_iffD1 [OF _ has_integral_spike_eq])
     show "negligible S"
       by (simp add: \<open>finite S\<close> negligible_finite)
     show "f (- \<gamma> x) * vector_derivative (uminus \<circ> \<gamma>) (at x within {0..1}) =
          - (f (- \<gamma> x) * vector_derivative \<gamma> (at x within {0..1}))"
       if "x \<in> {0..1} - S" for x
     proof -
       have "vector_derivative (uminus \<circ> \<gamma>) (at x within cbox 0 1) = - vector_derivative \<gamma> (at x within cbox 0 1)"
       proof (rule vector_derivative_within_cbox)
         show "(uminus \<circ> \<gamma> has_vector_derivative - vector_derivative \<gamma> (at x within cbox 0 1)) (at x within cbox 0 1)"
           using that unfolding o_def
           by (metis C1_differentiable_on_eq UNIV_I diff differentiable_subset has_vector_derivative_minus subsetI that vector_derivative_works)
       qed (use that in auto)
       then show ?thesis
         by simp
     qed
   qed
   then show ?thesis by (simp add: has_contour_integral_def)
 qed
 
 lemma contour_integrable_negatepath:
   assumes \<gamma>: "valid_path \<gamma>" and pi: "(\<lambda>z. f (- z)) contour_integrable_on \<gamma>"
   shows "f contour_integrable_on (uminus \<circ> \<gamma>)"
   by (metis \<gamma> add.inverse_inverse contour_integrable_on_def has_contour_integral_negatepath pi)
 
 lemma C1_differentiable_polynomial_function:
   fixes p :: "real \<Rightarrow> 'a::euclidean_space"
   shows "polynomial_function p \<Longrightarrow> p C1_differentiable_on S"
   by (metis continuous_on_polymonial_function C1_differentiable_on_def  has_vector_derivative_polynomial_function)
 
 lemma valid_path_polynomial_function:
   fixes p :: "real \<Rightarrow> 'a::euclidean_space"
   shows "polynomial_function p \<Longrightarrow> valid_path p"
   by (force simp: valid_path_def piecewise_C1_differentiable_on_def continuous_on_polymonial_function C1_differentiable_polynomial_function)
 
 lemma valid_path_subpath_trivial [simp]:
     fixes g :: "real \<Rightarrow> 'a::euclidean_space"
     shows "z \<noteq> g x \<Longrightarrow> valid_path (subpath x x g)"
   by (simp add: subpath_def valid_path_polynomial_function)
 
 subsection\<open>Partial circle path\<close>
 
 definition\<^marker>\<open>tag important\<close> part_circlepath :: "[complex, real, real, real, real] \<Rightarrow> complex"
   where "part_circlepath z r s t \<equiv> \<lambda>x. z + of_real r * exp (\<i> * of_real (linepath s t x))"
 
 lemma pathstart_part_circlepath [simp]:
   "pathstart(part_circlepath z r s t) = z + r*exp(\<i> * s)"
   by (metis part_circlepath_def pathstart_def pathstart_linepath)
 
 lemma pathfinish_part_circlepath [simp]:
   "pathfinish(part_circlepath z r s t) = z + r*exp(\<i>*t)"
   by (metis part_circlepath_def pathfinish_def pathfinish_linepath)
 
 lemma reversepath_part_circlepath[simp]:
   "reversepath (part_circlepath z r s t) = part_circlepath z r t s"
   unfolding part_circlepath_def reversepath_def linepath_def
   by (auto simp:algebra_simps)
 
 lemma has_vector_derivative_part_circlepath [derivative_intros]:
     "((part_circlepath z r s t) has_vector_derivative
       (\<i> * r * (of_real t - of_real s) * exp(\<i> * linepath s t x)))
      (at x within X)"
   unfolding part_circlepath_def linepath_def scaleR_conv_of_real
   by (rule has_vector_derivative_real_field derivative_eq_intros | simp)+
 
 lemma differentiable_part_circlepath:
   "part_circlepath c r a b differentiable at x within A"
   using has_vector_derivative_part_circlepath[of c r a b x A] differentiableI_vector by blast
 
 lemma vector_derivative_part_circlepath:
     "vector_derivative (part_circlepath z r s t) (at x) =
        \<i> * r * (of_real t - of_real s) * exp(\<i> * linepath s t x)"
   using has_vector_derivative_part_circlepath vector_derivative_at by blast
 
 lemma vector_derivative_part_circlepath01:
     "\<lbrakk>0 \<le> x; x \<le> 1\<rbrakk>
      \<Longrightarrow> vector_derivative (part_circlepath z r s t) (at x within {0..1}) =
           \<i> * r * (of_real t - of_real s) * exp(\<i> * linepath s t x)"
   using has_vector_derivative_part_circlepath
   by (auto simp: vector_derivative_at_within_ivl)
 
 lemma valid_path_part_circlepath [simp]: "valid_path (part_circlepath z r s t)"
   unfolding valid_path_def
   by (auto simp: C1_differentiable_on_eq vector_derivative_works vector_derivative_part_circlepath has_vector_derivative_part_circlepath
               intro!: C1_differentiable_imp_piecewise continuous_intros)
 
 lemma path_part_circlepath [simp]: "path (part_circlepath z r s t)"
   by (simp add: valid_path_imp_path)
 
 proposition path_image_part_circlepath:
   assumes "s \<le> t"
     shows "path_image (part_circlepath z r s t) = {z + r * exp(\<i> * of_real x) | x. s \<le> x \<and> x \<le> t}"
 proof -
   { fix z::real
     assume "0 \<le> z" "z \<le> 1"
     with \<open>s \<le> t\<close> have "\<exists>x. (exp (\<i> * linepath s t z) = exp (\<i> * of_real x)) \<and> s \<le> x \<and> x \<le> t"
       apply (rule_tac x="(1 - z) * s + z * t" in exI)
       apply (simp add: linepath_def scaleR_conv_of_real algebra_simps)
       by (metis (no_types) affine_ineq mult.commute mult_left_mono)
   }
   moreover
   { fix z
     assume "s \<le> z" "z \<le> t"
     then have "z + of_real r * exp (\<i> * of_real z) \<in> (\<lambda>x. z + of_real r * exp (\<i> * linepath s t x)) ` {0..1}"
       apply (rule_tac x="(z - s)/(t - s)" in image_eqI)
       apply (simp add: linepath_def scaleR_conv_of_real divide_simps exp_eq)
       apply (auto simp: field_split_simps)
       done
   }
   ultimately show ?thesis
     by (fastforce simp add: path_image_def part_circlepath_def)
 qed
 
 lemma path_image_part_circlepath':
   "path_image (part_circlepath z r s t) = (\<lambda>x. z + r * cis x) ` closed_segment s t"
 proof -
   have "path_image (part_circlepath z r s t) =
           (\<lambda>x. z + r * exp(\<i> * of_real x)) ` linepath s t ` {0..1}"
     by (simp add: image_image path_image_def part_circlepath_def)
   also have "linepath s t ` {0..1} = closed_segment s t"
     by (rule linepath_image_01)
   finally show ?thesis by (simp add: cis_conv_exp)
 qed
 
 lemma path_image_part_circlepath_subset:
     "\<lbrakk>s \<le> t; 0 \<le> r\<rbrakk> \<Longrightarrow> path_image(part_circlepath z r s t) \<subseteq> sphere z r"
 by (auto simp: path_image_part_circlepath sphere_def dist_norm algebra_simps norm_mult)
 
 lemma in_path_image_part_circlepath:
   assumes "w \<in> path_image(part_circlepath z r s t)" "s \<le> t" "0 \<le> r"
     shows "norm(w - z) = r"
   by (smt (verit) assms dist_norm mem_Collect_eq norm_minus_commute path_image_part_circlepath_subset sphere_def subsetD)
 
 lemma path_image_part_circlepath_subset':
   assumes "r \<ge> 0"
   shows   "path_image (part_circlepath z r s t) \<subseteq> sphere z r"
   by (smt (verit) assms path_image_part_circlepath_subset reversepath_part_circlepath reversepath_simps(2))
 
 lemma part_circlepath_cnj: "cnj (part_circlepath c r a b x) = part_circlepath (cnj c) r (-a) (-b) x"
   by (simp add: part_circlepath_def exp_cnj linepath_def algebra_simps)
 
+lemma contour_integrable_on_compose_cnj_iff:
+  assumes "valid_path \<gamma>"
+  shows   "f contour_integrable_on (cnj \<circ> \<gamma>) \<longleftrightarrow> (cnj \<circ> f \<circ> cnj) contour_integrable_on \<gamma>"
+proof -
+  from assms obtain S where S: "finite S" "\<gamma> C1_differentiable_on {0..1} - S"
+    unfolding valid_path_def piecewise_C1_differentiable_on_def by blast
+  have "f contour_integrable_on (cnj \<circ> \<gamma>) \<longleftrightarrow>
+        ((\<lambda>t. cnj (cnj (f (cnj (\<gamma> t))) * vector_derivative \<gamma> (at t))) integrable_on {0..1})"
+    unfolding contour_integrable_on o_def
+  proof (intro integrable_spike_finite_eq [OF S(1)])
+    fix t :: real assume "t \<in> {0..1} - S"
+    hence "\<gamma> differentiable at t"
+      using S(2) by (meson C1_differentiable_on_eq)
+    hence "vector_derivative (\<lambda>x. cnj (\<gamma> x)) (at t) = cnj (vector_derivative \<gamma> (at t))"
+      by (rule vector_derivative_cnj)
+    thus "f (cnj (\<gamma> t)) * vector_derivative (\<lambda>x. cnj (\<gamma> x)) (at t) =
+          cnj (cnj (f (cnj (\<gamma> t))) * vector_derivative \<gamma> (at t))"
+      by simp
+  qed
+  also have "\<dots> \<longleftrightarrow> ((\<lambda>t. cnj (f (cnj (\<gamma> t))) * vector_derivative \<gamma> (at t)) integrable_on {0..1})"
+    by (rule integrable_on_cnj_iff)
+  also have "\<dots> \<longleftrightarrow> (cnj \<circ> f \<circ> cnj) contour_integrable_on \<gamma>"
+    by (simp add: contour_integrable_on o_def)
+  finally show ?thesis .
+qed
+
+lemma contour_integral_cnj:
+  assumes "valid_path \<gamma>"
+  shows   "contour_integral (cnj \<circ> \<gamma>) f = cnj (contour_integral \<gamma> (cnj \<circ> f \<circ> cnj))"
+proof -
+  from assms obtain S where S: "finite S" "\<gamma> C1_differentiable_on {0..1} - S"
+    unfolding valid_path_def piecewise_C1_differentiable_on_def by blast
+  have "contour_integral (cnj \<circ> \<gamma>) f =
+          integral {0..1} (\<lambda>t. cnj (cnj (f (cnj (\<gamma> t))) * vector_derivative \<gamma> (at t)))"
+    unfolding contour_integral_integral
+  proof (intro integral_spike)
+    fix t assume "t \<in> {0..1} - S"
+    hence "\<gamma> differentiable at t"
+      using S(2) by (meson C1_differentiable_on_eq)
+    hence "vector_derivative (\<lambda>x. cnj (\<gamma> x)) (at t) = cnj (vector_derivative \<gamma> (at t))"
+      by (rule vector_derivative_cnj)
+    thus "cnj (cnj (f (cnj (\<gamma> t))) * vector_derivative \<gamma> (at t)) =
+            f ((cnj \<circ> \<gamma>) t) * vector_derivative (cnj \<circ> \<gamma>) (at t)"
+      by (simp add: o_def)
+  qed (use S(1) in auto)
+  also have "\<dots> = cnj (integral {0..1} (\<lambda>t. cnj (f (cnj (\<gamma> t))) * vector_derivative \<gamma> (at t)))"
+    by (subst integral_cnj [symmetric]) auto
+  also have "\<dots> = cnj (contour_integral \<gamma> (cnj \<circ> f \<circ> cnj))"
+    by (simp add: contour_integral_integral)
+  finally show ?thesis .
+qed
+
+lemma contour_integral_negatepath:
+  assumes "valid_path \<gamma>"
+  shows   "contour_integral (uminus \<circ> \<gamma>) f = -(contour_integral \<gamma> (\<lambda>x. f (-x)))" (is "?lhs = ?rhs")
+proof (cases "f contour_integrable_on (uminus \<circ> \<gamma>)")
+  case True
+  hence *: "(f has_contour_integral ?lhs) (uminus \<circ> \<gamma>)"
+    using has_contour_integral_integral by blast
+  have "((\<lambda>z. f (-z)) has_contour_integral - contour_integral (uminus \<circ> \<gamma>) f)
+            (uminus \<circ> (uminus \<circ> \<gamma>))"
+    by (rule has_contour_integral_negatepath) (use * assms in auto)
+  hence "((\<lambda>x. f (-x)) has_contour_integral -?lhs) \<gamma>"
+    by (simp add: o_def)
+  thus ?thesis
+    by (simp add: contour_integral_unique)
+next
+  case False
+  hence "\<not>(\<lambda>z. f (- z)) contour_integrable_on \<gamma>"
+    using contour_integrable_negatepath[of \<gamma> f] assms by auto
+  with False show ?thesis
+    by (simp add: not_integrable_contour_integral)
+qed
+
 lemma contour_integral_bound_part_circlepath:
   assumes "f contour_integrable_on part_circlepath c r a b"
   assumes "B \<ge> 0" "r \<ge> 0" "\<And>x. x \<in> path_image (part_circlepath c r a b) \<Longrightarrow> norm (f x) \<le> B"
   shows   "norm (contour_integral (part_circlepath c r a b) f) \<le> B * r * \<bar>b - a\<bar>"
 proof -
   let ?I = "integral {0..1} (\<lambda>x. f (part_circlepath c r a b x) * \<i> * of_real (r * (b - a)) *
               exp (\<i> * linepath a b x))"
   have "norm ?I \<le> integral {0..1} (\<lambda>x::real. B * 1 * (r * \<bar>b - a\<bar>) * 1)"
   proof (rule integral_norm_bound_integral, goal_cases)
     case 1
     with assms(1) show ?case
       by (simp add: contour_integrable_on vector_derivative_part_circlepath mult_ac)
   next
     case (3 x)
     with assms(2-) show ?case unfolding norm_mult norm_of_real abs_mult
       by (intro mult_mono) (auto simp: path_image_def)
   qed auto
   also have "?I = contour_integral (part_circlepath c r a b) f"
     by (simp add: contour_integral_integral vector_derivative_part_circlepath mult_ac)
   finally show ?thesis by simp
 qed
 
 lemma has_contour_integral_part_circlepath_iff:
   assumes "a < b"
   shows "(f has_contour_integral I) (part_circlepath c r a b) \<longleftrightarrow>
            ((\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) has_integral I) {a..b}"
 proof -
   have "(f has_contour_integral I) (part_circlepath c r a b) \<longleftrightarrow>
           ((\<lambda>x. f (part_circlepath c r a b x) * vector_derivative (part_circlepath c r a b)
            (at x within {0..1})) has_integral I) {0..1}"
     unfolding has_contour_integral_def ..
   also have "\<dots> \<longleftrightarrow> ((\<lambda>x. f (part_circlepath c r a b x) * r * (b - a) * \<i> *
                             cis (linepath a b x)) has_integral I) {0..1}"
     by (intro has_integral_cong, subst vector_derivative_part_circlepath01)
        (simp_all add: cis_conv_exp)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>x. f (c + r * exp (\<i> * linepath (of_real a) (of_real b) x)) *
                        r * \<i> * exp (\<i> * linepath (of_real a) (of_real b) x) *
                        vector_derivative (linepath (of_real a) (of_real b))
                          (at x within {0..1})) has_integral I) {0..1}"
     by (intro has_integral_cong, subst vector_derivative_linepath_within)
        (auto simp: part_circlepath_def cis_conv_exp of_real_linepath [symmetric])
   also have "\<dots> \<longleftrightarrow> ((\<lambda>z. f (c + r * exp (\<i> * z)) * r * \<i> * exp (\<i> * z)) has_contour_integral I)
                       (linepath (of_real a) (of_real b))"
     by (simp add: has_contour_integral_def)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) has_integral I) {a..b}" using assms
     by (subst has_contour_integral_linepath_Reals_iff) (simp_all add: cis_conv_exp)
   finally show ?thesis .
 qed
 
 lemma contour_integrable_part_circlepath_iff:
   assumes "a < b"
   shows "f contour_integrable_on (part_circlepath c r a b) \<longleftrightarrow>
            (\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}"
   using assms by (auto simp: contour_integrable_on_def integrable_on_def
                              has_contour_integral_part_circlepath_iff)
 
 lemma contour_integral_part_circlepath_eq:
   assumes "a < b"
   shows "contour_integral (part_circlepath c r a b) f =
            integral {a..b} (\<lambda>t. f (c + r * cis t) * r * \<i> * cis t)"
 proof (cases "f contour_integrable_on part_circlepath c r a b")
   case True
   hence "(\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}"
     using assms by (simp add: contour_integrable_part_circlepath_iff)
   with True show ?thesis
     using has_contour_integral_part_circlepath_iff[OF assms]
           contour_integral_unique has_integral_integrable_integral by blast
 next
   case False
   hence "\<not>(\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}"
     using assms by (simp add: contour_integrable_part_circlepath_iff)
   with False show ?thesis
     by (simp add: not_integrable_contour_integral not_integrable_integral)
 qed
 
 lemma contour_integral_part_circlepath_reverse:
   "contour_integral (part_circlepath c r a b) f = -contour_integral (part_circlepath c r b a) f"
   by (metis contour_integral_reversepath reversepath_part_circlepath valid_path_part_circlepath)
 
 lemma contour_integral_part_circlepath_reverse':
   "b < a \<Longrightarrow> contour_integral (part_circlepath c r a b) f =
                -contour_integral (part_circlepath c r b a) f"
   by (rule contour_integral_part_circlepath_reverse)
 
 lemma finite_bounded_log: "finite {z::complex. norm z \<le> b \<and> exp z = w}"
 proof (cases "w = 0")
   case True then show ?thesis by auto
 next
   case False
   have *: "finite {x. cmod ((2 * real_of_int x * pi) * \<i>) \<le> b + cmod (Ln w)}"
   proof (simp add: norm_mult finite_int_iff_bounded_le)
     show "\<exists>k. abs ` {x. 2 * \<bar>of_int x\<bar> * pi \<le> b + cmod (Ln w)} \<subseteq> {..k}"
     apply (rule_tac x="\<lfloor>(b + cmod (Ln w)) / (2*pi)\<rfloor>" in exI)
     apply (auto simp: field_split_simps le_floor_iff)
       done
   qed
   have [simp]: "\<And>P f. {z. P z \<and> (\<exists>n. z = f n)} = f ` {n. P (f n)}"
     by blast
   have "finite {z. cmod z \<le> b \<and> exp z = exp (Ln w)}"
     using norm_add_leD by (fastforce intro: finite_subset [OF _ *] simp: exp_eq)
   then show ?thesis
     using False by auto
 qed
 
 lemma finite_bounded_log2:
   fixes a::complex
     assumes "a \<noteq> 0"
     shows "finite {z. norm z \<le> b \<and> exp(a*z) = w}"
 proof -
   have *: "finite ((\<lambda>z. z / a) ` {z. cmod z \<le> b * cmod a \<and> exp z = w})"
     by (rule finite_imageI [OF finite_bounded_log])
   show ?thesis
     by (rule finite_subset [OF _ *]) (force simp: assms norm_mult)
 qed
 
 lemma has_contour_integral_bound_part_circlepath_strong:
   assumes fi: "(f has_contour_integral i) (part_circlepath z r s t)"
       and "finite k" and le: "0 \<le> B" "0 < r" "s \<le> t"
       and B: "\<And>x. x \<in> path_image(part_circlepath z r s t) - k \<Longrightarrow> norm(f x) \<le> B"
     shows "cmod i \<le> B * r * (t - s)"
 proof -
   consider "s = t" | "s < t" using \<open>s \<le> t\<close> by linarith
   then show ?thesis
   proof cases
     case 1 with fi [unfolded has_contour_integral]
     have "i = 0"  by (simp add: vector_derivative_part_circlepath)
     with assms show ?thesis by simp
   next
     case 2
     have [simp]: "\<bar>r\<bar> = r" using \<open>r > 0\<close> by linarith
     have [simp]: "cmod (complex_of_real t - complex_of_real s) = t-s"
       by (metis "2" abs_of_pos diff_gt_0_iff_gt norm_of_real of_real_diff)
     have "finite (part_circlepath z r s t -` {y} \<inter> {0..1})" if "y \<in> k" for y
     proof -
       let ?w = "(y - z)/of_real r / exp(\<i> * of_real s)"
       have fin: "finite (of_real -` {z. cmod z \<le> 1 \<and> exp (\<i> * complex_of_real (t - s) * z) = ?w})"
         using \<open>s < t\<close>
         by (intro finite_vimageI [OF finite_bounded_log2]) (auto simp: inj_of_real)
       show ?thesis
         unfolding part_circlepath_def linepath_def vimage_def
         using le
         by (intro finite_subset [OF _ fin]) (auto simp: algebra_simps scaleR_conv_of_real exp_add exp_diff)
     qed
     then have fin01: "finite ((part_circlepath z r s t) -` k \<inter> {0..1})"
       by (rule finite_finite_vimage_IntI [OF \<open>finite k\<close>])
     have **: "((\<lambda>x. if (part_circlepath z r s t x) \<in> k then 0
                     else f(part_circlepath z r s t x) *
                        vector_derivative (part_circlepath z r s t) (at x)) has_integral i)  {0..1}"
       by (rule has_integral_spike [OF negligible_finite [OF fin01]])  (use fi has_contour_integral in auto)
     have *: "\<And>x. \<lbrakk>0 \<le> x; x \<le> 1; part_circlepath z r s t x \<notin> k\<rbrakk> \<Longrightarrow> cmod (f (part_circlepath z r s t x)) \<le> B"
       by (auto intro!: B [unfolded path_image_def image_def])
     show ?thesis
       using has_integral_bound [where 'a=real, simplified, OF _ **]
       using assms le * "2" \<open>r > 0\<close> by (auto simp add: norm_mult vector_derivative_part_circlepath)
   qed
 qed
 
 corollary contour_integral_bound_part_circlepath_strong:
   assumes "f contour_integrable_on part_circlepath z r s t"
       and "finite k" and "0 \<le> B" "0 < r" "s \<le> t"
       and "\<And>x. x \<in> path_image(part_circlepath z r s t) - k \<Longrightarrow> norm(f x) \<le> B"
     shows "cmod (contour_integral (part_circlepath z r s t) f) \<le> B * r * (t - s)"
   using assms has_contour_integral_bound_part_circlepath_strong has_contour_integral_integral by blast
 
 lemma has_contour_integral_bound_part_circlepath:
       "\<lbrakk>(f has_contour_integral i) (part_circlepath z r s t);
         0 \<le> B; 0 < r; s \<le> t;
         \<And>x. x \<in> path_image(part_circlepath z r s t) \<Longrightarrow> norm(f x) \<le> B\<rbrakk>
        \<Longrightarrow> norm i \<le> B*r*(t - s)"
   by (auto intro: has_contour_integral_bound_part_circlepath_strong)
 
 lemma contour_integrable_continuous_part_circlepath:
      "continuous_on (path_image (part_circlepath z r s t)) f
       \<Longrightarrow> f contour_integrable_on (part_circlepath z r s t)"
   unfolding contour_integrable_on has_contour_integral_def vector_derivative_part_circlepath path_image_def
   by (best intro: integrable_continuous_real path_part_circlepath [unfolded path_def] continuous_intros 
       continuous_on_compose2 [where g=f, OF _ _ order_refl])
 
 lemma simple_path_part_circlepath:
     "simple_path(part_circlepath z r s t) \<longleftrightarrow> (r \<noteq> 0 \<and> s \<noteq> t \<and> \<bar>s - t\<bar> \<le> 2*pi)"
 proof (cases "r = 0 \<or> s = t")
   case True
   then show ?thesis
     unfolding part_circlepath_def simple_path_def loop_free_def
     by (rule disjE) (force intro: bexI [where x = "1/4"] bexI [where x = "1/3"])+
 next
   case False then have "r \<noteq> 0" "s \<noteq> t" by auto
   have *: "\<And>x y z s t. \<i>*((1 - x) * s + x * t) = \<i>*(((1 - y) * s + y * t)) + z  \<longleftrightarrow> \<i>*(x - y) * (t - s) = z"
     by (simp add: algebra_simps)
   have abs01: "\<And>x y::real. 0 \<le> x \<and> x \<le> 1 \<and> 0 \<le> y \<and> y \<le> 1
                       \<Longrightarrow> (x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0 \<longleftrightarrow> \<bar>x - y\<bar> \<in> {0,1})"
     by auto
   have **: "\<And>x y. (\<exists>n. (complex_of_real x - of_real y) * (of_real t - of_real s) = 2 * (of_int n * of_real pi)) \<longleftrightarrow>
                   (\<exists>n. \<bar>x - y\<bar> * (t - s) = 2 * (of_int n * pi))"
     by (force simp: algebra_simps abs_if dest: arg_cong [where f=Re] arg_cong [where f=complex_of_real]
                     intro: exI [where x = "-n" for n])
   have 1: "\<bar>s - t\<bar> \<le> 2 * pi"
     if "\<And>x. 0 \<le> x \<and> x \<le> 1 \<Longrightarrow> (\<exists>n. x * (t - s) = 2 * (real_of_int n * pi)) \<longrightarrow> x = 0 \<or> x = 1"
   proof (rule ccontr)
     assume "\<not> \<bar>s - t\<bar> \<le> 2 * pi"
     then have *: "\<And>n. t - s \<noteq> of_int n * \<bar>s - t\<bar>"
       using False that [of "2*pi / \<bar>t - s\<bar>"]
       by (simp add: abs_minus_commute divide_simps)
     show False
       using * [of 1] * [of "-1"] by auto
   qed
   have 2: "\<bar>s - t\<bar> = \<bar>2 * (real_of_int n * pi) / x\<bar>" if "x \<noteq> 0" "x * (t - s) = 2 * (real_of_int n * pi)" for x n
   proof -
     have "t-s = 2 * (real_of_int n * pi)/x"
       using that by (simp add: field_simps)
     then show ?thesis by (metis abs_minus_commute)
   qed
   have abs_away: "\<And>P. (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. P \<bar>x - y\<bar>) \<longleftrightarrow> (\<forall>x::real. 0 \<le> x \<and> x \<le> 1 \<longrightarrow> P x)"
     by force
   have "\<And>x n. \<lbrakk>s \<noteq> t; \<bar>s - t\<bar> \<le> 2 * pi; 0 \<le> x; x < 1;
             x * (t - s) = 2 * (real_of_int n * pi)\<rbrakk>
            \<Longrightarrow> x = 0"
     by (rule ccontr) (auto simp: 2 field_split_simps abs_mult dest: of_int_leD)
   then
   show ?thesis using False
     apply (simp add: simple_path_def loop_free_def)
     apply (simp add: part_circlepath_def linepath_def exp_eq  * ** abs01 del: Set.insert_iff)
     apply (subst abs_away)
     apply (auto simp: 1)
     done
 qed
 
 lemma arc_part_circlepath:
   assumes "r \<noteq> 0" "s \<noteq> t" "\<bar>s - t\<bar> < 2*pi"
     shows "arc (part_circlepath z r s t)"
 proof -
   have *: "x = y" if eq: "\<i> * (linepath s t x) = \<i> * (linepath s t y) + 2 * of_int n * complex_of_real pi * \<i>"
     and x: "x \<in> {0..1}" and y: "y \<in> {0..1}" for x y n
   proof (rule ccontr)
     assume "x \<noteq> y"
     have "(linepath s t x) = (linepath s t y) + 2 * of_int n * complex_of_real pi"
       by (metis add_divide_eq_iff complex_i_not_zero mult.commute nonzero_mult_div_cancel_left eq)
     then have "s*y + t*x = s*x + (t*y + of_int n * (pi * 2))"
       by (force simp: algebra_simps linepath_def dest: arg_cong [where f=Re])
     with \<open>x \<noteq> y\<close> have st: "s-t = (of_int n * (pi * 2) / (y-x))"
       by (force simp: field_simps)
     have "\<bar>real_of_int n\<bar> < \<bar>y - x\<bar>"
       using assms \<open>x \<noteq> y\<close> by (simp add: st abs_mult field_simps)
     then show False
       using assms x y st by (auto dest: of_int_lessD)
   qed
   then have "inj_on (part_circlepath z r s t) {0..1}"
     using assms by (force simp add: part_circlepath_def inj_on_def exp_eq)
   then show ?thesis
     by (simp add: arc_def)
 qed
 
 subsection\<open>Special case of one complete circle\<close>
 
 definition\<^marker>\<open>tag important\<close> circlepath :: "[complex, real, real] \<Rightarrow> complex"
   where "circlepath z r \<equiv> part_circlepath z r 0 (2*pi)"
 
 lemma circlepath: "circlepath z r = (\<lambda>x. z + r * exp(2 * of_real pi * \<i> * of_real x))"
   by (simp add: circlepath_def part_circlepath_def linepath_def algebra_simps)
 
 lemma pathstart_circlepath [simp]: "pathstart (circlepath z r) = z + r"
   by (simp add: circlepath_def)
 
 lemma pathfinish_circlepath [simp]: "pathfinish (circlepath z r) = z + r"
   by (simp add: circlepath_def) (metis exp_two_pi_i mult.commute)
 
 lemma circlepath_minus: "circlepath z (-r) x = circlepath z r (x + 1/2)"
 proof -
   have "z + of_real r * exp (2 * pi * \<i> * (x + 1/2)) =
         z + of_real r * exp (2 * pi * \<i> * x + pi * \<i>)"
     by (simp add: divide_simps) (simp add: algebra_simps)
   also have "\<dots> = z - r * exp (2 * pi * \<i> * x)"
     by (simp add: exp_add)
   finally show ?thesis
     by (simp add: circlepath path_image_def sphere_def dist_norm)
 qed
 
 lemma circlepath_add1: "circlepath z r (x+1) = circlepath z r x"
   using circlepath_minus [of z r "x+1/2"] circlepath_minus [of z "-r" x]
   by (simp add: add.commute)
 
 lemma circlepath_add_half: "circlepath z r (x + 1/2) = circlepath z r (x - 1/2)"
   using circlepath_add1 [of z r "x-1/2"]
   by (simp add: add.commute)
 
 lemma path_image_circlepath_minus_subset:
      "path_image (circlepath z (-r)) \<subseteq> path_image (circlepath z r)"
 proof -
   have "\<exists>x\<in>{0..1}. circlepath z r (y + 1/2) = circlepath z r x"
     if "0 \<le> y" "y \<le> 1" for y
   proof (cases "y \<le> 1/2")
     case False
     with that show ?thesis
       by (force simp: circlepath_add_half)
   qed (use that in force)
   then show ?thesis
     by (auto simp add: path_image_def image_def circlepath_minus)
 qed
 
 lemma path_image_circlepath_minus: "path_image (circlepath z (-r)) = path_image (circlepath z r)"
   using path_image_circlepath_minus_subset by fastforce
 
 lemma has_vector_derivative_circlepath [derivative_intros]:
  "((circlepath z r) has_vector_derivative (2 * pi * \<i> * r * exp (2 * of_real pi * \<i> * x)))
    (at x within X)"
   unfolding circlepath_def scaleR_conv_of_real
   by (rule derivative_eq_intros) (simp add: algebra_simps)
 
 lemma vector_derivative_circlepath:
   "vector_derivative (circlepath z r) (at x) =
     2 * pi * \<i> * r * exp(2 * of_real pi * \<i> * x)"
   using has_vector_derivative_circlepath vector_derivative_at by blast
 
 lemma vector_derivative_circlepath01:
     "\<lbrakk>0 \<le> x; x \<le> 1\<rbrakk>
      \<Longrightarrow> vector_derivative (circlepath z r) (at x within {0..1}) =
           2 * pi * \<i> * r * exp(2 * of_real pi * \<i> * x)"
   using has_vector_derivative_circlepath
   by (auto simp: vector_derivative_at_within_ivl)
 
 lemma valid_path_circlepath [simp]: "valid_path (circlepath z r)"
   by (simp add: circlepath_def)
 
 lemma path_circlepath [simp]: "path (circlepath z r)"
   by (simp add: valid_path_imp_path)
 
 lemma path_image_circlepath_nonneg:
   assumes "0 \<le> r" shows "path_image (circlepath z r) = sphere z r"
 proof -
   have *: "x \<in> (\<lambda>u. z + (cmod (x - z)) * exp (\<i> * (of_real u * (of_real pi * 2)))) ` {0..1}" for x
   proof (cases "x = z")
     case True then show ?thesis by force
   next
     case False
     define w where "w = x - z"
     then have "w \<noteq> 0" by (simp add: False)
     have **: "\<And>t. \<lbrakk>Re w = cos t * cmod w; Im w = sin t * cmod w\<rbrakk> \<Longrightarrow> w = of_real (cmod w) * exp (\<i> * t)"
       using cis_conv_exp complex_eq_iff by auto
     obtain t where "0 \<le> t" "t < 2*pi" "Re(w/norm w) = cos t" "Im(w/norm w) = sin t"
       apply (rule sincos_total_2pi [of "Re(w/(norm w))" "Im(w/(norm w))"])
       by (auto simp add: divide_simps \<open>w \<noteq> 0\<close> cmod_power2 [symmetric])
     then
     show ?thesis
       using False ** w_def \<open>w \<noteq> 0\<close>
       by (rule_tac x="t / (2*pi)" in image_eqI) (auto simp add: field_simps)
   qed
   show ?thesis
     unfolding circlepath path_image_def sphere_def dist_norm
     by (force simp: assms algebra_simps norm_mult norm_minus_commute intro: *)
 qed
 
 lemma path_image_circlepath [simp]:
     "path_image (circlepath z r) = sphere z \<bar>r\<bar>"
   using path_image_circlepath_minus
   by (force simp: path_image_circlepath_nonneg abs_if)
 
 lemma has_contour_integral_bound_circlepath_strong:
       "\<lbrakk>(f has_contour_integral i) (circlepath z r);
         finite k; 0 \<le> B; 0 < r;
         \<And>x. \<lbrakk>norm(x - z) = r; x \<notin> k\<rbrakk> \<Longrightarrow> norm(f x) \<le> B\<rbrakk>
         \<Longrightarrow> norm i \<le> B*(2*pi*r)"
   unfolding circlepath_def
   by (auto simp: algebra_simps in_path_image_part_circlepath dest!: has_contour_integral_bound_part_circlepath_strong)
 
 lemma has_contour_integral_bound_circlepath:
       "\<lbrakk>(f has_contour_integral i) (circlepath z r);
         0 \<le> B; 0 < r; \<And>x. norm(x - z) = r \<Longrightarrow> norm(f x) \<le> B\<rbrakk>
         \<Longrightarrow> norm i \<le> B*(2*pi*r)"
   by (auto intro: has_contour_integral_bound_circlepath_strong)
 
 lemma contour_integrable_continuous_circlepath:
     "continuous_on (path_image (circlepath z r)) f
      \<Longrightarrow> f contour_integrable_on (circlepath z r)"
   by (simp add: circlepath_def contour_integrable_continuous_part_circlepath)
 
 lemma simple_path_circlepath: "simple_path(circlepath z r) \<longleftrightarrow> (r \<noteq> 0)"
   by (simp add: circlepath_def simple_path_part_circlepath)
 
 lemma notin_path_image_circlepath [simp]: "cmod (w - z) < r \<Longrightarrow> w \<notin> path_image (circlepath z r)"
   by (simp add: sphere_def dist_norm norm_minus_commute)
 
 lemma contour_integral_circlepath:
   assumes "r > 0"
   shows "contour_integral (circlepath z r) (\<lambda>w. 1 / (w - z)) = 2 * complex_of_real pi * \<i>"
 proof (rule contour_integral_unique)
   show "((\<lambda>w. 1 / (w - z)) has_contour_integral 2 * complex_of_real pi * \<i>) (circlepath z r)"
     unfolding has_contour_integral_def using assms has_integral_const_real [of _ 0 1]
     apply (subst has_integral_cong)
      apply (simp add: vector_derivative_circlepath01)
     apply (force simp: circlepath)
     done
 qed
 
 subsection\<open> Uniform convergence of path integral\<close>
 
 text\<open>Uniform convergence when the derivative of the path is bounded, and in particular for the special case of a circle.\<close>
 
 proposition contour_integral_uniform_limit:
   assumes ev_fint: "eventually (\<lambda>n::'a. (f n) contour_integrable_on \<gamma>) F"
       and ul_f: "uniform_limit (path_image \<gamma>) f l F"
       and noleB: "\<And>t. t \<in> {0..1} \<Longrightarrow> norm (vector_derivative \<gamma> (at t)) \<le> B"
       and \<gamma>: "valid_path \<gamma>"
       and [simp]: "\<not> trivial_limit F"
   shows "l contour_integrable_on \<gamma>" "((\<lambda>n. contour_integral \<gamma> (f n)) \<longlongrightarrow> contour_integral \<gamma> l) F"
 proof -
   have "0 \<le> B" by (meson noleB [of 0] atLeastAtMost_iff norm_ge_zero order_refl order_trans zero_le_one)
   { fix e::real
     assume "0 < e"
     then have "0 < e / (\<bar>B\<bar> + 1)" by simp
-    then have "\<forall>\<^sub>F n in F. \<forall>x\<in>path_image \<gamma>. cmod (f n x - l x) < e / (\<bar>B\<bar> + 1)"
+    then have \<section>: "\<forall>\<^sub>F n in F. \<forall>x\<in>path_image \<gamma>. cmod (f n x - l x) < e / (\<bar>B\<bar> + 1)"
       using ul_f [unfolded uniform_limit_iff dist_norm] by auto
-    with ev_fint
     obtain a where fga: "\<And>x. x \<in> {0..1} \<Longrightarrow> cmod (f a (\<gamma> x) - l (\<gamma> x)) < e / (\<bar>B\<bar> + 1)"
                and inta: "(\<lambda>t. f a (\<gamma> t) * vector_derivative \<gamma> (at t)) integrable_on {0..1}"
-      using eventually_happens [OF eventually_conj]
+      using eventually_happens [OF eventually_conj [OF ev_fint \<section>]]
       by (fastforce simp: contour_integrable_on path_image_def)
     have "\<exists>h. (\<forall>x\<in>{0..1}. cmod (l (\<gamma> x) * vector_derivative \<gamma> (at x) - h x) \<le> e) \<and> h integrable_on {0..1}"
     proof (intro exI conjI ballI)
       show "cmod (l (\<gamma> x) * vector_derivative \<gamma> (at x) - f a (\<gamma> x) * vector_derivative \<gamma> (at x)) \<le> e"
         if "x \<in> {0..1}" for x
       proof -
         have "cmod (l (\<gamma> x) * vector_derivative \<gamma> (at x) - f a (\<gamma> x) * vector_derivative \<gamma> (at x)) \<le> B * e / (\<bar>B\<bar> + 1)"
           using noleB [OF that] fga [OF that] \<open>0 \<le> B\<close> \<open>0 < e\<close>
           by (fastforce simp: mult_ac dest: mult_mono [OF less_imp_le] simp add: norm_mult left_diff_distrib [symmetric] norm_minus_commute divide_simps)
         also have "\<dots> \<le> e"
           using \<open>0 \<le> B\<close>  \<open>0 < e\<close> by (simp add: field_split_simps)
         finally show ?thesis .
       qed
     qed (rule inta)
   }
   then show lintg: "l contour_integrable_on \<gamma>"
     unfolding contour_integrable_on by (metis (mono_tags, lifting)integrable_uniform_limit_real)
   { fix e::real
     define B' where "B' = B + 1"
     have B': "B' > 0" "B' > B" using  \<open>0 \<le> B\<close> by (auto simp: B'_def)
     assume "0 < e"
     then have ev_no': "\<forall>\<^sub>F n in F. \<forall>x\<in>path_image \<gamma>. 2 * cmod (f n x - l x) < e / B'"
       using ul_f [unfolded uniform_limit_iff dist_norm, rule_format, of "e / B'/2"] B'
         by (simp add: field_simps)
     have ie: "integral {0..1::real} (\<lambda>x. e/2) < e" using \<open>0 < e\<close> by simp
     have *: "cmod (f x (\<gamma> t) * vector_derivative \<gamma> (at t) - l (\<gamma> t) * vector_derivative \<gamma> (at t)) \<le> e/2"
              if t: "t\<in>{0..1}" and leB': "2 * cmod (f x (\<gamma> t) - l (\<gamma> t)) < e / B'" for x t
     proof -
       have "2 * cmod (f x (\<gamma> t) - l (\<gamma> t)) * cmod (vector_derivative \<gamma> (at t)) \<le> e * (B/ B')"
         using mult_mono [OF less_imp_le [OF leB'] noleB] B' \<open>0 < e\<close> t by auto
       also have "\<dots> < e"
         by (simp add: B' \<open>0 < e\<close> mult_imp_div_pos_less)
       finally have "2 * cmod (f x (\<gamma> t) - l (\<gamma> t)) * cmod (vector_derivative \<gamma> (at t)) < e" .
       then show ?thesis
         by (simp add: left_diff_distrib [symmetric] norm_mult)
     qed
     have le_e: "\<And>x. \<lbrakk>\<forall>u\<in>{0..1}. 2 * cmod (f x (\<gamma> u) - l (\<gamma> u)) < e / B'; f x contour_integrable_on \<gamma>\<rbrakk>
          \<Longrightarrow> cmod (integral {0..1}
                     (\<lambda>u. f x (\<gamma> u) * vector_derivative \<gamma> (at u) - l (\<gamma> u) * vector_derivative \<gamma> (at u))) < e"
       apply (rule le_less_trans [OF integral_norm_bound_integral ie])
         apply (simp add: lintg integrable_diff contour_integrable_on [symmetric])
        apply (blast intro: *)+
       done
     have "\<forall>\<^sub>F x in F. dist (contour_integral \<gamma> (f x)) (contour_integral \<gamma> l) < e"
       apply (rule eventually_mono [OF eventually_conj [OF ev_no' ev_fint]])
       apply (simp add: dist_norm contour_integrable_on path_image_def contour_integral_integral)
       apply (simp add: lintg integral_diff [symmetric] contour_integrable_on [symmetric] le_e)
       done
   }
   then show "((\<lambda>n. contour_integral \<gamma> (f n)) \<longlongrightarrow> contour_integral \<gamma> l) F"
     by (rule tendstoI)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> contour_integral_uniform_limit_circlepath:
   assumes "\<forall>\<^sub>F n::'a in F. (f n) contour_integrable_on (circlepath z r)"
       and "uniform_limit (sphere z r) f l F"
       and "\<not> trivial_limit F" "0 < r"
     shows "l contour_integrable_on (circlepath z r)"
           "((\<lambda>n. contour_integral (circlepath z r) (f n)) \<longlongrightarrow> contour_integral (circlepath z r) l) F"
   using assms by (auto simp: vector_derivative_circlepath norm_mult intro!: contour_integral_uniform_limit)
 
 end
diff --git a/src/HOL/Complex_Analysis/Winding_Numbers.thy b/src/HOL/Complex_Analysis/Winding_Numbers.thy
--- a/src/HOL/Complex_Analysis/Winding_Numbers.thy
+++ b/src/HOL/Complex_Analysis/Winding_Numbers.thy
@@ -1,2230 +1,2311 @@
 section \<open>Winding numbers\<close>
 theory Winding_Numbers
   imports Cauchy_Integral_Theorem
 begin
 
 subsection \<open>Definition\<close>
 
 definition\<^marker>\<open>tag important\<close> winding_number_prop :: "[real \<Rightarrow> complex, complex, real, real \<Rightarrow> complex, complex] \<Rightarrow> bool" where
   "winding_number_prop \<gamma> z e p n \<equiv>
       valid_path p \<and> z \<notin> path_image p \<and>
       pathstart p = pathstart \<gamma> \<and>
       pathfinish p = pathfinish \<gamma> \<and>
       (\<forall>t \<in> {0..1}. norm(\<gamma> t - p t) < e) \<and>
       contour_integral p (\<lambda>w. 1/(w - z)) = 2 * pi * \<i> * n"
 
 definition\<^marker>\<open>tag important\<close> winding_number:: "[real \<Rightarrow> complex, complex] \<Rightarrow> complex" where
   "winding_number \<gamma> z \<equiv> SOME n. \<forall>e > 0. \<exists>p. winding_number_prop \<gamma> z e p n"
 
 
 lemma winding_number:
   assumes "path \<gamma>" "z \<notin> path_image \<gamma>" "0 < e"
     shows "\<exists>p. winding_number_prop \<gamma> z e p (winding_number \<gamma> z)"
 proof -
   have "path_image \<gamma> \<subseteq> UNIV - {z}"
     using assms by blast
   then obtain d
     where d: "d>0"
       and pi_eq: "\<And>h1 h2. valid_path h1 \<and> valid_path h2 \<and>
                     (\<forall>t\<in>{0..1}. cmod (h1 t - \<gamma> t) < d \<and> cmod (h2 t - \<gamma> t) < d) \<and>
                     pathstart h2 = pathstart h1 \<and> pathfinish h2 = pathfinish h1 \<longrightarrow>
                       path_image h1 \<subseteq> UNIV - {z} \<and> path_image h2 \<subseteq> UNIV - {z} \<and>
                       (\<forall>f. f holomorphic_on UNIV - {z} \<longrightarrow> contour_integral h2 f = contour_integral h1 f)"
     using contour_integral_nearby_ends [of "UNIV - {z}" \<gamma>] assms by (auto simp: open_delete)
   then obtain h where h: "polynomial_function h \<and> pathstart h = pathstart \<gamma> \<and> pathfinish h = pathfinish \<gamma> \<and>
                           (\<forall>t \<in> {0..1}. norm(h t - \<gamma> t) < d/2)"
     using path_approx_polynomial_function [OF \<open>path \<gamma>\<close>, of "d/2"] d by (metis half_gt_zero_iff)
   define nn where "nn = 1/(2* pi*\<i>) * contour_integral h (\<lambda>w. 1/(w - z))"
   have "\<exists>n. \<forall>e > 0. \<exists>p. winding_number_prop \<gamma> z e p n"
     proof (rule_tac x=nn in exI, clarify)
       fix e::real
       assume e: "e>0"
       obtain p where p: "polynomial_function p \<and>
             pathstart p = pathstart \<gamma> \<and> pathfinish p = pathfinish \<gamma> \<and> (\<forall>t\<in>{0..1}. cmod (p t - \<gamma> t) < min e (d/2))"
         using path_approx_polynomial_function [OF \<open>path \<gamma>\<close>, of "min e (d/2)"] d \<open>0<e\<close>
         by (metis min_less_iff_conj zero_less_divide_iff zero_less_numeral) 
       have "(\<lambda>w. 1 / (w - z)) holomorphic_on UNIV - {z}"
         by (auto simp: intro!: holomorphic_intros)
       then have "winding_number_prop \<gamma> z e p nn"
         using pi_eq [of h p] h p d
         by (auto simp: valid_path_polynomial_function norm_minus_commute nn_def winding_number_prop_def)
       then show "\<exists>p. winding_number_prop \<gamma> z e p nn" 
         by metis
     qed
   then show ?thesis
     unfolding winding_number_def by (rule someI2_ex) (blast intro: \<open>0<e\<close>)
 qed
 
 lemma winding_number_unique:
   assumes \<gamma>: "path \<gamma>" "z \<notin> path_image \<gamma>"
       and pi: "\<And>e. e>0 \<Longrightarrow> \<exists>p. winding_number_prop \<gamma> z e p n"
    shows "winding_number \<gamma> z = n"
 proof -
   have "path_image \<gamma> \<subseteq> UNIV - {z}"
     using assms by blast
   then obtain e
     where e: "e>0"
       and pi_eq: "\<And>h1 h2 f. \<lbrakk>valid_path h1; valid_path h2;
                     (\<forall>t\<in>{0..1}. cmod (h1 t - \<gamma> t) < e \<and> cmod (h2 t - \<gamma> t) < e);
                     pathstart h2 = pathstart h1; pathfinish h2 = pathfinish h1; f holomorphic_on UNIV - {z}\<rbrakk> \<Longrightarrow>
                     contour_integral h2 f = contour_integral h1 f"
     using contour_integral_nearby_ends [of "UNIV - {z}" \<gamma>] assms  by (auto simp: open_delete)
   obtain p where p: "winding_number_prop \<gamma> z e p n"
     using pi [OF e] by blast
   obtain q where q: "winding_number_prop \<gamma> z e q (winding_number \<gamma> z)"
     using winding_number [OF \<gamma> e] by blast
   have "2 * complex_of_real pi * \<i> * n = contour_integral p (\<lambda>w. 1 / (w - z))"
     using p by (auto simp: winding_number_prop_def)
   also have "\<dots> = contour_integral q (\<lambda>w. 1 / (w - z))"
   proof (rule pi_eq)
     show "(\<lambda>w. 1 / (w - z)) holomorphic_on UNIV - {z}"
       by (auto intro!: holomorphic_intros)
   qed (use p q in \<open>auto simp: winding_number_prop_def norm_minus_commute\<close>)
   also have "\<dots> = 2 * complex_of_real pi * \<i> * winding_number \<gamma> z"
     using q by (auto simp: winding_number_prop_def)
   finally have "2 * complex_of_real pi * \<i> * n = 2 * complex_of_real pi * \<i> * winding_number \<gamma> z" .
   then show ?thesis
     by simp
 qed
 
+lemma winding_number_prop_reversepath:
+  assumes "winding_number_prop \<gamma> z e p n"
+  shows   "winding_number_prop (reversepath \<gamma>) z e (reversepath p) (-n)"
+proof -
+  have p: "valid_path p" "z \<notin> path_image p" "pathstart p = pathstart \<gamma>"
+          "pathfinish p = pathfinish \<gamma>" "\<And>t. t \<in> {0..1} \<Longrightarrow> norm (\<gamma> t - p t) < e"
+          "contour_integral p (\<lambda>w. 1 / (w - z)) = 2 * complex_of_real pi * \<i> * n"
+    using assms by (auto simp: winding_number_prop_def)
+  show ?thesis
+    unfolding winding_number_prop_def
+  proof (intro conjI strip)
+    show "norm (reversepath \<gamma> t - reversepath p t) < e" if "t \<in> {0..1}" for t
+      unfolding reversepath_def using p(5)[of "1 - t"] that by auto
+    show "contour_integral (reversepath p) (\<lambda>w. 1 / (w - z)) =
+             complex_of_real (2 * pi) * \<i> * - n"
+      using p by (subst contour_integral_reversepath) auto
+  qed (use p in auto)
+qed
+
+lemma winding_number_prop_reversepath_iff:
+  "winding_number_prop (reversepath \<gamma>) z e p n \<longleftrightarrow> winding_number_prop \<gamma> z e (reversepath p) (-n)"
+  using winding_number_prop_reversepath[of "reversepath \<gamma>" z e p n]
+        winding_number_prop_reversepath[of \<gamma> z e "reversepath p" "-n"] by auto
+
 (*NB not winding_number_prop here due to the loop in p*)
 lemma winding_number_unique_loop:
   assumes \<gamma>: "path \<gamma>" "z \<notin> path_image \<gamma>"
       and loop: "pathfinish \<gamma> = pathstart \<gamma>"
       and pi:
         "\<And>e. e>0 \<Longrightarrow> \<exists>p. valid_path p \<and> z \<notin> path_image p \<and>
                            pathfinish p = pathstart p \<and>
                            (\<forall>t \<in> {0..1}. norm (\<gamma> t - p t) < e) \<and>
                            contour_integral p (\<lambda>w. 1/(w - z)) = 2 * pi * \<i> * n"
    shows "winding_number \<gamma> z = n"
 proof -
   have "path_image \<gamma> \<subseteq> UNIV - {z}"
     using assms by blast
   then obtain e
     where e: "e>0"
       and pi_eq: "\<And>h1 h2 f. \<lbrakk>valid_path h1; valid_path h2;
                     (\<forall>t\<in>{0..1}. cmod (h1 t - \<gamma> t) < e \<and> cmod (h2 t - \<gamma> t) < e);
                     pathfinish h1 = pathstart h1; pathfinish h2 = pathstart h2; f holomorphic_on UNIV - {z}\<rbrakk> \<Longrightarrow>
                     contour_integral h2 f = contour_integral h1 f"
     using contour_integral_nearby_loops [of "UNIV - {z}" \<gamma>] assms  by (auto simp: open_delete)
   obtain p where p:
      "valid_path p \<and> z \<notin> path_image p \<and> pathfinish p = pathstart p \<and>
       (\<forall>t \<in> {0..1}. norm (\<gamma> t - p t) < e) \<and>
       contour_integral p (\<lambda>w. 1/(w - z)) = 2 * pi * \<i> * n"
     using pi [OF e] by blast
   obtain q where q: "winding_number_prop \<gamma> z e q (winding_number \<gamma> z)"
     using winding_number [OF \<gamma> e] by blast
   have "2 * complex_of_real pi * \<i> * n = contour_integral p (\<lambda>w. 1 / (w - z))"
     using p by auto
   also have "\<dots> = contour_integral q (\<lambda>w. 1 / (w - z))"
   proof (rule pi_eq)
     show "(\<lambda>w. 1 / (w - z)) holomorphic_on UNIV - {z}"
       by (auto intro!: holomorphic_intros)
   qed (use p q loop in \<open>auto simp: winding_number_prop_def norm_minus_commute\<close>)
   also have "\<dots> = 2 * complex_of_real pi * \<i> * winding_number \<gamma> z"
     using q by (auto simp: winding_number_prop_def)
   finally have "2 * complex_of_real pi * \<i> * n = 2 * complex_of_real pi * \<i> * winding_number \<gamma> z" .
   then show ?thesis
     by simp
 qed
 
 proposition winding_number_valid_path:
   assumes "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
   shows "winding_number \<gamma> z = 1/(2*pi*\<i>) * contour_integral \<gamma> (\<lambda>w. 1/(w - z))"
   by (rule winding_number_unique)
   (use assms in \<open>auto simp: valid_path_imp_path winding_number_prop_def\<close>)
 
 proposition has_contour_integral_winding_number:
   assumes \<gamma>: "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
     shows "((\<lambda>w. 1/(w - z)) has_contour_integral (2*pi*\<i>*winding_number \<gamma> z)) \<gamma>"
 by (simp add: winding_number_valid_path has_contour_integral_integral contour_integrable_inversediff assms)
 
 lemma winding_number_trivial [simp]: "z \<noteq> a \<Longrightarrow> winding_number(linepath a a) z = 0"
   by (simp add: winding_number_valid_path)
 
 lemma winding_number_subpath_trivial [simp]: "z \<noteq> g x \<Longrightarrow> winding_number (subpath x x g) z = 0"
   by (simp add: path_image_subpath winding_number_valid_path)
 
 lemma winding_number_join:
   assumes \<gamma>1: "path \<gamma>1" "z \<notin> path_image \<gamma>1"
       and \<gamma>2: "path \<gamma>2" "z \<notin> path_image \<gamma>2"
       and "pathfinish \<gamma>1 = pathstart \<gamma>2"
     shows "winding_number(\<gamma>1 +++ \<gamma>2) z = winding_number \<gamma>1 z + winding_number \<gamma>2 z"
 proof (rule winding_number_unique)
   show "\<exists>p. winding_number_prop (\<gamma>1 +++ \<gamma>2) z e p
               (winding_number \<gamma>1 z + winding_number \<gamma>2 z)" if "e > 0" for e
   proof -
     obtain p1 where "winding_number_prop \<gamma>1 z e p1 (winding_number \<gamma>1 z)"
       using \<open>0 < e\<close> \<gamma>1 winding_number by blast
     moreover
     obtain p2 where "winding_number_prop \<gamma>2 z e p2 (winding_number \<gamma>2 z)"
       using \<open>0 < e\<close> \<gamma>2 winding_number by blast
     ultimately
     have "winding_number_prop (\<gamma>1+++\<gamma>2) z e (p1+++p2) (winding_number \<gamma>1 z + winding_number \<gamma>2 z)"
       using assms
       apply (simp add: winding_number_prop_def not_in_path_image_join contour_integrable_inversediff algebra_simps)
       apply (auto simp: joinpaths_def)
       done
     then show ?thesis
       by blast
   qed
 qed (use assms in \<open>auto simp: not_in_path_image_join\<close>)
 
 lemma winding_number_reversepath:
   assumes "path \<gamma>" "z \<notin> path_image \<gamma>"
     shows "winding_number(reversepath \<gamma>) z = - (winding_number \<gamma> z)"
 proof (rule winding_number_unique)
   show "\<exists>p. winding_number_prop (reversepath \<gamma>) z e p (- winding_number \<gamma> z)" if "e > 0" for e
   proof -
     obtain p where "winding_number_prop \<gamma> z e p (winding_number \<gamma> z)"
       using \<open>0 < e\<close> assms winding_number by blast
     then have "winding_number_prop (reversepath \<gamma>) z e (reversepath p) (- winding_number \<gamma> z)"
       using assms unfolding winding_number_prop_def
       apply (simp add: contour_integral_reversepath contour_integrable_inversediff valid_path_imp_reverse)
       apply (auto simp: reversepath_def)
       done
     then show ?thesis
       by blast
   qed
 qed (use assms in auto)
 
 lemma winding_number_shiftpath:
   assumes \<gamma>: "path \<gamma>" "z \<notin> path_image \<gamma>"
       and "pathfinish \<gamma> = pathstart \<gamma>" "a \<in> {0..1}"
     shows "winding_number(shiftpath a \<gamma>) z = winding_number \<gamma> z"
 proof (rule winding_number_unique_loop)
   show "\<exists>p. valid_path p \<and> z \<notin> path_image p \<and> pathfinish p = pathstart p \<and>
             (\<forall>t\<in>{0..1}. cmod (shiftpath a \<gamma> t - p t) < e) \<and>
             contour_integral p (\<lambda>w. 1 / (w - z)) =
             2 * pi * \<i> * winding_number \<gamma> z"
     if "e > 0" for e
   proof -
     obtain p where "winding_number_prop \<gamma> z e p (winding_number \<gamma> z)"
       using \<open>0 < e\<close> assms winding_number by blast
     then show ?thesis
       apply (rule_tac x="shiftpath a p" in exI)
       using assms that
       apply (auto simp: winding_number_prop_def path_image_shiftpath pathfinish_shiftpath pathstart_shiftpath contour_integral_shiftpath)
       apply (simp add: shiftpath_def)
       done
   qed
 qed (use assms in \<open>auto simp: path_shiftpath path_image_shiftpath pathfinish_shiftpath pathstart_shiftpath\<close>)
 
 lemma winding_number_split_linepath:
   assumes "c \<in> closed_segment a b" "z \<notin> closed_segment a b"
     shows "winding_number(linepath a b) z = winding_number(linepath a c) z + winding_number(linepath c b) z"
 proof -
   have "z \<notin> closed_segment a c" "z \<notin> closed_segment c b"
     using assms  by (meson convex_contains_segment convex_segment ends_in_segment subsetCE)+
   then show ?thesis
     using assms
     by (simp add: winding_number_valid_path contour_integral_split_linepath [symmetric] continuous_on_inversediff field_simps)
 qed
 
 lemma winding_number_cong:
    "(\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> p t = q t) \<Longrightarrow> winding_number p z = winding_number q z"
   by (simp add: winding_number_def winding_number_prop_def pathstart_def pathfinish_def)
 
 lemma winding_number_constI:
   assumes "c\<noteq>z" and g: "\<And>t. \<lbrakk>0\<le>t; t\<le>1\<rbrakk> \<Longrightarrow> g t = c" 
   shows "winding_number g z = 0"
 proof -
   have "winding_number g z = winding_number (linepath c c) z"
     using g winding_number_cong by fastforce
   moreover have "winding_number (linepath c c) z = 0"
     using \<open>c\<noteq>z\<close> by auto
   ultimately show ?thesis by auto
 qed
 
 lemma winding_number_offset: "winding_number p z = winding_number (\<lambda>w. p w - z) 0"
   unfolding winding_number_def
 proof (intro ext arg_cong [where f = Eps] arg_cong [where f = All] imp_cong refl, safe)
   fix n e g
   assume "0 < e" and g: "winding_number_prop p z e g n"
   then show "\<exists>r. winding_number_prop (\<lambda>w. p w - z) 0 e r n"
     by (rule_tac x="\<lambda>t. g t - z" in exI)
        (force simp: winding_number_prop_def contour_integral_integral valid_path_def path_defs
                 vector_derivative_def has_vector_derivative_diff_const piecewise_C1_differentiable_diff C1_differentiable_imp_piecewise)
 next
   fix n e g
   assume "0 < e" and g: "winding_number_prop (\<lambda>w. p w - z) 0 e g n"
   then have "winding_number_prop p z e (\<lambda>t. g t + z) n"
     apply (simp add: winding_number_prop_def contour_integral_integral valid_path_def path_defs
         piecewise_C1_differentiable_add vector_derivative_def has_vector_derivative_add_const C1_differentiable_imp_piecewise)
     apply (force simp: algebra_simps)
     done
   then show "\<exists>r. winding_number_prop p z e r n" 
     by metis
 qed
 
 lemma winding_number_negatepath:
   assumes \<gamma>: "valid_path \<gamma>" and 0: "0 \<notin> path_image \<gamma>"
   shows "winding_number(uminus \<circ> \<gamma>) 0 = winding_number \<gamma> 0"
 proof -
   have "(/) 1 contour_integrable_on \<gamma>"
     using "0" \<gamma> contour_integrable_inversediff by fastforce
   then have "((\<lambda>z. 1/z) has_contour_integral contour_integral \<gamma> ((/) 1)) \<gamma>"
     by (rule has_contour_integral_integral)
   then have "((\<lambda>z. 1 / - z) has_contour_integral - contour_integral \<gamma> ((/) 1)) \<gamma>"
     using has_contour_integral_neg by auto
   then have "contour_integral (uminus \<circ> \<gamma>) ((/) 1) =
         contour_integral \<gamma> ((/) 1)"
     using \<gamma> by (simp add: contour_integral_unique has_contour_integral_negatepath)
   then show ?thesis
     using assms by (simp add: winding_number_valid_path valid_path_negatepath image_def path_defs)
 qed
 
+lemma winding_number_cnj:
+  assumes "path \<gamma>" "z \<notin> path_image \<gamma>"
+  shows   "winding_number (cnj \<circ> \<gamma>) (cnj z) = -cnj (winding_number \<gamma> z)"
+proof (rule winding_number_unique)
+  show "\<exists>p. winding_number_prop (cnj \<circ> \<gamma>) (cnj z) e p (-cnj (winding_number \<gamma> z))"
+    if "e > 0" for e
+  proof -
+    from winding_number[OF assms(1,2) \<open>e > 0\<close>]
+    obtain p where "winding_number_prop \<gamma> z e p (winding_number \<gamma> z)"
+      by blast
+    then have p: "valid_path p" "z \<notin> path_image p"
+        "pathstart p = pathstart \<gamma>"
+        "pathfinish p = pathfinish \<gamma>"
+        "\<And>t. t \<in> {0..1} \<Longrightarrow> cmod (\<gamma> t - p t) < e" and
+        p_cont:"contour_integral p (\<lambda>w. 1 / (w - z)) =
+          complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z" 
+      unfolding winding_number_prop_def by auto
+    
+    have "valid_path (cnj \<circ> p)"
+      using p(1) by (subst valid_path_cnj) auto
+    moreover have "cnj z \<notin> path_image (cnj \<circ> p)"
+      using p(2) by (auto simp: path_image_def)
+    moreover have "pathstart (cnj \<circ> p) = pathstart (cnj \<circ> \<gamma>)" 
+      using p(3) by (simp add: pathstart_compose)
+    moreover have "pathfinish (cnj \<circ> p) = pathfinish (cnj \<circ> \<gamma>)" 
+      using p(4) by (simp add: pathfinish_compose)
+    moreover have "cmod ((cnj \<circ> \<gamma>) t - (cnj \<circ> p) t) < e"
+      if t: "t \<in> {0..1}" for t
+    proof -
+      have "(cnj \<circ> \<gamma>) t - (cnj \<circ> p) t = cnj (\<gamma> t - p t)"
+        by simp
+      also have "norm \<dots> = norm (\<gamma> t - p t)"
+        by (subst complex_mod_cnj) auto
+      also have "\<dots> < e"
+        using p(5)[OF t] by simp
+      finally show ?thesis .
+    qed
+    moreover have "contour_integral (cnj \<circ> p) (\<lambda>w. 1 / (w - cnj z)) =
+          cnj (complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z)" (is "?L=?R")
+    proof -
+      have "?L = contour_integral (cnj \<circ> p) (cnj \<circ> (\<lambda>w. 1 / (cnj w - z)))"
+        by (simp add: o_def)
+      also have "\<dots> = cnj (contour_integral p (\<lambda>x. 1 / (x - z)))"
+        using p(1) by (subst contour_integral_cnj) (auto simp: o_def)
+      also have "\<dots> = ?R"
+        using p_cont by simp
+      finally show ?thesis .
+    qed
+    ultimately show ?thesis
+      by (intro exI[of _ "cnj \<circ> p"]) (auto simp: winding_number_prop_def)
+  qed
+  show "path (cnj \<circ> \<gamma>)"
+    by (intro path_continuous_image continuous_intros) (use assms in auto)
+  show "cnj z \<notin> path_image (cnj \<circ> \<gamma>)"
+    using \<open>z \<notin> path_image \<gamma>\<close> unfolding path_image_def by auto
+qed
+
 text \<open>A combined theorem deducing several things piecewise.\<close>
 lemma winding_number_join_pos_combined:
      "\<lbrakk>valid_path \<gamma>1; z \<notin> path_image \<gamma>1; 0 < Re(winding_number \<gamma>1 z);
        valid_path \<gamma>2; z \<notin> path_image \<gamma>2; 0 < Re(winding_number \<gamma>2 z); pathfinish \<gamma>1 = pathstart \<gamma>2\<rbrakk>
       \<Longrightarrow> valid_path(\<gamma>1 +++ \<gamma>2) \<and> z \<notin> path_image(\<gamma>1 +++ \<gamma>2) \<and> 0 < Re(winding_number(\<gamma>1 +++ \<gamma>2) z)"
   by (simp add: valid_path_join path_image_join winding_number_join valid_path_imp_path)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Useful sufficient conditions for the winding number to be positive\<close>
 
 lemma Re_winding_number:
     "\<lbrakk>valid_path \<gamma>; z \<notin> path_image \<gamma>\<rbrakk>
      \<Longrightarrow> Re(winding_number \<gamma> z) = Im(contour_integral \<gamma> (\<lambda>w. 1/(w - z))) / (2*pi)"
 by (simp add: winding_number_valid_path field_simps Re_divide power2_eq_square)
 
 lemma winding_number_pos_le:
   assumes \<gamma>: "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
       and ge: "\<And>x. \<lbrakk>0 < x; x < 1\<rbrakk> \<Longrightarrow> 0 \<le> Im (vector_derivative \<gamma> (at x) * cnj(\<gamma> x - z))"
     shows "0 \<le> Re(winding_number \<gamma> z)"
 proof -
   have ge0: "0 \<le> Im (vector_derivative \<gamma> (at x) / (\<gamma> x - z))" if x: "0 < x" "x < 1" for x
     using ge by (simp add: Complex.Im_divide algebra_simps x)
   let ?vd = "\<lambda>x. 1 / (\<gamma> x - z) * vector_derivative \<gamma> (at x)"
   let ?int = "\<lambda>z. contour_integral \<gamma> (\<lambda>w. 1 / (w - z))"
   have "0 \<le> Im (?int z)"
   proof (rule has_integral_component_nonneg [of \<i>, simplified])
     show "\<And>x. x \<in> cbox 0 1 \<Longrightarrow> 0 \<le> Im (if 0 < x \<and> x < 1 then ?vd x else 0)"
       by (force simp: ge0)
     have "((\<lambda>a. 1 / (a - z)) has_contour_integral contour_integral \<gamma> (\<lambda>w. 1 / (w - z))) \<gamma>"
       using \<gamma> by (simp flip: add: contour_integrable_inversediff has_contour_integral_integral)
     then have hi: "(?vd has_integral ?int z) (cbox 0 1)"
       using has_contour_integral by auto
     show "((\<lambda>x. if 0 < x \<and> x < 1 then ?vd x else 0) has_integral ?int z) (cbox 0 1)"
       by (rule has_integral_spike_interior [OF hi]) simp
   qed
   then show ?thesis
     by (simp add: Re_winding_number [OF \<gamma>] field_simps)
 qed
 
 lemma winding_number_pos_lt_lemma:
   assumes \<gamma>: "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
       and e: "0 < e"
       and ge: "\<And>x. \<lbrakk>0 < x; x < 1\<rbrakk> \<Longrightarrow> e \<le> Im (vector_derivative \<gamma> (at x) / (\<gamma> x - z))"
     shows "0 < Re(winding_number \<gamma> z)"
 proof -
   let ?vd = "\<lambda>x. 1 / (\<gamma> x - z) * vector_derivative \<gamma> (at x)"
   let ?int = "\<lambda>z. contour_integral \<gamma> (\<lambda>w. 1 / (w - z))"
   have "e \<le> Im (contour_integral \<gamma> (\<lambda>w. 1 / (w - z)))"
   proof (rule has_integral_component_le [of \<i> "\<lambda>x. \<i>*e" "\<i>*e" "{0..1}", simplified])
     have "((\<lambda>a. 1 / (a - z)) has_contour_integral contour_integral \<gamma> (\<lambda>w. 1 / (w - z))) \<gamma>"
       thm has_integral_component_le [of \<i> "\<lambda>x. \<i>*e" "\<i>*e" "{0..1}", simplified]
       using \<gamma> by (simp add: contour_integrable_inversediff has_contour_integral_integral)
     then have hi: "(?vd has_integral ?int z) (cbox 0 1)"
       using has_contour_integral by auto
     show "((\<lambda>x. if 0 < x \<and> x < 1 then ?vd x else \<i> * e) has_integral ?int z) {0..1}"
       by (rule has_integral_spike_interior [OF hi, simplified box_real]) (use e in simp)
     show "\<And>x. 0 \<le> x \<and> x \<le> 1 \<Longrightarrow> e \<le> Im (if 0 < x \<and> x < 1 then ?vd x else \<i> * e)"
       by (simp add: ge)
   qed (use has_integral_const_real [of _ 0 1] in auto)
   with e show ?thesis
     by (simp add: Re_winding_number [OF \<gamma>] field_simps)
 qed
 
 lemma winding_number_pos_lt:
   assumes \<gamma>: "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
       and e: "0 < e"
       and ge: "\<And>x. \<lbrakk>0 < x; x < 1\<rbrakk> \<Longrightarrow> e \<le> Im (vector_derivative \<gamma> (at x) * cnj(\<gamma> x - z))"
     shows "0 < Re (winding_number \<gamma> z)"
 proof -
   have bm: "bounded ((\<lambda>w. w - z) ` (path_image \<gamma>))"
     using bounded_translation [of _ "-z"] \<gamma> by (simp add: bounded_valid_path_image)
   then obtain B where B: "B > 0" and Bno: "\<And>x. x \<in> (\<lambda>w. w - z) ` (path_image \<gamma>) \<Longrightarrow> norm x \<le> B"
     using bounded_pos [THEN iffD1, OF bm] by blast
   { fix x::real  assume x: "0 < x" "x < 1"
     then have B2: "cmod (\<gamma> x - z)^2 \<le> B^2" using Bno [of "\<gamma> x - z"]
       by (simp add: path_image_def power2_eq_square mult_mono')
     with x have "\<gamma> x \<noteq> z" using \<gamma>
       using path_image_def by fastforce
     then have "e / B\<^sup>2 \<le> e / (cmod (\<gamma> x - z))\<^sup>2"
       using B B2 e by (auto simp: divide_left_mono)
     also have "... \<le> Im (vector_derivative \<gamma> (at x) * cnj (\<gamma> x - z)) / (cmod (\<gamma> x - z))\<^sup>2"
       using ge [OF x] by (auto simp: divide_right_mono)
     finally have "e / B\<^sup>2 \<le> Im (vector_derivative \<gamma> (at x) * cnj (\<gamma> x - z)) / (cmod (\<gamma> x - z))\<^sup>2" .
     then have "e / B\<^sup>2 \<le> Im (vector_derivative \<gamma> (at x) / (\<gamma> x - z))"
       by (simp add: complex_div_cnj [of _ "\<gamma> x - z" for x] del: complex_cnj_diff times_complex.sel)
   } note * = this
   show ?thesis
     using e B by (simp add: * winding_number_pos_lt_lemma [OF \<gamma>, of "e/B^2"])
 qed
 
 subsection\<open>The winding number is an integer\<close>
 
 text\<open>Proof from the book Complex Analysis by Lars V. Ahlfors, Chapter 4, section 2.1,
      Also on page 134 of Serge Lang's book with the name title, etc.\<close>
 
 lemma exp_fg:
   fixes z::complex
   assumes g: "(g has_vector_derivative g') (at x within s)"
       and f: "(f has_vector_derivative (g' / (g x - z))) (at x within s)"
       and z: "g x \<noteq> z"
     shows "((\<lambda>x. exp(-f x) * (g x - z)) has_vector_derivative 0) (at x within s)"
 proof -
   have *: "(exp \<circ> (\<lambda>x. (- f x)) has_vector_derivative - (g' / (g x - z)) * exp (- f x)) (at x within s)"
     using assms unfolding has_vector_derivative_def scaleR_conv_of_real
     by (auto intro!: derivative_eq_intros)
   show ?thesis
     using z by (auto intro!: derivative_eq_intros * [unfolded o_def] g)
 qed
 
 lemma winding_number_exp_integral:
   fixes z::complex
   assumes \<gamma>: "\<gamma> piecewise_C1_differentiable_on {a..b}"
       and ab: "a \<le> b"
       and z: "z \<notin> \<gamma> ` {a..b}"
     shows "(\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z)) integrable_on {a..b}"
           (is "?thesis1")
           "exp (- (integral {a..b} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z)))) * (\<gamma> b - z) = \<gamma> a - z"
           (is "?thesis2")
 proof -
   let ?D\<gamma> = "\<lambda>x. vector_derivative \<gamma> (at x)"
   have [simp]: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> \<gamma> x \<noteq> z"
     using z by force
   have con_g: "continuous_on {a..b} \<gamma>"
     using \<gamma> by (simp add: piecewise_C1_differentiable_on_def)
   obtain k where fink: "finite k" and g_C1_diff: "\<gamma> C1_differentiable_on ({a..b} - k)"
     using \<gamma> by (force simp: piecewise_C1_differentiable_on_def)
   have \<circ>: "open ({a<..<b} - k)"
     using \<open>finite k\<close> by (simp add: finite_imp_closed open_Diff)
   moreover have "{a<..<b} - k \<subseteq> {a..b} - k"
     by force
   ultimately have g_diff_at: "\<And>x. \<lbrakk>x \<notin> k; x \<in> {a<..<b}\<rbrakk> \<Longrightarrow> \<gamma> differentiable at x"
     by (metis Diff_iff differentiable_on_subset C1_diff_imp_diff [OF g_C1_diff] differentiable_on_def at_within_open)
   { fix w
     assume "w \<noteq> z"
     have "continuous_on (ball w (cmod (w - z))) (\<lambda>w. 1 / (w - z))"
       by (auto simp: dist_norm intro!: continuous_intros)
     moreover have "\<And>x. cmod (w - x) < cmod (w - z) \<Longrightarrow> \<exists>f'. ((\<lambda>w. 1 / (w - z)) has_field_derivative f') (at x)"
       by (auto simp: intro!: derivative_eq_intros)
     ultimately have "\<exists>h. \<forall>y. norm(y - w) < norm(w - z) \<longrightarrow> (h has_field_derivative 1/(y - z)) (at y)"
       using holomorphic_convex_primitive [of "ball w (norm(w - z))" "{}" "\<lambda>w. 1/(w - z)"]
       by (force simp: field_differentiable_def Ball_def dist_norm at_within_open_NO_MATCH norm_minus_commute)
   }
   then obtain h where h: "\<And>w y. w \<noteq> z \<Longrightarrow> norm(y - w) < norm(w - z) \<Longrightarrow> (h w has_field_derivative 1/(y - z)) (at y)"
     by meson
   have exy: "\<exists>y. ((\<lambda>x. inverse (\<gamma> x - z) * ?D\<gamma> x) has_integral y) {a..b}"
     unfolding integrable_on_def [symmetric]
   proof (rule contour_integral_local_primitive_any [OF piecewise_C1_imp_differentiable [OF \<gamma>]])
     show "\<exists>d h. 0 < d \<and>
                (\<forall>y. cmod (y - w) < d \<longrightarrow> (h has_field_derivative inverse (y - z))(at y within - {z}))"
           if "w \<in> - {z}" for w
       using that inverse_eq_divide has_field_derivative_at_within h
       by (metis Compl_insert DiffD2 insertCI right_minus_eq zero_less_norm_iff)
   qed simp
   have vg_int: "(\<lambda>x. ?D\<gamma> x / (\<gamma> x - z)) integrable_on {a..b}"
     unfolding box_real [symmetric] divide_inverse_commute
     by (auto intro!: exy integrable_subinterval simp add: integrable_on_def ab)
   with ab show ?thesis1
     by (simp add: divide_inverse_commute integral_def integrable_on_def)
   { fix t
     assume t: "t \<in> {a..b}"
     have cball: "continuous_on (ball (\<gamma> t) (dist (\<gamma> t) z)) (\<lambda>x. inverse (x - z))"
         using z by (auto intro!: continuous_intros simp: dist_norm)
     have icd: "\<And>x. cmod (\<gamma> t - x) < cmod (\<gamma> t - z) \<Longrightarrow> (\<lambda>w. inverse (w - z)) field_differentiable at x"
       unfolding field_differentiable_def by (force simp: intro!: derivative_eq_intros)
     obtain h where h: "\<And>x. cmod (\<gamma> t - x) < cmod (\<gamma> t - z) \<Longrightarrow>
                        (h has_field_derivative inverse (x - z)) (at x within {y. cmod (\<gamma> t - y) < cmod (\<gamma> t - z)})"
       using holomorphic_convex_primitive [where f = "\<lambda>w. inverse(w - z)", OF convex_ball finite.emptyI cball icd]
       by simp (auto simp: ball_def dist_norm that)
     have "exp (- (integral {a..t} (\<lambda>x. ?D\<gamma> x / (\<gamma> x - z)))) * (\<gamma> t - z) =\<gamma> a - z"
     proof (rule has_derivative_zero_unique_strong_interval [of "{a,b} \<union> k" a b])
       show "continuous_on {a..b} (\<lambda>b. exp (- integral {a..b} (\<lambda>x. ?D\<gamma> x / (\<gamma> x - z))) * (\<gamma> b - z))"
         by (auto intro!: continuous_intros con_g indefinite_integral_continuous_1 [OF vg_int])
       show "((\<lambda>b. exp (- integral {a..b} (\<lambda>x. ?D\<gamma> x / (\<gamma> x - z))) * (\<gamma> b - z)) has_derivative (\<lambda>h. 0))
             (at x within {a..b})" 
         if "x \<in> {a..b} - ({a, b} \<union> k)" for x
       proof -
         have x: "x \<notin> k" "a < x" "x < b"
           using that by auto
         then have "x \<in> interior ({a..b} - k)"
           using open_subset_interior [OF \<circ>] by fastforce
         then have con: "isCont ?D\<gamma> x"
           using g_C1_diff x by (auto simp: C1_differentiable_on_eq intro: continuous_on_interior)
         then have con_vd: "continuous (at x within {a..b}) (\<lambda>x. ?D\<gamma> x)"
           by (rule continuous_at_imp_continuous_within)
         have gdx: "\<gamma> differentiable at x"
           using x by (simp add: g_diff_at)
         then obtain d where d: "(\<gamma> has_derivative (\<lambda>x. x *\<^sub>R d)) (at x)"
           by (auto simp add: differentiable_iff_scaleR)
         show "((\<lambda>c. exp (- integral {a..c} (\<lambda>x. ?D\<gamma> x / (\<gamma> x - z))) * (\<gamma> c - z)) has_derivative (\<lambda>h. 0))
           (at x within {a..b})"
         proof (rule exp_fg [unfolded has_vector_derivative_def, simplified])
           show "(\<gamma> has_derivative (\<lambda>c. c *\<^sub>R d)) (at x within {a..b})"
             using d by (blast intro: has_derivative_at_withinI)
           have "((\<lambda>x. integral {a..x} (\<lambda>x. ?D\<gamma> x / (\<gamma> x - z))) has_vector_derivative d / (\<gamma> x - z))
               (at x within {a..b})"
           proof (rule has_vector_derivative_eq_rhs [OF integral_has_vector_derivative_continuous_at [where S = "{}", simplified]])
             show "continuous (at x within {a..b}) (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z))"
               using continuous_at_imp_continuous_at_within differentiable_imp_continuous_within gdx x
               by (intro con_vd continuous_intros) (force+) 
             show "vector_derivative \<gamma> (at x) / (\<gamma> x - z) = d / (\<gamma> x - z)"
               using d vector_derivative_at
               by (simp add: vector_derivative_at has_vector_derivative_def)
           qed (use x vg_int in auto)
           then show "((\<lambda>x. integral {a..x} (\<lambda>x. ?D\<gamma> x / (\<gamma> x - z))) has_derivative (\<lambda>c. c *\<^sub>R (d / (\<gamma> x - z))))
                (at x within {a..b})"
             by (auto simp: has_vector_derivative_def)
         qed (use x in auto)
       qed
     qed (use fink t in auto)
   }
   with ab show ?thesis2
     by (simp add: divide_inverse_commute integral_def)
 qed
 
 lemma winding_number_exp_2pi:
     "\<lbrakk>path p; z \<notin> path_image p\<rbrakk>
      \<Longrightarrow> pathfinish p - z = exp (2 * pi * \<i> * winding_number p z) * (pathstart p - z)"
 using winding_number [of p z 1] unfolding valid_path_def path_image_def pathstart_def pathfinish_def winding_number_prop_def
   by (force dest: winding_number_exp_integral(2) [of _ 0 1 z] simp: field_simps contour_integral_integral exp_minus)
 
 lemma integer_winding_number_eq:
   assumes \<gamma>: "path \<gamma>" and z: "z \<notin> path_image \<gamma>"
   shows "winding_number \<gamma> z \<in> \<int> \<longleftrightarrow> pathfinish \<gamma> = pathstart \<gamma>"
 proof -
   obtain p where p: "valid_path p" "z \<notin> path_image p"
                     "pathstart p = pathstart \<gamma>" "pathfinish p = pathfinish \<gamma>"
            and eq: "contour_integral p (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z"
     using winding_number [OF assms, of 1] unfolding winding_number_prop_def by auto
   then have wneq: "winding_number \<gamma> z = winding_number p z"
       using eq winding_number_valid_path by force
   have iff: "(winding_number \<gamma> z \<in> \<int>) \<longleftrightarrow> (exp (contour_integral p (\<lambda>w. 1 / (w - z))) = 1)"
     using eq by (simp add: exp_eq_1 complex_is_Int_iff)
   have "\<gamma> 0 \<noteq> z"
     by (metis pathstart_def pathstart_in_path_image z)
   then have "exp (contour_integral p (\<lambda>w. 1 / (w - z))) = (\<gamma> 1 - z) / (\<gamma> 0 - z)"
     using p winding_number_exp_integral(2) [of p 0 1 z]
     by (simp add: valid_path_def path_defs contour_integral_integral exp_minus field_split_simps)
   then have "winding_number p z \<in> \<int> \<longleftrightarrow> pathfinish p = pathstart p"
     using p wneq iff by (auto simp: path_defs)
   then show ?thesis using p eq
     by (auto simp: winding_number_valid_path)
 qed
 
 theorem integer_winding_number:
   "\<lbrakk>path \<gamma>; pathfinish \<gamma> = pathstart \<gamma>; z \<notin> path_image \<gamma>\<rbrakk> \<Longrightarrow> winding_number \<gamma> z \<in> \<int>"
 by (metis integer_winding_number_eq)
 
 
 text\<open>If the winding number's magnitude is at least one, then the path must contain points in every direction.*)
    We can thus bound the winding number of a path that doesn't intersect a given ray. \<close>
 
 lemma winding_number_pos_meets:
   fixes z::complex
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and 1: "Re (winding_number \<gamma> z) \<ge> 1"
       and w: "w \<noteq> z"
   shows "\<exists>a::real. 0 < a \<and> z + of_real a * (w - z) \<in> path_image \<gamma>"
 proof -
   have [simp]: "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> \<gamma> x \<noteq> z"
     using z by (auto simp: path_image_def)
   have [simp]: "z \<notin> \<gamma> ` {0..1}"
     using path_image_def z by auto
   have gpd: "\<gamma> piecewise_C1_differentiable_on {0..1}"
     using \<gamma> valid_path_def by blast
   define r where "r = (w - z) / (\<gamma> 0 - z)"
   have [simp]: "r \<noteq> 0"
     using w z by (auto simp: r_def)
   have cont: "continuous_on {0..1}
      (\<lambda>x. Im (integral {0..x} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z))))"
     by (intro continuous_intros indefinite_integral_continuous_1 winding_number_exp_integral [OF gpd]; simp)
   have "Arg2pi r \<le> 2*pi"
     by (simp add: Arg2pi less_eq_real_def)
   also have "\<dots> \<le> Im (integral {0..1} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z)))"
     using 1
     by (simp add: winding_number_valid_path [OF \<gamma> z] contour_integral_integral Complex.Re_divide field_simps power2_eq_square)
   finally have "Arg2pi r \<le> Im (integral {0..1} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z)))" .
   then have "\<exists>t. t \<in> {0..1} \<and> Im(integral {0..t} (\<lambda>x. vector_derivative \<gamma> (at x)/(\<gamma> x - z))) = Arg2pi r"
     by (simp add: Arg2pi_ge_0 cont IVT')
   then obtain t where t:     "t \<in> {0..1}"
                   and eqArg: "Im (integral {0..t} (\<lambda>x. vector_derivative \<gamma> (at x)/(\<gamma> x - z))) = Arg2pi r"
     by blast
   define i where "i = integral {0..t} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z))"
   have gpdt: "\<gamma> piecewise_C1_differentiable_on {0..t}"
     by (metis atLeastAtMost_iff atLeastatMost_subset_iff order_refl piecewise_C1_differentiable_on_subset gpd t)
   have "exp (- i) * (\<gamma> t - z) = \<gamma> 0 - z"
     unfolding i_def
   proof (rule winding_number_exp_integral [OF gpdt])
     show "z \<notin> \<gamma> ` {0..t}"
       using t z unfolding path_image_def by force
   qed (use t in auto)
   then have *: "\<gamma> t - z = exp i * (\<gamma> 0 - z)"
     by (simp add: exp_minus field_simps)
   then have "(w - z) = r * (\<gamma> 0 - z)"
     by (simp add: r_def)
   moreover have "z + exp (Re i) * (exp (\<i> * Im i) * (\<gamma> 0 - z)) = \<gamma> t"
     using * by (simp add: exp_eq_polar field_simps)
   moreover have "Arg2pi r = Im i"
     using eqArg by (simp add: i_def)
   ultimately have "z + complex_of_real (exp (Re i)) * (w - z) / complex_of_real (cmod r) = \<gamma> t"
     using Complex_Transcendental.Arg2pi_eq [of r] \<open>r \<noteq> 0\<close>
     by (metis  mult.left_commute nonzero_mult_div_cancel_left norm_eq_zero of_real_0 of_real_eq_iff times_divide_eq_left)
   with t show ?thesis
     by (rule_tac x="exp(Re i) / norm r" in exI) (auto simp: path_image_def)
 qed
 
 lemma winding_number_big_meets:
   fixes z::complex
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and "\<bar>Re (winding_number \<gamma> z)\<bar> \<ge> 1"
       and w: "w \<noteq> z"
   shows "\<exists>a::real. 0 < a \<and> z + of_real a * (w - z) \<in> path_image \<gamma>"
 proof -
   { assume "Re (winding_number \<gamma> z) \<le> - 1"
     then have "Re (winding_number (reversepath \<gamma>) z) \<ge> 1"
       by (simp add: \<gamma> valid_path_imp_path winding_number_reversepath z)
     moreover have "valid_path (reversepath \<gamma>)"
       using \<gamma> valid_path_imp_reverse by auto
     moreover have "z \<notin> path_image (reversepath \<gamma>)"
       by (simp add: z)
     ultimately have "\<exists>a::real. 0 < a \<and> z + of_real a * (w - z) \<in> path_image (reversepath \<gamma>)"
       using winding_number_pos_meets w by blast
     then have ?thesis
       by simp
   }
   then show ?thesis
     using assms
     by (simp add: abs_if winding_number_pos_meets split: if_split_asm)
 qed
 
 lemma winding_number_less_1:
   fixes z::complex
   shows
   "\<lbrakk>valid_path \<gamma>; z \<notin> path_image \<gamma>; w \<noteq> z;
     \<And>a::real. 0 < a \<Longrightarrow> z + of_real a * (w - z) \<notin> path_image \<gamma>\<rbrakk>
    \<Longrightarrow> Re(winding_number \<gamma> z) < 1"
    by (auto simp: not_less dest: winding_number_big_meets)
 
 text\<open>One way of proving that WN=1 for a loop.\<close>
 lemma winding_number_eq_1:
   fixes z::complex
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
       and 0: "0 < Re(winding_number \<gamma> z)" and 2: "Re(winding_number \<gamma> z) < 2"
   shows "winding_number \<gamma> z = 1"
 proof -
   have "winding_number \<gamma> z \<in> Ints"
     by (simp add: \<gamma> integer_winding_number loop valid_path_imp_path z)
   then show ?thesis
     using 0 2 by (auto simp: Ints_def)
 qed
 
 subsection\<open>Continuity of winding number and invariance on connected sets\<close>
 
 theorem continuous_at_winding_number:
   fixes z::complex
   assumes \<gamma>: "path \<gamma>" and z: "z \<notin> path_image \<gamma>"
   shows "continuous (at z) (winding_number \<gamma>)"
 proof -
   obtain e where "e>0" and cbg: "cball z e \<subseteq> - path_image \<gamma>"
     using open_contains_cball [of "- path_image \<gamma>"]  z
     by (force simp: closed_def [symmetric] closed_path_image [OF \<gamma>])
   then have ppag: "path_image \<gamma> \<subseteq> - cball z (e/2)"
     by (force simp: cball_def dist_norm)
   have oc: "open (- cball z (e/2))"
     by (simp add: closed_def [symmetric])
   obtain d where "d>0" and pi_eq:
     "\<And>h1 h2. \<lbrakk>valid_path h1; valid_path h2;
               (\<forall>t\<in>{0..1}. cmod (h1 t - \<gamma> t) < d \<and> cmod (h2 t - \<gamma> t) < d);
               pathstart h2 = pathstart h1; pathfinish h2 = pathfinish h1\<rbrakk>
              \<Longrightarrow>
                path_image h1 \<subseteq> - cball z (e/2) \<and>
                path_image h2 \<subseteq> - cball z (e/2) \<and>
                (\<forall>f. f holomorphic_on - cball z (e/2) \<longrightarrow> contour_integral h2 f = contour_integral h1 f)"
     using contour_integral_nearby_ends [OF oc \<gamma> ppag] by metis
   obtain p where "valid_path p" "z \<notin> path_image p"
               and p: "pathstart p = pathstart \<gamma>" "pathfinish p = pathfinish \<gamma>"
               and pg: "\<And>t. t\<in>{0..1} \<Longrightarrow> cmod (\<gamma> t - p t) < min d e/2"
               and pi: "contour_integral p (\<lambda>x. 1 / (x - z)) = complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z"
     using winding_number [OF \<gamma> z, of "min d e/2"] \<open>d>0\<close> \<open>e>0\<close> by (auto simp: winding_number_prop_def)
   { fix w
     assume d2: "cmod (w - z) < d/2" and e2: "cmod (w - z) < e/2"
     have wnotp: "w \<notin> path_image p"
     proof (clarsimp simp add: path_image_def)
       show False if w: "w = p x" and "0 \<le> x" "x \<le> 1" for x
       proof -
         have "cmod (\<gamma> x - p x) < min d e/2"
           using pg that by auto
         then have "cmod (z - \<gamma> x) < e"
           by (metis e2 less_divide_eq_numeral1(1) min_less_iff_conj norm_minus_commute norm_triangle_half_l w)
         then show ?thesis
           using cbg that by (auto simp add: path_image_def cball_def dist_norm less_eq_real_def)
       qed
     qed
     have wnotg: "w \<notin> path_image \<gamma>"
       using cbg e2 \<open>e>0\<close> by (force simp: dist_norm norm_minus_commute)
     { fix k::real
       assume k: "k>0"
       then obtain q where q: "valid_path q" "w \<notin> path_image q"
                              "pathstart q = pathstart \<gamma> \<and> pathfinish q = pathfinish \<gamma>"
                     and qg: "\<And>t. t \<in> {0..1} \<Longrightarrow> cmod (\<gamma> t - q t) < min k (min d e) / 2"
                     and qi: "contour_integral q (\<lambda>u. 1 / (u - w)) = complex_of_real (2 * pi) * \<i> * winding_number \<gamma> w"
         using winding_number [OF \<gamma> wnotg, of "min k (min d e) / 2"] \<open>d>0\<close> \<open>e>0\<close> k
         by (force simp: min_divide_distrib_right winding_number_prop_def)
       moreover have "\<And>t. t \<in> {0..1} \<Longrightarrow> cmod (q t - \<gamma> t) < d \<and> cmod (p t - \<gamma> t) < d"
         using pg qg \<open>0 < d\<close> by (fastforce simp add: norm_minus_commute)
       moreover have "(\<lambda>u. 1 / (u-w)) holomorphic_on - cball z (e/2)"
         using e2 by (auto simp: dist_norm norm_minus_commute intro!: holomorphic_intros)
       ultimately have "contour_integral p (\<lambda>u. 1 / (u - w)) = contour_integral q (\<lambda>u. 1 / (u - w))"
         by (metis p \<open>valid_path p\<close> pi_eq)
       then have "contour_integral p (\<lambda>x. 1 / (x - w)) = complex_of_real (2 * pi) * \<i> * winding_number \<gamma> w"
         by (simp add: pi qi)
     } note pip = this
     have "path p"
       by (simp add: \<open>valid_path p\<close> valid_path_imp_path)
     moreover have "\<And>e. e > 0 \<Longrightarrow> winding_number_prop p w e p (winding_number \<gamma> w)"
       by (simp add: \<open>valid_path p\<close> pip winding_number_prop_def wnotp)
     ultimately have "winding_number p w = winding_number \<gamma> w"
       using winding_number_unique wnotp by blast
   } note wnwn = this
   obtain pe where "pe>0" and cbp: "cball z (3 / 4 * pe) \<subseteq> - path_image p"
     using \<open>valid_path p\<close> \<open>z \<notin> path_image p\<close> open_contains_cball [of "- path_image p"]
     by (force simp: closed_def [symmetric] closed_path_image [OF valid_path_imp_path])
   obtain L
     where "L>0"
       and L: "\<And>f B. \<lbrakk>f holomorphic_on - cball z (3 / 4 * pe);
                       \<forall>z \<in> - cball z (3 / 4 * pe). cmod (f z) \<le> B\<rbrakk> \<Longrightarrow>
                       cmod (contour_integral p f) \<le> L * B"
     using contour_integral_bound_exists [of "- cball z (3/4*pe)" p] cbp \<open>valid_path p\<close> by blast
   { fix e::real and w::complex
     assume e: "0 < e" and w: "cmod (w - z) < pe/4" "cmod (w - z) < e * pe\<^sup>2 / (8 * L)"
     then have [simp]: "w \<notin> path_image p"
       using cbp p(2) \<open>0 < pe\<close>
       by (force simp: dist_norm norm_minus_commute path_image_def cball_def)
     have [simp]: "contour_integral p (\<lambda>x. 1/(x - w)) - contour_integral p (\<lambda>x. 1/(x - z)) =
                   contour_integral p (\<lambda>x. 1/(x - w) - 1/(x - z))"
       by (simp add: \<open>valid_path p\<close> \<open>z \<notin> path_image p\<close> contour_integrable_inversediff contour_integral_diff)
     { fix x
       assume pe: "3/4 * pe < cmod (z - x)"
       have "cmod (w - x) < pe/4 + cmod (z - x)"
         by (meson add_less_cancel_right norm_diff_triangle_le order_refl order_trans_rules(21) w(1))
       then have wx: "cmod (w - x) < 4/3 * cmod (z - x)" using pe by simp
       have "cmod (z - x) \<le> cmod (z - w) + cmod (w - x)"
         using norm_diff_triangle_le by blast
       also have "\<dots> < pe/4 + cmod (w - x)"
         using w by (simp add: norm_minus_commute)
       finally have "pe/2 < cmod (w - x)"
         using pe by auto
       then have pe_less: "(pe/2)^2 < cmod (w - x) ^ 2"
         by (simp add: \<open>0 < pe\<close> less_eq_real_def power_strict_mono)
       then have pe2: "pe^2 < 4 * cmod (w - x) ^ 2"
         by (simp add: power_divide)
       have "8 * L * cmod (w - z) < e * pe\<^sup>2"
         using w \<open>L>0\<close> by (simp add: field_simps)
       also have "\<dots> < e * 4 * cmod (w - x) * cmod (w - x)"
         using pe2 \<open>e>0\<close> by (simp add: power2_eq_square)
       also have "\<dots> < e * 4 * cmod (w - x) * (4/3 * cmod (z - x))"
         using \<open>0 < pe\<close> pe_less e less_eq_real_def wx by fastforce
       finally have "L * cmod (w - z) < 2/3 * e * cmod (w - x) * cmod (z - x)"
         by simp
       also have "\<dots> \<le> e * cmod (w - x) * cmod (z - x)"
          using e by simp
       finally have Lwz: "L * cmod (w - z) < e * cmod (w - x) * cmod (z - x)" .
       have "L * cmod (1 / (x - w) - 1 / (x - z)) \<le> e" 
       proof (cases "x=z \<or> x=w")
         case True
         with pe \<open>pe>0\<close> w \<open>L>0\<close>
         show ?thesis
           by (force simp: norm_minus_commute)
       next
         case False
         with wx w(2) \<open>L>0\<close> pe pe2 Lwz
         show ?thesis
           by (auto simp: divide_simps mult_less_0_iff norm_minus_commute norm_divide norm_mult power2_eq_square)
       qed
     } note L_cmod_le = this
     let ?f = "(\<lambda>x. 1 / (x - w) - 1 / (x - z))"
     have "cmod (contour_integral p ?f) \<le> L * (e * pe\<^sup>2 / L / 4 * (inverse (pe / 2))\<^sup>2)"
     proof (rule L)
       show "?f  holomorphic_on - cball z (3 / 4 * pe)"
         using \<open>pe>0\<close> w
         by (force simp: dist_norm norm_minus_commute intro!: holomorphic_intros)
       show " \<forall>u \<in>- cball z (3 / 4 * pe).  cmod (?f u) \<le> e * pe\<^sup>2 / L / 4 * (inverse (pe / 2))\<^sup>2"
         using \<open>pe>0\<close> w \<open>L>0\<close>
         by (auto simp: cball_def dist_norm field_simps L_cmod_le  simp del: less_divide_eq_numeral1 le_divide_eq_numeral1)
     qed
     also have "\<dots> < 2*e"
       using \<open>L>0\<close> e by (force simp: field_simps)
     finally have "cmod (winding_number p w - winding_number p z) < e"
       using pi_ge_two e
       by (force simp: winding_number_valid_path \<open>valid_path p\<close> \<open>z \<notin> path_image p\<close> field_simps norm_divide norm_mult intro: less_le_trans)
   } note cmod_wn_diff = this
   have "isCont (winding_number p) z"
   proof (clarsimp simp add: continuous_at_eps_delta)
     fix e::real assume "e>0"
     show "\<exists>d>0. \<forall>x'. dist x' z < d \<longrightarrow> dist (winding_number p x') (winding_number p z) < e"
       using \<open>pe>0\<close> \<open>L>0\<close> \<open>e>0\<close>
       by (rule_tac x="min (pe/4) (e/2*pe^2/L/4)" in exI) (simp add: dist_norm cmod_wn_diff)
   qed
   then show ?thesis
     apply (rule continuous_transform_within [where d = "min d e/2"])
     apply (auto simp: \<open>d>0\<close> \<open>e>0\<close> dist_norm wnwn)
     done
 qed
 
 corollary continuous_on_winding_number:
     "path \<gamma> \<Longrightarrow> continuous_on (- path_image \<gamma>) (\<lambda>w. winding_number \<gamma> w)"
   by (simp add: continuous_at_imp_continuous_on continuous_at_winding_number)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>The winding number is constant on a connected region\<close>
 
 lemma winding_number_constant:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>" and cs: "connected S" and sg: "S \<inter> path_image \<gamma> = {}"
   shows "winding_number \<gamma> constant_on S"
 proof -
   have *: "1 \<le> cmod (winding_number \<gamma> y - winding_number \<gamma> z)"
       if ne: "winding_number \<gamma> y \<noteq> winding_number \<gamma> z" and "y \<in> S" "z \<in> S" for y z
   proof -
     have "winding_number \<gamma> y \<in> \<int>"  "winding_number \<gamma> z \<in>  \<int>"
       using that integer_winding_number [OF \<gamma> loop] sg \<open>y \<in> S\<close> by auto
     with ne show ?thesis
       by (auto simp: Ints_def simp flip: of_int_diff)
   qed
   have cont: "continuous_on S (\<lambda>w. winding_number \<gamma> w)"
     using continuous_on_winding_number [OF \<gamma>] sg
     by (meson continuous_on_subset disjoint_eq_subset_Compl)
   show ?thesis
     using "*" zero_less_one
     by (blast intro: continuous_discrete_range_constant [OF cs cont])
 qed
 
 lemma winding_number_eq:
      "\<lbrakk>path \<gamma>; pathfinish \<gamma> = pathstart \<gamma>; w \<in> S; z \<in> S; connected S; S \<inter> path_image \<gamma> = {}\<rbrakk>
       \<Longrightarrow> winding_number \<gamma> w = winding_number \<gamma> z"
   using winding_number_constant by (metis constant_on_def)
 
 lemma open_winding_number_levelsets:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
   shows "open {z. z \<notin> path_image \<gamma> \<and> winding_number \<gamma> z = k}"
 proof (clarsimp simp: open_dist)
   fix z assume z: "z \<notin> path_image \<gamma>" and k: "k = winding_number \<gamma> z"
   have "open (- path_image \<gamma>)"
     by (simp add: closed_path_image \<gamma> open_Compl)
   then obtain e where "e>0" "ball z e \<subseteq> - path_image \<gamma>"
     using open_contains_ball [of "- path_image \<gamma>"] z by blast
   then show "\<exists>e>0. \<forall>y. dist y z < e \<longrightarrow> y \<notin> path_image \<gamma> \<and> winding_number \<gamma> y = winding_number \<gamma> z"
     using \<open>e>0\<close> by (force simp: norm_minus_commute dist_norm intro: winding_number_eq [OF assms, where S = "ball z e"])
 qed
 
 subsection\<open>Winding number is zero "outside" a curve\<close>
 
 proposition winding_number_zero_in_outside:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>" and z: "z \<in> outside (path_image \<gamma>)"
     shows "winding_number \<gamma> z = 0"
 proof -
   obtain B::real where "0 < B" and B: "path_image \<gamma> \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF bounded_path_image [OF \<gamma>]] by auto
   obtain w::complex where w: "w \<notin> ball 0 (B + 1)"
     by (metis abs_of_nonneg le_less less_irrefl mem_ball_0 norm_of_real)
   have "- ball 0 (B + 1) \<subseteq> outside (path_image \<gamma>)"
     using B subset_ball  by (intro outside_subset_convex) auto
   then have wout: "w \<in> outside (path_image \<gamma>)"
     using w by blast
   moreover have "winding_number \<gamma> constant_on outside (path_image \<gamma>)"
     using winding_number_constant [OF \<gamma> loop, of "outside(path_image \<gamma>)"] connected_outside
     by (metis DIM_complex bounded_path_image dual_order.refl \<gamma> outside_no_overlap)
   ultimately have "winding_number \<gamma> z = winding_number \<gamma> w"
     by (metis (no_types, opaque_lifting) constant_on_def z)
   also have "\<dots> = 0"
   proof -
     have wnot: "w \<notin> path_image \<gamma>"  using wout by (simp add: outside_def)
     { fix e::real assume "0<e"
       obtain p where p: "polynomial_function p" "pathstart p = pathstart \<gamma>" "pathfinish p = pathfinish \<gamma>"
                  and pg1: "(\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> cmod (p t - \<gamma> t) < 1)"
                  and pge: "(\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> cmod (p t - \<gamma> t) < e)"
         using path_approx_polynomial_function [OF \<gamma>, of "min 1 e"] \<open>e>0\<close>
         by (metis atLeastAtMost_iff min_less_iff_conj zero_less_one)
       have "\<exists>p. valid_path p \<and> w \<notin> path_image p \<and>
                      pathstart p = pathstart \<gamma> \<and> pathfinish p = pathfinish \<gamma> \<and>
                      (\<forall>t\<in>{0..1}. cmod (\<gamma> t - p t) < e) \<and> contour_integral p (\<lambda>wa. 1 / (wa - w)) = 0"
       proof (intro exI conjI)
         have "\<And>x. \<lbrakk>0 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> cmod (p x) < B + 1"
           using B unfolding image_subset_iff path_image_def
           by (meson add_strict_mono atLeastAtMost_iff le_less_trans mem_ball_0 norm_triangle_sub pg1) 
         then have pip: "path_image p \<subseteq> ball 0 (B + 1)"
           by (auto simp add: path_image_def dist_norm ball_def)
         then show "w \<notin> path_image p" using w by blast
         show vap: "valid_path p"
           by (simp add: p(1) valid_path_polynomial_function)
         show "\<forall>t\<in>{0..1}. cmod (\<gamma> t - p t) < e"
           by (metis atLeastAtMost_iff norm_minus_commute pge)
         show "contour_integral p (\<lambda>wa. 1 / (wa - w)) = 0"
         proof (rule contour_integral_unique [OF Cauchy_theorem_convex_simple [OF _ convex_ball [of 0 "B+1"]]])
           have "\<And>z. cmod z < B + 1 \<Longrightarrow> z \<noteq> w"
             using mem_ball_0 w by blast
           then show "(\<lambda>z. 1 / (z - w)) holomorphic_on ball 0 (B + 1)"
             by (intro holomorphic_intros; simp add: dist_norm)
         qed (use p vap pip loop in auto)
       qed (use p in auto)
     }
     then show ?thesis
       by (auto intro: winding_number_unique [OF \<gamma>] simp add: winding_number_prop_def wnot)
   qed
   finally show ?thesis .
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> winding_number_zero_const: "a \<noteq> z \<Longrightarrow> winding_number (\<lambda>t. a) z = 0"
   by (rule winding_number_zero_in_outside)
      (auto simp: pathfinish_def pathstart_def path_polynomial_function)
 
 corollary\<^marker>\<open>tag unimportant\<close> winding_number_zero_outside:
     "\<lbrakk>path \<gamma>; convex s; pathfinish \<gamma> = pathstart \<gamma>; z \<notin> s; path_image \<gamma> \<subseteq> s\<rbrakk> \<Longrightarrow> winding_number \<gamma> z = 0"
   by (meson convex_in_outside outside_mono subsetCE winding_number_zero_in_outside)
 
 lemma winding_number_zero_at_infinity:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
     shows "\<exists>B. \<forall>z. B \<le> norm z \<longrightarrow> winding_number \<gamma> z = 0"
 proof -
   obtain B::real where "0 < B" and B: "path_image \<gamma> \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF bounded_path_image [OF \<gamma>]] by auto
   have "winding_number \<gamma> z = 0" if "B + 1 \<le> cmod z" for z
   proof (rule winding_number_zero_outside [OF \<gamma> convex_cball loop])
     show "z \<notin> cball 0 B"
       using that by auto
     show "path_image \<gamma> \<subseteq> cball 0 B"
       using B order.trans by blast
   qed
   then show ?thesis
     by metis
 qed
 
 lemma bounded_winding_number_nz:
   assumes "path g" "pathfinish g = pathstart g"
   shows   "bounded {z. winding_number g z \<noteq> 0}"
 proof -
   obtain B where "\<And>x. norm x \<ge> B \<Longrightarrow> winding_number g x = 0"
     using winding_number_zero_at_infinity[OF assms] by auto
   thus ?thesis
     unfolding bounded_iff by (intro exI[of _ "B + 1"]) force
 qed
   
 lemma winding_number_zero_point:
     "\<lbrakk>path \<gamma>; convex S; pathfinish \<gamma> = pathstart \<gamma>; open S; path_image \<gamma> \<subseteq> S\<rbrakk>
      \<Longrightarrow> \<exists>z. z \<in> S \<and> winding_number \<gamma> z = 0"
   using outside_compact_in_open [of "path_image \<gamma>" S] path_image_nonempty winding_number_zero_in_outside
   by (fastforce simp add: compact_path_image)
 
 
 text\<open>If a path winds round a set, it winds rounds its inside.\<close>
 lemma winding_number_around_inside:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
       and cls: "closed S" and cos: "connected S" and S_disj: "S \<inter> path_image \<gamma> = {}"
       and z: "z \<in> S" and wn_nz: "winding_number \<gamma> z \<noteq> 0" and w: "w \<in> S \<union> inside S"
     shows "winding_number \<gamma> w = winding_number \<gamma> z"
 proof -
   have ssb: "S \<subseteq> inside(path_image \<gamma>)"
   proof
     fix x :: complex
     assume "x \<in> S"
     hence "x \<notin> path_image \<gamma>"
       by (meson disjoint_iff_not_equal S_disj)
     thus "x \<in> inside (path_image \<gamma>)"
       by (metis Compl_iff S_disj UnE \<gamma> \<open>x \<in> S\<close> cos inside_outside loop winding_number_eq winding_number_zero_in_outside wn_nz z)
   qed
   show ?thesis
   proof (rule winding_number_eq [OF \<gamma> loop w])
     show "z \<in> S \<union> inside S"
       using z by blast
     show "connected (S \<union> inside S)"
       by (simp add: cls connected_with_inside cos)
     show "(S \<union> inside S) \<inter> path_image \<gamma> = {}"
       unfolding disjoint_iff Un_iff 
       by (metis ComplD UnI1 \<gamma> cls compact_path_image connected_path_image inside_Un_outside inside_inside_compact_connected ssb subsetD)
   qed
 qed
 
 text\<open>Bounding a WN by 1/2 for a path and point in opposite halfspaces.\<close>
 lemma winding_number_subpath_continuous:
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>"
     shows "continuous_on {0..1} (\<lambda>x. winding_number(subpath 0 x \<gamma>) z)"
 proof (rule continuous_on_eq)
   let ?f = "\<lambda>x. integral {0..x} (\<lambda>t. vector_derivative \<gamma> (at t) / (\<gamma> t - z))"
   show "continuous_on {0..1} (\<lambda>x. 1 / (2 * pi * \<i>) * ?f x)"
   proof (intro indefinite_integral_continuous_1 winding_number_exp_integral continuous_intros)
     show "\<gamma> piecewise_C1_differentiable_on {0..1}"
       using \<gamma> valid_path_def by blast
   qed (use path_image_def z in auto)
   show "1 / (2 * pi * \<i>) * ?f x = winding_number (subpath 0 x \<gamma>) z"
     if x: "x \<in> {0..1}" for x
   proof -
     have "1 / (2*pi*\<i>) * ?f x = 1 / (2*pi*\<i>) * contour_integral (subpath 0 x \<gamma>) (\<lambda>w. 1/(w - z))"
       using assms x
       by (simp add: contour_integral_subcontour_integral [OF contour_integrable_inversediff])
     also have "\<dots> = winding_number (subpath 0 x \<gamma>) z"
     proof (subst winding_number_valid_path)
       show "z \<notin> path_image (subpath 0 x \<gamma>)"
         using assms x atLeastAtMost_iff path_image_subpath_subset by force
     qed (use assms x valid_path_subpath in \<open>force+\<close>)
     finally show ?thesis .
   qed
 qed
 
 lemma winding_number_ivt_pos:
     assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and "0 \<le> w" "w \<le> Re(winding_number \<gamma> z)"
     shows "\<exists>t \<in> {0..1}. Re(winding_number(subpath 0 t \<gamma>) z) = w"
 proof -
   have "continuous_on {0..1} (\<lambda>x. winding_number (subpath 0 x \<gamma>) z)"
     using \<gamma> winding_number_subpath_continuous z by blast
   moreover have "Re (winding_number (subpath 0 0 \<gamma>) z) \<le> w" "w \<le> Re (winding_number (subpath 0 1 \<gamma>) z)"
     using assms by (auto simp: path_image_def image_def)
   ultimately show ?thesis
     using ivt_increasing_component_on_1[of 0 1, where ?k = "1"] by force
 qed
 
 lemma winding_number_ivt_neg:
     assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and "Re(winding_number \<gamma> z) \<le> w" "w \<le> 0"
       shows "\<exists>t \<in> {0..1}. Re(winding_number(subpath 0 t \<gamma>) z) = w"
 proof -
   have "continuous_on {0..1} (\<lambda>x. winding_number (subpath 0 x \<gamma>) z)"
     using \<gamma> winding_number_subpath_continuous z by blast
   moreover have "Re (winding_number (subpath 0 0 \<gamma>) z) \<ge> w" "w \<ge> Re (winding_number (subpath 0 1 \<gamma>) z)"
     using assms by (auto simp: path_image_def image_def)
   ultimately show ?thesis
     using ivt_decreasing_component_on_1[of 0 1, where ?k = "1"] by force
 qed
 
 lemma winding_number_ivt_abs:
     assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and "0 \<le> w" "w \<le> \<bar>Re(winding_number \<gamma> z)\<bar>"
       shows "\<exists>t \<in> {0..1}. \<bar>Re (winding_number (subpath 0 t \<gamma>) z)\<bar> = w"
   using assms winding_number_ivt_pos [of \<gamma> z w] winding_number_ivt_neg [of \<gamma> z "-w"]
   by force
 
 lemma winding_number_lt_half_lemma:
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and az: "a \<bullet> z \<le> b" and pag: "path_image \<gamma> \<subseteq> {w. a \<bullet> w > b}"
     shows "Re(winding_number \<gamma> z) < 1/2"
 proof -
   { assume "Re(winding_number \<gamma> z) \<ge> 1/2"
     then obtain t::real where t: "0 \<le> t" "t \<le> 1" and sub12: "Re (winding_number (subpath 0 t \<gamma>) z) = 1/2"
       using winding_number_ivt_pos [OF \<gamma> z, of "1/2"] by auto
     have gt: "\<gamma> t - z = - (of_real (exp (- (2 * pi * Im (winding_number (subpath 0 t \<gamma>) z)))) * (\<gamma> 0 - z))"
       using winding_number_exp_2pi [of "subpath 0 t \<gamma>" z]
       apply (simp add: t \<gamma> valid_path_imp_path)
       using closed_segment_eq_real_ivl path_image_def t z by (fastforce simp: path_image_subpath Euler sub12)
     have "b < a \<bullet> \<gamma> 0"
     proof -
       have "\<gamma> 0 \<in> {c. b < a \<bullet> c}"
         by (metis (no_types) pag atLeastAtMost_iff image_subset_iff order_refl path_image_def zero_le_one)
       thus ?thesis
         by blast
     qed
     moreover have "b < a \<bullet> \<gamma> t"
       by (metis atLeastAtMost_iff image_eqI mem_Collect_eq pag path_image_def subset_iff t)
     ultimately have "0 < a \<bullet> (\<gamma> 0 - z)" "0 < a \<bullet> (\<gamma> t - z)" using az
       by (simp add: inner_diff_right)+
     then have False
       by (simp add: gt inner_mult_right mult_less_0_iff)
   }
   then show ?thesis by force
 qed
 
 lemma winding_number_lt_half:
   assumes "valid_path \<gamma>" "a \<bullet> z \<le> b" "path_image \<gamma> \<subseteq> {w. a \<bullet> w > b}"
     shows "\<bar>Re (winding_number \<gamma> z)\<bar> < 1/2"
 proof -
   have "z \<notin> path_image \<gamma>" using assms by auto
   with assms have "Re (winding_number \<gamma> z) < 0 \<Longrightarrow> - Re (winding_number \<gamma> z) < 1/2"
     by (metis complex_inner_1_right winding_number_lt_half_lemma [OF valid_path_imp_reverse, of \<gamma> z a b]
         winding_number_reversepath valid_path_imp_path inner_minus_left path_image_reversepath)
   with assms show ?thesis
     using \<open>z \<notin> path_image \<gamma>\<close> winding_number_lt_half_lemma by fastforce
 qed
 
 lemma winding_number_le_half:
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>"
       and anz: "a \<noteq> 0" and azb: "a \<bullet> z \<le> b" and pag: "path_image \<gamma> \<subseteq> {w. a \<bullet> w \<ge> b}"
     shows "\<bar>Re (winding_number \<gamma> z)\<bar> \<le> 1/2"
 proof -
   { assume wnz_12: "\<bar>Re (winding_number \<gamma> z)\<bar> > 1/2"
     have "isCont (winding_number \<gamma>) z"
       by (metis continuous_at_winding_number valid_path_imp_path \<gamma> z)
     then obtain d where "d>0" and d: "\<And>x'. dist x' z < d \<Longrightarrow> dist (winding_number \<gamma> x') (winding_number \<gamma> z) < \<bar>Re(winding_number \<gamma> z)\<bar> - 1/2"
       using continuous_at_eps_delta wnz_12 diff_gt_0_iff_gt by blast
     define z' where "z' = z - (d / (2 * cmod a)) *\<^sub>R a"
     have "a \<bullet> z * 6 \<le> d * cmod a + b * 6"
       by (metis \<open>0 < d\<close> add_increasing azb less_eq_real_def mult_nonneg_nonneg mult_right_mono norm_ge_zero norm_numeral)
     with anz have *: "a \<bullet> z' \<le> b - d / 3 * cmod a"
       unfolding z'_def inner_mult_right' divide_inverse
       by (simp add: field_split_simps algebra_simps dot_square_norm power2_eq_square)
     have "cmod (winding_number \<gamma> z' - winding_number \<gamma> z) < \<bar>Re (winding_number \<gamma> z)\<bar> - 1/2"
       using d [of z'] anz \<open>d>0\<close> by (simp add: dist_norm z'_def)
     then have "1/2 < \<bar>Re (winding_number \<gamma> z)\<bar> - cmod (winding_number \<gamma> z' - winding_number \<gamma> z)"
       by simp
     then have "1/2 < \<bar>Re (winding_number \<gamma> z)\<bar> - \<bar>Re (winding_number \<gamma> z') - Re (winding_number \<gamma> z)\<bar>"
       using abs_Re_le_cmod [of "winding_number \<gamma> z' - winding_number \<gamma> z"] by simp
     then have wnz_12': "\<bar>Re (winding_number \<gamma> z')\<bar> > 1/2"
       by linarith
     moreover have "\<bar>Re (winding_number \<gamma> z')\<bar> < 1/2"
     proof (rule winding_number_lt_half [OF \<gamma> *])
       show "path_image \<gamma> \<subseteq> {w. b - d / 3 * cmod a < a \<bullet> w}"
         using azb \<open>d>0\<close> pag by (auto simp: add_strict_increasing anz field_split_simps dest!: subsetD)
     qed
     ultimately have False
       by simp
   }
   then show ?thesis by force
 qed
 
 lemma winding_number_lt_half_linepath:
   assumes "z \<notin> closed_segment a b" shows "\<bar>Re (winding_number (linepath a b) z)\<bar> < 1/2"
 proof -
   obtain u v where "u \<bullet> z \<le> v" and uv: "\<And>x. x \<in> closed_segment a b \<Longrightarrow> inner u x > v"
     using separating_hyperplane_closed_point assms closed_segment convex_closed_segment less_eq_real_def by metis
   moreover have "path_image (linepath a b) \<subseteq> {w. v < u \<bullet> w}"
     using in_segment(1) uv by auto
   ultimately show ?thesis
     using winding_number_lt_half by auto
 qed
 
 text\<open> Positivity of WN for a linepath.\<close>
 lemma winding_number_linepath_pos_lt:
     assumes "0 < Im ((b - a) * cnj (b - z))"
       shows "0 < Re(winding_number(linepath a b) z)"
 proof -
   have z: "z \<notin> path_image (linepath a b)"
     using assms
     by (simp add: closed_segment_def) (force simp: algebra_simps)
   show ?thesis
     by (intro winding_number_pos_lt [OF valid_path_linepath z assms]) (simp add: linepath_def algebra_simps)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More winding number properties\<close>
 
 text\<open>including the fact that it's +-1 inside a simple closed curve.\<close>
 
 lemma winding_number_homotopic_paths:
     assumes "homotopic_paths (-{z}) g h"
       shows "winding_number g z = winding_number h z"
 proof -
   have "path g" "path h" using homotopic_paths_imp_path [OF assms] by auto
   moreover have pag: "z \<notin> path_image g" and pah: "z \<notin> path_image h"
     using homotopic_paths_imp_subset [OF assms] by auto
   ultimately obtain d e where "d > 0" "e > 0"
       and d: "\<And>p. \<lbrakk>path p; pathstart p = pathstart g; pathfinish p = pathfinish g; \<forall>t\<in>{0..1}. norm (p t - g t) < d\<rbrakk>
             \<Longrightarrow> homotopic_paths (-{z}) g p"
       and e: "\<And>q. \<lbrakk>path q; pathstart q = pathstart h; pathfinish q = pathfinish h; \<forall>t\<in>{0..1}. norm (q t - h t) < e\<rbrakk>
             \<Longrightarrow> homotopic_paths (-{z}) h q"
     using homotopic_nearby_paths [of g "-{z}"] homotopic_nearby_paths [of h "-{z}"] by force
   obtain p where p:
        "valid_path p" "z \<notin> path_image p"
        "pathstart p = pathstart g" "pathfinish p = pathfinish g"
        and gp_less:"\<forall>t\<in>{0..1}. cmod (g t - p t) < d"
        and pap: "contour_integral p (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number g z"
     using winding_number [OF \<open>path g\<close> pag \<open>0 < d\<close>] unfolding winding_number_prop_def by blast
   obtain q where q:
        "valid_path q" "z \<notin> path_image q"
        "pathstart q = pathstart h" "pathfinish q = pathfinish h"
        and hq_less: "\<forall>t\<in>{0..1}. cmod (h t - q t) < e"
        and paq:  "contour_integral q (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number h z"
     using winding_number [OF \<open>path h\<close> pah \<open>0 < e\<close>] unfolding winding_number_prop_def by blast
   have "homotopic_paths (- {z}) g p"
     by (simp add: d p valid_path_imp_path norm_minus_commute gp_less)
   moreover have "homotopic_paths (- {z}) h q"
     by (simp add: e q valid_path_imp_path norm_minus_commute hq_less)
   ultimately have "homotopic_paths (- {z}) p q"
     by (blast intro: homotopic_paths_trans homotopic_paths_sym assms)
   then have "contour_integral p (\<lambda>w. 1/(w - z)) = contour_integral q (\<lambda>w. 1/(w - z))"
     by (rule Cauchy_theorem_homotopic_paths) (auto intro!: holomorphic_intros simp: p q)
   then show ?thesis
     by (simp add: pap paq)
 qed
 
 lemma winding_number_homotopic_loops:
     assumes "homotopic_loops (-{z}) g h"
       shows "winding_number g z = winding_number h z"
 proof -
   have "path g" "path h" using homotopic_loops_imp_path [OF assms] by auto
   moreover have pag: "z \<notin> path_image g" and pah: "z \<notin> path_image h"
     using homotopic_loops_imp_subset [OF assms] by auto
   moreover have gloop: "pathfinish g = pathstart g" and hloop: "pathfinish h = pathstart h"
     using homotopic_loops_imp_loop [OF assms] by auto
   ultimately obtain d e where "d > 0" "e > 0"
       and d: "\<And>p. \<lbrakk>path p; pathfinish p = pathstart p; \<forall>t\<in>{0..1}. norm (p t - g t) < d\<rbrakk>
             \<Longrightarrow> homotopic_loops (-{z}) g p"
       and e: "\<And>q. \<lbrakk>path q; pathfinish q = pathstart q; \<forall>t\<in>{0..1}. norm (q t - h t) < e\<rbrakk>
             \<Longrightarrow> homotopic_loops (-{z}) h q"
     using homotopic_nearby_loops [of g "-{z}"] homotopic_nearby_loops [of h "-{z}"] by force
   obtain p where p:
        "valid_path p" "z \<notin> path_image p"
        "pathstart p = pathstart g" "pathfinish p = pathfinish g"
        and gp_less:"\<forall>t\<in>{0..1}. cmod (g t - p t) < d"
        and pap: "contour_integral p (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number g z"
     using winding_number [OF \<open>path g\<close> pag \<open>0 < d\<close>] unfolding winding_number_prop_def by blast
   obtain q where q:
        "valid_path q" "z \<notin> path_image q"
        "pathstart q = pathstart h" "pathfinish q = pathfinish h"
        and hq_less: "\<forall>t\<in>{0..1}. cmod (h t - q t) < e"
        and paq:  "contour_integral q (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number h z"
     using winding_number [OF \<open>path h\<close> pah \<open>0 < e\<close>] unfolding winding_number_prop_def by blast
   have gp: "homotopic_loops (- {z}) g p"
     by (simp add: gloop d gp_less norm_minus_commute p valid_path_imp_path)
   have hq: "homotopic_loops (- {z}) h q"
     by (simp add: e hloop hq_less norm_minus_commute q valid_path_imp_path)
   have "contour_integral p (\<lambda>w. 1/(w - z)) = contour_integral q (\<lambda>w. 1/(w - z))"
   proof (rule Cauchy_theorem_homotopic_loops)
     show "homotopic_loops (- {z}) p q"
       by (blast intro: homotopic_loops_trans homotopic_loops_sym gp hq assms)
   qed (auto intro!: holomorphic_intros simp: p q)
   then show ?thesis
     by (simp add: pap paq)
 qed
 
 lemma winding_number_paths_linear_eq:
   "\<lbrakk>path g; path h; pathstart h = pathstart g; pathfinish h = pathfinish g;
     \<And>t. t \<in> {0..1} \<Longrightarrow> z \<notin> closed_segment (g t) (h t)\<rbrakk>
         \<Longrightarrow> winding_number h z = winding_number g z"
   by (blast intro: sym homotopic_paths_linear winding_number_homotopic_paths)
 
 lemma winding_number_loops_linear_eq:
   "\<lbrakk>path g; path h; pathfinish g = pathstart g; pathfinish h = pathstart h;
     \<And>t. t \<in> {0..1} \<Longrightarrow> z \<notin> closed_segment (g t) (h t)\<rbrakk>
         \<Longrightarrow> winding_number h z = winding_number g z"
   by (blast intro: sym homotopic_loops_linear winding_number_homotopic_loops)
 
 lemma winding_number_nearby_paths_eq:
      "\<lbrakk>path g; path h; pathstart h = pathstart g; pathfinish h = pathfinish g;
       \<And>t. t \<in> {0..1} \<Longrightarrow> norm(h t - g t) < norm(g t - z)\<rbrakk>
       \<Longrightarrow> winding_number h z = winding_number g z"
   by (metis segment_bound(2) norm_minus_commute not_le winding_number_paths_linear_eq)
 
 lemma winding_number_nearby_loops_eq:
      "\<lbrakk>path g; path h; pathfinish g = pathstart g; pathfinish h = pathstart h;
       \<And>t. t \<in> {0..1} \<Longrightarrow> norm(h t - g t) < norm(g t - z)\<rbrakk>
       \<Longrightarrow> winding_number h z = winding_number g z"
   by (metis segment_bound(2) norm_minus_commute not_le winding_number_loops_linear_eq)
 
 
 lemma winding_number_subpath_combine:
   assumes "path g" and notin: "z \<notin> path_image g" and "u \<in> {0..1}" "v \<in> {0..1}" "w \<in> {0..1}"
   shows "winding_number (subpath u v g) z + winding_number (subpath v w g) z =
          winding_number (subpath u w g) z" (is "?lhs = ?rhs")
 proof -
   have "?lhs = winding_number (subpath u v g +++ subpath v w g) z"
     using assms
     by (metis (no_types, lifting) path_image_subpath_subset path_subpath pathfinish_subpath pathstart_subpath subsetD winding_number_join)
   also have "... = ?rhs"
     by (meson assms homotopic_join_subpaths subset_Compl_singleton winding_number_homotopic_paths)
   finally show ?thesis .
 qed
 
 text \<open>Winding numbers of circular contours\<close>
 
 proposition winding_number_part_circlepath_pos_less:
   assumes "s < t" and no: "norm(w - z) < r"
     shows "0 < Re (winding_number(part_circlepath z r s t) w)"
 proof -
   have "0 < r" by (meson no norm_not_less_zero not_le order.strict_trans2)
   note valid_path_part_circlepath
   moreover have " w \<notin> path_image (part_circlepath z r s t)"
     using assms by (auto simp: path_image_def image_def part_circlepath_def norm_mult linepath_def)
   moreover have "0 < r * (t - s) * (r - cmod (w - z))"
     using assms by (metis \<open>0 < r\<close> diff_gt_0_iff_gt mult_pos_pos)
   ultimately show ?thesis
     apply (rule winding_number_pos_lt [where e = "r*(t - s)*(r - norm(w - z))"])
     apply (simp add: vector_derivative_part_circlepath right_diff_distrib [symmetric] mult_ac mult_le_cancel_left_pos assms \<open>0<r\<close>)
     using Re_Im_le_cmod [of "w-z" "linepath s t x" for x]
     by (simp add: exp_Euler cos_of_real sin_of_real part_circlepath_def algebra_simps cos_squared_eq [unfolded power2_eq_square])
 qed
 
 lemma winding_number_circlepath_centre: "0 < r \<Longrightarrow> winding_number (circlepath z r) z = 1"
   apply (rule winding_number_unique_loop)
   apply (simp_all add: sphere_def valid_path_imp_path)
   apply (rule_tac x="circlepath z r" in exI)
   apply (simp add: sphere_def contour_integral_circlepath)
   done
 
 proposition winding_number_circlepath:
   assumes "norm(w - z) < r" shows "winding_number(circlepath z r) w = 1"
 proof (cases "w = z")
   case True then show ?thesis
     using assms winding_number_circlepath_centre by auto
 next
   case False
   have [simp]: "r > 0"
     using assms le_less_trans norm_ge_zero by blast
   define r' where "r' = norm(w - z)"
   have "r' < r"
     by (simp add: assms r'_def)
   have disjo: "cball z r' \<inter> sphere z r = {}"
     using \<open>r' < r\<close> by (force simp: cball_def sphere_def)
   have "winding_number(circlepath z r) w = winding_number(circlepath z r) z"
   proof (rule winding_number_around_inside [where S = "cball z r'"])
     show "winding_number (circlepath z r) z \<noteq> 0"
       by (simp add: winding_number_circlepath_centre)
     show "cball z r' \<inter> path_image (circlepath z r) = {}"
       by (simp add: disjo less_eq_real_def)
   qed (auto simp: r'_def dist_norm norm_minus_commute)
   also have "\<dots> = 1"
     by (simp add: winding_number_circlepath_centre)
   finally show ?thesis .
 qed
 
 lemma no_bounded_connected_component_imp_winding_number_zero:
   assumes g: "path g" "path_image g \<subseteq> S" "pathfinish g = pathstart g" "z \<notin> S"
       and nb: "\<And>z. bounded (connected_component_set (- S) z) \<Longrightarrow> z \<in> S"
     shows "winding_number g z = 0"
 proof -
   have "z \<in> outside (path_image g)"
     by (metis nb [of z] \<open>path_image g \<subseteq> S\<close> \<open>z \<notin> S\<close> subsetD mem_Collect_eq outside outside_mono)
   then show ?thesis
     by (simp add: g winding_number_zero_in_outside)
 qed
 
 lemma no_bounded_path_component_imp_winding_number_zero:
   assumes g: "path g" "path_image g \<subseteq> S" "pathfinish g = pathstart g" "z \<notin> S"
       and nb: "\<And>z. bounded (path_component_set (- S) z) \<Longrightarrow> z \<in> S"
   shows "winding_number g z = 0"
   by (simp add: bounded_subset nb path_component_subset_connected_component 
                 no_bounded_connected_component_imp_winding_number_zero [OF g])
 
 subsection\<open>Winding number for a triangle\<close>
 
 lemma wn_triangle1:
   assumes "0 \<in> interior(convex hull {a,b,c})"
     shows "\<not> (Im(a/b) \<le> 0 \<and> 0 \<le> Im(b/c))"
 proof -
   { assume 0: "Im(a/b) \<le> 0" "0 \<le> Im(b/c)"
     have "0 \<notin> interior (convex hull {a,b,c})"
     proof (cases "a=0 \<or> b=0 \<or> c=0")
       case True then show ?thesis
         by (auto simp: not_in_interior_convex_hull_3)
     next
       case False
       then have "b \<noteq> 0" by blast
       { fix x y::complex and u::real
         assume eq_f': "Im x * Re b \<le> Im b * Re x" "Im y * Re b \<le> Im b * Re y" "0 \<le> u" "u \<le> 1"
         then have "((1 - u) * Im x) * Re b \<le> Im b * ((1 - u) * Re x)"
           by (simp add: mult_left_mono mult.assoc mult.left_commute [of "Im b"])
         then have "((1 - u) * Im x + u * Im y) * Re b \<le> Im b * ((1 - u) * Re x + u * Re y)"
           using eq_f' ordered_comm_semiring_class.comm_mult_left_mono
           by (fastforce simp add: algebra_simps)
       }
       then have "convex {z. Im z * Re b \<le> Im b * Re z}"
         by (auto simp: algebra_simps convex_alt)
       with False 0 have "convex hull {a,b,c} \<le> {z. Im z * Re b \<le> Im b * Re z}"
         by (simp add: subset_hull mult.commute Complex.Im_divide divide_simps complex_neq_0 [symmetric])
       moreover have "0 \<notin> interior({z. Im z * Re b \<le> Im b * Re z})"
       proof
         assume "0 \<in> interior {z. Im z * Re b \<le> Im b * Re z}"
         then obtain e where "e>0" and e: "ball 0 e \<subseteq> {z. Im z * Re b \<le> Im b * Re z}"
           by (meson mem_interior)
         define z where "z \<equiv> - sgn (Im b) * (e/3) + sgn (Re b) * (e/3) * \<i>"
         have "cmod z = cmod (e/3) * cmod (- sgn (Im b) + sgn (Re b) * \<i>)"
           unfolding z_def norm_mult [symmetric] by (simp add: algebra_simps)
         also have "... < e"
           using \<open>e>0\<close> by (auto simp: norm_mult intro: le_less_trans [OF norm_triangle_ineq4])
         finally have "z \<in> ball 0 e"
           using \<open>e>0\<close> by simp
         then have "Im z * Re b \<le> Im b * Re z"
           using e by blast
         then have b: "0 < Re b" "0 < Im b" and disj: "e * Re b < - (Im b * e) \<or> e * Re b = - (Im b * e)"
           using \<open>e>0\<close> \<open>b \<noteq> 0\<close>
           by (auto simp add: z_def dist_norm sgn_if less_eq_real_def mult_less_0_iff complex.expand split: if_split_asm)
         show False \<comment>\<open>or just one smt line\<close>
           using disj
         proof
           assume "e * Re b < - (Im b * e)"
           with b \<open>0 < e\<close> less_trans [of _ 0] show False
             by (metis (no_types) mult_pos_pos neg_less_0_iff_less not_less_iff_gr_or_eq)
         next
           assume "e * Re b = - (Im b * e)"
           with b \<open>0 < e\<close> show False
             by (metis mult_pos_pos neg_less_0_iff_less not_less_iff_gr_or_eq) 
         qed
       qed
       ultimately show ?thesis
         using interior_mono by blast
     qed
   } with assms show ?thesis by blast
 qed
 
 lemma wn_triangle2_0:
   assumes "0 \<in> interior(convex hull {a,b,c})"
   shows
        "0 < Im((b - a) * cnj (b)) \<and>
         0 < Im((c - b) * cnj (c)) \<and>
         0 < Im((a - c) * cnj (a))
         \<or>
         Im((b - a) * cnj (b)) < 0 \<and>
         0 < Im((b - c) * cnj (b)) \<and>
         0 < Im((a - b) * cnj (a)) \<and>
         0 < Im((c - a) * cnj (c))"
 proof -
   have [simp]: "{b,c,a} = {a,b,c}" "{c,a,b} = {a,b,c}" by auto
   show ?thesis
     using wn_triangle1 [OF assms] wn_triangle1 [of b c a] wn_triangle1 [of c a b] assms
     by (auto simp: algebra_simps Im_complex_div_gt_0 Im_complex_div_lt_0 not_le not_less)
 qed
 
 lemma wn_triangle2:
   assumes "z \<in> interior(convex hull {a,b,c})"
    shows "0 < Im((b - a) * cnj (b - z)) \<and>
           0 < Im((c - b) * cnj (c - z)) \<and>
           0 < Im((a - c) * cnj (a - z))
           \<or>
           Im((b - a) * cnj (b - z)) < 0 \<and>
           0 < Im((b - c) * cnj (b - z)) \<and>
           0 < Im((a - b) * cnj (a - z)) \<and>
           0 < Im((c - a) * cnj (c - z))"
 proof -
   have 0: "0 \<in> interior(convex hull {a-z, b-z, c-z})"
     using assms convex_hull_translation [of "-z" "{a,b,c}"]
                 interior_translation [of "-z"]
     by (simp cong: image_cong_simp)
   show ?thesis using wn_triangle2_0 [OF 0]
     by simp
 qed
 
 lemma wn_triangle3:
   assumes z: "z \<in> interior(convex hull {a,b,c})"
       and "0 < Im((b-a) * cnj (b-z))"
           "0 < Im((c-b) * cnj (c-z))"
           "0 < Im((a-c) * cnj (a-z))"
     shows "winding_number (linepath a b +++ linepath b c +++ linepath c a) z = 1"
 proof -
   have znot[simp]: "z \<notin> closed_segment a b" "z \<notin> closed_segment b c" "z \<notin> closed_segment c a"
     using z interior_of_triangle [of a b c]
     by (auto simp: closed_segment_def)
   have gt0: "0 < Re (winding_number (linepath a b +++ linepath b c +++ linepath c a) z)"
     using assms
     by (simp add: winding_number_linepath_pos_lt path_image_join winding_number_join_pos_combined)
   have lt2: "Re (winding_number (linepath a b +++ linepath b c +++ linepath c a) z) < 2"
     using winding_number_lt_half_linepath [of _ a b]
     using winding_number_lt_half_linepath [of _ b c]
     using winding_number_lt_half_linepath [of _ c a] znot
     by (fastforce simp add: winding_number_join path_image_join)
   show ?thesis
     by (rule winding_number_eq_1) (simp_all add: path_image_join gt0 lt2)
 qed
 
 proposition winding_number_triangle:
   assumes z: "z \<in> interior(convex hull {a,b,c})"
     shows "winding_number(linepath a b +++ linepath b c +++ linepath c a) z =
            (if 0 < Im((b - a) * cnj (b - z)) then 1 else -1)"
 proof -
   have [simp]: "{a,c,b} = {a,b,c}"  by auto
   have znot[simp]: "z \<notin> closed_segment a b" "z \<notin> closed_segment b c" "z \<notin> closed_segment c a"
     using z interior_of_triangle [of a b c]
     by (auto simp: closed_segment_def)
   then have [simp]: "z \<notin> closed_segment b a" "z \<notin> closed_segment c b" "z \<notin> closed_segment a c"
     using closed_segment_commute by blast+
   have *: "winding_number (linepath a b +++ linepath b c +++ linepath c a) z =
             winding_number (reversepath (linepath a c +++ linepath c b +++ linepath b a)) z"
     by (simp add: reversepath_joinpaths winding_number_join not_in_path_image_join)
   show ?thesis
     apply (rule disjE [OF wn_triangle2 [OF z]])
     subgoal
       by (simp add: wn_triangle3 z)
     subgoal
       by (simp add: path_image_join winding_number_reversepath * wn_triangle3 z)
     done
 qed
 
 subsection\<open>Winding numbers for simple closed paths\<close>
 
 lemma winding_number_from_innerpath:
   assumes "simple_path c1" and c1: "pathstart c1 = a" "pathfinish c1 = b"
       and "simple_path c2" and c2: "pathstart c2 = a" "pathfinish c2 = b"
       and "simple_path c" and c: "pathstart c = a" "pathfinish c = b"
       and c1c2: "path_image c1 \<inter> path_image c2 = {a,b}"
       and c1c:  "path_image c1 \<inter> path_image c = {a,b}"
       and c2c:  "path_image c2 \<inter> path_image c = {a,b}"
       and ne_12: "path_image c \<inter> inside(path_image c1 \<union> path_image c2) \<noteq> {}"
       and z: "z \<in> inside(path_image c1 \<union> path_image c)"
       and wn_d: "winding_number (c1 +++ reversepath c) z = d"
       and "a \<noteq> b" "d \<noteq> 0"
   obtains "z \<in> inside(path_image c1 \<union> path_image c2)" "winding_number (c1 +++ reversepath c2) z = d"
 proof -
   obtain 0: "inside(path_image c1 \<union> path_image c) \<inter> inside(path_image c2 \<union> path_image c) = {}"
      and 1: "inside(path_image c1 \<union> path_image c) \<union> inside(path_image c2 \<union> path_image c) \<union>
              (path_image c - {a,b}) = inside(path_image c1 \<union> path_image c2)"
     by (rule split_inside_simple_closed_curve
               [OF \<open>simple_path c1\<close> c1 \<open>simple_path c2\<close> c2 \<open>simple_path c\<close> c \<open>a \<noteq> b\<close> c1c2 c1c c2c ne_12])
   have znot: "z \<notin> path_image c"  "z \<notin> path_image c1" "z \<notin> path_image c2"
     using union_with_outside z 1 by auto
   then have zout: "z \<in> outside (path_image c \<union> path_image c2)"
     by (metis "0" ComplI UnE disjoint_iff_not_equal sup.commute union_with_inside z)
   have wn_cc2: "winding_number (c +++ reversepath c2) z = 0"
     by (rule winding_number_zero_in_outside; simp add: zout \<open>simple_path c2\<close> c c2 \<open>simple_path c\<close> simple_path_imp_path path_image_join)
   show ?thesis
   proof
     show "z \<in> inside (path_image c1 \<union> path_image c2)"
       using "1" z by blast
     have "winding_number c1 z - winding_number c z = d "
       using assms znot
       by (metis wn_d winding_number_join simple_path_imp_path winding_number_reversepath add.commute path_image_reversepath path_reversepath pathstart_reversepath uminus_add_conv_diff)
     then show "winding_number (c1 +++ reversepath c2) z = d"
       using wn_cc2 by (simp add: winding_number_join simple_path_imp_path assms znot winding_number_reversepath)
   qed
 qed
 
 lemma simple_closed_path_wn1:
   fixes a::complex and e::real
   assumes "0 < e"
     and sp_pl: "simple_path(p +++ linepath (a - e) (a + e))" (is "simple_path ?pae")
     and psp:   "pathstart p = a + e"
     and pfp:   "pathfinish p = a - e"
     and disj:  "ball a e \<inter> path_image p = {}"
 obtains z where "z \<in> inside (path_image ?pae)" "cmod (winding_number ?pae z) = 1"
 proof -
   have "arc p" and arc_lp: "arc (linepath (a - e) (a + e))"
     and pap: "path_image p \<inter> path_image (linepath (a - e) (a + e)) \<subseteq> {pathstart p, a-e}"
     using simple_path_join_loop_eq [of "linepath (a - e) (a + e)" p] assms by auto
   have mid_eq_a: "midpoint (a - e) (a + e) = a"
     by (simp add: midpoint_def)
   with assms have "a \<in> path_image ?pae"
     by (simp add: assms path_image_join) (metis midpoint_in_closed_segment)
   then have "a \<in> frontier(inside (path_image ?pae))"
     using assms by (simp add: Jordan_inside_outside )
   with \<open>0 < e\<close> obtain c where c: "c \<in> inside (path_image ?pae)"
                   and dac: "dist a c < e"
     by (auto simp: frontier_straddle)
   then have "c \<notin> path_image ?pae"
     using inside_no_overlap by blast
   then have "c \<notin> path_image p" "c \<notin> closed_segment (a - e) (a + e)"
     by (simp_all add: assms path_image_join)
   with \<open>0 < e\<close> dac have "c \<notin> affine hull {a - e, a + e}"
     by (simp add: segment_as_ball not_le)
   with \<open>0 < e\<close> have *: "\<not> collinear {a - e, c,a + e}"
     using collinear_3_affine_hull [of "a-e" "a+e"] by (auto simp: insert_commute)
   have 13: "1/3 + 1/3 + 1/3 = (1::real)" by simp
   have "(1/3) *\<^sub>R (a - of_real e) + (1/3) *\<^sub>R c + (1/3) *\<^sub>R (a + of_real e) \<in> interior(convex hull {a - e, c, a + e})"
     using interior_convex_hull_3_minimal [OF * DIM_complex]
     by clarsimp (metis 13 zero_less_divide_1_iff zero_less_numeral)
   then obtain z where z: "z \<in> interior(convex hull {a - e, c, a + e})" by force
   have [simp]: "z \<notin> closed_segment (a - e) c"
     by (metis DIM_complex Diff_iff IntD2 inf_sup_absorb interior_of_triangle z)
   have [simp]: "z \<notin> closed_segment (a + e) (a - e)"
     by (metis DIM_complex DiffD2 Un_iff interior_of_triangle z)
   have [simp]: "z \<notin> closed_segment c (a + e)"
     by (metis (no_types, lifting) DIM_complex DiffD2 Un_insert_right inf_sup_aci(5) insertCI interior_of_triangle mk_disjoint_insert z)
   show thesis
   proof
     have "norm (winding_number (linepath (a - e) c +++ linepath c (a + e) +++ linepath (a + e) (a - e)) z) = 1"
       using winding_number_triangle [OF z] by simp
     have zin: "z \<in> inside (path_image (linepath (a + e) (a - e)) \<union> path_image p)"
       and zeq: "winding_number (linepath (a + e) (a - e) +++ reversepath p) z =
                 winding_number (linepath (a - e) c +++ linepath c (a + e) +++ linepath (a + e) (a - e)) z"
     proof (rule winding_number_from_innerpath
         [of "linepath (a + e) (a - e)" "a+e" "a-e" p
           "linepath (a + e) c +++ linepath c (a - e)" z
           "winding_number (linepath (a - e)  c +++ linepath  c (a + e) +++ linepath (a + e) (a - e)) z"])
       show sp_aec: "simple_path (linepath (a + e) c +++ linepath c (a - e))"
       proof (rule arc_imp_simple_path [OF arc_join])
         show "arc (linepath (a + e) c)"
           by (metis \<open>c \<notin> path_image p\<close> arc_linepath pathstart_in_path_image psp)
         show "arc (linepath c (a - e))"
           by (metis \<open>c \<notin> path_image p\<close> arc_linepath pathfinish_in_path_image pfp)
         show "path_image (linepath (a + e) c) \<inter> path_image (linepath c (a - e)) \<subseteq> {pathstart (linepath c (a - e))}"
           by clarsimp (metis "*" IntI Int_closed_segment closed_segment_commute singleton_iff)
       qed auto
       show "simple_path p"
         using \<open>arc p\<close> arc_simple_path by blast
       show sp_ae2: "simple_path (linepath (a + e) (a - e))"
         using \<open>arc p\<close> arc_distinct_ends pfp psp by fastforce
       show pa: "pathfinish (linepath (a + e) (a - e)) = a - e"
            "pathstart (linepath (a + e) c +++ linepath c (a - e)) = a + e"
            "pathfinish (linepath (a + e) c +++ linepath c (a - e)) = a - e"
            "pathstart p = a + e" "pathfinish p = a - e"
            "pathstart (linepath (a + e) (a - e)) = a + e"
         by (simp_all add: assms)
       show 1: "path_image (linepath (a + e) (a - e)) \<inter> path_image p = {a + e, a - e}"
       proof
         show "path_image (linepath (a + e) (a - e)) \<inter> path_image p \<subseteq> {a + e, a - e}"
           using pap closed_segment_commute psp segment_convex_hull by fastforce
         show "{a + e, a - e} \<subseteq> path_image (linepath (a + e) (a - e)) \<inter> path_image p"
           using pap pathfinish_in_path_image pathstart_in_path_image pfp psp by fastforce
       qed
       show 2: "path_image (linepath (a + e) (a - e)) \<inter> path_image (linepath (a + e) c +++ linepath c (a - e)) =
                {a + e, a - e}"  (is "?lhs = ?rhs")
       proof
         have "\<not> collinear {c, a + e, a - e}"
           using * by (simp add: insert_commute)
         then have "convex hull {a + e, a - e} \<inter> convex hull {a + e, c} = {a + e}"
                   "convex hull {a + e, a - e} \<inter> convex hull {c, a - e} = {a - e}"
           by (metis (full_types) Int_closed_segment insert_commute segment_convex_hull)+
         then show "?lhs \<subseteq> ?rhs"
           by (metis Int_Un_distrib equalityD1 insert_is_Un path_image_join path_image_linepath path_join_eq path_linepath segment_convex_hull simple_path_def sp_aec)
         show "?rhs \<subseteq> ?lhs"
           using segment_convex_hull by (simp add: path_image_join)
       qed
       have "path_image p \<inter> path_image (linepath (a + e) c) \<subseteq> {a + e}"
       proof (clarsimp simp: path_image_join)
         fix x
         assume "x \<in> path_image p" and x_ac: "x \<in> closed_segment (a + e) c"
         then have "dist x a \<ge> e"
           by (metis IntI all_not_in_conv disj dist_commute mem_ball not_less)
         with x_ac dac \<open>e > 0\<close> show "x = a + e"
           by (auto simp: norm_minus_commute dist_norm closed_segment_eq_open dest: open_segment_furthest_le [where y=a])
       qed
       moreover
       have "path_image p \<inter> path_image (linepath c (a - e)) \<subseteq> {a - e}"
       proof (clarsimp simp: path_image_join)
         fix x
         assume "x \<in> path_image p" and x_ac: "x \<in> closed_segment c (a - e)"
         then have "dist x a \<ge> e"
           by (metis IntI all_not_in_conv disj dist_commute mem_ball not_less)
         with x_ac dac \<open>e > 0\<close> show "x = a - e"
           by (auto simp: norm_minus_commute dist_norm closed_segment_eq_open dest: open_segment_furthest_le [where y=a])
       qed
       ultimately
       have "path_image p \<inter> path_image (linepath (a + e) c +++ linepath c (a - e)) \<subseteq> {a + e, a - e}"
         by (force simp: path_image_join)
       then show 3: "path_image p \<inter> path_image (linepath (a + e) c +++ linepath c (a - e)) = {a + e, a - e}"
         using "1" "2" by blast
       show 4: "path_image (linepath (a + e) c +++ linepath c (a - e)) \<inter>
                inside (path_image (linepath (a + e) (a - e)) \<union> path_image p) \<noteq> {}"
         apply (clarsimp simp: path_image_join segment_convex_hull disjoint_iff_not_equal)
         by (metis (no_types, opaque_lifting) UnI1 Un_commute c closed_segment_commute ends_in_segment(1) path_image_join
                   path_image_linepath pathstart_linepath pfp segment_convex_hull)
       show zin_inside: "z \<in> inside (path_image (linepath (a + e) (a - e)) \<union>
                                     path_image (linepath (a + e) c +++ linepath c (a - e)))"
       proof (simp add: path_image_join)
         show "z \<in> inside (closed_segment (a + e) (a - e) \<union> (closed_segment (a + e) c \<union> closed_segment c (a - e)))"
           by (metis z inside_of_triangle DIM_complex Un_commute closed_segment_commute)
       qed
       show 5: "winding_number
              (linepath (a + e) (a - e) +++ reversepath (linepath (a + e) c +++ linepath c (a - e))) z =
             winding_number (linepath (a - e) c +++ linepath c (a + e) +++ linepath (a + e) (a - e)) z"
         by (simp add: reversepath_joinpaths path_image_join winding_number_join)
       show 6: "winding_number (linepath (a - e) c +++ linepath c (a + e) +++ linepath (a + e) (a - e)) z \<noteq> 0"
         by (simp add: winding_number_triangle z)
       show "winding_number (linepath (a + e) (a - e) +++ reversepath p) z =
             winding_number (linepath (a - e) c +++ linepath c (a + e) +++ linepath (a + e) (a - e)) z"
         by (metis 1 2 3 4 5 6 pa sp_aec sp_ae2 \<open>arc p\<close> \<open>simple_path p\<close> arc_distinct_ends winding_number_from_innerpath zin_inside)
     qed (use assms \<open>e > 0\<close> in auto)
     show z_inside: "z \<in> inside (path_image ?pae)"
       using zin by (simp add: assms path_image_join Un_commute closed_segment_commute)
     have "cmod (winding_number ?pae z) = cmod ((winding_number(reversepath ?pae) z))"
     proof (subst winding_number_reversepath)
       show "path ?pae"
         using simple_path_imp_path sp_pl by blast
       show "z \<notin> path_image ?pae"
         by (metis IntI emptyE inside_no_overlap z_inside)
     qed (simp add: inside_def)
     also have "... = cmod (winding_number(linepath (a + e) (a - e) +++ reversepath p) z)"
       by (simp add: pfp reversepath_joinpaths)
     also have "... = cmod (winding_number (linepath (a - e) c +++ linepath c (a + e) +++ linepath (a + e) (a - e)) z)"
       by (simp add: zeq)
     also have "... = 1"
       using z by (simp add: interior_of_triangle winding_number_triangle)
     finally show "cmod (winding_number ?pae z) = 1" .
   qed
 qed
 
 lemma simple_closed_path_wn2:
   fixes a::complex and d e::real
   assumes "0 < d" "0 < e"
     and sp_pl: "simple_path(p +++ linepath (a - d) (a + e))"
     and psp:   "pathstart p = a + e"
     and pfp:   "pathfinish p = a - d"
 obtains z where "z \<in> inside (path_image (p +++ linepath (a - d) (a + e)))"
                 "cmod (winding_number (p +++ linepath (a - d) (a + e)) z) = 1"
 proof -
   have [simp]: "a + of_real x \<in> closed_segment (a - \<alpha>) (a - \<beta>) \<longleftrightarrow> x \<in> closed_segment (-\<alpha>) (-\<beta>)" for x \<alpha> \<beta>::real
     using closed_segment_translation_eq [of a]
     by (metis (no_types, opaque_lifting) add_uminus_conv_diff of_real_minus of_real_closed_segment)
   have [simp]: "a - of_real x \<in> closed_segment (a + \<alpha>) (a + \<beta>) \<longleftrightarrow> -x \<in> closed_segment \<alpha> \<beta>" for x \<alpha> \<beta>::real
     by (metis closed_segment_translation_eq diff_conv_add_uminus of_real_closed_segment of_real_minus)
   have "arc p" and arc_lp: "arc (linepath (a - d) (a + e))" and "path p"
     and pap: "path_image p \<inter> closed_segment (a - d) (a + e) \<subseteq> {a+e, a-d}"
     using simple_path_join_loop_eq [of "linepath (a - d) (a + e)" p] assms arc_imp_path  by auto
   have "0 \<in> closed_segment (-d) e"
     using \<open>0 < d\<close> \<open>0 < e\<close> closed_segment_eq_real_ivl by auto
   then have "a \<in> path_image (linepath (a - d) (a + e))"
     using of_real_closed_segment [THEN iffD2]
     by (force dest: closed_segment_translation_eq [of a, THEN iffD2] simp del: of_real_closed_segment)
   then have "a \<notin> path_image p"
     using \<open>0 < d\<close> \<open>0 < e\<close> pap by auto
   then obtain k where "0 < k" and k: "ball a k \<inter> (path_image p) = {}"
     using \<open>0 < e\<close> \<open>path p\<close> not_on_path_ball by blast
   define kde where "kde \<equiv> (min k (min d e)) / 2"
   have "0 < kde" "kde < k" "kde < d" "kde < e"
     using \<open>0 < k\<close> \<open>0 < d\<close> \<open>0 < e\<close> by (auto simp: kde_def)
   let ?q = "linepath (a + kde) (a + e) +++ p +++ linepath (a - d) (a - kde)"
   have "- kde \<in> closed_segment (-d) e"
     using \<open>0 < kde\<close> \<open>kde < d\<close> \<open>kde < e\<close> closed_segment_eq_real_ivl by auto
   then have a_diff_kde: "a - kde \<in> closed_segment (a - d) (a + e)"
     using of_real_closed_segment [THEN iffD2]
     by (force dest: closed_segment_translation_eq [of a, THEN iffD2] simp del: of_real_closed_segment)
   then have clsub2: "closed_segment (a - d) (a - kde) \<subseteq> closed_segment (a - d) (a + e)"
     by (simp add: subset_closed_segment)
   then have "path_image p \<inter> closed_segment (a - d) (a - kde) \<subseteq> {a + e, a - d}"
     using pap by force
   moreover
   have "a + e \<notin> path_image p \<inter> closed_segment (a - d) (a - kde)"
     using \<open>0 < kde\<close> \<open>kde < d\<close> \<open>0 < e\<close> by (auto simp: closed_segment_eq_real_ivl)
   ultimately have sub_a_diff_d: "path_image p \<inter> closed_segment (a - d) (a - kde) \<subseteq> {a - d}"
     by blast
   have "kde \<in> closed_segment (-d) e"
     using \<open>0 < kde\<close> \<open>kde < d\<close> \<open>kde < e\<close> closed_segment_eq_real_ivl by auto
   then have a_diff_kde: "a + kde \<in> closed_segment (a - d) (a + e)"
     using of_real_closed_segment [THEN iffD2]
     by (force dest: closed_segment_translation_eq [of "a", THEN iffD2] simp del: of_real_closed_segment)
   then have clsub1: "closed_segment (a + kde) (a + e) \<subseteq> closed_segment (a - d) (a + e)"
     by (simp add: subset_closed_segment)
   then have "closed_segment (a + kde) (a + e) \<inter> path_image p \<subseteq> {a + e, a - d}"
     using pap by force
   moreover
   have "closed_segment (a + kde) (a + e) \<inter> closed_segment (a - d) (a - kde) = {}"
   proof (clarsimp intro!: equals0I)
     fix y
     assume y1: "y \<in> closed_segment (a + kde) (a + e)"
        and y2: "y \<in> closed_segment (a - d) (a - kde)"
     obtain u::real where u: "y = a + u" and "0 < u"
     proof -
       obtain \<xi> where \<xi>: "y = (1 - \<xi>) *\<^sub>R (a + kde) + \<xi> *\<^sub>R (a + e)" and "0 \<le> \<xi>" "\<xi> \<le> 1"
         using y1 by (auto simp: in_segment)
       show thesis
       proof
         show "y = a + ((1 - \<xi>)*kde + \<xi>*e)"
           using \<xi> by (auto simp: scaleR_conv_of_real algebra_simps)
         have "(1 - \<xi>)*kde + \<xi>*e \<ge> 0"
           using \<open>0 < kde\<close> \<open>0 \<le> \<xi>\<close> \<open>\<xi> \<le> 1\<close> \<open>0 < e\<close> by auto
         moreover have "(1 - \<xi>)*kde + \<xi>*e \<noteq> 0"
           using \<open>0 < kde\<close> \<open>0 \<le> \<xi>\<close> \<open>\<xi> \<le> 1\<close> \<open>0 < e\<close> by (auto simp: add_nonneg_eq_0_iff)
         ultimately show "(1 - \<xi>)*kde + \<xi>*e > 0" by simp
       qed
     qed
     moreover
     obtain v::real where v: "y = a + v" and "v \<le> 0"
     proof -
       obtain \<xi> where \<xi>: "y = (1 - \<xi>) *\<^sub>R (a - d) + \<xi> *\<^sub>R (a - kde)" and "0 \<le> \<xi>" "\<xi> \<le> 1"
         using y2 by (auto simp: in_segment)
       show thesis
       proof
         show "y = a + (- ((1 - \<xi>)*d + \<xi>*kde))"
           using \<xi> by (force simp: scaleR_conv_of_real algebra_simps)
         show "- ((1 - \<xi>)*d + \<xi>*kde) \<le> 0"
           using \<open>0 < kde\<close> \<open>0 \<le> \<xi>\<close> \<open>\<xi> \<le> 1\<close> \<open>0 < d\<close>
           by (metis add.left_neutral add_nonneg_nonneg le_diff_eq less_eq_real_def neg_le_0_iff_le split_mult_pos_le)
 
       qed
     qed
     ultimately show False
       by auto
   qed
   moreover have "a - d \<notin> closed_segment (a + kde) (a + e)"
     using \<open>0 < kde\<close> \<open>kde < d\<close> \<open>0 < e\<close> by (auto simp: closed_segment_eq_real_ivl)
   ultimately have sub_a_plus_e:
     "closed_segment (a + kde) (a + e) \<inter> (path_image p \<union> closed_segment (a - d) (a - kde)) \<subseteq> {a + e}"
     by auto
   have "kde \<in> closed_segment (-kde) e"
     using \<open>0 < kde\<close> \<open>kde < d\<close> \<open>kde < e\<close> closed_segment_eq_real_ivl by auto
   then have a_add_kde: "a + kde \<in> closed_segment (a - kde) (a + e)"
     using of_real_closed_segment [THEN iffD2]
     by (force dest: closed_segment_translation_eq [of "a", THEN iffD2] simp del: of_real_closed_segment)
   have "closed_segment (a - kde) (a + kde) \<inter> closed_segment (a + kde) (a + e) = {a + kde}"
     by (metis a_add_kde Int_closed_segment)
   moreover
   have "path_image p \<inter> closed_segment (a - kde) (a + kde) = {}"
   proof (rule equals0I, clarify)
     fix y  assume "y \<in> path_image p" "y \<in> closed_segment (a - kde) (a + kde)"
     with equals0D [OF k, of y] \<open>0 < kde\<close> \<open>kde < k\<close> show False
       by (auto simp: dist_norm dest: dist_decreases_closed_segment [where c=a])
   qed
   moreover
   have "- kde \<in> closed_segment (-d) kde"
     using \<open>0 < kde\<close> \<open>kde < d\<close> \<open>kde < e\<close> closed_segment_eq_real_ivl by auto
   then have a_diff_kde': "a - kde \<in> closed_segment (a - d) (a + kde)"
     using of_real_closed_segment [THEN iffD2]
     by (force dest: closed_segment_translation_eq [of a, THEN iffD2] simp del: of_real_closed_segment)
   then have "closed_segment (a - d) (a - kde) \<inter> closed_segment (a - kde) (a + kde) = {a - kde}"
     by (metis Int_closed_segment)
   ultimately
   have pa_subset_pm_kde: "path_image ?q \<inter> closed_segment (a - kde) (a + kde) \<subseteq> {a - kde, a + kde}"
     by (auto simp: path_image_join assms)
   have ge_kde1: "\<exists>y. x = a + of_real y \<and> y \<ge> kde" if x: "x \<in> closed_segment (a + kde) (a + e)" for x
   proof -
     obtain u where "0 \<le> u" "u \<le> 1" and u: "x = (1 - u) *\<^sub>R (a + kde) + u *\<^sub>R (a + e)"
       using x by (auto simp: in_segment)
     then have "kde \<le> (1 - u) * kde + u * e"
       using \<open>kde < e\<close> segment_bound_lemma by auto
     moreover have "x = a + ((1 - u) * kde + u * e)"
       by (fastforce simp: u algebra_simps scaleR_conv_of_real)
     ultimately
     show ?thesis by blast
   qed
   have ge_kde2: "\<exists>y. x = a + of_real y \<and> y \<le> -kde" if x: "x \<in> closed_segment (a - d) (a - kde)" for x
   proof -
     obtain u where "0 \<le> u" "u \<le> 1" and u: "x = (1 - u) *\<^sub>R (a - d) + u *\<^sub>R (a - kde)"
       using x by (auto simp: in_segment)
     then have "kde \<le> ((1-u)*d + u*kde)"
       using \<open>kde < d\<close> segment_bound_lemma by auto
     moreover have "x = a - ((1-u)*d + u*kde)"
       by (fastforce simp: u algebra_simps scaleR_conv_of_real)
     ultimately show ?thesis
       by (metis add_uminus_conv_diff neg_le_iff_le of_real_minus)
   qed
   have notin_paq: "x \<notin> path_image ?q" if "dist a x < kde" for x
   proof -
     have "x \<notin> path_image p"
       using k \<open>kde < k\<close> that by force
     then show ?thesis
       using that assms by (auto simp: path_image_join dist_norm dest!: ge_kde1 ge_kde2)
   qed
   obtain z where zin: "z \<in> inside (path_image (?q +++ linepath (a - kde) (a + kde)))"
            and z1: "cmod (winding_number (?q +++ linepath (a - kde) (a + kde)) z) = 1"
   proof (rule simple_closed_path_wn1 [of kde ?q a])
     show "simple_path (?q +++ linepath (a - kde) (a + kde))"
     proof (intro simple_path_join_loop conjI)
       show "arc ?q"
       proof (rule arc_join)
         show "arc (linepath (a + kde) (a + e))"
           using \<open>kde < e\<close> \<open>arc p\<close> by (force simp: pfp)
         show "arc (p +++ linepath (a - d) (a - kde))"
           using \<open>kde < d\<close> \<open>kde < e\<close> \<open>arc p\<close> sub_a_diff_d by (force simp: pfp intro: arc_join)
       qed (auto simp: psp pfp path_image_join sub_a_plus_e)
       show "arc (linepath (a - kde) (a + kde))"
         using \<open>0 < kde\<close> by auto
     qed (use pa_subset_pm_kde in auto)
   qed (use \<open>0 < kde\<close> notin_paq in auto)
   have eq: "path_image (?q +++ linepath (a - kde) (a + kde)) = path_image (p +++ linepath (a - d) (a + e))"
             (is "?lhs = ?rhs")
   proof
     show "?lhs \<subseteq> ?rhs"
       using clsub1 clsub2 apply (auto simp: path_image_join assms)
       by (meson subsetCE subset_closed_segment)
     show "?rhs \<subseteq> ?lhs"
       apply (simp add: path_image_join assms Un_ac)
         by (metis Un_closed_segment Un_assoc a_diff_kde a_diff_kde' le_supI2 subset_refl)
     qed
   show thesis
   proof
     show zzin: "z \<in> inside (path_image (p +++ linepath (a - d) (a + e)))"
       by (metis eq zin)
     then have znotin: "z \<notin> path_image p"
       by (metis ComplD Un_iff inside_Un_outside path_image_join pathfinish_linepath pathstart_reversepath pfp reversepath_linepath)
     have znotin_d_kde: "z \<notin> closed_segment (a - d) (a + kde)"
       by (metis ComplD Un_iff Un_closed_segment a_diff_kde inside_Un_outside path_image_join path_image_linepath pathstart_linepath pfp zzin)
     have znotin_d_e: "z \<notin> closed_segment (a - d) (a + e)"
       by (metis IntI UnCI emptyE inside_no_overlap path_image_join path_image_linepath pathstart_linepath pfp zzin)
     have znotin_kde_e: "z \<notin> closed_segment (a + kde) (a + e)" and znotin_d_kde': "z \<notin> closed_segment (a - d) (a - kde)"
       using clsub1 clsub2 zzin 
       by (metis (no_types, opaque_lifting) IntI Un_iff emptyE inside_no_overlap path_image_join path_image_linepath pathstart_linepath pfp subsetD)+
     have "winding_number (linepath (a - d) (a + e)) z =
           winding_number (linepath (a - d) (a + kde)) z + winding_number (linepath (a + kde) (a + e)) z"
     proof (rule winding_number_split_linepath)
       show "a + complex_of_real kde \<in> closed_segment (a - d) (a + e)"
         by (simp add: a_diff_kde)
       show "z \<notin> closed_segment (a - d) (a + e)"
         by (metis ComplD Un_iff inside_Un_outside path_image_join path_image_linepath pathstart_linepath pfp zzin)
     qed
     also have "... = winding_number (linepath (a + kde) (a + e)) z +
                      (winding_number (linepath (a - d) (a - kde)) z + winding_number (linepath (a - kde) (a + kde)) z)"
       by (simp add: winding_number_split_linepath [of "a-kde", symmetric] znotin_d_kde a_diff_kde')
     finally have "winding_number (p +++ linepath (a - d) (a + e)) z =
                     winding_number p z + winding_number (linepath (a + kde) (a + e)) z +
                    (winding_number (linepath (a - d) (a - kde)) z +
                     winding_number (linepath (a - kde) (a + kde)) z)"
       by (metis (no_types, lifting) ComplD Un_iff \<open>arc p\<close> add.assoc arc_imp_path eq path_image_join path_join_path_ends path_linepath simple_path_imp_path sp_pl union_with_outside winding_number_join zin)
     also have "... = winding_number (linepath (a + kde) (a + e)) z 
                    + winding_number (p +++ linepath (a - d) (a - kde)) z 
                    + winding_number (linepath (a - kde) (a + kde)) z"
       using \<open>path p\<close> znotin assms 
       by simp (metis Un_iff Un_closed_segment a_diff_kde' path_image_linepath path_linepath pathstart_linepath winding_number_join znotin_d_kde)
     also have "... = winding_number ?q z + winding_number (linepath (a - kde) (a + kde)) z"
       using \<open>path p\<close> znotin assms by (simp add: path_image_join winding_number_join znotin_kde_e znotin_d_kde')
     also have "... = winding_number (?q +++ linepath (a - kde) (a + kde)) z"
       by (metis (mono_tags, lifting) ComplD UnCI \<open>path p\<close> eq inside_outside path_image_join path_join_eq path_linepath pathfinish_join pathfinish_linepath pathstart_join pathstart_linepath pfp psp winding_number_join zzin)
     finally have "winding_number (p +++ linepath (a - d) (a + e)) z =
                   winding_number (?q +++ linepath (a - kde) (a + kde)) z" .
     then show "cmod (winding_number (p +++ linepath (a - d) (a + e)) z) = 1"
       by (simp add: z1)
   qed
 qed
 
 lemma simple_closed_path_wn3:
   fixes p :: "real \<Rightarrow> complex"
   assumes "simple_path p" and loop: "pathfinish p = pathstart p"
   obtains z where "z \<in> inside (path_image p)" "cmod (winding_number p z) = 1"
 proof -
   have ins: "inside(path_image p) \<noteq> {}" "open(inside(path_image p))"
             "connected(inside(path_image p))"
    and out: "outside(path_image p) \<noteq> {}" "open(outside(path_image p))"
             "connected(outside(path_image p))"
    and bo:  "bounded(inside(path_image p))" "\<not> bounded(outside(path_image p))"
    and ins_out: "inside(path_image p) \<inter> outside(path_image p) = {}"
                 "inside(path_image p) \<union> outside(path_image p) = - path_image p"
    and fro: "frontier(inside(path_image p)) = path_image p"
             "frontier(outside(path_image p)) = path_image p"
     using Jordan_inside_outside [OF assms] by auto
   obtain a where a: "a \<in> inside(path_image p)"
     using \<open>inside (path_image p) \<noteq> {}\<close> by blast
   obtain d::real where "0 < d" and d_fro: "a - d \<in> frontier (inside (path_image p))"
                  and d_int: "\<And>\<epsilon>. \<lbrakk>0 \<le> \<epsilon>; \<epsilon> < d\<rbrakk> \<Longrightarrow> (a - \<epsilon>) \<in> inside (path_image p)"
     using ray_to_frontier [of "inside (path_image p)" a "-1"] bo ins a interior_eq
     by (metis ab_group_add_class.ab_diff_conv_add_uminus of_real_def scale_minus_right zero_neq_neg_one)
   obtain e::real where "0 < e" and e_fro: "a + e \<in> frontier (inside (path_image p))"
     and e_int: "\<And>\<epsilon>. \<lbrakk>0 \<le> \<epsilon>; \<epsilon> < e\<rbrakk> \<Longrightarrow> (a + \<epsilon>) \<in> inside (path_image p)"
     using ray_to_frontier [of "inside (path_image p)" a 1] bo ins a interior_eq
     by (metis of_real_def zero_neq_one)
   obtain t0 where "0 \<le> t0" "t0 \<le> 1" and pt: "p t0 = a - d"
     using a d_fro fro by (auto simp: path_image_def)
   obtain q where "simple_path q" and q_ends: "pathstart q = a - d" "pathfinish q = a - d"
     and q_eq_p: "path_image q = path_image p"
     and wn_q_eq_wn_p: "\<And>z. z \<in> inside(path_image p) \<Longrightarrow> winding_number q z = winding_number p z"
   proof
     show "simple_path (shiftpath t0 p)"
       by (simp add: pathstart_shiftpath pathfinish_shiftpath
           simple_path_shiftpath path_image_shiftpath \<open>0 \<le> t0\<close> \<open>t0 \<le> 1\<close> assms)
     show "pathstart (shiftpath t0 p) = a - d"
       using pt by (simp add: \<open>t0 \<le> 1\<close> pathstart_shiftpath)
     show "pathfinish (shiftpath t0 p) = a - d"
       by (simp add: \<open>0 \<le> t0\<close> loop pathfinish_shiftpath pt)
     show "path_image (shiftpath t0 p) = path_image p"
       by (simp add: \<open>0 \<le> t0\<close> \<open>t0 \<le> 1\<close> loop path_image_shiftpath)
     show "winding_number (shiftpath t0 p) z = winding_number p z"
       if "z \<in> inside (path_image p)" for z
       by (metis ComplD Un_iff \<open>0 \<le> t0\<close> \<open>t0 \<le> 1\<close> \<open>simple_path p\<close> atLeastAtMost_iff inside_Un_outside
           loop simple_path_imp_path that winding_number_shiftpath)
   qed
   have ad_not_ae: "a - d \<noteq> a + e"
     by (metis \<open>0 < d\<close> \<open>0 < e\<close> add.left_inverse add_left_cancel add_uminus_conv_diff
         le_add_same_cancel2 less_eq_real_def not_less of_real_add of_real_def of_real_eq_0_iff pt)
   have ad_ae_q: "{a - d, a + e} \<subseteq> path_image q"
     using \<open>path_image q = path_image p\<close> d_fro e_fro fro(1) by auto
   have ada: "open_segment (a - d) a \<subseteq> inside (path_image p)"
   proof (clarsimp simp: in_segment)
     fix u::real assume "0 < u" "u < 1"
     with d_int have "a - (1 - u) * d \<in> inside (path_image p)"
       by (metis \<open>0 < d\<close> add.commute diff_add_cancel left_diff_distrib' less_add_same_cancel2 less_eq_real_def mult.left_neutral zero_less_mult_iff)
     then show "(1 - u) *\<^sub>R (a - d) + u *\<^sub>R a \<in> inside (path_image p)"
       by (simp add: diff_add_eq of_real_def real_vector.scale_right_diff_distrib)
   qed
   have aae: "open_segment a (a + e) \<subseteq> inside (path_image p)"
   proof (clarsimp simp: in_segment)
     fix u::real assume "0 < u" "u < 1"
     with e_int have "a + u * e \<in> inside (path_image p)"
       by (meson \<open>0 < e\<close> less_eq_real_def mult_less_cancel_right2 not_less zero_less_mult_iff)
     then show "(1 - u) *\<^sub>R a + u *\<^sub>R (a + e) \<in> inside (path_image p)"
       by (metis (mono_tags, lifting) add.assoc of_real_mult pth_6 scaleR_collapse scaleR_conv_of_real)
   qed
   have "complex_of_real (d * d + (e * e + d * (e + e))) \<noteq> 0"
     using ad_not_ae
     by (metis \<open>0 < d\<close> \<open>0 < e\<close> add_strict_left_mono less_add_same_cancel1 not_sum_squares_lt_zero
         of_real_eq_0_iff zero_less_double_add_iff_zero_less_single_add zero_less_mult_iff)
   moreover have "\<exists>u>0. u < 1 \<and> d = u * d + u * e"
     using \<open>0 < d\<close> \<open>0 < e\<close>
     by (rule_tac x="d / (d+e)" in exI) (simp add: divide_simps scaleR_conv_of_real flip: distrib_left)
   ultimately have a_in_de: "a \<in> open_segment (a - d) (a + e)"
     using ad_not_ae by (simp add: in_segment algebra_simps scaleR_conv_of_real flip: of_real_add of_real_mult)
   then have "open_segment (a - d) (a + e) \<subseteq> inside (path_image p)"
     using ada a aae Un_open_segment [of a "a-d" "a+e"] by blast
   then have "path_image q \<inter> open_segment (a - d) (a + e) = {}"
     using inside_no_overlap by (fastforce simp: q_eq_p)
   with ad_ae_q have paq_Int_cs: "path_image q \<inter> closed_segment (a - d) (a + e) = {a - d, a + e}"
     by (simp add: closed_segment_eq_open)
   obtain t where "0 \<le> t" "t \<le> 1" and qt: "q t = a + e"
     using a e_fro fro ad_ae_q by (auto simp: path_defs)
   then have "t \<noteq> 0"
     by (metis ad_not_ae pathstart_def q_ends(1))
   then have "t \<noteq> 1"
     by (metis ad_not_ae pathfinish_def q_ends(2) qt)
   have q01: "q 0 = a - d" "q 1 = a - d"
     using q_ends by (auto simp: pathstart_def pathfinish_def)
   obtain z where zin: "z \<in> inside (path_image (subpath t 0 q +++ linepath (a - d) (a + e)))"
              and z1: "cmod (winding_number (subpath t 0 q +++ linepath (a - d) (a + e)) z) = 1"
   proof (rule simple_closed_path_wn2 [of d e "subpath t 0 q" a], simp_all add: q01)
     show "simple_path (subpath t 0 q +++ linepath (a - d) (a + e))"
     proof (rule simple_path_join_loop, simp_all add: qt q01)
       have "inj_on q (closed_segment t 0)"
         using \<open>0 \<le> t\<close> \<open>simple_path q\<close> \<open>t \<le> 1\<close> \<open>t \<noteq> 0\<close> \<open>t \<noteq> 1\<close>
         by (fastforce simp: simple_path_def loop_free_def inj_on_def closed_segment_eq_real_ivl)
       then show "arc (subpath t 0 q)"
         using \<open>0 \<le> t\<close> \<open>simple_path q\<close> \<open>t \<le> 1\<close> \<open>t \<noteq> 0\<close>
         by (simp add: arc_subpath_eq simple_path_imp_path)
       show "arc (linepath (a - d) (a + e))"
         by (simp add: ad_not_ae)
       show "path_image (subpath t 0 q) \<inter> closed_segment (a - d) (a + e) \<subseteq> {a + e, a - d}"
         using qt paq_Int_cs  \<open>simple_path q\<close> \<open>0 \<le> t\<close> \<open>t \<le> 1\<close>
         by (force simp: dest: rev_subsetD [OF _ path_image_subpath_subset] intro: simple_path_imp_path)
     qed
   qed (auto simp: \<open>0 < d\<close> \<open>0 < e\<close> qt)
   have pa01_Un: "path_image (subpath 0 t q) \<union> path_image (subpath 1 t q) = path_image q"
     unfolding path_image_subpath
     using \<open>0 \<le> t\<close> \<open>t \<le> 1\<close> by (force simp: path_image_def image_iff)
   with paq_Int_cs have pa_01q:
         "(path_image (subpath 0 t q) \<union> path_image (subpath 1 t q)) \<inter> closed_segment (a - d) (a + e) = {a - d, a + e}"
     by metis
   have z_notin_ed: "z \<notin> closed_segment (a + e) (a - d)"
     using zin q01 by (simp add: path_image_join closed_segment_commute inside_def)
   have z_notin_0t: "z \<notin> path_image (subpath 0 t q)"
     by (metis (no_types, opaque_lifting) IntI Un_upper1 subsetD empty_iff inside_no_overlap path_image_join
         path_image_subpath_commute pathfinish_subpath pathstart_def pathstart_linepath q_ends(1) qt subpath_trivial zin)
   have [simp]: "- winding_number (subpath t 0 q) z = winding_number (subpath 0 t q) z"
     by (metis \<open>0 \<le> t\<close> \<open>simple_path q\<close> \<open>t \<le> 1\<close> atLeastAtMost_iff zero_le_one
               path_image_subpath_commute path_subpath real_eq_0_iff_le_ge_0
               reversepath_subpath simple_path_imp_path winding_number_reversepath z_notin_0t)
   obtain z_in_q: "z \<in> inside(path_image q)"
      and wn_q: "winding_number (subpath 0 t q +++ subpath t 1 q) z = - winding_number (subpath t 0 q +++ linepath (a - d) (a + e)) z"
   proof (rule winding_number_from_innerpath
           [of "subpath 0 t q" "a-d" "a+e" "subpath 1 t q" "linepath (a - d) (a + e)"
             z "- winding_number (subpath t 0 q +++ linepath (a - d) (a + e)) z"],
          simp_all add: q01 qt pa01_Un reversepath_subpath)
     show "simple_path (subpath 0 t q)" "simple_path (subpath 1 t q)"
       by (simp_all add: \<open>0 \<le> t\<close> \<open>simple_path q\<close> \<open>t \<le> 1\<close> \<open>t \<noteq> 0\<close> \<open>t \<noteq> 1\<close> simple_path_subpath)
     show "simple_path (linepath (a - d) (a + e))"
       using ad_not_ae by blast
     show "path_image (subpath 0 t q) \<inter> path_image (subpath 1 t q) = {a - d, a + e}"  (is "?lhs = ?rhs")
     proof
       show "?lhs \<subseteq> ?rhs"
         using \<open>0 \<le> t\<close> \<open>simple_path q\<close> \<open>t \<le> 1\<close> \<open>t \<noteq> 1\<close> q_ends qt q01
         by (force simp: pathfinish_def qt simple_path_def loop_free_def path_image_subpath)
       show "?rhs \<subseteq> ?lhs"
         using \<open>0 \<le> t\<close> \<open>t \<le> 1\<close> q01 qt by (force simp: path_image_subpath)
     qed
     show "path_image (subpath 0 t q) \<inter> closed_segment (a - d) (a + e) = {a - d, a + e}" (is "?lhs = ?rhs")
     proof
       show "?lhs \<subseteq> ?rhs"  using paq_Int_cs pa01_Un by fastforce
       show "?rhs \<subseteq> ?lhs"  using \<open>0 \<le> t\<close> \<open>t \<le> 1\<close> q01 qt by (force simp: path_image_subpath)
     qed
     show "path_image (subpath 1 t q) \<inter> closed_segment (a - d) (a + e) = {a - d, a + e}" (is "?lhs = ?rhs")
     proof
       show "?lhs \<subseteq> ?rhs"  by (auto simp: pa_01q [symmetric])
       show "?rhs \<subseteq> ?lhs"  using \<open>0 \<le> t\<close> \<open>t \<le> 1\<close> q01 qt by (force simp: path_image_subpath)
     qed
     show "closed_segment (a - d) (a + e) \<inter> inside (path_image q) \<noteq> {}"
       using a a_in_de open_closed_segment pa01_Un q_eq_p by fastforce
     show "z \<in> inside (path_image (subpath 0 t q) \<union> closed_segment (a - d) (a + e))"
       by (metis path_image_join path_image_linepath path_image_subpath_commute pathfinish_subpath pathstart_linepath q01(1) zin)
     show "winding_number (subpath 0 t q +++ linepath (a + e) (a - d)) z =
       - winding_number (subpath t 0 q +++ linepath (a - d) (a + e)) z"
       using z_notin_ed z_notin_0t \<open>0 \<le> t\<close> \<open>simple_path q\<close> \<open>t \<le> 1\<close>
       by (simp add: simple_path_imp_path qt q01 path_image_subpath_commute closed_segment_commute winding_number_join winding_number_reversepath [symmetric])
     show "- d \<noteq> e"
       using ad_not_ae by auto
     show "winding_number (subpath t 0 q +++ linepath (a - d) (a + e)) z \<noteq> 0"
       using z1 by auto
   qed
   show ?thesis
   proof
     show "z \<in> inside (path_image p)"
       using q_eq_p z_in_q by auto
     then have [simp]: "z \<notin> path_image q"
       by (metis disjoint_iff_not_equal inside_no_overlap q_eq_p)
     have [simp]: "z \<notin> path_image (subpath 1 t q)"
       using inside_def pa01_Un z_in_q by fastforce
     have "winding_number(subpath 0 t q +++ subpath t 1 q) z = winding_number(subpath 0 1 q) z"
       using z_notin_0t \<open>0 \<le> t\<close> \<open>simple_path q\<close> \<open>t \<le> 1\<close>
       by (simp add: simple_path_imp_path qt path_image_subpath_commute winding_number_join winding_number_subpath_combine)
     with wn_q have "winding_number (subpath t 0 q +++ linepath (a - d) (a + e)) z = - winding_number q z"
       by auto
     with z1 have "cmod (winding_number q z) = 1"
       by simp
     with z1 wn_q_eq_wn_p show "cmod (winding_number p z) = 1"
       using z1 wn_q_eq_wn_p  by (simp add: \<open>z \<in> inside (path_image p)\<close>)
     qed
 qed
 
 proposition simple_closed_path_winding_number_inside:
   assumes "simple_path \<gamma>"
   obtains "\<And>z. z \<in> inside(path_image \<gamma>) \<Longrightarrow> winding_number \<gamma> z = 1"
         | "\<And>z. z \<in> inside(path_image \<gamma>) \<Longrightarrow> winding_number \<gamma> z = -1"
 proof (cases "pathfinish \<gamma> = pathstart \<gamma>")
   case True
   have "path \<gamma>"
     by (simp add: assms simple_path_imp_path)
   then have const: "winding_number \<gamma> constant_on inside(path_image \<gamma>)"
   proof (rule winding_number_constant)
     show "connected (inside(path_image \<gamma>))"
       by (simp add: Jordan_inside_outside True assms)
   qed (use inside_no_overlap True in auto)
   obtain z where zin: "z \<in> inside (path_image \<gamma>)" and z1: "cmod (winding_number \<gamma> z) = 1"
     using simple_closed_path_wn3 [of \<gamma>] True assms by blast
   have "winding_number \<gamma> z \<in> \<int>"
     using zin integer_winding_number [OF \<open>path \<gamma>\<close> True] inside_def by blast
   moreover have "real_of_int x = - 1 \<longleftrightarrow> x = -1" for x
     by linarith
   ultimately consider "winding_number \<gamma> z = 1" | "winding_number \<gamma> z = -1"
     using z1 by (auto simp: Ints_def abs_if split: if_split_asm)
   with that const zin show ?thesis
     unfolding constant_on_def by metis
 next
   case False
   then show ?thesis
     using inside_simple_curve_imp_closed assms that(2) by blast
 qed
 
 lemma simple_closed_path_abs_winding_number_inside:
   assumes "simple_path \<gamma>" "z \<in> inside(path_image \<gamma>)"
     shows "\<bar>Re (winding_number \<gamma> z)\<bar> = 1"
   by (metis assms norm_minus_cancel norm_one one_complex.simps(1) real_norm_def simple_closed_path_winding_number_inside uminus_complex.simps(1))
 
 lemma simple_closed_path_norm_winding_number_inside:
   assumes "simple_path \<gamma>" "z \<in> inside(path_image \<gamma>)"
   shows "norm (winding_number \<gamma> z) = 1"
 proof -
   have "pathfinish \<gamma> = pathstart \<gamma>"
     using assms inside_simple_curve_imp_closed by blast
   with assms integer_winding_number have "winding_number \<gamma> z \<in> \<int>"
     by (simp add: inside_def simple_path_def)
   then show ?thesis
     by (metis assms norm_minus_cancel norm_one simple_closed_path_winding_number_inside)
 qed
 
 lemma simple_closed_path_winding_number_cases:
   assumes "simple_path \<gamma>" "pathfinish \<gamma> = pathstart \<gamma>" "z \<notin> path_image \<gamma>"
   shows "winding_number \<gamma> z \<in> {-1,0,1}"
 proof -
   consider "z \<in> inside (path_image \<gamma>)" | "z \<in> outside (path_image \<gamma>)"
     by (metis ComplI UnE assms(3) inside_Un_outside)
   then show ?thesis
   proof cases
     case 1
     then show ?thesis
       using assms simple_closed_path_winding_number_inside by auto
   next
     case 2
     then show ?thesis
       using assms simple_path_def winding_number_zero_in_outside by blast
   qed
 qed
 
 lemma simple_closed_path_winding_number_pos:
    "\<lbrakk>simple_path \<gamma>; pathfinish \<gamma> = pathstart \<gamma>; z \<notin> path_image \<gamma>; 0 < Re(winding_number \<gamma> z)\<rbrakk>
     \<Longrightarrow> winding_number \<gamma> z = 1"
 using simple_closed_path_winding_number_cases
   by fastforce
 
 subsection \<open>Winding number for rectangular paths\<close>
 
 proposition winding_number_rectpath:
   assumes "z \<in> box a1 a3"
   shows   "winding_number (rectpath a1 a3) z = 1"
 proof -
   from assms have less: "Re a1 < Re a3" "Im a1 < Im a3"
     by (auto simp: in_box_complex_iff)
   define a2 a4 where "a2 = Complex (Re a3) (Im a1)" and "a4 = Complex (Re a1) (Im a3)"
   let ?l1 = "linepath a1 a2" and ?l2 = "linepath a2 a3"
   and ?l3 = "linepath a3 a4" and ?l4 = "linepath a4 a1"
   from assms and less have "z \<notin> path_image (rectpath a1 a3)"
     by (auto simp: path_image_rectpath_cbox_minus_box)
   also have "path_image (rectpath a1 a3) =
                path_image ?l1 \<union> path_image ?l2 \<union> path_image ?l3 \<union> path_image ?l4"
     by (simp add: rectpath_def Let_def path_image_join Un_assoc a2_def a4_def)
   finally have "z \<notin> \<dots>" .
   moreover have "\<forall>l\<in>{?l1,?l2,?l3,?l4}. Re (winding_number l z) > 0"
     unfolding ball_simps HOL.simp_thms a2_def a4_def
     by (intro conjI; (rule winding_number_linepath_pos_lt;
           (insert assms, auto simp: a2_def a4_def in_box_complex_iff mult_neg_neg))+)
   ultimately have "Re (winding_number (rectpath a1 a3) z) > 0"
     by (simp add: winding_number_join path_image_join rectpath_def Let_def a2_def a4_def)
   thus "winding_number (rectpath a1 a3) z = 1" using assms less
     by (intro simple_closed_path_winding_number_pos simple_path_rectpath)
        (auto simp: path_image_rectpath_cbox_minus_box)
 qed
 
 proposition winding_number_rectpath_outside:
   assumes "Re a1 \<le> Re a3" "Im a1 \<le> Im a3"
   assumes "z \<notin> cbox a1 a3"
   shows   "winding_number (rectpath a1 a3) z = 0"
   using assms by (intro winding_number_zero_outside[OF _ _ _ assms(3)]
                      path_image_rectpath_subset_cbox) simp_all
 
 text\<open>A per-function version for continuous logs, a kind of monodromy\<close>
 proposition\<^marker>\<open>tag unimportant\<close> winding_number_compose_exp:
   assumes "path p"
   shows "winding_number (exp \<circ> p) 0 = (pathfinish p - pathstart p) / (2 * of_real pi * \<i>)"
 proof -
   obtain e where "0 < e" and e: "\<And>t. t \<in> {0..1} \<Longrightarrow> e \<le> norm(exp(p t))"
   proof
     have "closed (path_image (exp \<circ> p))"
       by (simp add: assms closed_path_image holomorphic_on_exp holomorphic_on_imp_continuous_on path_continuous_image)
     then show "0 < setdist {0} (path_image (exp \<circ> p))"
       by (metis exp_not_eq_zero imageE image_comp infdist_eq_setdist infdist_pos_not_in_closed path_defs(4) path_image_nonempty)
   next
     fix t::real
     assume "t \<in> {0..1}"
     have "setdist {0} (path_image (exp \<circ> p)) \<le> dist 0 (exp (p t))"
     proof (rule setdist_le_dist)
       show "exp (p t) \<in> path_image (exp \<circ> p)"
         using \<open>t \<in> {0..1}\<close> path_image_def by fastforce+
     qed auto
     then show "setdist {0} (path_image (exp \<circ> p)) \<le> cmod (exp (p t))"
       by simp
   qed
   have "bounded (path_image p)"
     by (simp add: assms bounded_path_image)
   then obtain B where "0 < B" and B: "path_image p \<subseteq> cball 0 B"
     by (meson bounded_pos mem_cball_0 subsetI)
   let ?B = "cball (0::complex) (B+1)"
   have "uniformly_continuous_on ?B exp"
     using holomorphic_on_exp holomorphic_on_imp_continuous_on
     by (force intro: compact_uniformly_continuous)
   then obtain d where "d > 0"
         and d: "\<And>x x'. \<lbrakk>x\<in>?B; x'\<in>?B; dist x' x < d\<rbrakk> \<Longrightarrow> norm (exp x' - exp x) < e"
     using \<open>e > 0\<close> by (auto simp: uniformly_continuous_on_def dist_norm)
   then have "min 1 d > 0"
     by force
   then obtain g where pfg: "polynomial_function g"  and "g 0 = p 0" "g 1 = p 1"
            and gless: "\<And>t. t \<in> {0..1} \<Longrightarrow> norm(g t - p t) < min 1 d"
     using path_approx_polynomial_function [OF \<open>path p\<close>] \<open>d > 0\<close> \<open>0 < e\<close>
     unfolding pathfinish_def pathstart_def by blast
   have "winding_number (exp \<circ> p) 0 = winding_number (exp \<circ> g) 0"
   proof (rule winding_number_nearby_paths_eq [symmetric])
     show "path (exp \<circ> p)" "path (exp \<circ> g)"
       by (simp_all add: pfg assms holomorphic_on_exp holomorphic_on_imp_continuous_on path_continuous_image path_polynomial_function)
   next
     fix t :: "real"
     assume t: "t \<in> {0..1}"
     with gless have "norm(g t - p t) < 1"
       using min_less_iff_conj by blast
     moreover have ptB: "norm (p t) \<le> B"
       using B t by (force simp: path_image_def)
     ultimately have "cmod (g t) \<le> B + 1"
       by (meson add_mono_thms_linordered_field(4) le_less_trans less_imp_le norm_triangle_sub)
     with ptB gless t have "cmod ((exp \<circ> g) t - (exp \<circ> p) t) < e"
       by (auto simp: dist_norm d)
     with e t show "cmod ((exp \<circ> g) t - (exp \<circ> p) t) < cmod ((exp \<circ> p) t - 0)"
       by fastforce
   qed (use \<open>g 0 = p 0\<close> \<open>g 1 = p 1\<close> in \<open>auto simp: pathfinish_def pathstart_def\<close>)
   also have "... = 1 / (of_real (2 * pi) * \<i>) * contour_integral (exp \<circ> g) (\<lambda>w. 1 / (w - 0))"
   proof (rule winding_number_valid_path)
     have "continuous_on (path_image g) (deriv exp)"
       by (metis DERIV_exp DERIV_imp_deriv continuous_on_cong holomorphic_on_exp holomorphic_on_imp_continuous_on)
     then show "valid_path (exp \<circ> g)"
       by (simp add: field_differentiable_within_exp pfg valid_path_compose valid_path_polynomial_function)
     show "0 \<notin> path_image (exp \<circ> g)"
       by (auto simp: path_image_def)
   qed
   also have "... = 1 / (of_real (2 * pi) * \<i>) * integral {0..1} (\<lambda>x. vector_derivative g (at x))"
   proof (simp add: contour_integral_integral, rule integral_cong)
     fix t :: "real"
     assume t: "t \<in> {0..1}"
     show "vector_derivative (exp \<circ> g) (at t) / exp (g t) = vector_derivative g (at t)"
     proof -
       have "(exp \<circ> g has_vector_derivative vector_derivative (exp \<circ> g) (at t)) (at t)"
         by (meson DERIV_exp differentiable_def field_vector_diff_chain_at has_vector_derivative_def
             has_vector_derivative_polynomial_function pfg vector_derivative_works)
       moreover have "(exp \<circ> g has_vector_derivative vector_derivative g (at t) * exp (g t)) (at t)"
         by (metis DERIV_exp field_vector_diff_chain_at has_vector_derivative_polynomial_function pfg vector_derivative_at)
       ultimately show ?thesis
         by (simp add: divide_simps, rule vector_derivative_unique_at)
     qed
   qed
   also have "... = (pathfinish p - pathstart p) / (2 * of_real pi * \<i>)"
   proof -
     have "((\<lambda>x. vector_derivative g (at x)) has_integral g 1 - g 0) {0..1}"
       by (meson differentiable_at_polynomial_function fundamental_theorem_of_calculus 
                 has_vector_derivative_at_within pfg vector_derivative_works zero_le_one)
     then show ?thesis
       unfolding pathfinish_def pathstart_def
       using \<open>g 0 = p 0\<close> \<open>g 1 = p 1\<close> by auto
   qed
   finally show ?thesis .
 qed
 
 end
\ No newline at end of file
diff --git a/src/HOL/Transcendental.thy b/src/HOL/Transcendental.thy
--- a/src/HOL/Transcendental.thy
+++ b/src/HOL/Transcendental.thy
@@ -1,7774 +1,7780 @@
 (*  Title:      HOL/Transcendental.thy
     Author:     Jacques D. Fleuriot, University of Cambridge, University of Edinburgh
     Author:     Lawrence C Paulson
     Author:     Jeremy Avigad
 *)
 
 section \<open>Power Series, Transcendental Functions etc.\<close>
 
 theory Transcendental
 imports Series Deriv NthRoot
 begin
 
 text \<open>A theorem about the factcorial function on the reals.\<close>
 
 lemma square_fact_le_2_fact: "fact n * fact n \<le> (fact (2 * n) :: real)"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have "(fact (Suc n)) * (fact (Suc n)) = of_nat (Suc n) * of_nat (Suc n) * (fact n * fact n :: real)"
     by (simp add: field_simps)
   also have "\<dots> \<le> of_nat (Suc n) * of_nat (Suc n) * fact (2 * n)"
     by (rule mult_left_mono [OF Suc]) simp
   also have "\<dots> \<le> of_nat (Suc (Suc (2 * n))) * of_nat (Suc (2 * n)) * fact (2 * n)"
     by (rule mult_right_mono)+ (auto simp: field_simps)
   also have "\<dots> = fact (2 * Suc n)" by (simp add: field_simps)
   finally show ?case .
 qed
 
 lemma fact_in_Reals: "fact n \<in> \<real>"
   by (induction n) auto
 
 lemma of_real_fact [simp]: "of_real (fact n) = fact n"
   by (metis of_nat_fact of_real_of_nat_eq)
 
 lemma pochhammer_of_real: "pochhammer (of_real x) n = of_real (pochhammer x n)"
   by (simp add: pochhammer_prod)
 
 lemma norm_fact [simp]: "norm (fact n :: 'a::real_normed_algebra_1) = fact n"
 proof -
   have "(fact n :: 'a) = of_real (fact n)"
     by simp
   also have "norm \<dots> = fact n"
     by (subst norm_of_real) simp
   finally show ?thesis .
 qed
 
 lemma root_test_convergence:
   fixes f :: "nat \<Rightarrow> 'a::banach"
   assumes f: "(\<lambda>n. root n (norm (f n))) \<longlonglongrightarrow> x" \<comment> \<open>could be weakened to lim sup\<close>
     and "x < 1"
   shows "summable f"
 proof -
   have "0 \<le> x"
     by (rule LIMSEQ_le[OF tendsto_const f]) (auto intro!: exI[of _ 1])
   from \<open>x < 1\<close> obtain z where z: "x < z" "z < 1"
     by (metis dense)
   from f \<open>x < z\<close> have "eventually (\<lambda>n. root n (norm (f n)) < z) sequentially"
     by (rule order_tendstoD)
   then have "eventually (\<lambda>n. norm (f n) \<le> z^n) sequentially"
     using eventually_ge_at_top
   proof eventually_elim
     fix n
     assume less: "root n (norm (f n)) < z" and n: "1 \<le> n"
     from power_strict_mono[OF less, of n] n show "norm (f n) \<le> z ^ n"
       by simp
   qed
   then show "summable f"
     unfolding eventually_sequentially
     using z \<open>0 \<le> x\<close> by (auto intro!: summable_comparison_test[OF _  summable_geometric])
 qed
 
 subsection \<open>More facts about binomial coefficients\<close>
 
 text \<open>
   These facts could have been proven before, but having real numbers
   makes the proofs a lot easier.
 \<close>
 
 lemma central_binomial_odd:
   "odd n \<Longrightarrow> n choose (Suc (n div 2)) = n choose (n div 2)"
 proof -
   assume "odd n"
   hence "Suc (n div 2) \<le> n" by presburger
   hence "n choose (Suc (n div 2)) = n choose (n - Suc (n div 2))"
     by (rule binomial_symmetric)
   also from \<open>odd n\<close> have "n - Suc (n div 2) = n div 2" by presburger
   finally show ?thesis .
 qed
 
 lemma binomial_less_binomial_Suc:
   assumes k: "k < n div 2"
   shows   "n choose k < n choose (Suc k)"
 proof -
   from k have k': "k \<le> n" "Suc k \<le> n" by simp_all
   from k' have "real (n choose k) = fact n / (fact k * fact (n - k))"
     by (simp add: binomial_fact)
   also from k' have "n - k = Suc (n - Suc k)" by simp
   also from k' have "fact \<dots> = (real n - real k) * fact (n - Suc k)"
     by (subst fact_Suc) (simp_all add: of_nat_diff)
   also from k have "fact k = fact (Suc k) / (real k + 1)" by (simp add: field_simps)
   also have "fact n / (fact (Suc k) / (real k + 1) * ((real n - real k) * fact (n - Suc k))) =
                (n choose (Suc k)) * ((real k + 1) / (real n - real k))"
     using k by (simp add: field_split_simps binomial_fact)
   also from assms have "(real k + 1) / (real n - real k) < 1" by simp
   finally show ?thesis using k by (simp add: mult_less_cancel_left)
 qed
 
 lemma binomial_strict_mono:
   assumes "k < k'" "2*k' \<le> n"
   shows   "n choose k < n choose k'"
 proof -
   from assms have "k \<le> k' - 1" by simp
   thus ?thesis
   proof (induction rule: inc_induct)
     case base
     with assms binomial_less_binomial_Suc[of "k' - 1" n]
       show ?case by simp
   next
     case (step k)
     from step.prems step.hyps assms have "n choose k < n choose (Suc k)"
       by (intro binomial_less_binomial_Suc) simp_all
     also have "\<dots> < n choose k'" by (rule step.IH)
     finally show ?case .
   qed
 qed
 
 lemma binomial_mono:
   assumes "k \<le> k'" "2*k' \<le> n"
   shows   "n choose k \<le> n choose k'"
   using assms binomial_strict_mono[of k k' n] by (cases "k = k'") simp_all
 
 lemma binomial_strict_antimono:
   assumes "k < k'" "2 * k \<ge> n" "k' \<le> n"
   shows   "n choose k > n choose k'"
 proof -
   from assms have "n choose (n - k) > n choose (n - k')"
     by (intro binomial_strict_mono) (simp_all add: algebra_simps)
   with assms show ?thesis by (simp add: binomial_symmetric [symmetric])
 qed
 
 lemma binomial_antimono:
   assumes "k \<le> k'" "k \<ge> n div 2" "k' \<le> n"
   shows   "n choose k \<ge> n choose k'"
 proof (cases "k = k'")
   case False
   note not_eq = False
   show ?thesis
   proof (cases "k = n div 2 \<and> odd n")
     case False
     with assms(2) have "2*k \<ge> n" by presburger
     with not_eq assms binomial_strict_antimono[of k k' n]
       show ?thesis by simp
   next
     case True
     have "n choose k' \<le> n choose (Suc (n div 2))"
     proof (cases "k' = Suc (n div 2)")
       case False
       with assms True not_eq have "Suc (n div 2) < k'" by simp
       with assms binomial_strict_antimono[of "Suc (n div 2)" k' n] True
         show ?thesis by auto
     qed simp_all
     also from True have "\<dots> = n choose k" by (simp add: central_binomial_odd)
     finally show ?thesis .
   qed
 qed simp_all
 
 lemma binomial_maximum: "n choose k \<le> n choose (n div 2)"
 proof -
   have "k \<le> n div 2 \<longleftrightarrow> 2*k \<le> n" by linarith
   consider "2*k \<le> n" | "2*k \<ge> n" "k \<le> n" | "k > n" by linarith
   thus ?thesis
   proof cases
     case 1
     thus ?thesis by (intro binomial_mono) linarith+
   next
     case 2
     thus ?thesis by (intro binomial_antimono) simp_all
   qed (simp_all add: binomial_eq_0)
 qed
 
 lemma binomial_maximum': "(2*n) choose k \<le> (2*n) choose n"
   using binomial_maximum[of "2*n"] by simp
 
 lemma central_binomial_lower_bound:
   assumes "n > 0"
   shows   "4^n / (2*real n) \<le> real ((2*n) choose n)"
 proof -
   from binomial[of 1 1 "2*n"]
     have "4 ^ n = (\<Sum>k\<le>2*n. (2*n) choose k)"
     by (simp add: power_mult power2_eq_square One_nat_def [symmetric] del: One_nat_def)
   also have "{..2*n} = {0<..<2*n} \<union> {0,2*n}" by auto
   also have "(\<Sum>k\<in>\<dots>. (2*n) choose k) =
              (\<Sum>k\<in>{0<..<2*n}. (2*n) choose k) + (\<Sum>k\<in>{0,2*n}. (2*n) choose k)"
     by (subst sum.union_disjoint) auto
   also have "(\<Sum>k\<in>{0,2*n}. (2*n) choose k) \<le> (\<Sum>k\<le>1. (n choose k)\<^sup>2)"
     by (cases n) simp_all
   also from assms have "\<dots> \<le> (\<Sum>k\<le>n. (n choose k)\<^sup>2)"
     by (intro sum_mono2) auto
   also have "\<dots> = (2*n) choose n" by (rule choose_square_sum)
   also have "(\<Sum>k\<in>{0<..<2*n}. (2*n) choose k) \<le> (\<Sum>k\<in>{0<..<2*n}. (2*n) choose n)"
     by (intro sum_mono binomial_maximum')
   also have "\<dots> = card {0<..<2*n} * ((2*n) choose n)" by simp
   also have "card {0<..<2*n} \<le> 2*n - 1" by (cases n) simp_all
   also have "(2 * n - 1) * (2 * n choose n) + (2 * n choose n) = ((2*n) choose n) * (2*n)"
     using assms by (simp add: algebra_simps)
   finally have "4 ^ n \<le> (2 * n choose n) * (2 * n)" by simp_all
   hence "real (4 ^ n) \<le> real ((2 * n choose n) * (2 * n))"
     by (subst of_nat_le_iff)
   with assms show ?thesis by (simp add: field_simps)
 qed
 
 
 subsection \<open>Properties of Power Series\<close>
 
 lemma powser_zero [simp]: "(\<Sum>n. f n * 0 ^ n) = f 0"
   for f :: "nat \<Rightarrow> 'a::real_normed_algebra_1"
 proof -
   have "(\<Sum>n<1. f n * 0 ^ n) = (\<Sum>n. f n * 0 ^ n)"
     by (subst suminf_finite[where N="{0}"]) (auto simp: power_0_left)
   then show ?thesis by simp
 qed
 
 lemma powser_sums_zero: "(\<lambda>n. a n * 0^n) sums a 0"
   for a :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   using sums_finite [of "{0}" "\<lambda>n. a n * 0 ^ n"]
   by simp
 
 lemma powser_sums_zero_iff [simp]: "(\<lambda>n. a n * 0^n) sums x \<longleftrightarrow> a 0 = x"
   for a :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   using powser_sums_zero sums_unique2 by blast
 
 text \<open>
   Power series has a circle or radius of convergence: if it sums for \<open>x\<close>,
   then it sums absolutely for \<open>z\<close> with \<^term>\<open>\<bar>z\<bar> < \<bar>x\<bar>\<close>.\<close>
 
 lemma powser_insidea:
   fixes x z :: "'a::real_normed_div_algebra"
   assumes 1: "summable (\<lambda>n. f n * x^n)"
     and 2: "norm z < norm x"
   shows "summable (\<lambda>n. norm (f n * z ^ n))"
 proof -
   from 2 have x_neq_0: "x \<noteq> 0" by clarsimp
   from 1 have "(\<lambda>n. f n * x^n) \<longlonglongrightarrow> 0"
     by (rule summable_LIMSEQ_zero)
   then have "convergent (\<lambda>n. f n * x^n)"
     by (rule convergentI)
   then have "Cauchy (\<lambda>n. f n * x^n)"
     by (rule convergent_Cauchy)
   then have "Bseq (\<lambda>n. f n * x^n)"
     by (rule Cauchy_Bseq)
   then obtain K where 3: "0 < K" and 4: "\<forall>n. norm (f n * x^n) \<le> K"
     by (auto simp: Bseq_def)
   have "\<exists>N. \<forall>n\<ge>N. norm (norm (f n * z ^ n)) \<le> K * norm (z ^ n) * inverse (norm (x^n))"
   proof (intro exI allI impI)
     fix n :: nat
     assume "0 \<le> n"
     have "norm (norm (f n * z ^ n)) * norm (x^n) =
           norm (f n * x^n) * norm (z ^ n)"
       by (simp add: norm_mult abs_mult)
     also have "\<dots> \<le> K * norm (z ^ n)"
       by (simp only: mult_right_mono 4 norm_ge_zero)
     also have "\<dots> = K * norm (z ^ n) * (inverse (norm (x^n)) * norm (x^n))"
       by (simp add: x_neq_0)
     also have "\<dots> = K * norm (z ^ n) * inverse (norm (x^n)) * norm (x^n)"
       by (simp only: mult.assoc)
     finally show "norm (norm (f n * z ^ n)) \<le> K * norm (z ^ n) * inverse (norm (x^n))"
       by (simp add: mult_le_cancel_right x_neq_0)
   qed
   moreover have "summable (\<lambda>n. K * norm (z ^ n) * inverse (norm (x^n)))"
   proof -
     from 2 have "norm (norm (z * inverse x)) < 1"
       using x_neq_0
       by (simp add: norm_mult nonzero_norm_inverse divide_inverse [where 'a=real, symmetric])
     then have "summable (\<lambda>n. norm (z * inverse x) ^ n)"
       by (rule summable_geometric)
     then have "summable (\<lambda>n. K * norm (z * inverse x) ^ n)"
       by (rule summable_mult)
     then show "summable (\<lambda>n. K * norm (z ^ n) * inverse (norm (x^n)))"
       using x_neq_0
       by (simp add: norm_mult nonzero_norm_inverse power_mult_distrib
           power_inverse norm_power mult.assoc)
   qed
   ultimately show "summable (\<lambda>n. norm (f n * z ^ n))"
     by (rule summable_comparison_test)
 qed
 
 lemma powser_inside:
   fixes f :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,banach}"
   shows
     "summable (\<lambda>n. f n * (x^n)) \<Longrightarrow> norm z < norm x \<Longrightarrow>
       summable (\<lambda>n. f n * (z ^ n))"
   by (rule powser_insidea [THEN summable_norm_cancel])
 
 lemma powser_times_n_limit_0:
   fixes x :: "'a::{real_normed_div_algebra,banach}"
   assumes "norm x < 1"
     shows "(\<lambda>n. of_nat n * x ^ n) \<longlonglongrightarrow> 0"
 proof -
   have "norm x / (1 - norm x) \<ge> 0"
     using assms by (auto simp: field_split_simps)
   moreover obtain N where N: "norm x / (1 - norm x) < of_int N"
     using ex_le_of_int by (meson ex_less_of_int)
   ultimately have N0: "N>0"
     by auto
   then have *: "real_of_int (N + 1) * norm x / real_of_int N < 1"
     using N assms by (auto simp: field_simps)
   have **: "real_of_int N * (norm x * (real_of_nat (Suc n) * norm (x ^ n))) \<le>
       real_of_nat n * (norm x * ((1 + N) * norm (x ^ n)))" if "N \<le> int n" for n :: nat
   proof -
     from that have "real_of_int N * real_of_nat (Suc n) \<le> real_of_nat n * real_of_int (1 + N)"
       by (simp add: algebra_simps)
     then have "(real_of_int N * real_of_nat (Suc n)) * (norm x * norm (x ^ n)) \<le>
         (real_of_nat n *  (1 + N)) * (norm x * norm (x ^ n))"
       using N0 mult_mono by fastforce
     then show ?thesis
       by (simp add: algebra_simps)
   qed
   show ?thesis using *
     by (rule summable_LIMSEQ_zero [OF summable_ratio_test, where N1="nat N"])
       (simp add: N0 norm_mult field_simps ** del: of_nat_Suc of_int_add)
 qed
 
 corollary lim_n_over_pown:
   fixes x :: "'a::{real_normed_field,banach}"
   shows "1 < norm x \<Longrightarrow> ((\<lambda>n. of_nat n / x^n) \<longlongrightarrow> 0) sequentially"
   using powser_times_n_limit_0 [of "inverse x"]
   by (simp add: norm_divide field_split_simps)
 
 lemma sum_split_even_odd:
   fixes f :: "nat \<Rightarrow> real"
   shows "(\<Sum>i<2 * n. if even i then f i else g i) = (\<Sum>i<n. f (2 * i)) + (\<Sum>i<n. g (2 * i + 1))"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have "(\<Sum>i<2 * Suc n. if even i then f i else g i) =
     (\<Sum>i<n. f (2 * i)) + (\<Sum>i<n. g (2 * i + 1)) + (f (2 * n) + g (2 * n + 1))"
     using Suc.hyps unfolding One_nat_def by auto
   also have "\<dots> = (\<Sum>i<Suc n. f (2 * i)) + (\<Sum>i<Suc n. g (2 * i + 1))"
     by auto
   finally show ?case .
 qed
 
 lemma sums_if':
   fixes g :: "nat \<Rightarrow> real"
   assumes "g sums x"
   shows "(\<lambda> n. if even n then 0 else g ((n - 1) div 2)) sums x"
   unfolding sums_def
 proof (rule LIMSEQ_I)
   fix r :: real
   assume "0 < r"
   from \<open>g sums x\<close>[unfolded sums_def, THEN LIMSEQ_D, OF this]
   obtain no where no_eq: "\<And>n. n \<ge> no \<Longrightarrow> (norm (sum g {..<n} - x) < r)"
     by blast
 
   let ?SUM = "\<lambda> m. \<Sum>i<m. if even i then 0 else g ((i - 1) div 2)"
   have "(norm (?SUM m - x) < r)" if "m \<ge> 2 * no" for m
   proof -
     from that have "m div 2 \<ge> no" by auto
     have sum_eq: "?SUM (2 * (m div 2)) = sum g {..< m div 2}"
       using sum_split_even_odd by auto
     then have "(norm (?SUM (2 * (m div 2)) - x) < r)"
       using no_eq unfolding sum_eq using \<open>m div 2 \<ge> no\<close> by auto
     moreover
     have "?SUM (2 * (m div 2)) = ?SUM m"
     proof (cases "even m")
       case True
       then show ?thesis
         by (auto simp: even_two_times_div_two)
     next
       case False
       then have eq: "Suc (2 * (m div 2)) = m" by simp
       then have "even (2 * (m div 2))" using \<open>odd m\<close> by auto
       have "?SUM m = ?SUM (Suc (2 * (m div 2)))" unfolding eq ..
       also have "\<dots> = ?SUM (2 * (m div 2))" using \<open>even (2 * (m div 2))\<close> by auto
       finally show ?thesis by auto
     qed
     ultimately show ?thesis by auto
   qed
   then show "\<exists>no. \<forall> m \<ge> no. norm (?SUM m - x) < r"
     by blast
 qed
 
 lemma sums_if:
   fixes g :: "nat \<Rightarrow> real"
   assumes "g sums x" and "f sums y"
   shows "(\<lambda> n. if even n then f (n div 2) else g ((n - 1) div 2)) sums (x + y)"
 proof -
   let ?s = "\<lambda> n. if even n then 0 else f ((n - 1) div 2)"
   have if_sum: "(if B then (0 :: real) else E) + (if B then T else 0) = (if B then T else E)"
     for B T E
     by (cases B) auto
   have g_sums: "(\<lambda> n. if even n then 0 else g ((n - 1) div 2)) sums x"
     using sums_if'[OF \<open>g sums x\<close>] .
   have if_eq: "\<And>B T E. (if \<not> B then T else E) = (if B then E else T)"
     by auto
   have "?s sums y" using sums_if'[OF \<open>f sums y\<close>] .
   from this[unfolded sums_def, THEN LIMSEQ_Suc]
   have "(\<lambda>n. if even n then f (n div 2) else 0) sums y"
     by (simp add: lessThan_Suc_eq_insert_0 sum.atLeast1_atMost_eq image_Suc_lessThan
         if_eq sums_def cong del: if_weak_cong)
   from sums_add[OF g_sums this] show ?thesis
     by (simp only: if_sum)
 qed
 
 subsection \<open>Alternating series test / Leibniz formula\<close>
 (* FIXME: generalise these results from the reals via type classes? *)
 
 lemma sums_alternating_upper_lower:
   fixes a :: "nat \<Rightarrow> real"
   assumes mono: "\<And>n. a (Suc n) \<le> a n"
     and a_pos: "\<And>n. 0 \<le> a n"
     and "a \<longlonglongrightarrow> 0"
   shows "\<exists>l. ((\<forall>n. (\<Sum>i<2*n. (- 1)^i*a i) \<le> l) \<and> (\<lambda> n. \<Sum>i<2*n. (- 1)^i*a i) \<longlonglongrightarrow> l) \<and>
              ((\<forall>n. l \<le> (\<Sum>i<2*n + 1. (- 1)^i*a i)) \<and> (\<lambda> n. \<Sum>i<2*n + 1. (- 1)^i*a i) \<longlonglongrightarrow> l)"
   (is "\<exists>l. ((\<forall>n. ?f n \<le> l) \<and> _) \<and> ((\<forall>n. l \<le> ?g n) \<and> _)")
 proof (rule nested_sequence_unique)
   have fg_diff: "\<And>n. ?f n - ?g n = - a (2 * n)" by auto
 
   show "\<forall>n. ?f n \<le> ?f (Suc n)"
   proof
     show "?f n \<le> ?f (Suc n)" for n
       using mono[of "2*n"] by auto
   qed
   show "\<forall>n. ?g (Suc n) \<le> ?g n"
   proof
     show "?g (Suc n) \<le> ?g n" for n
       using mono[of "Suc (2*n)"] by auto
   qed
   show "\<forall>n. ?f n \<le> ?g n"
   proof
     show "?f n \<le> ?g n" for n
       using fg_diff a_pos by auto
   qed
   show "(\<lambda>n. ?f n - ?g n) \<longlonglongrightarrow> 0"
     unfolding fg_diff
   proof (rule LIMSEQ_I)
     fix r :: real
     assume "0 < r"
     with \<open>a \<longlonglongrightarrow> 0\<close>[THEN LIMSEQ_D] obtain N where "\<And> n. n \<ge> N \<Longrightarrow> norm (a n - 0) < r"
       by auto
     then have "\<forall>n \<ge> N. norm (- a (2 * n) - 0) < r"
       by auto
     then show "\<exists>N. \<forall>n \<ge> N. norm (- a (2 * n) - 0) < r"
       by auto
   qed
 qed
 
 lemma summable_Leibniz':
   fixes a :: "nat \<Rightarrow> real"
   assumes a_zero: "a \<longlonglongrightarrow> 0"
     and a_pos: "\<And>n. 0 \<le> a n"
     and a_monotone: "\<And>n. a (Suc n) \<le> a n"
   shows summable: "summable (\<lambda> n. (-1)^n * a n)"
     and "\<And>n. (\<Sum>i<2*n. (-1)^i*a i) \<le> (\<Sum>i. (-1)^i*a i)"
     and "(\<lambda>n. \<Sum>i<2*n. (-1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (-1)^i*a i)"
     and "\<And>n. (\<Sum>i. (-1)^i*a i) \<le> (\<Sum>i<2*n+1. (-1)^i*a i)"
     and "(\<lambda>n. \<Sum>i<2*n+1. (-1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (-1)^i*a i)"
 proof -
   let ?S = "\<lambda>n. (-1)^n * a n"
   let ?P = "\<lambda>n. \<Sum>i<n. ?S i"
   let ?f = "\<lambda>n. ?P (2 * n)"
   let ?g = "\<lambda>n. ?P (2 * n + 1)"
   obtain l :: real
     where below_l: "\<forall> n. ?f n \<le> l"
       and "?f \<longlonglongrightarrow> l"
       and above_l: "\<forall> n. l \<le> ?g n"
       and "?g \<longlonglongrightarrow> l"
     using sums_alternating_upper_lower[OF a_monotone a_pos a_zero] by blast
 
   let ?Sa = "\<lambda>m. \<Sum>n<m. ?S n"
   have "?Sa \<longlonglongrightarrow> l"
   proof (rule LIMSEQ_I)
     fix r :: real
     assume "0 < r"
     with \<open>?f \<longlonglongrightarrow> l\<close>[THEN LIMSEQ_D]
     obtain f_no where f: "\<And>n. n \<ge> f_no \<Longrightarrow> norm (?f n - l) < r"
       by auto
     from \<open>0 < r\<close> \<open>?g \<longlonglongrightarrow> l\<close>[THEN LIMSEQ_D]
     obtain g_no where g: "\<And>n. n \<ge> g_no \<Longrightarrow> norm (?g n - l) < r"
       by auto
     have "norm (?Sa n - l) < r" if "n \<ge> (max (2 * f_no) (2 * g_no))" for n
     proof -
       from that have "n \<ge> 2 * f_no" and "n \<ge> 2 * g_no" by auto
       show ?thesis
       proof (cases "even n")
         case True
         then have n_eq: "2 * (n div 2) = n"
           by (simp add: even_two_times_div_two)
         with \<open>n \<ge> 2 * f_no\<close> have "n div 2 \<ge> f_no"
           by auto
         from f[OF this] show ?thesis
           unfolding n_eq atLeastLessThanSuc_atLeastAtMost .
       next
         case False
         then have "even (n - 1)" by simp
         then have n_eq: "2 * ((n - 1) div 2) = n - 1"
           by (simp add: even_two_times_div_two)
         then have range_eq: "n - 1 + 1 = n"
           using odd_pos[OF False] by auto
         from n_eq \<open>n \<ge> 2 * g_no\<close> have "(n - 1) div 2 \<ge> g_no"
           by auto
         from g[OF this] show ?thesis
           by (simp only: n_eq range_eq)
       qed
     qed
     then show "\<exists>no. \<forall>n \<ge> no. norm (?Sa n - l) < r" by blast
   qed
   then have sums_l: "(\<lambda>i. (-1)^i * a i) sums l"
     by (simp only: sums_def)
   then show "summable ?S"
     by (auto simp: summable_def)
 
   have "l = suminf ?S" by (rule sums_unique[OF sums_l])
 
   fix n
   show "suminf ?S \<le> ?g n"
     unfolding sums_unique[OF sums_l, symmetric] using above_l by auto
   show "?f n \<le> suminf ?S"
     unfolding sums_unique[OF sums_l, symmetric] using below_l by auto
   show "?g \<longlonglongrightarrow> suminf ?S"
     using \<open>?g \<longlonglongrightarrow> l\<close> \<open>l = suminf ?S\<close> by auto
   show "?f \<longlonglongrightarrow> suminf ?S"
     using \<open>?f \<longlonglongrightarrow> l\<close> \<open>l = suminf ?S\<close> by auto
 qed
 
 theorem summable_Leibniz:
   fixes a :: "nat \<Rightarrow> real"
   assumes a_zero: "a \<longlonglongrightarrow> 0"
     and "monoseq a"
   shows "summable (\<lambda> n. (-1)^n * a n)" (is "?summable")
     and "0 < a 0 \<longrightarrow>
       (\<forall>n. (\<Sum>i. (- 1)^i*a i) \<in> { \<Sum>i<2*n. (- 1)^i * a i .. \<Sum>i<2*n+1. (- 1)^i * a i})" (is "?pos")
     and "a 0 < 0 \<longrightarrow>
       (\<forall>n. (\<Sum>i. (- 1)^i*a i) \<in> { \<Sum>i<2*n+1. (- 1)^i * a i .. \<Sum>i<2*n. (- 1)^i * a i})" (is "?neg")
     and "(\<lambda>n. \<Sum>i<2*n. (- 1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (- 1)^i*a i)" (is "?f")
     and "(\<lambda>n. \<Sum>i<2*n+1. (- 1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (- 1)^i*a i)" (is "?g")
 proof -
   have "?summable \<and> ?pos \<and> ?neg \<and> ?f \<and> ?g"
   proof (cases "(\<forall>n. 0 \<le> a n) \<and> (\<forall>m. \<forall>n\<ge>m. a n \<le> a m)")
     case True
     then have ord: "\<And>n m. m \<le> n \<Longrightarrow> a n \<le> a m"
       and ge0: "\<And>n. 0 \<le> a n"
       by auto
     have mono: "a (Suc n) \<le> a n" for n
       using ord[where n="Suc n" and m=n] by auto
     note leibniz = summable_Leibniz'[OF \<open>a \<longlonglongrightarrow> 0\<close> ge0]
     from leibniz[OF mono]
     show ?thesis using \<open>0 \<le> a 0\<close> by auto
   next
     let ?a = "\<lambda>n. - a n"
     case False
     with monoseq_le[OF \<open>monoseq a\<close> \<open>a \<longlonglongrightarrow> 0\<close>]
     have "(\<forall> n. a n \<le> 0) \<and> (\<forall>m. \<forall>n\<ge>m. a m \<le> a n)" by auto
     then have ord: "\<And>n m. m \<le> n \<Longrightarrow> ?a n \<le> ?a m" and ge0: "\<And> n. 0 \<le> ?a n"
       by auto
     have monotone: "?a (Suc n) \<le> ?a n" for n
       using ord[where n="Suc n" and m=n] by auto
     note leibniz =
       summable_Leibniz'[OF _ ge0, of "\<lambda>x. x",
         OF tendsto_minus[OF \<open>a \<longlonglongrightarrow> 0\<close>, unfolded minus_zero] monotone]
     have "summable (\<lambda> n. (-1)^n * ?a n)"
       using leibniz(1) by auto
     then obtain l where "(\<lambda> n. (-1)^n * ?a n) sums l"
       unfolding summable_def by auto
     from this[THEN sums_minus] have "(\<lambda> n. (-1)^n * a n) sums -l"
       by auto
     then have ?summable by (auto simp: summable_def)
     moreover
     have "\<bar>- a - - b\<bar> = \<bar>a - b\<bar>" for a b :: real
       unfolding minus_diff_minus by auto
 
     from suminf_minus[OF leibniz(1), unfolded mult_minus_right minus_minus]
     have move_minus: "(\<Sum>n. - ((- 1) ^ n * a n)) = - (\<Sum>n. (- 1) ^ n * a n)"
       by auto
 
     have ?pos using \<open>0 \<le> ?a 0\<close> by auto
     moreover have ?neg
       using leibniz(2,4)
       unfolding mult_minus_right sum_negf move_minus neg_le_iff_le
       by auto
     moreover have ?f and ?g
       using leibniz(3,5)[unfolded mult_minus_right sum_negf move_minus, THEN tendsto_minus_cancel]
       by auto
     ultimately show ?thesis by auto
   qed
   then show ?summable and ?pos and ?neg and ?f and ?g
     by safe
 qed
 
 
 subsection \<open>Term-by-Term Differentiability of Power Series\<close>
 
 definition diffs :: "(nat \<Rightarrow> 'a::ring_1) \<Rightarrow> nat \<Rightarrow> 'a"
   where "diffs c = (\<lambda>n. of_nat (Suc n) * c (Suc n))"
 
 text \<open>Lemma about distributing negation over it.\<close>
 lemma diffs_minus: "diffs (\<lambda>n. - c n) = (\<lambda>n. - diffs c n)"
   by (simp add: diffs_def)
 
 lemma diffs_equiv:
   fixes x :: "'a::{real_normed_vector,ring_1}"
   shows "summable (\<lambda>n. diffs c n * x^n) \<Longrightarrow>
     (\<lambda>n. of_nat n * c n * x^(n - Suc 0)) sums (\<Sum>n. diffs c n * x^n)"
   unfolding diffs_def
   by (simp add: summable_sums sums_Suc_imp)
 
 lemma lemma_termdiff1:
   fixes z :: "'a :: {monoid_mult,comm_ring}"
   shows "(\<Sum>p<m. (((z + h) ^ (m - p)) * (z ^ p)) - (z ^ m)) =
     (\<Sum>p<m. (z ^ p) * (((z + h) ^ (m - p)) - (z ^ (m - p))))"
   by (auto simp: algebra_simps power_add [symmetric])
 
 lemma sumr_diff_mult_const2: "sum f {..<n} - of_nat n * r = (\<Sum>i<n. f i - r)"
   for r :: "'a::ring_1"
   by (simp add: sum_subtractf)
 
 lemma lemma_termdiff2:
   fixes h :: "'a::field"
   assumes h: "h \<noteq> 0"
   shows "((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0) =
          h * (\<Sum>p< n - Suc 0. \<Sum>q< n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q))"
     (is "?lhs = ?rhs")
 proof (cases n)
   case (Suc m)
   have 0: "\<And>x k. (\<Sum>n<Suc k. h * (z ^ x * (z ^ (k - n) * (h + z) ^ n))) =
                  (\<Sum>j<Suc k.  h * ((h + z) ^ j * z ^ (x + k - j)))"
     by (auto simp add: power_add [symmetric] mult.commute intro: sum.cong)
   have *: "(\<Sum>i<m. z ^ i * ((z + h) ^ (m - i) - z ^ (m - i))) =
            (\<Sum>i<m. \<Sum>j<m - i. h * ((z + h) ^ j * z ^ (m - Suc j)))"
     by (force simp add: less_iff_Suc_add sum_distrib_left diff_power_eq_sum ac_simps 0
         simp del: sum.lessThan_Suc power_Suc intro: sum.cong)
   have "h * ?lhs = (z + h) ^ n - z ^ n - h * of_nat n * z ^ (n - Suc 0)"
     by (simp add: right_diff_distrib diff_divide_distrib h mult.assoc [symmetric])
   also have "... = h * ((\<Sum>p<Suc m. (z + h) ^ p * z ^ (m - p)) - of_nat (Suc m) * z ^ m)"
     by (simp add: Suc diff_power_eq_sum h right_diff_distrib [symmetric] mult.assoc
         del: power_Suc sum.lessThan_Suc of_nat_Suc)
   also have "... = h * ((\<Sum>p<Suc m. (z + h) ^ (m - p) * z ^ p) - of_nat (Suc m) * z ^ m)"
     by (subst sum.nat_diff_reindex[symmetric]) simp
   also have "... = h * (\<Sum>i<Suc m. (z + h) ^ (m - i) * z ^ i - z ^ m)"
     by (simp add: sum_subtractf)
   also have "... = h * ?rhs"
     by (simp add: lemma_termdiff1 sum_distrib_left Suc *)
   finally have "h * ?lhs = h * ?rhs" .
   then show ?thesis
     by (simp add: h)
 qed auto
 
 
 lemma real_sum_nat_ivl_bounded2:
   fixes K :: "'a::linordered_semidom"
   assumes f: "\<And>p::nat. p < n \<Longrightarrow> f p \<le> K" and K: "0 \<le> K"
   shows "sum f {..<n-k} \<le> of_nat n * K"
 proof -
   have "sum f {..<n-k} \<le> (\<Sum>i<n - k. K)"
     by (rule sum_mono [OF f]) auto
   also have "... \<le> of_nat n * K"
     by (auto simp: mult_right_mono K)
   finally show ?thesis .
 qed
 
 lemma lemma_termdiff3:
   fixes h z :: "'a::real_normed_field"
   assumes 1: "h \<noteq> 0"
     and 2: "norm z \<le> K"
     and 3: "norm (z + h) \<le> K"
   shows "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) \<le>
     of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
 proof -
   have "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) =
     norm (\<Sum>p<n - Suc 0. \<Sum>q<n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q)) * norm h"
     by (metis (lifting, no_types) lemma_termdiff2 [OF 1] mult.commute norm_mult)
   also have "\<dots> \<le> of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2)) * norm h"
   proof (rule mult_right_mono [OF _ norm_ge_zero])
     from norm_ge_zero 2 have K: "0 \<le> K"
       by (rule order_trans)
     have le_Kn: "norm ((z + h) ^ i * z ^ j) \<le> K ^ n" if "i + j = n" for i j n
     proof -
       have "norm (z + h) ^ i * norm z ^ j \<le> K ^ i * K ^ j"
         by (intro mult_mono power_mono 2 3 norm_ge_zero zero_le_power K)
       also have "... = K^n"
         by (metis power_add that)
       finally show ?thesis
         by (simp add: norm_mult norm_power) 
     qed
     then have "\<And>p q.
        \<lbrakk>p < n; q < n - Suc 0\<rbrakk> \<Longrightarrow> norm ((z + h) ^ q * z ^ (n - 2 - q)) \<le> K ^ (n - 2)"
       by (simp del: subst_all)
     then
     show "norm (\<Sum>p<n - Suc 0. \<Sum>q<n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q)) \<le>
         of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2))"
       by (intro order_trans [OF norm_sum]
           real_sum_nat_ivl_bounded2 mult_nonneg_nonneg of_nat_0_le_iff zero_le_power K)
   qed
   also have "\<dots> = of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
     by (simp only: mult.assoc)
   finally show ?thesis .
 qed
 
 lemma lemma_termdiff4:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and k :: real
   assumes k: "0 < k"
     and le: "\<And>h. h \<noteq> 0 \<Longrightarrow> norm h < k \<Longrightarrow> norm (f h) \<le> K * norm h"
   shows "f \<midarrow>0\<rightarrow> 0"
 proof (rule tendsto_norm_zero_cancel)
   show "(\<lambda>h. norm (f h)) \<midarrow>0\<rightarrow> 0"
   proof (rule real_tendsto_sandwich)
     show "eventually (\<lambda>h. 0 \<le> norm (f h)) (at 0)"
       by simp
     show "eventually (\<lambda>h. norm (f h) \<le> K * norm h) (at 0)"
       using k by (auto simp: eventually_at dist_norm le)
     show "(\<lambda>h. 0) \<midarrow>(0::'a)\<rightarrow> (0::real)"
       by (rule tendsto_const)
     have "(\<lambda>h. K * norm h) \<midarrow>(0::'a)\<rightarrow> K * norm (0::'a)"
       by (intro tendsto_intros)
     then show "(\<lambda>h. K * norm h) \<midarrow>(0::'a)\<rightarrow> 0"
       by simp
   qed
 qed
 
 lemma lemma_termdiff5:
   fixes g :: "'a::real_normed_vector \<Rightarrow> nat \<Rightarrow> 'b::banach"
     and k :: real
   assumes k: "0 < k"
     and f: "summable f"
     and le: "\<And>h n. h \<noteq> 0 \<Longrightarrow> norm h < k \<Longrightarrow> norm (g h n) \<le> f n * norm h"
   shows "(\<lambda>h. suminf (g h)) \<midarrow>0\<rightarrow> 0"
 proof (rule lemma_termdiff4 [OF k])
   fix h :: 'a
   assume "h \<noteq> 0" and "norm h < k"
   then have 1: "\<forall>n. norm (g h n) \<le> f n * norm h"
     by (simp add: le)
   then have "\<exists>N. \<forall>n\<ge>N. norm (norm (g h n)) \<le> f n * norm h"
     by simp
   moreover from f have 2: "summable (\<lambda>n. f n * norm h)"
     by (rule summable_mult2)
   ultimately have 3: "summable (\<lambda>n. norm (g h n))"
     by (rule summable_comparison_test)
   then have "norm (suminf (g h)) \<le> (\<Sum>n. norm (g h n))"
     by (rule summable_norm)
   also from 1 3 2 have "(\<Sum>n. norm (g h n)) \<le> (\<Sum>n. f n * norm h)"
     by (simp add: suminf_le)
   also from f have "(\<Sum>n. f n * norm h) = suminf f * norm h"
     by (rule suminf_mult2 [symmetric])
   finally show "norm (suminf (g h)) \<le> suminf f * norm h" .
 qed
 
 
 (* FIXME: Long proofs *)
 
 lemma termdiffs_aux:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes 1: "summable (\<lambda>n. diffs (diffs c) n * K ^ n)"
     and 2: "norm x < norm K"
   shows "(\<lambda>h. \<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<midarrow>0\<rightarrow> 0"
 proof -
   from dense [OF 2] obtain r where r1: "norm x < r" and r2: "r < norm K"
     by fast
   from norm_ge_zero r1 have r: "0 < r"
     by (rule order_le_less_trans)
   then have r_neq_0: "r \<noteq> 0" by simp
   show ?thesis
   proof (rule lemma_termdiff5)
     show "0 < r - norm x"
       using r1 by simp
     from r r2 have "norm (of_real r::'a) < norm K"
       by simp
     with 1 have "summable (\<lambda>n. norm (diffs (diffs c) n * (of_real r ^ n)))"
       by (rule powser_insidea)
     then have "summable (\<lambda>n. diffs (diffs (\<lambda>n. norm (c n))) n * r ^ n)"
       using r by (simp add: diffs_def norm_mult norm_power del: of_nat_Suc)
     then have "summable (\<lambda>n. of_nat n * diffs (\<lambda>n. norm (c n)) n * r ^ (n - Suc 0))"
       by (rule diffs_equiv [THEN sums_summable])
     also have "(\<lambda>n. of_nat n * diffs (\<lambda>n. norm (c n)) n * r ^ (n - Suc 0)) =
                (\<lambda>n. diffs (\<lambda>m. of_nat (m - Suc 0) * norm (c m) * inverse r) n * (r ^ n))"
       by (simp add: diffs_def r_neq_0 fun_eq_iff split: nat_diff_split)
     finally have "summable
       (\<lambda>n. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0))"
       by (rule diffs_equiv [THEN sums_summable])
     also have
       "(\<lambda>n. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0)) =
        (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))"
       by (rule ext) (simp add: r_neq_0 split: nat_diff_split)
     finally show "summable (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))" .
   next
     fix h :: 'a and n
     assume h: "h \<noteq> 0"
     assume "norm h < r - norm x"
     then have "norm x + norm h < r" by simp
     with norm_triangle_ineq 
     have xh: "norm (x + h) < r"
       by (rule order_le_less_trans)
     have "norm (((x + h) ^ n - x ^ n) / h - of_nat n * x ^ (n - Suc 0))
     \<le> real n * (real (n - Suc 0) * (r ^ (n - 2) * norm h))"
       by (metis (mono_tags, lifting) h mult.assoc lemma_termdiff3 less_eq_real_def r1 xh)
     then show "norm (c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<le>
       norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2) * norm h"
       by (simp only: norm_mult mult.assoc mult_left_mono [OF _ norm_ge_zero])
   qed
 qed
 
 lemma termdiffs:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes 1: "summable (\<lambda>n. c n * K ^ n)"
     and 2: "summable (\<lambda>n. (diffs c) n * K ^ n)"
     and 3: "summable (\<lambda>n. (diffs (diffs c)) n * K ^ n)"
     and 4: "norm x < norm K"
   shows "DERIV (\<lambda>x. \<Sum>n. c n * x^n) x :> (\<Sum>n. (diffs c) n * x^n)"
   unfolding DERIV_def
 proof (rule LIM_zero_cancel)
   show "(\<lambda>h. (suminf (\<lambda>n. c n * (x + h) ^ n) - suminf (\<lambda>n. c n * x^n)) / h
             - suminf (\<lambda>n. diffs c n * x^n)) \<midarrow>0\<rightarrow> 0"
   proof (rule LIM_equal2)
     show "0 < norm K - norm x"
       using 4 by (simp add: less_diff_eq)
   next
     fix h :: 'a
     assume "norm (h - 0) < norm K - norm x"
     then have "norm x + norm h < norm K" by simp
     then have 5: "norm (x + h) < norm K"
       by (rule norm_triangle_ineq [THEN order_le_less_trans])
     have "summable (\<lambda>n. c n * x^n)"
       and "summable (\<lambda>n. c n * (x + h) ^ n)"
       and "summable (\<lambda>n. diffs c n * x^n)"
       using 1 2 4 5 by (auto elim: powser_inside)
     then have "((\<Sum>n. c n * (x + h) ^ n) - (\<Sum>n. c n * x^n)) / h - (\<Sum>n. diffs c n * x^n) =
           (\<Sum>n. (c n * (x + h) ^ n - c n * x^n) / h - of_nat n * c n * x ^ (n - Suc 0))"
       by (intro sums_unique sums_diff sums_divide diffs_equiv summable_sums)
     then show "((\<Sum>n. c n * (x + h) ^ n) - (\<Sum>n. c n * x^n)) / h - (\<Sum>n. diffs c n * x^n) =
           (\<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0)))"
       by (simp add: algebra_simps)
   next
     show "(\<lambda>h. \<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<midarrow>0\<rightarrow> 0"
       by (rule termdiffs_aux [OF 3 4])
   qed
 qed
 
 subsection \<open>The Derivative of a Power Series Has the Same Radius of Convergence\<close>
 
 lemma termdiff_converges:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes K: "norm x < K"
     and sm: "\<And>x. norm x < K \<Longrightarrow> summable(\<lambda>n. c n * x ^ n)"
   shows "summable (\<lambda>n. diffs c n * x ^ n)"
 proof (cases "x = 0")
   case True
   then show ?thesis
     using powser_sums_zero sums_summable by auto
 next
   case False
   then have "K > 0"
     using K less_trans zero_less_norm_iff by blast
   then obtain r :: real where r: "norm x < norm r" "norm r < K" "r > 0"
     using K False
     by (auto simp: field_simps abs_less_iff add_pos_pos intro: that [of "(norm x + K) / 2"])
   have to0: "(\<lambda>n. of_nat n * (x / of_real r) ^ n) \<longlonglongrightarrow> 0"
     using r by (simp add: norm_divide powser_times_n_limit_0 [of "x / of_real r"])
   obtain N where N: "\<And>n. n\<ge>N \<Longrightarrow> real_of_nat n * norm x ^ n < r ^ n"
     using r LIMSEQ_D [OF to0, of 1]
     by (auto simp: norm_divide norm_mult norm_power field_simps)
   have "summable (\<lambda>n. (of_nat n * c n) * x ^ n)"
   proof (rule summable_comparison_test')
     show "summable (\<lambda>n. norm (c n * of_real r ^ n))"
       apply (rule powser_insidea [OF sm [of "of_real ((r+K)/2)"]])
       using N r norm_of_real [of "r + K", where 'a = 'a] by auto
     show "\<And>n. N \<le> n \<Longrightarrow> norm (of_nat n * c n * x ^ n) \<le> norm (c n * of_real r ^ n)"
       using N r by (fastforce simp add: norm_mult norm_power less_eq_real_def)
   qed
   then have "summable (\<lambda>n. (of_nat (Suc n) * c(Suc n)) * x ^ Suc n)"
     using summable_iff_shift [of "\<lambda>n. of_nat n * c n * x ^ n" 1]
     by simp
   then have "summable (\<lambda>n. (of_nat (Suc n) * c(Suc n)) * x ^ n)"
     using False summable_mult2 [of "\<lambda>n. (of_nat (Suc n) * c(Suc n) * x ^ n) * x" "inverse x"]
     by (simp add: mult.assoc) (auto simp: ac_simps)
   then show ?thesis
     by (simp add: diffs_def)
 qed
 
 lemma termdiff_converges_all:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes "\<And>x. summable (\<lambda>n. c n * x^n)"
   shows "summable (\<lambda>n. diffs c n * x^n)"
   by (rule termdiff_converges [where K = "1 + norm x"]) (use assms in auto)
 
 lemma termdiffs_strong:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes sm: "summable (\<lambda>n. c n * K ^ n)"
     and K: "norm x < norm K"
   shows "DERIV (\<lambda>x. \<Sum>n. c n * x^n) x :> (\<Sum>n. diffs c n * x^n)"
 proof -
   have "norm K + norm x < norm K + norm K"
     using K by force
   then have K2: "norm ((of_real (norm K) + of_real (norm x)) / 2 :: 'a) < norm K"
     by (auto simp: norm_triangle_lt norm_divide field_simps)
   then have [simp]: "norm ((of_real (norm K) + of_real (norm x)) :: 'a) < norm K * 2"
     by simp
   have "summable (\<lambda>n. c n * (of_real (norm x + norm K) / 2) ^ n)"
     by (metis K2 summable_norm_cancel [OF powser_insidea [OF sm]] add.commute of_real_add)
   moreover have "\<And>x. norm x < norm K \<Longrightarrow> summable (\<lambda>n. diffs c n * x ^ n)"
     by (blast intro: sm termdiff_converges powser_inside)
   moreover have "\<And>x. norm x < norm K \<Longrightarrow> summable (\<lambda>n. diffs(diffs c) n * x ^ n)"
     by (blast intro: sm termdiff_converges powser_inside)
   ultimately show ?thesis
     by (rule termdiffs [where K = "of_real (norm x + norm K) / 2"])
        (use K in \<open>auto simp: field_simps simp flip: of_real_add\<close>)
 qed
 
 lemma termdiffs_strong_converges_everywhere:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes "\<And>y. summable (\<lambda>n. c n * y ^ n)"
   shows "((\<lambda>x. \<Sum>n. c n * x^n) has_field_derivative (\<Sum>n. diffs c n * x^n)) (at x)"
   using termdiffs_strong[OF assms[of "of_real (norm x + 1)"], of x]
   by (force simp del: of_real_add)
 
 lemma termdiffs_strong':
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes "\<And>z. norm z < K \<Longrightarrow> summable (\<lambda>n. c n * z ^ n)"
   assumes "norm z < K"
   shows   "((\<lambda>z. \<Sum>n. c n * z^n) has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
 proof (rule termdiffs_strong)
   define L :: real where "L =  (norm z + K) / 2"
   have "0 \<le> norm z" by simp
   also note \<open>norm z < K\<close>
   finally have K: "K \<ge> 0" by simp
   from assms K have L: "L \<ge> 0" "norm z < L" "L < K" by (simp_all add: L_def)
   from L show "norm z < norm (of_real L :: 'a)" by simp
   from L show "summable (\<lambda>n. c n * of_real L ^ n)" by (intro assms(1)) simp_all
 qed
 
 lemma termdiffs_sums_strong:
   fixes z :: "'a :: {banach,real_normed_field}"
   assumes sums: "\<And>z. norm z < K \<Longrightarrow> (\<lambda>n. c n * z ^ n) sums f z"
   assumes deriv: "(f has_field_derivative f') (at z)"
   assumes norm: "norm z < K"
   shows   "(\<lambda>n. diffs c n * z ^ n) sums f'"
 proof -
   have summable: "summable (\<lambda>n. diffs c n * z^n)"
     by (intro termdiff_converges[OF norm] sums_summable[OF sums])
   from norm have "eventually (\<lambda>z. z \<in> norm -` {..<K}) (nhds z)"
     by (intro eventually_nhds_in_open open_vimage)
        (simp_all add: continuous_on_norm)
   hence eq: "eventually (\<lambda>z. (\<Sum>n. c n * z^n) = f z) (nhds z)"
     by eventually_elim (insert sums, simp add: sums_iff)
 
   have "((\<lambda>z. \<Sum>n. c n * z^n) has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
     by (intro termdiffs_strong'[OF _ norm] sums_summable[OF sums])
   hence "(f has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
     by (subst (asm) DERIV_cong_ev[OF refl eq refl])
   from this and deriv have "(\<Sum>n. diffs c n * z^n) = f'" by (rule DERIV_unique)
   with summable show ?thesis by (simp add: sums_iff)
 qed
 
 lemma isCont_powser:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes "summable (\<lambda>n. c n * K ^ n)"
   assumes "norm x < norm K"
   shows "isCont (\<lambda>x. \<Sum>n. c n * x^n) x"
   using termdiffs_strong[OF assms] by (blast intro!: DERIV_isCont)
 
 lemmas isCont_powser' = isCont_o2[OF _ isCont_powser]
 
 lemma isCont_powser_converges_everywhere:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes "\<And>y. summable (\<lambda>n. c n * y ^ n)"
   shows "isCont (\<lambda>x. \<Sum>n. c n * x^n) x"
   using termdiffs_strong[OF assms[of "of_real (norm x + 1)"], of x]
   by (force intro!: DERIV_isCont simp del: of_real_add)
 
 lemma powser_limit_0:
   fixes a :: "nat \<Rightarrow> 'a::{real_normed_field,banach}"
   assumes s: "0 < s"
     and sm: "\<And>x. norm x < s \<Longrightarrow> (\<lambda>n. a n * x ^ n) sums (f x)"
   shows "(f \<longlongrightarrow> a 0) (at 0)"
 proof -
   have "norm (of_real s / 2 :: 'a) < s"
     using s  by (auto simp: norm_divide)
   then have "summable (\<lambda>n. a n * (of_real s / 2) ^ n)"
     by (rule sums_summable [OF sm])
   then have "((\<lambda>x. \<Sum>n. a n * x ^ n) has_field_derivative (\<Sum>n. diffs a n * 0 ^ n)) (at 0)"
     by (rule termdiffs_strong) (use s in \<open>auto simp: norm_divide\<close>)
   then have "isCont (\<lambda>x. \<Sum>n. a n * x ^ n) 0"
     by (blast intro: DERIV_continuous)
   then have "((\<lambda>x. \<Sum>n. a n * x ^ n) \<longlongrightarrow> a 0) (at 0)"
     by (simp add: continuous_within)
   moreover have "(\<lambda>x. f x - (\<Sum>n. a n * x ^ n)) \<midarrow>0\<rightarrow> 0"
     apply (clarsimp simp: LIM_eq)
     apply (rule_tac x=s in exI)
     using s sm sums_unique by fastforce
   ultimately show ?thesis
     by (rule Lim_transform)
 qed
 
 lemma powser_limit_0_strong:
   fixes a :: "nat \<Rightarrow> 'a::{real_normed_field,banach}"
   assumes s: "0 < s"
     and sm: "\<And>x. x \<noteq> 0 \<Longrightarrow> norm x < s \<Longrightarrow> (\<lambda>n. a n * x ^ n) sums (f x)"
   shows "(f \<longlongrightarrow> a 0) (at 0)"
 proof -
   have *: "((\<lambda>x. if x = 0 then a 0 else f x) \<longlongrightarrow> a 0) (at 0)"
     by (rule powser_limit_0 [OF s]) (auto simp: powser_sums_zero sm)
   show ?thesis
     using "*" by (auto cong: Lim_cong_within)
 qed
 
 
 subsection \<open>Derivability of power series\<close>
 
 lemma DERIV_series':
   fixes f :: "real \<Rightarrow> nat \<Rightarrow> real"
   assumes DERIV_f: "\<And> n. DERIV (\<lambda> x. f x n) x0 :> (f' x0 n)"
     and allf_summable: "\<And> x. x \<in> {a <..< b} \<Longrightarrow> summable (f x)"
     and x0_in_I: "x0 \<in> {a <..< b}"
     and "summable (f' x0)"
     and "summable L"
     and L_def: "\<And>n x y. x \<in> {a <..< b} \<Longrightarrow> y \<in> {a <..< b} \<Longrightarrow> \<bar>f x n - f y n\<bar> \<le> L n * \<bar>x - y\<bar>"
   shows "DERIV (\<lambda> x. suminf (f x)) x0 :> (suminf (f' x0))"
   unfolding DERIV_def
 proof (rule LIM_I)
   fix r :: real
   assume "0 < r" then have "0 < r/3" by auto
 
   obtain N_L where N_L: "\<And> n. N_L \<le> n \<Longrightarrow> \<bar> \<Sum> i. L (i + n) \<bar> < r/3"
     using suminf_exist_split[OF \<open>0 < r/3\<close> \<open>summable L\<close>] by auto
 
   obtain N_f' where N_f': "\<And> n. N_f' \<le> n \<Longrightarrow> \<bar> \<Sum> i. f' x0 (i + n) \<bar> < r/3"
     using suminf_exist_split[OF \<open>0 < r/3\<close> \<open>summable (f' x0)\<close>] by auto
 
   let ?N = "Suc (max N_L N_f')"
   have "\<bar> \<Sum> i. f' x0 (i + ?N) \<bar> < r/3" (is "?f'_part < r/3")
     and L_estimate: "\<bar> \<Sum> i. L (i + ?N) \<bar> < r/3"
     using N_L[of "?N"] and N_f' [of "?N"] by auto
 
   let ?diff = "\<lambda>i x. (f (x0 + x) i - f x0 i) / x"
 
   let ?r = "r / (3 * real ?N)"
   from \<open>0 < r\<close> have "0 < ?r" by simp
 
   let ?s = "\<lambda>n. SOME s. 0 < s \<and> (\<forall> x. x \<noteq> 0 \<and> \<bar> x \<bar> < s \<longrightarrow> \<bar> ?diff n x - f' x0 n \<bar> < ?r)"
   define S' where "S' = Min (?s ` {..< ?N })"
 
   have "0 < S'"
     unfolding S'_def
   proof (rule iffD2[OF Min_gr_iff])
     show "\<forall>x \<in> (?s ` {..< ?N }). 0 < x"
     proof
       fix x
       assume "x \<in> ?s ` {..<?N}"
       then obtain n where "x = ?s n" and "n \<in> {..<?N}"
         using image_iff[THEN iffD1] by blast
       from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF \<open>0 < ?r\<close>, unfolded real_norm_def]
       obtain s where s_bound: "0 < s \<and> (\<forall>x. x \<noteq> 0 \<and> \<bar>x\<bar> < s \<longrightarrow> \<bar>?diff n x - f' x0 n\<bar> < ?r)"
         by auto
       have "0 < ?s n"
         by (rule someI2[where a=s]) (auto simp: s_bound simp del: of_nat_Suc)
       then show "0 < x" by (simp only: \<open>x = ?s n\<close>)
     qed
   qed auto
 
   define S where "S = min (min (x0 - a) (b - x0)) S'"
   then have "0 < S" and S_a: "S \<le> x0 - a" and S_b: "S \<le> b - x0"
     and "S \<le> S'" using x0_in_I and \<open>0 < S'\<close>
     by auto
 
   have "\<bar>(suminf (f (x0 + x)) - suminf (f x0)) / x - suminf (f' x0)\<bar> < r"
     if "x \<noteq> 0" and "\<bar>x\<bar> < S" for x
   proof -
     from that have x_in_I: "x0 + x \<in> {a <..< b}"
       using S_a S_b by auto
 
     note diff_smbl = summable_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
     note div_smbl = summable_divide[OF diff_smbl]
     note all_smbl = summable_diff[OF div_smbl \<open>summable (f' x0)\<close>]
     note ign = summable_ignore_initial_segment[where k="?N"]
     note diff_shft_smbl = summable_diff[OF ign[OF allf_summable[OF x_in_I]] ign[OF allf_summable[OF x0_in_I]]]
     note div_shft_smbl = summable_divide[OF diff_shft_smbl]
     note all_shft_smbl = summable_diff[OF div_smbl ign[OF \<open>summable (f' x0)\<close>]]
 
     have 1: "\<bar>(\<bar>?diff (n + ?N) x\<bar>)\<bar> \<le> L (n + ?N)" for n
     proof -
       have "\<bar>?diff (n + ?N) x\<bar> \<le> L (n + ?N) * \<bar>(x0 + x) - x0\<bar> / \<bar>x\<bar>"
         using divide_right_mono[OF L_def[OF x_in_I x0_in_I] abs_ge_zero]
         by (simp only: abs_divide)
       with \<open>x \<noteq> 0\<close> show ?thesis by auto
     qed
     note 2 = summable_rabs_comparison_test[OF _ ign[OF \<open>summable L\<close>]]
     from 1 have "\<bar> \<Sum> i. ?diff (i + ?N) x \<bar> \<le> (\<Sum> i. L (i + ?N))"
       by (metis (lifting) abs_idempotent
           order_trans[OF summable_rabs[OF 2] suminf_le[OF _ 2 ign[OF \<open>summable L\<close>]]])
     then have "\<bar>\<Sum>i. ?diff (i + ?N) x\<bar> \<le> r / 3" (is "?L_part \<le> r/3")
       using L_estimate by auto
 
     have "\<bar>\<Sum>n<?N. ?diff n x - f' x0 n\<bar> \<le> (\<Sum>n<?N. \<bar>?diff n x - f' x0 n\<bar>)" ..
     also have "\<dots> < (\<Sum>n<?N. ?r)"
     proof (rule sum_strict_mono)
       fix n
       assume "n \<in> {..< ?N}"
       have "\<bar>x\<bar> < S" using \<open>\<bar>x\<bar> < S\<close> .
       also have "S \<le> S'" using \<open>S \<le> S'\<close> .
       also have "S' \<le> ?s n"
         unfolding S'_def
       proof (rule Min_le_iff[THEN iffD2])
         have "?s n \<in> (?s ` {..<?N}) \<and> ?s n \<le> ?s n"
           using \<open>n \<in> {..< ?N}\<close> by auto
         then show "\<exists> a \<in> (?s ` {..<?N}). a \<le> ?s n"
           by blast
       qed auto
       finally have "\<bar>x\<bar> < ?s n" .
 
       from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF \<open>0 < ?r\<close>,
           unfolded real_norm_def diff_0_right, unfolded some_eq_ex[symmetric], THEN conjunct2]
       have "\<forall>x. x \<noteq> 0 \<and> \<bar>x\<bar> < ?s n \<longrightarrow> \<bar>?diff n x - f' x0 n\<bar> < ?r" .
       with \<open>x \<noteq> 0\<close> and \<open>\<bar>x\<bar> < ?s n\<close> show "\<bar>?diff n x - f' x0 n\<bar> < ?r"
         by blast
     qed auto
     also have "\<dots> = of_nat (card {..<?N}) * ?r"
       by (rule sum_constant)
     also have "\<dots> = real ?N * ?r"
       by simp
     also have "\<dots> = r/3"
       by (auto simp del: of_nat_Suc)
     finally have "\<bar>\<Sum>n<?N. ?diff n x - f' x0 n \<bar> < r / 3" (is "?diff_part < r / 3") .
 
     from suminf_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
     have "\<bar>(suminf (f (x0 + x)) - (suminf (f x0))) / x - suminf (f' x0)\<bar> =
         \<bar>\<Sum>n. ?diff n x - f' x0 n\<bar>"
       unfolding suminf_diff[OF div_smbl \<open>summable (f' x0)\<close>, symmetric]
       using suminf_divide[OF diff_smbl, symmetric] by auto
     also have "\<dots> \<le> ?diff_part + \<bar>(\<Sum>n. ?diff (n + ?N) x) - (\<Sum> n. f' x0 (n + ?N))\<bar>"
       unfolding suminf_split_initial_segment[OF all_smbl, where k="?N"]
       unfolding suminf_diff[OF div_shft_smbl ign[OF \<open>summable (f' x0)\<close>]]
       apply (simp only: add.commute)
       using abs_triangle_ineq by blast
     also have "\<dots> \<le> ?diff_part + ?L_part + ?f'_part"
       using abs_triangle_ineq4 by auto
     also have "\<dots> < r /3 + r/3 + r/3"
       using \<open>?diff_part < r/3\<close> \<open>?L_part \<le> r/3\<close> and \<open>?f'_part < r/3\<close>
       by (rule add_strict_mono [OF add_less_le_mono])
     finally show ?thesis
       by auto
   qed
   then show "\<exists>s > 0. \<forall> x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow>
       norm (((\<Sum>n. f (x0 + x) n) - (\<Sum>n. f x0 n)) / x - (\<Sum>n. f' x0 n)) < r"
     using \<open>0 < S\<close> by auto
 qed
 
 lemma DERIV_power_series':
   fixes f :: "nat \<Rightarrow> real"
   assumes converges: "\<And>x. x \<in> {-R <..< R} \<Longrightarrow> summable (\<lambda>n. f n * real (Suc n) * x^n)"
     and x0_in_I: "x0 \<in> {-R <..< R}"
     and "0 < R"
   shows "DERIV (\<lambda>x. (\<Sum>n. f n * x^(Suc n))) x0 :> (\<Sum>n. f n * real (Suc n) * x0^n)"
     (is "DERIV (\<lambda>x. suminf (?f x)) x0 :> suminf (?f' x0)")
 proof -
   have for_subinterval: "DERIV (\<lambda>x. suminf (?f x)) x0 :> suminf (?f' x0)"
     if "0 < R'" and "R' < R" and "-R' < x0" and "x0 < R'" for R'
   proof -
     from that have "x0 \<in> {-R' <..< R'}" and "R' \<in> {-R <..< R}" and "x0 \<in> {-R <..< R}"
       by auto
     show ?thesis
     proof (rule DERIV_series')
       show "summable (\<lambda> n. \<bar>f n * real (Suc n) * R'^n\<bar>)"
       proof -
         have "(R' + R) / 2 < R" and "0 < (R' + R) / 2"
           using \<open>0 < R'\<close> \<open>0 < R\<close> \<open>R' < R\<close> by (auto simp: field_simps)
         then have in_Rball: "(R' + R) / 2 \<in> {-R <..< R}"
           using \<open>R' < R\<close> by auto
         have "norm R' < norm ((R' + R) / 2)"
           using \<open>0 < R'\<close> \<open>0 < R\<close> \<open>R' < R\<close> by (auto simp: field_simps)
         from powser_insidea[OF converges[OF in_Rball] this] show ?thesis
           by auto
       qed
     next
       fix n x y
       assume "x \<in> {-R' <..< R'}" and "y \<in> {-R' <..< R'}"
       show "\<bar>?f x n - ?f y n\<bar> \<le> \<bar>f n * real (Suc n) * R'^n\<bar> * \<bar>x-y\<bar>"
       proof -
         have "\<bar>f n * x ^ (Suc n) - f n * y ^ (Suc n)\<bar> =
           (\<bar>f n\<bar> * \<bar>x-y\<bar>) * \<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar>"
           unfolding right_diff_distrib[symmetric] diff_power_eq_sum abs_mult
           by auto
         also have "\<dots> \<le> (\<bar>f n\<bar> * \<bar>x-y\<bar>) * (\<bar>real (Suc n)\<bar> * \<bar>R' ^ n\<bar>)"
         proof (rule mult_left_mono)
           have "\<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar> \<le> (\<Sum>p<Suc n. \<bar>x ^ p * y ^ (n - p)\<bar>)"
             by (rule sum_abs)
           also have "\<dots> \<le> (\<Sum>p<Suc n. R' ^ n)"
           proof (rule sum_mono)
             fix p
             assume "p \<in> {..<Suc n}"
             then have "p \<le> n" by auto
             have "\<bar>x^n\<bar> \<le> R'^n" if  "x \<in> {-R'<..<R'}" for n and x :: real
             proof -
               from that have "\<bar>x\<bar> \<le> R'" by auto
               then show ?thesis
                 unfolding power_abs by (rule power_mono) auto
             qed
             from mult_mono[OF this[OF \<open>x \<in> {-R'<..<R'}\<close>, of p] this[OF \<open>y \<in> {-R'<..<R'}\<close>, of "n-p"]]
               and \<open>0 < R'\<close>
             have "\<bar>x^p * y^(n - p)\<bar> \<le> R'^p * R'^(n - p)"
               unfolding abs_mult by auto
             then show "\<bar>x^p * y^(n - p)\<bar> \<le> R'^n"
               unfolding power_add[symmetric] using \<open>p \<le> n\<close> by auto
           qed
           also have "\<dots> = real (Suc n) * R' ^ n"
             unfolding sum_constant card_atLeastLessThan by auto
           finally show "\<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar> \<le> \<bar>real (Suc n)\<bar> * \<bar>R' ^ n\<bar>"
             unfolding abs_of_nonneg[OF zero_le_power[OF less_imp_le[OF \<open>0 < R'\<close>]]]
             by linarith
           show "0 \<le> \<bar>f n\<bar> * \<bar>x - y\<bar>"
             unfolding abs_mult[symmetric] by auto
         qed
         also have "\<dots> = \<bar>f n * real (Suc n) * R' ^ n\<bar> * \<bar>x - y\<bar>"
           unfolding abs_mult mult.assoc[symmetric] by algebra
         finally show ?thesis .
       qed
     next
       show "DERIV (\<lambda>x. ?f x n) x0 :> ?f' x0 n" for n
         by (auto intro!: derivative_eq_intros simp del: power_Suc)
     next
       fix x
       assume "x \<in> {-R' <..< R'}"
       then have "R' \<in> {-R <..< R}" and "norm x < norm R'"
         using assms \<open>R' < R\<close> by auto
       have "summable (\<lambda>n. f n * x^n)"
       proof (rule summable_comparison_test, intro exI allI impI)
         fix n
         have le: "\<bar>f n\<bar> * 1 \<le> \<bar>f n\<bar> * real (Suc n)"
           by (rule mult_left_mono) auto
         show "norm (f n * x^n) \<le> norm (f n * real (Suc n) * x^n)"
           unfolding real_norm_def abs_mult
           using le mult_right_mono by fastforce
       qed (rule powser_insidea[OF converges[OF \<open>R' \<in> {-R <..< R}\<close>] \<open>norm x < norm R'\<close>])
       from this[THEN summable_mult2[where c=x], simplified mult.assoc, simplified mult.commute]
       show "summable (?f x)" by auto
     next
       show "summable (?f' x0)"
         using converges[OF \<open>x0 \<in> {-R <..< R}\<close>] .
       show "x0 \<in> {-R' <..< R'}"
         using \<open>x0 \<in> {-R' <..< R'}\<close> .
     qed
   qed
   let ?R = "(R + \<bar>x0\<bar>) / 2"
   have "\<bar>x0\<bar> < ?R"
     using assms by (auto simp: field_simps)
   then have "- ?R < x0"
   proof (cases "x0 < 0")
     case True
     then have "- x0 < ?R"
       using \<open>\<bar>x0\<bar> < ?R\<close> by auto
     then show ?thesis
       unfolding neg_less_iff_less[symmetric, of "- x0"] by auto
   next
     case False
     have "- ?R < 0" using assms by auto
     also have "\<dots> \<le> x0" using False by auto
     finally show ?thesis .
   qed
   then have "0 < ?R" "?R < R" "- ?R < x0" and "x0 < ?R"
     using assms by (auto simp: field_simps)
   from for_subinterval[OF this] show ?thesis .
 qed
 
 lemma geometric_deriv_sums:
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes "norm z < 1"
   shows   "(\<lambda>n. of_nat (Suc n) * z ^ n) sums (1 / (1 - z)^2)"
 proof -
   have "(\<lambda>n. diffs (\<lambda>n. 1) n * z^n) sums (1 / (1 - z)^2)"
   proof (rule termdiffs_sums_strong)
     fix z :: 'a assume "norm z < 1"
     thus "(\<lambda>n. 1 * z^n) sums (1 / (1 - z))" by (simp add: geometric_sums)
   qed (insert assms, auto intro!: derivative_eq_intros simp: power2_eq_square)
   thus ?thesis unfolding diffs_def by simp
 qed
 
 lemma isCont_pochhammer [continuous_intros]: "isCont (\<lambda>z. pochhammer z n) z"
   for z :: "'a::real_normed_field"
   by (induct n) (auto simp: pochhammer_rec')
 
 lemma continuous_on_pochhammer [continuous_intros]: "continuous_on A (\<lambda>z. pochhammer z n)"
   for A :: "'a::real_normed_field set"
   by (intro continuous_at_imp_continuous_on ballI isCont_pochhammer)
 
 lemmas continuous_on_pochhammer' [continuous_intros] =
   continuous_on_compose2[OF continuous_on_pochhammer _ subset_UNIV]
 
 
 subsection \<open>Exponential Function\<close>
 
 definition exp :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
   where "exp = (\<lambda>x. \<Sum>n. x^n /\<^sub>R fact n)"
 
 lemma summable_exp_generic:
   fixes x :: "'a::{real_normed_algebra_1,banach}"
   defines S_def: "S \<equiv> \<lambda>n. x^n /\<^sub>R fact n"
   shows "summable S"
 proof -
   have S_Suc: "\<And>n. S (Suc n) = (x * S n) /\<^sub>R (Suc n)"
     unfolding S_def by (simp del: mult_Suc)
   obtain r :: real where r0: "0 < r" and r1: "r < 1"
     using dense [OF zero_less_one] by fast
   obtain N :: nat where N: "norm x < real N * r"
     using ex_less_of_nat_mult r0 by auto
   from r1 show ?thesis
   proof (rule summable_ratio_test [rule_format])
     fix n :: nat
     assume n: "N \<le> n"
     have "norm x \<le> real N * r"
       using N by (rule order_less_imp_le)
     also have "real N * r \<le> real (Suc n) * r"
       using r0 n by (simp add: mult_right_mono)
     finally have "norm x * norm (S n) \<le> real (Suc n) * r * norm (S n)"
       using norm_ge_zero by (rule mult_right_mono)
     then have "norm (x * S n) \<le> real (Suc n) * r * norm (S n)"
       by (rule order_trans [OF norm_mult_ineq])
     then have "norm (x * S n) / real (Suc n) \<le> r * norm (S n)"
       by (simp add: pos_divide_le_eq ac_simps)
     then show "norm (S (Suc n)) \<le> r * norm (S n)"
       by (simp add: S_Suc inverse_eq_divide)
   qed
 qed
 
 lemma summable_norm_exp: "summable (\<lambda>n. norm (x^n /\<^sub>R fact n))"
   for x :: "'a::{real_normed_algebra_1,banach}"
 proof (rule summable_norm_comparison_test [OF exI, rule_format])
   show "summable (\<lambda>n. norm x^n /\<^sub>R fact n)"
     by (rule summable_exp_generic)
   show "norm (x^n /\<^sub>R fact n) \<le> norm x^n /\<^sub>R fact n" for n
     by (simp add: norm_power_ineq)
 qed
 
 lemma summable_exp: "summable (\<lambda>n. inverse (fact n) * x^n)"
   for x :: "'a::{real_normed_field,banach}"
   using summable_exp_generic [where x=x]
   by (simp add: scaleR_conv_of_real nonzero_of_real_inverse)
 
 lemma exp_converges: "(\<lambda>n. x^n /\<^sub>R fact n) sums exp x"
   unfolding exp_def by (rule summable_exp_generic [THEN summable_sums])
 
 lemma exp_fdiffs:
   "diffs (\<lambda>n. inverse (fact n)) = (\<lambda>n. inverse (fact n :: 'a::{real_normed_field,banach}))"
   by (simp add: diffs_def mult_ac nonzero_inverse_mult_distrib nonzero_of_real_inverse
       del: mult_Suc of_nat_Suc)
 
 lemma diffs_of_real: "diffs (\<lambda>n. of_real (f n)) = (\<lambda>n. of_real (diffs f n))"
   by (simp add: diffs_def)
 
 lemma DERIV_exp [simp]: "DERIV exp x :> exp x"
   unfolding exp_def scaleR_conv_of_real
 proof (rule DERIV_cong)
   have sinv: "summable (\<lambda>n. of_real (inverse (fact n)) * x ^ n)" for x::'a
     by (rule exp_converges [THEN sums_summable, unfolded scaleR_conv_of_real])
   note xx = exp_converges [THEN sums_summable, unfolded scaleR_conv_of_real]
   show "((\<lambda>x. \<Sum>n. of_real (inverse (fact n)) * x ^ n) has_field_derivative
         (\<Sum>n. diffs (\<lambda>n. of_real (inverse (fact n))) n * x ^ n))  (at x)"
     by (rule termdiffs [where K="of_real (1 + norm x)"]) (simp_all only: diffs_of_real exp_fdiffs sinv norm_of_real)
   show "(\<Sum>n. diffs (\<lambda>n. of_real (inverse (fact n))) n * x ^ n) = (\<Sum>n. of_real (inverse (fact n)) * x ^ n)"
     by (simp add: diffs_of_real exp_fdiffs)
 qed
 
 declare DERIV_exp[THEN DERIV_chain2, derivative_intros]
   and DERIV_exp[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_exp[derivative_intros] = DERIV_exp[THEN DERIV_compose_FDERIV]
 
 lemma norm_exp: "norm (exp x) \<le> exp (norm x)"
 proof -
   from summable_norm[OF summable_norm_exp, of x]
   have "norm (exp x) \<le> (\<Sum>n. inverse (fact n) * norm (x^n))"
     by (simp add: exp_def)
   also have "\<dots> \<le> exp (norm x)"
     using summable_exp_generic[of "norm x"] summable_norm_exp[of x]
     by (auto simp: exp_def intro!: suminf_le norm_power_ineq)
   finally show ?thesis .
 qed
 
 lemma isCont_exp: "isCont exp x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_exp [THEN DERIV_isCont])
 
 lemma isCont_exp' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. exp (f x)) a"
   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   by (rule isCont_o2 [OF _ isCont_exp])
 
 lemma tendsto_exp [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. exp (f x)) \<longlongrightarrow> exp a) F"
   for f:: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   by (rule isCont_tendsto_compose [OF isCont_exp])
 
 lemma continuous_exp [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. exp (f x))"
   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   unfolding continuous_def by (rule tendsto_exp)
 
 lemma continuous_on_exp [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. exp (f x))"
   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   unfolding continuous_on_def by (auto intro: tendsto_exp)
 
 
 subsubsection \<open>Properties of the Exponential Function\<close>
 
 lemma exp_zero [simp]: "exp 0 = 1"
   unfolding exp_def by (simp add: scaleR_conv_of_real)
 
 lemma exp_series_add_commuting:
   fixes x y :: "'a::{real_normed_algebra_1,banach}"
   defines S_def: "S \<equiv> \<lambda>x n. x^n /\<^sub>R fact n"
   assumes comm: "x * y = y * x"
   shows "S (x + y) n = (\<Sum>i\<le>n. S x i * S y (n - i))"
 proof (induct n)
   case 0
   show ?case
     unfolding S_def by simp
 next
   case (Suc n)
   have S_Suc: "\<And>x n. S x (Suc n) = (x * S x n) /\<^sub>R real (Suc n)"
     unfolding S_def by (simp del: mult_Suc)
   then have times_S: "\<And>x n. x * S x n = real (Suc n) *\<^sub>R S x (Suc n)"
     by simp
   have S_comm: "\<And>n. S x n * y = y * S x n"
     by (simp add: power_commuting_commutes comm S_def)
 
   have "real (Suc n) *\<^sub>R S (x + y) (Suc n) = (x + y) * (\<Sum>i\<le>n. S x i * S y (n - i))"
     by (metis Suc.hyps times_S)
   also have "\<dots> = x * (\<Sum>i\<le>n. S x i * S y (n - i)) + y * (\<Sum>i\<le>n. S x i * S y (n - i))"
     by (rule distrib_right)
   also have "\<dots> = (\<Sum>i\<le>n. x * S x i * S y (n - i)) + (\<Sum>i\<le>n. S x i * y * S y (n - i))"
     by (simp add: sum_distrib_left ac_simps S_comm)
   also have "\<dots> = (\<Sum>i\<le>n. x * S x i * S y (n - i)) + (\<Sum>i\<le>n. S x i * (y * S y (n - i)))"
     by (simp add: ac_simps)
   also have "\<dots> = (\<Sum>i\<le>n. real (Suc i) *\<^sub>R (S x (Suc i) * S y (n - i))) 
                 + (\<Sum>i\<le>n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i)))"
     by (simp add: times_S Suc_diff_le)
   also have "(\<Sum>i\<le>n. real (Suc i) *\<^sub>R (S x (Suc i) * S y (n - i)))
            = (\<Sum>i\<le>Suc n. real i *\<^sub>R (S x i * S y (Suc n - i)))"
     by (subst sum.atMost_Suc_shift) simp
   also have "(\<Sum>i\<le>n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i)))
            = (\<Sum>i\<le>Suc n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i)))"
     by simp
   also have "(\<Sum>i\<le>Suc n. real i *\<^sub>R (S x i * S y (Suc n - i)))
            + (\<Sum>i\<le>Suc n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i))) 
            = (\<Sum>i\<le>Suc n. real (Suc n) *\<^sub>R (S x i * S y (Suc n - i)))"
     by (simp flip: sum.distrib scaleR_add_left of_nat_add) 
   also have "\<dots> = real (Suc n) *\<^sub>R (\<Sum>i\<le>Suc n. S x i * S y (Suc n - i))"
     by (simp only: scaleR_right.sum)
   finally show "S (x + y) (Suc n) = (\<Sum>i\<le>Suc n. S x i * S y (Suc n - i))"
     by (simp del: sum.cl_ivl_Suc)
 qed
 
 lemma exp_add_commuting: "x * y = y * x \<Longrightarrow> exp (x + y) = exp x * exp y"
   by (simp only: exp_def Cauchy_product summable_norm_exp exp_series_add_commuting)
 
 lemma exp_times_arg_commute: "exp A * A = A * exp A"
   by (simp add: exp_def suminf_mult[symmetric] summable_exp_generic power_commutes suminf_mult2)
 
 lemma exp_add: "exp (x + y) = exp x * exp y"
   for x y :: "'a::{real_normed_field,banach}"
   by (rule exp_add_commuting) (simp add: ac_simps)
 
 lemma exp_double: "exp(2 * z) = exp z ^ 2"
   by (simp add: exp_add_commuting mult_2 power2_eq_square)
 
 lemmas mult_exp_exp = exp_add [symmetric]
 
 lemma exp_of_real: "exp (of_real x) = of_real (exp x)"
   unfolding exp_def
   apply (subst suminf_of_real [OF summable_exp_generic])
   apply (simp add: scaleR_conv_of_real)
   done
 
 lemmas of_real_exp = exp_of_real[symmetric]
 
 corollary exp_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> exp z \<in> \<real>"
   by (metis Reals_cases Reals_of_real exp_of_real)
 
 lemma exp_not_eq_zero [simp]: "exp x \<noteq> 0"
 proof
   have "exp x * exp (- x) = 1"
     by (simp add: exp_add_commuting[symmetric])
   also assume "exp x = 0"
   finally show False by simp
 qed
 
 lemma exp_minus_inverse: "exp x * exp (- x) = 1"
   by (simp add: exp_add_commuting[symmetric])
 
 lemma exp_minus: "exp (- x) = inverse (exp x)"
   for x :: "'a::{real_normed_field,banach}"
   by (intro inverse_unique [symmetric] exp_minus_inverse)
 
 lemma exp_diff: "exp (x - y) = exp x / exp y"
   for x :: "'a::{real_normed_field,banach}"
   using exp_add [of x "- y"] by (simp add: exp_minus divide_inverse)
 
 lemma exp_of_nat_mult: "exp (of_nat n * x) = exp x ^ n"
   for x :: "'a::{real_normed_field,banach}"
   by (induct n) (auto simp: distrib_left exp_add mult.commute)
 
 corollary exp_of_nat2_mult: "exp (x * of_nat n) = exp x ^ n"
   for x :: "'a::{real_normed_field,banach}"
   by (metis exp_of_nat_mult mult_of_nat_commute)
 
 lemma exp_sum: "finite I \<Longrightarrow> exp (sum f I) = prod (\<lambda>x. exp (f x)) I"
   by (induct I rule: finite_induct) (auto simp: exp_add_commuting mult.commute)
 
 lemma exp_divide_power_eq:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes "n > 0"
   shows "exp (x / of_nat n) ^ n = exp x"
   using assms
 proof (induction n arbitrary: x)
   case (Suc n)
   show ?case
   proof (cases "n = 0")
     case True
     then show ?thesis by simp
   next
     case False
     have [simp]: "1 + (of_nat n * of_nat n + of_nat n * 2) \<noteq> (0::'a)"
       using of_nat_eq_iff [of "1 + n * n + n * 2" "0"]
       by simp
     from False have [simp]: "x * of_nat n / (1 + of_nat n) / of_nat n = x / (1 + of_nat n)"
       by simp
     have [simp]: "x / (1 + of_nat n) + x * of_nat n / (1 + of_nat n) = x"
       using of_nat_neq_0
       by (auto simp add: field_split_simps)
     show ?thesis
       using Suc.IH [of "x * of_nat n / (1 + of_nat n)"] False
       by (simp add: exp_add [symmetric])
   qed
 qed simp
 
 lemma exp_power_int:
   fixes  x :: "'a::{real_normed_field,banach}"
   shows "exp x powi n = exp (of_int n * x)"
 proof (cases "n \<ge> 0")
   case True
   have "exp x powi n = exp x ^ nat n"
     using True by (simp add: power_int_def)
   thus ?thesis
     using True by (subst (asm) exp_of_nat_mult [symmetric]) auto
 next
   case False
   have "exp x powi n = inverse (exp x ^ nat (-n))"
     using False by (simp add: power_int_def field_simps)
   also have "exp x ^ nat (-n) = exp (of_nat (nat (-n)) * x)"
     using False by (subst exp_of_nat_mult) auto
   also have "inverse \<dots> = exp (-(of_nat (nat (-n)) * x))"
     by (subst exp_minus) (auto simp: field_simps)
   also have "-(of_nat (nat (-n)) * x) = of_int n * x"
     using False by simp
   finally show ?thesis .
 qed
 
 
 subsubsection \<open>Properties of the Exponential Function on Reals\<close>
 
 text \<open>Comparisons of \<^term>\<open>exp x\<close> with zero.\<close>
 
 text \<open>Proof: because every exponential can be seen as a square.\<close>
 lemma exp_ge_zero [simp]: "0 \<le> exp x"
   for x :: real
 proof -
   have "0 \<le> exp (x/2) * exp (x/2)"
     by simp
   then show ?thesis
     by (simp add: exp_add [symmetric])
 qed
 
 lemma exp_gt_zero [simp]: "0 < exp x"
   for x :: real
   by (simp add: order_less_le)
 
 lemma not_exp_less_zero [simp]: "\<not> exp x < 0"
   for x :: real
   by (simp add: not_less)
 
 lemma not_exp_le_zero [simp]: "\<not> exp x \<le> 0"
   for x :: real
   by (simp add: not_le)
 
 lemma abs_exp_cancel [simp]: "\<bar>exp x\<bar> = exp x"
   for x :: real
   by simp
 
 text \<open>Strict monotonicity of exponential.\<close>
 
 lemma exp_ge_add_one_self_aux:
   fixes x :: real
   assumes "0 \<le> x"
   shows "1 + x \<le> exp x"
   using order_le_imp_less_or_eq [OF assms]
 proof
   assume "0 < x"
   have "1 + x \<le> (\<Sum>n<2. inverse (fact n) * x^n)"
     by (auto simp: numeral_2_eq_2)
   also have "\<dots> \<le> (\<Sum>n. inverse (fact n) * x^n)"
     using \<open>0 < x\<close> by (auto  simp add: zero_le_mult_iff intro: sum_le_suminf [OF summable_exp])
   finally show "1 + x \<le> exp x"
     by (simp add: exp_def)
 qed auto
 
 lemma exp_gt_one: "0 < x \<Longrightarrow> 1 < exp x"
   for x :: real
 proof -
   assume x: "0 < x"
   then have "1 < 1 + x" by simp
   also from x have "1 + x \<le> exp x"
     by (simp add: exp_ge_add_one_self_aux)
   finally show ?thesis .
 qed
 
 lemma exp_less_mono:
   fixes x y :: real
   assumes "x < y"
   shows "exp x < exp y"
 proof -
   from \<open>x < y\<close> have "0 < y - x" by simp
   then have "1 < exp (y - x)" by (rule exp_gt_one)
   then have "1 < exp y / exp x" by (simp only: exp_diff)
   then show "exp x < exp y" by simp
 qed
 
 lemma exp_less_cancel: "exp x < exp y \<Longrightarrow> x < y"
   for x y :: real
   unfolding linorder_not_le [symmetric]
   by (auto simp: order_le_less exp_less_mono)
 
 lemma exp_less_cancel_iff [iff]: "exp x < exp y \<longleftrightarrow> x < y"
   for x y :: real
   by (auto intro: exp_less_mono exp_less_cancel)
 
 lemma exp_le_cancel_iff [iff]: "exp x \<le> exp y \<longleftrightarrow> x \<le> y"
   for x y :: real
   by (auto simp: linorder_not_less [symmetric])
 
 lemma exp_inj_iff [iff]: "exp x = exp y \<longleftrightarrow> x = y"
   for x y :: real
   by (simp add: order_eq_iff)
 
 text \<open>Comparisons of \<^term>\<open>exp x\<close> with one.\<close>
 
 lemma one_less_exp_iff [simp]: "1 < exp x \<longleftrightarrow> 0 < x"
   for x :: real
   using exp_less_cancel_iff [where x = 0 and y = x] by simp
 
 lemma exp_less_one_iff [simp]: "exp x < 1 \<longleftrightarrow> x < 0"
   for x :: real
   using exp_less_cancel_iff [where x = x and y = 0] by simp
 
 lemma one_le_exp_iff [simp]: "1 \<le> exp x \<longleftrightarrow> 0 \<le> x"
   for x :: real
   using exp_le_cancel_iff [where x = 0 and y = x] by simp
 
 lemma exp_le_one_iff [simp]: "exp x \<le> 1 \<longleftrightarrow> x \<le> 0"
   for x :: real
   using exp_le_cancel_iff [where x = x and y = 0] by simp
 
 lemma exp_eq_one_iff [simp]: "exp x = 1 \<longleftrightarrow> x = 0"
   for x :: real
   using exp_inj_iff [where x = x and y = 0] by simp
 
 lemma lemma_exp_total: "1 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x \<and> x \<le> y - 1 \<and> exp x = y"
   for y :: real
 proof (rule IVT)
   assume "1 \<le> y"
   then have "0 \<le> y - 1" by simp
   then have "1 + (y - 1) \<le> exp (y - 1)"
     by (rule exp_ge_add_one_self_aux)
   then show "y \<le> exp (y - 1)" by simp
 qed (simp_all add: le_diff_eq)
 
 lemma exp_total: "0 < y \<Longrightarrow> \<exists>x. exp x = y"
   for y :: real
 proof (rule linorder_le_cases [of 1 y])
   assume "1 \<le> y"
   then show "\<exists>x. exp x = y"
     by (fast dest: lemma_exp_total)
 next
   assume "0 < y" and "y \<le> 1"
   then have "1 \<le> inverse y"
     by (simp add: one_le_inverse_iff)
   then obtain x where "exp x = inverse y"
     by (fast dest: lemma_exp_total)
   then have "exp (- x) = y"
     by (simp add: exp_minus)
   then show "\<exists>x. exp x = y" ..
 qed
 
 
 subsection \<open>Natural Logarithm\<close>
 
 class ln = real_normed_algebra_1 + banach +
   fixes ln :: "'a \<Rightarrow> 'a"
   assumes ln_one [simp]: "ln 1 = 0"
 
 definition powr :: "'a \<Rightarrow> 'a \<Rightarrow> 'a::ln"  (infixr "powr" 80)
   \<comment> \<open>exponentation via ln and exp\<close>
   where "x powr a \<equiv> if x = 0 then 0 else exp (a * ln x)"
 
 lemma powr_0 [simp]: "0 powr z = 0"
   by (simp add: powr_def)
 
 
 instantiation real :: ln
 begin
 
 definition ln_real :: "real \<Rightarrow> real"
   where "ln_real x = (THE u. exp u = x)"
 
 instance
   by intro_classes (simp add: ln_real_def)
 
 end
 
 lemma powr_eq_0_iff [simp]: "w powr z = 0 \<longleftrightarrow> w = 0"
   by (simp add: powr_def)
 
 lemma ln_exp [simp]: "ln (exp x) = x"
   for x :: real
   by (simp add: ln_real_def)
 
 lemma exp_ln [simp]: "0 < x \<Longrightarrow> exp (ln x) = x"
   for x :: real
   by (auto dest: exp_total)
 
 lemma exp_ln_iff [simp]: "exp (ln x) = x \<longleftrightarrow> 0 < x"
   for x :: real
   by (metis exp_gt_zero exp_ln)
 
 lemma ln_unique: "exp y = x \<Longrightarrow> ln x = y"
   for x :: real
   by (erule subst) (rule ln_exp)
 
 lemma ln_mult: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x * y) = ln x + ln y"
   for x :: real
   by (rule ln_unique) (simp add: exp_add)
 
 lemma ln_prod: "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f i > 0) \<Longrightarrow> ln (prod f I) = sum (\<lambda>x. ln(f x)) I"
   for f :: "'a \<Rightarrow> real"
   by (induct I rule: finite_induct) (auto simp: ln_mult prod_pos)
 
 lemma ln_inverse: "0 < x \<Longrightarrow> ln (inverse x) = - ln x"
   for x :: real
   by (rule ln_unique) (simp add: exp_minus)
 
 lemma ln_div: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x / y) = ln x - ln y"
   for x :: real
   by (rule ln_unique) (simp add: exp_diff)
 
 lemma ln_realpow: "0 < x \<Longrightarrow> ln (x^n) = real n * ln x"
   by (rule ln_unique) (simp add: exp_of_nat_mult)
 
 lemma ln_less_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x < ln y \<longleftrightarrow> x < y"
   for x :: real
   by (subst exp_less_cancel_iff [symmetric]) simp
 
 lemma ln_le_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x \<le> ln y \<longleftrightarrow> x \<le> y"
   for x :: real
   by (simp add: linorder_not_less [symmetric])
 
 lemma ln_mono: "\<And>x::real. \<lbrakk>x \<le> y; 0 < x; 0 < y\<rbrakk> \<Longrightarrow> ln x \<le> ln y"
   using ln_le_cancel_iff by presburger
 
 lemma ln_inj_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x = ln y \<longleftrightarrow> x = y"
   for x :: real
   by (simp add: order_eq_iff)
 
 lemma ln_add_one_self_le_self: "0 \<le> x \<Longrightarrow> ln (1 + x) \<le> x"
   for x :: real
   by (rule exp_le_cancel_iff [THEN iffD1]) (simp add: exp_ge_add_one_self_aux)
 
 lemma ln_less_self [simp]: "0 < x \<Longrightarrow> ln x < x"
   for x :: real
   by (rule order_less_le_trans [where y = "ln (1 + x)"]) (simp_all add: ln_add_one_self_le_self)
 
 lemma ln_ge_iff: "\<And>x::real. 0 < x \<Longrightarrow> y \<le> ln x \<longleftrightarrow> exp y \<le> x"
   using exp_le_cancel_iff exp_total by force
 
 lemma ln_ge_zero [simp]: "1 \<le> x \<Longrightarrow> 0 \<le> ln x"
   for x :: real
   using ln_le_cancel_iff [of 1 x] by simp
 
 lemma ln_ge_zero_imp_ge_one: "0 \<le> ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> x"
   for x :: real
   using ln_le_cancel_iff [of 1 x] by simp
 
 lemma ln_ge_zero_iff [simp]: "0 < x \<Longrightarrow> 0 \<le> ln x \<longleftrightarrow> 1 \<le> x"
   for x :: real
   using ln_le_cancel_iff [of 1 x] by simp
 
 lemma ln_less_zero_iff [simp]: "0 < x \<Longrightarrow> ln x < 0 \<longleftrightarrow> x < 1"
   for x :: real
   using ln_less_cancel_iff [of x 1] by simp
 
 lemma ln_le_zero_iff [simp]: "0 < x \<Longrightarrow> ln x \<le> 0 \<longleftrightarrow> x \<le> 1"
   for x :: real
   by (metis less_numeral_extra(1) ln_le_cancel_iff ln_one)
 
 lemma ln_gt_zero: "1 < x \<Longrightarrow> 0 < ln x"
   for x :: real
   using ln_less_cancel_iff [of 1 x] by simp
 
 lemma ln_gt_zero_imp_gt_one: "0 < ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 < x"
   for x :: real
   using ln_less_cancel_iff [of 1 x] by simp
 
 lemma ln_gt_zero_iff [simp]: "0 < x \<Longrightarrow> 0 < ln x \<longleftrightarrow> 1 < x"
   for x :: real
   using ln_less_cancel_iff [of 1 x] by simp
 
 lemma ln_eq_zero_iff [simp]: "0 < x \<Longrightarrow> ln x = 0 \<longleftrightarrow> x = 1"
   for x :: real
   using ln_inj_iff [of x 1] by simp
 
 lemma ln_less_zero: "0 < x \<Longrightarrow> x < 1 \<Longrightarrow> ln x < 0"
   for x :: real
   by simp
 
 lemma ln_neg_is_const: "x \<le> 0 \<Longrightarrow> ln x = (THE x. False)"
   for x :: real
   by (auto simp: ln_real_def intro!: arg_cong[where f = The])
 
 lemma powr_eq_one_iff [simp]:
   "a powr x = 1 \<longleftrightarrow> x = 0" if "a > 1" for a x :: real
   using that by (auto simp: powr_def split: if_splits)
 
 lemma isCont_ln:
   fixes x :: real
   assumes "x \<noteq> 0"
   shows "isCont ln x"
 proof (cases "0 < x")
   case True
   then have "isCont ln (exp (ln x))"
     by (intro isCont_inverse_function[where d = "\<bar>x\<bar>" and f = exp]) auto
   with True show ?thesis
     by simp
 next
   case False
   with \<open>x \<noteq> 0\<close> show "isCont ln x"
     unfolding isCont_def
     by (subst filterlim_cong[OF _ refl, of _ "nhds (ln 0)" _ "\<lambda>_. ln 0"])
        (auto simp: ln_neg_is_const not_less eventually_at dist_real_def
          intro!: exI[of _ "\<bar>x\<bar>"])
 qed
 
 lemma tendsto_ln [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. ln (f x)) \<longlongrightarrow> ln a) F"
   for a :: real
   by (rule isCont_tendsto_compose [OF isCont_ln])
 
 lemma continuous_ln:
   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. ln (f x :: real))"
   unfolding continuous_def by (rule tendsto_ln)
 
 lemma isCont_ln' [continuous_intros]:
   "continuous (at x) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x) (\<lambda>x. ln (f x :: real))"
   unfolding continuous_at by (rule tendsto_ln)
 
 lemma continuous_within_ln [continuous_intros]:
   "continuous (at x within s) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. ln (f x :: real))"
   unfolding continuous_within by (rule tendsto_ln)
 
 lemma continuous_on_ln [continuous_intros]:
   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. f x \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. ln (f x :: real))"
   unfolding continuous_on_def by (auto intro: tendsto_ln)
 
 lemma DERIV_ln: "0 < x \<Longrightarrow> DERIV ln x :> inverse x"
   for x :: real
   by (rule DERIV_inverse_function [where f=exp and a=0 and b="x+1"])
     (auto intro: DERIV_cong [OF DERIV_exp exp_ln] isCont_ln)
 
 lemma DERIV_ln_divide: "0 < x \<Longrightarrow> DERIV ln x :> 1/x"
   for x :: real
   by (rule DERIV_ln[THEN DERIV_cong]) (simp_all add: divide_inverse)
 
 declare DERIV_ln_divide[THEN DERIV_chain2, derivative_intros]
   and DERIV_ln_divide[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_ln[derivative_intros] = DERIV_ln[THEN DERIV_compose_FDERIV]
 
 lemma ln_series:
   assumes "0 < x" and "x < 2"
   shows "ln x = (\<Sum> n. (-1)^n * (1 / real (n + 1)) * (x - 1)^(Suc n))"
     (is "ln x = suminf (?f (x - 1))")
 proof -
   let ?f' = "\<lambda>x n. (-1)^n * (x - 1)^n"
 
   have "ln x - suminf (?f (x - 1)) = ln 1 - suminf (?f (1 - 1))"
   proof (rule DERIV_isconst3 [where x = x])
     fix x :: real
     assume "x \<in> {0 <..< 2}"
     then have "0 < x" and "x < 2" by auto
     have "norm (1 - x) < 1"
       using \<open>0 < x\<close> and \<open>x < 2\<close> by auto
     have "1/x = 1 / (1 - (1 - x))" by auto
     also have "\<dots> = (\<Sum> n. (1 - x)^n)"
       using geometric_sums[OF \<open>norm (1 - x) < 1\<close>] by (rule sums_unique)
     also have "\<dots> = suminf (?f' x)"
       unfolding power_mult_distrib[symmetric]
       by (rule arg_cong[where f=suminf], rule arg_cong[where f="(^)"], auto)
     finally have "DERIV ln x :> suminf (?f' x)"
       using DERIV_ln[OF \<open>0 < x\<close>] unfolding divide_inverse by auto
     moreover
     have repos: "\<And> h x :: real. h - 1 + x = h + x - 1" by auto
     have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :>
       (\<Sum>n. (-1)^n * (1 / real (n + 1)) * real (Suc n) * (x - 1) ^ n)"
     proof (rule DERIV_power_series')
       show "x - 1 \<in> {- 1<..<1}" and "(0 :: real) < 1"
         using \<open>0 < x\<close> \<open>x < 2\<close> by auto
     next
       fix x :: real
       assume "x \<in> {- 1<..<1}"
       then show "summable (\<lambda>n. (- 1) ^ n * (1 / real (n + 1)) * real (Suc n) * x^n)"
         by (simp add: abs_if flip: power_mult_distrib)
     qed
     then have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)"
       unfolding One_nat_def by auto
     then have "DERIV (\<lambda>x. suminf (?f (x - 1))) x :> suminf (?f' x)"
       unfolding DERIV_def repos .
     ultimately have "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> suminf (?f' x) - suminf (?f' x)"
       by (rule DERIV_diff)
     then show "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> 0" by auto
   qed (auto simp: assms)
   then show ?thesis by auto
 qed
 
 lemma exp_first_terms:
   fixes x :: "'a::{real_normed_algebra_1,banach}"
   shows "exp x = (\<Sum>n<k. inverse(fact n) *\<^sub>R (x ^ n)) + (\<Sum>n. inverse(fact (n + k)) *\<^sub>R (x ^ (n + k)))"
 proof -
   have "exp x = suminf (\<lambda>n. inverse(fact n) *\<^sub>R (x^n))"
     by (simp add: exp_def)
   also from summable_exp_generic have "\<dots> = (\<Sum> n. inverse(fact(n+k)) *\<^sub>R (x ^ (n + k))) +
     (\<Sum> n::nat<k. inverse(fact n) *\<^sub>R (x^n))" (is "_ = _ + ?a")
     by (rule suminf_split_initial_segment)
   finally show ?thesis by simp
 qed
 
 lemma exp_first_term: "exp x = 1 + (\<Sum>n. inverse (fact (Suc n)) *\<^sub>R (x ^ Suc n))"
   for x :: "'a::{real_normed_algebra_1,banach}"
   using exp_first_terms[of x 1] by simp
 
 lemma exp_first_two_terms: "exp x = 1 + x + (\<Sum>n. inverse (fact (n + 2)) *\<^sub>R (x ^ (n + 2)))"
   for x :: "'a::{real_normed_algebra_1,banach}"
   using exp_first_terms[of x 2] by (simp add: eval_nat_numeral)
 
 lemma exp_bound:
   fixes x :: real
   assumes a: "0 \<le> x"
     and b: "x \<le> 1"
   shows "exp x \<le> 1 + x + x\<^sup>2"
 proof -
   have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n + 2))) \<le> x\<^sup>2"
   proof -
     have "(\<lambda>n. x\<^sup>2 / 2 * (1/2) ^ n) sums (x\<^sup>2 / 2 * (1 / (1 - 1/2)))"
       by (intro sums_mult geometric_sums) simp
     then have sumsx: "(\<lambda>n. x\<^sup>2 / 2 * (1/2) ^ n) sums x\<^sup>2"
       by simp
     have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n + 2))) \<le> suminf (\<lambda>n. (x\<^sup>2/2) * ((1/2)^n))"
     proof (intro suminf_le allI)
       show "inverse (fact (n + 2)) * x ^ (n + 2) \<le> (x\<^sup>2/2) * ((1/2)^n)" for n :: nat
       proof -
         have "(2::nat) * 2 ^ n \<le> fact (n + 2)"
           by (induct n) simp_all
         then have "real ((2::nat) * 2 ^ n) \<le> real_of_nat (fact (n + 2))"
           by (simp only: of_nat_le_iff)
         then have "((2::real) * 2 ^ n) \<le> fact (n + 2)"
           unfolding of_nat_fact by simp
         then have "inverse (fact (n + 2)) \<le> inverse ((2::real) * 2 ^ n)"
           by (rule le_imp_inverse_le) simp
         then have "inverse (fact (n + 2)) \<le> 1/(2::real) * (1/2)^n"
           by (simp add: power_inverse [symmetric])
         then have "inverse (fact (n + 2)) * (x^n * x\<^sup>2) \<le> 1/2 * (1/2)^n * (1 * x\<^sup>2)"
           by (rule mult_mono) (rule mult_mono, simp_all add: power_le_one a b)
         then show ?thesis
           unfolding power_add by (simp add: ac_simps del: fact_Suc)
       qed
       show "summable (\<lambda>n. inverse (fact (n + 2)) * x ^ (n + 2))"
         by (rule summable_exp [THEN summable_ignore_initial_segment])
       show "summable (\<lambda>n. x\<^sup>2 / 2 * (1/2) ^ n)"
         by (rule sums_summable [OF sumsx])
     qed
     also have "\<dots> = x\<^sup>2"
       by (rule sums_unique [THEN sym]) (rule sumsx)
     finally show ?thesis .
   qed
   then show ?thesis
     unfolding exp_first_two_terms by auto
 qed
 
 corollary exp_half_le2: "exp(1/2) \<le> (2::real)"
   using exp_bound [of "1/2"]
   by (simp add: field_simps)
 
 corollary exp_le: "exp 1 \<le> (3::real)"
   using exp_bound [of 1]
   by (simp add: field_simps)
 
 lemma exp_bound_half: "norm z \<le> 1/2 \<Longrightarrow> norm (exp z) \<le> 2"
   by (blast intro: order_trans intro!: exp_half_le2 norm_exp)
 
 lemma exp_bound_lemma:
   assumes "norm z \<le> 1/2"
   shows "norm (exp z) \<le> 1 + 2 * norm z"
 proof -
   have *: "(norm z)\<^sup>2 \<le> norm z * 1"
     unfolding power2_eq_square
     by (rule mult_left_mono) (use assms in auto)
   have "norm (exp z) \<le> exp (norm z)"
     by (rule norm_exp)
   also have "\<dots> \<le> 1 + (norm z) + (norm z)\<^sup>2"
     using assms exp_bound by auto
   also have "\<dots> \<le> 1 + 2 * norm z"
     using * by auto
   finally show ?thesis .
 qed
 
 lemma real_exp_bound_lemma: "0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> exp x \<le> 1 + 2 * x"
   for x :: real
   using exp_bound_lemma [of x] by simp
 
 lemma ln_one_minus_pos_upper_bound:
   fixes x :: real
   assumes a: "0 \<le> x" and b: "x < 1"
   shows "ln (1 - x) \<le> - x"
 proof -
   have "(1 - x) * (1 + x + x\<^sup>2) = 1 - x^3"
     by (simp add: algebra_simps power2_eq_square power3_eq_cube)
   also have "\<dots> \<le> 1"
     by (auto simp: a)
   finally have "(1 - x) * (1 + x + x\<^sup>2) \<le> 1" .
   moreover have c: "0 < 1 + x + x\<^sup>2"
     by (simp add: add_pos_nonneg a)
   ultimately have "1 - x \<le> 1 / (1 + x + x\<^sup>2)"
     by (elim mult_imp_le_div_pos)
   also have "\<dots> \<le> 1 / exp x"
     by (metis a abs_one b exp_bound exp_gt_zero frac_le less_eq_real_def real_sqrt_abs
         real_sqrt_pow2_iff real_sqrt_power)
   also have "\<dots> = exp (- x)"
     by (auto simp: exp_minus divide_inverse)
   finally have "1 - x \<le> exp (- x)" .
   also have "1 - x = exp (ln (1 - x))"
     by (metis b diff_0 exp_ln_iff less_iff_diff_less_0 minus_diff_eq)
   finally have "exp (ln (1 - x)) \<le> exp (- x)" .
   then show ?thesis
     by (auto simp only: exp_le_cancel_iff)
 qed
 
 lemma exp_ge_add_one_self [simp]: "1 + x \<le> exp x"
   for x :: real
 proof (cases "0 \<le> x \<or> x \<le> -1")
   case True
   then show ?thesis
     by (meson exp_ge_add_one_self_aux exp_ge_zero order.trans real_add_le_0_iff)
 next
   case False
   then have ln1: "ln (1 + x) \<le> x"
     using ln_one_minus_pos_upper_bound [of "-x"] by simp
   have "1 + x = exp (ln (1 + x))"
     using False by auto
   also have "\<dots> \<le> exp x"
     by (simp add: ln1)
   finally show ?thesis .
 qed
 
 lemma ln_one_plus_pos_lower_bound:
   fixes x :: real
   assumes a: "0 \<le> x" and b: "x \<le> 1"
   shows "x - x\<^sup>2 \<le> ln (1 + x)"
 proof -
   have "exp (x - x\<^sup>2) = exp x / exp (x\<^sup>2)"
     by (rule exp_diff)
   also have "\<dots> \<le> (1 + x + x\<^sup>2) / exp (x \<^sup>2)"
     by (metis a b divide_right_mono exp_bound exp_ge_zero)
   also have "\<dots> \<le> (1 + x + x\<^sup>2) / (1 + x\<^sup>2)"
     by (simp add: a divide_left_mono add_pos_nonneg)
   also from a have "\<dots> \<le> 1 + x"
     by (simp add: field_simps add_strict_increasing zero_le_mult_iff)
   finally have "exp (x - x\<^sup>2) \<le> 1 + x" .
   also have "\<dots> = exp (ln (1 + x))"
   proof -
     from a have "0 < 1 + x" by auto
     then show ?thesis
       by (auto simp only: exp_ln_iff [THEN sym])
   qed
   finally have "exp (x - x\<^sup>2) \<le> exp (ln (1 + x))" .
   then show ?thesis
     by (metis exp_le_cancel_iff)
 qed
 
 lemma ln_one_minus_pos_lower_bound:
   fixes x :: real
   assumes a: "0 \<le> x" and b: "x \<le> 1/2"
   shows "- x - 2 * x\<^sup>2 \<le> ln (1 - x)"
 proof -
   from b have c: "x < 1" by auto
   then have "ln (1 - x) = - ln (1 + x / (1 - x))"
     by (auto simp: ln_inverse [symmetric] field_simps intro: arg_cong [where f=ln])
   also have "- (x / (1 - x)) \<le> \<dots>"
   proof -
     have "ln (1 + x / (1 - x)) \<le> x / (1 - x)"
       using a c by (intro ln_add_one_self_le_self) auto
     then show ?thesis
       by auto
   qed
   also have "- (x / (1 - x)) = - x / (1 - x)"
     by auto
   finally have d: "- x / (1 - x) \<le> ln (1 - x)" .
   have "0 < 1 - x" using a b by simp
   then have e: "- x - 2 * x\<^sup>2 \<le> - x / (1 - x)"
     using mult_right_le_one_le[of "x * x" "2 * x"] a b
     by (simp add: field_simps power2_eq_square)
   from e d show "- x - 2 * x\<^sup>2 \<le> ln (1 - x)"
     by (rule order_trans)
 qed
 
 lemma ln_add_one_self_le_self2:
   fixes x :: real
   shows "-1 < x \<Longrightarrow> ln (1 + x) \<le> x"
   by (metis diff_gt_0_iff_gt diff_minus_eq_add exp_ge_add_one_self exp_le_cancel_iff exp_ln minus_less_iff)
 
 lemma abs_ln_one_plus_x_minus_x_bound_nonneg:
   fixes x :: real
   assumes x: "0 \<le> x" and x1: "x \<le> 1"
   shows "\<bar>ln (1 + x) - x\<bar> \<le> x\<^sup>2"
 proof -
   from x have "ln (1 + x) \<le> x"
     by (rule ln_add_one_self_le_self)
   then have "ln (1 + x) - x \<le> 0"
     by simp
   then have "\<bar>ln(1 + x) - x\<bar> = - (ln(1 + x) - x)"
     by (rule abs_of_nonpos)
   also have "\<dots> = x - ln (1 + x)"
     by simp
   also have "\<dots> \<le> x\<^sup>2"
   proof -
     from x x1 have "x - x\<^sup>2 \<le> ln (1 + x)"
       by (intro ln_one_plus_pos_lower_bound)
     then show ?thesis
       by simp
   qed
   finally show ?thesis .
 qed
 
 lemma abs_ln_one_plus_x_minus_x_bound_nonpos:
   fixes x :: real
   assumes a: "-(1/2) \<le> x" and b: "x \<le> 0"
   shows "\<bar>ln (1 + x) - x\<bar> \<le> 2 * x\<^sup>2"
 proof -
   have *: "- (-x) - 2 * (-x)\<^sup>2 \<le> ln (1 - (- x))"
     by (metis a b diff_zero ln_one_minus_pos_lower_bound minus_diff_eq neg_le_iff_le) 
   have "\<bar>ln (1 + x) - x\<bar> = x - ln (1 - (- x))"
     using a ln_add_one_self_le_self2 [of x] by (simp add: abs_if)
   also have "\<dots> \<le> 2 * x\<^sup>2"
     using * by (simp add: algebra_simps)
   finally show ?thesis .
 qed
 
 lemma abs_ln_one_plus_x_minus_x_bound:
   fixes x :: real
   assumes "\<bar>x\<bar> \<le> 1/2"
   shows "\<bar>ln (1 + x) - x\<bar> \<le> 2 * x\<^sup>2"
 proof (cases "0 \<le> x")
   case True
   then show ?thesis
     using abs_ln_one_plus_x_minus_x_bound_nonneg assms by fastforce
 next
   case False
   then show ?thesis
     using abs_ln_one_plus_x_minus_x_bound_nonpos assms by auto
 qed
 
 lemma ln_x_over_x_mono:
   fixes x :: real
   assumes x: "exp 1 \<le> x" "x \<le> y"
   shows "ln y / y \<le> ln x / x"
 proof -
   note x
   moreover have "0 < exp (1::real)" by simp
   ultimately have a: "0 < x" and b: "0 < y"
     by (fast intro: less_le_trans order_trans)+
   have "x * ln y - x * ln x = x * (ln y - ln x)"
     by (simp add: algebra_simps)
   also have "\<dots> = x * ln (y / x)"
     by (simp only: ln_div a b)
   also have "y / x = (x + (y - x)) / x"
     by simp
   also have "\<dots> = 1 + (y - x) / x"
     using x a by (simp add: field_simps)
   also have "x * ln (1 + (y - x) / x) \<le> x * ((y - x) / x)"
     using x a
     by (intro mult_left_mono ln_add_one_self_le_self) simp_all
   also have "\<dots> = y - x"
     using a by simp
   also have "\<dots> = (y - x) * ln (exp 1)" by simp
   also have "\<dots> \<le> (y - x) * ln x"
     using a x exp_total of_nat_1 x(1)  by (fastforce intro: mult_left_mono)
   also have "\<dots> = y * ln x - x * ln x"
     by (rule left_diff_distrib)
   finally have "x * ln y \<le> y * ln x"
     by arith
   then have "ln y \<le> (y * ln x) / x"
     using a by (simp add: field_simps)
   also have "\<dots> = y * (ln x / x)" by simp
   finally show ?thesis
     using b by (simp add: field_simps)
 qed
 
 lemma ln_le_minus_one: "0 < x \<Longrightarrow> ln x \<le> x - 1"
   for x :: real
   using exp_ge_add_one_self[of "ln x"] by simp
 
 corollary ln_diff_le: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x - ln y \<le> (x - y) / y"
   for x :: real
   by (simp add: ln_div [symmetric] diff_divide_distrib ln_le_minus_one)
 
 lemma ln_eq_minus_one:
   fixes x :: real
   assumes "0 < x" "ln x = x - 1"
   shows "x = 1"
 proof -
   let ?l = "\<lambda>y. ln y - y + 1"
   have D: "\<And>x::real. 0 < x \<Longrightarrow> DERIV ?l x :> (1/x - 1)"
     by (auto intro!: derivative_eq_intros)
   show ?thesis
   proof (cases rule: linorder_cases)
     assume "x < 1"
     from dense[OF \<open>x < 1\<close>] obtain a where "x < a" "a < 1" by blast
     from \<open>x < a\<close> have "?l x < ?l a"
     proof (rule DERIV_pos_imp_increasing)
       fix y
       assume "x \<le> y" "y \<le> a"
       with \<open>0 < x\<close> \<open>a < 1\<close> have "0 < 1 / y - 1" "0 < y"
         by (auto simp: field_simps)
       with D show "\<exists>z. DERIV ?l y :> z \<and> 0 < z" by blast
     qed
     also have "\<dots> \<le> 0"
       using ln_le_minus_one \<open>0 < x\<close> \<open>x < a\<close> by (auto simp: field_simps)
     finally show "x = 1" using assms by auto
   next
     assume "1 < x"
     from dense[OF this] obtain a where "1 < a" "a < x" by blast
     from \<open>a < x\<close> have "?l x < ?l a"
     proof (rule DERIV_neg_imp_decreasing)
       fix y
       assume "a \<le> y" "y \<le> x"
       with \<open>1 < a\<close> have "1 / y - 1 < 0" "0 < y"
         by (auto simp: field_simps)
       with D show "\<exists>z. DERIV ?l y :> z \<and> z < 0"
         by blast
     qed
     also have "\<dots> \<le> 0"
       using ln_le_minus_one \<open>1 < a\<close> by (auto simp: field_simps)
     finally show "x = 1" using assms by auto
   next
     assume "x = 1"
     then show ?thesis by simp
   qed
 qed
 
 lemma ln_add_one_self_less_self:
   fixes x :: real
   assumes "x > 0" 
   shows "ln (1 + x) < x"
   by (smt (verit, best) assms ln_eq_minus_one ln_le_minus_one)
 
 lemma ln_x_over_x_tendsto_0: "((\<lambda>x::real. ln x / x) \<longlongrightarrow> 0) at_top"
 proof (rule lhospital_at_top_at_top[where f' = inverse and g' = "\<lambda>_. 1"])
   from eventually_gt_at_top[of "0::real"]
   show "\<forall>\<^sub>F x in at_top. (ln has_real_derivative inverse x) (at x)"
     by eventually_elim (auto intro!: derivative_eq_intros simp: field_simps)
 qed (use tendsto_inverse_0 in
       \<open>auto simp: filterlim_ident dest!: tendsto_mono[OF at_top_le_at_infinity]\<close>)
 
 corollary exp_1_gt_powr:
   assumes "x > (0::real)"
   shows   "exp 1 > (1 + 1/x) powr x" 
 proof -
   have "ln (1 + 1/x) < 1/x"
     using ln_add_one_self_less_self assms by simp
   thus "exp 1 > (1 + 1/x) powr x" using assms
     by (simp add: field_simps powr_def)
 qed
 
 lemma exp_ge_one_plus_x_over_n_power_n:
   assumes "x \<ge> - real n" "n > 0"
   shows "(1 + x / of_nat n) ^ n \<le> exp x"
 proof (cases "x = - of_nat n")
   case False
   from assms False have "(1 + x / of_nat n) ^ n = exp (of_nat n * ln (1 + x / of_nat n))"
     by (subst exp_of_nat_mult, subst exp_ln) (simp_all add: field_simps)
   also from assms False have "ln (1 + x / real n) \<le> x / real n"
     by (intro ln_add_one_self_le_self2) (simp_all add: field_simps)
   with assms have "exp (of_nat n * ln (1 + x / of_nat n)) \<le> exp x"
     by (simp add: field_simps)
   finally show ?thesis .
 next
   case True
   then show ?thesis by (simp add: zero_power)
 qed
 
 lemma exp_ge_one_minus_x_over_n_power_n:
   assumes "x \<le> real n" "n > 0"
   shows "(1 - x / of_nat n) ^ n \<le> exp (-x)"
   using exp_ge_one_plus_x_over_n_power_n[of n "-x"] assms by simp
 
 lemma exp_at_bot: "(exp \<longlongrightarrow> (0::real)) at_bot"
   unfolding tendsto_Zfun_iff
 proof (rule ZfunI, simp add: eventually_at_bot_dense)
   fix r :: real
   assume "0 < r"
   have "exp x < r" if "x < ln r" for x
     by (metis \<open>0 < r\<close> exp_less_mono exp_ln that)
   then show "\<exists>k. \<forall>n<k. exp n < r" by auto
 qed
 
 lemma exp_at_top: "LIM x at_top. exp x :: real :> at_top"
   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. True" and P="\<lambda>x. 0 < x" and g=ln])
     (auto intro: eventually_gt_at_top)
 
 lemma lim_exp_minus_1: "((\<lambda>z::'a. (exp(z) - 1) / z) \<longlongrightarrow> 1) (at 0)"
   for x :: "'a::{real_normed_field,banach}"
 proof -
   have "((\<lambda>z::'a. exp(z) - 1) has_field_derivative 1) (at 0)"
     by (intro derivative_eq_intros | simp)+
   then show ?thesis
     by (simp add: Deriv.has_field_derivative_iff)
 qed
 
 lemma ln_at_0: "LIM x at_right 0. ln (x::real) :> at_bot"
   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g=exp])
      (auto simp: eventually_at_filter)
 
 lemma ln_at_top: "LIM x at_top. ln (x::real) :> at_top"
   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g=exp])
      (auto intro: eventually_gt_at_top)
 
 lemma filtermap_ln_at_top: "filtermap (ln::real \<Rightarrow> real) at_top = at_top"
   by (intro filtermap_fun_inverse[of exp] exp_at_top ln_at_top) auto
 
 lemma filtermap_exp_at_top: "filtermap (exp::real \<Rightarrow> real) at_top = at_top"
   by (intro filtermap_fun_inverse[of ln] exp_at_top ln_at_top)
      (auto simp: eventually_at_top_dense)
 
 lemma filtermap_ln_at_right: "filtermap ln (at_right (0::real)) = at_bot"
   by (auto intro!: filtermap_fun_inverse[where g="\<lambda>x. exp x"] ln_at_0
       simp: filterlim_at exp_at_bot)
 
 lemma tendsto_power_div_exp_0: "((\<lambda>x. x ^ k / exp x) \<longlongrightarrow> (0::real)) at_top"
 proof (induct k)
   case 0
   show "((\<lambda>x. x ^ 0 / exp x) \<longlongrightarrow> (0::real)) at_top"
     by (simp add: inverse_eq_divide[symmetric])
        (metis filterlim_compose[OF tendsto_inverse_0] exp_at_top filterlim_mono
          at_top_le_at_infinity order_refl)
 next
   case (Suc k)
   show ?case
   proof (rule lhospital_at_top_at_top)
     show "eventually (\<lambda>x. DERIV (\<lambda>x. x ^ Suc k) x :> (real (Suc k) * x^k)) at_top"
       by eventually_elim (intro derivative_eq_intros, auto)
     show "eventually (\<lambda>x. DERIV exp x :> exp x) at_top"
       by eventually_elim auto
     show "eventually (\<lambda>x. exp x \<noteq> 0) at_top"
       by auto
     from tendsto_mult[OF tendsto_const Suc, of "real (Suc k)"]
     show "((\<lambda>x. real (Suc k) * x ^ k / exp x) \<longlongrightarrow> 0) at_top"
       by simp
   qed (rule exp_at_top)
 qed
 
 subsubsection\<open> A couple of simple bounds\<close>
 
 lemma exp_plus_inverse_exp:
   fixes x::real
   shows "2 \<le> exp x + inverse (exp x)"
 proof -
   have "2 \<le> exp x + exp (-x)"
     using exp_ge_add_one_self [of x] exp_ge_add_one_self [of "-x"]
     by linarith
   then show ?thesis
     by (simp add: exp_minus)
 qed
 
 lemma real_le_x_sinh:
   fixes x::real
   assumes "0 \<le> x"
   shows "x \<le> (exp x - inverse(exp x)) / 2"
 proof -
   have *: "exp a - inverse(exp a) - 2*a \<le> exp b - inverse(exp b) - 2*b" if "a \<le> b" for a b::real
     using exp_plus_inverse_exp
     by (fastforce intro: derivative_eq_intros DERIV_nonneg_imp_nondecreasing [OF that])
   show ?thesis
     using*[OF assms] by simp
 qed
 
 lemma real_le_abs_sinh:
   fixes x::real
   shows "abs x \<le> abs((exp x - inverse(exp x)) / 2)"
 proof (cases "0 \<le> x")
   case True
   show ?thesis
     using real_le_x_sinh [OF True] True by (simp add: abs_if)
 next
   case False
   have "-x \<le> (exp(-x) - inverse(exp(-x))) / 2"
     by (meson False linear neg_le_0_iff_le real_le_x_sinh)
   also have "\<dots> \<le> \<bar>(exp x - inverse (exp x)) / 2\<bar>"
     by (metis (no_types, opaque_lifting) abs_divide abs_le_iff abs_minus_cancel
        add.inverse_inverse exp_minus minus_diff_eq order_refl)
   finally show ?thesis
     using False by linarith
 qed
 
 subsection\<open>The general logarithm\<close>
 
 definition log :: "real \<Rightarrow> real \<Rightarrow> real"
   \<comment> \<open>logarithm of \<^term>\<open>x\<close> to base \<^term>\<open>a\<close>\<close>
   where "log a x = ln x / ln a"
 
 lemma tendsto_log [tendsto_intros]:
   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow>
     ((\<lambda>x. log (f x) (g x)) \<longlongrightarrow> log a b) F"
   unfolding log_def by (intro tendsto_intros) auto
 
 lemma continuous_log:
   assumes "continuous F f"
     and "continuous F g"
     and "0 < f (Lim F (\<lambda>x. x))"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 1"
     and "0 < g (Lim F (\<lambda>x. x))"
   shows "continuous F (\<lambda>x. log (f x) (g x))"
   using assms unfolding continuous_def by (rule tendsto_log)
 
 lemma continuous_at_within_log[continuous_intros]:
   assumes "continuous (at a within s) f"
     and "continuous (at a within s) g"
     and "0 < f a"
     and "f a \<noteq> 1"
     and "0 < g a"
   shows "continuous (at a within s) (\<lambda>x. log (f x) (g x))"
   using assms unfolding continuous_within by (rule tendsto_log)
 
 lemma isCont_log[continuous_intros, simp]:
   assumes "isCont f a" "isCont g a" "0 < f a" "f a \<noteq> 1" "0 < g a"
   shows "isCont (\<lambda>x. log (f x) (g x)) a"
   using assms unfolding continuous_at by (rule tendsto_log)
 
 lemma continuous_on_log[continuous_intros]:
   assumes "continuous_on s f" "continuous_on s g"
     and "\<forall>x\<in>s. 0 < f x" "\<forall>x\<in>s. f x \<noteq> 1" "\<forall>x\<in>s. 0 < g x"
   shows "continuous_on s (\<lambda>x. log (f x) (g x))"
   using assms unfolding continuous_on_def by (fast intro: tendsto_log)
 
 lemma exp_powr_real:
   fixes x::real shows "exp x powr y = exp (x*y)"
   by (simp add: powr_def)
 
 lemma powr_one_eq_one [simp]: "1 powr a = 1"
   by (simp add: powr_def)
 
 lemma powr_zero_eq_one [simp]: "x powr 0 = (if x = 0 then 0 else 1)"
   by (simp add: powr_def)
 
 lemma powr_one_gt_zero_iff [simp]: "x powr 1 = x \<longleftrightarrow> 0 \<le> x"
   for x :: real
   by (auto simp: powr_def)
 declare powr_one_gt_zero_iff [THEN iffD2, simp]
 
 lemma powr_diff:
   fixes w:: "'a::{ln,real_normed_field}" shows  "w powr (z1 - z2) = w powr z1 / w powr z2"
   by (simp add: powr_def algebra_simps exp_diff)
 
 lemma powr_mult: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> (x * y) powr a = (x powr a) * (y powr a)"
   for a x y :: real
   by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)
 
 lemma prod_powr_distrib:
   fixes  x :: "'a \<Rightarrow> real"
   assumes "\<And>i. i\<in>I \<Longrightarrow> x i \<ge> 0"
   shows "(prod x I) powr r = (\<Prod>i\<in>I. x i powr r)"
   using assms
   by (induction I rule: infinite_finite_induct) (auto simp add: powr_mult prod_nonneg)
 
 lemma powr_ge_pzero [simp]: "0 \<le> x powr y"
   for x y :: real
   by (simp add: powr_def)
 
 lemma powr_non_neg[simp]: "\<not>a powr x < 0" for a x::real
   using powr_ge_pzero[of a x] by arith
 
 lemma inverse_powr: "\<And>y::real. 0 \<le> y \<Longrightarrow> inverse y powr a = inverse (y powr a)"
     by (simp add: exp_minus ln_inverse powr_def)
 
 lemma powr_divide: "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> (x / y) powr a = (x powr a) / (y powr a)"
   for a b x :: real
     by (simp add: divide_inverse powr_mult inverse_powr)
 
 lemma powr_add: "x powr (a + b) = (x powr a) * (x powr b)"
   for a b x :: "'a::{ln,real_normed_field}"
   by (simp add: powr_def exp_add [symmetric] distrib_right)
 
 lemma powr_mult_base: "0 \<le> x \<Longrightarrow>x * x powr y = x powr (1 + y)"
   for x :: real
   by (auto simp: powr_add)
 
 lemma powr_powr: "(x powr a) powr b = x powr (a * b)"
   for a b x :: real
   by (simp add: powr_def)
 
 lemma powr_power: 
   fixes z:: "'a::{real_normed_field,ln}"
   shows "z \<noteq> 0 \<or> n \<noteq> 0 \<Longrightarrow> (z powr u) ^ n = z powr (of_nat n * u)"
   by (induction n) (auto simp: algebra_simps powr_add)
 
 lemma powr_powr_swap: "(x powr a) powr b = (x powr b) powr a"
   for a b x :: real
   by (simp add: powr_powr mult.commute)
 
 lemma powr_minus: "x powr (- a) = inverse (x powr a)"
       for a x :: "'a::{ln,real_normed_field}"
   by (simp add: powr_def exp_minus [symmetric])
 
 lemma powr_minus_divide: "x powr (- a) = 1/(x powr a)"
       for a x :: "'a::{ln,real_normed_field}"
   by (simp add: divide_inverse powr_minus)
 
 lemma powr_sum: "x \<noteq> 0 \<Longrightarrow> finite A \<Longrightarrow> x powr sum f A = (\<Prod>y\<in>A. x powr f y)"
   by (simp add: powr_def exp_sum sum_distrib_right)
 
 lemma divide_powr_uminus: "a / b powr c = a * b powr (- c)"
   for a b c :: real
   by (simp add: powr_minus_divide)
 
 lemma powr_less_mono: "a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powr a < x powr b"
   for a b x :: real
   by (simp add: powr_def)
 
 lemma powr_less_cancel: "x powr a < x powr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
   for a b x :: real
   by (simp add: powr_def)
 
 lemma powr_less_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a < x powr b \<longleftrightarrow> a < b"
   for a b x :: real
   by (blast intro: powr_less_cancel powr_less_mono)
 
 lemma powr_le_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a \<le> x powr b \<longleftrightarrow> a \<le> b"
   for a b x :: real
   by (simp add: linorder_not_less [symmetric])
 
 lemma powr_realpow: "0 < x \<Longrightarrow> x powr (real n) = x^n"
   by (induction n) (simp_all add: ac_simps powr_add)
 
 lemma powr_realpow': "(z :: real) \<ge> 0 \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> z powr of_nat n = z ^ n"
   by (cases "z = 0") (auto simp: powr_realpow)
 
 lemma powr_real_of_int':
   assumes "x \<ge> 0" "x \<noteq> 0 \<or> n > 0"
   shows   "x powr real_of_int n = power_int x n"
   by (metis assms exp_ln_iff exp_power_int nless_le power_int_eq_0_iff powr_def)
 
 lemma exp_minus_ge: 
   fixes x::real shows "1 - x \<le> exp (-x)"
   by (smt (verit) exp_ge_add_one_self)
 
 lemma exp_minus_greater: 
   fixes x::real shows "1 - x < exp (-x) \<longleftrightarrow> x \<noteq> 0"
   by (smt (verit) exp_minus_ge exp_eq_one_iff exp_gt_zero ln_eq_minus_one ln_exp)
 
 lemma log_ln: "ln x = log (exp(1)) x"
   by (simp add: log_def)
 
 lemma DERIV_log:
   assumes "x > 0"
   shows "DERIV (\<lambda>y. log b y) x :> 1 / (ln b * x)"
 proof -
   define lb where "lb = 1 / ln b"
   moreover have "DERIV (\<lambda>y. lb * ln y) x :> lb / x"
     using \<open>x > 0\<close> by (auto intro!: derivative_eq_intros)
   ultimately show ?thesis
     by (simp add: log_def)
 qed
 
 lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
   and DERIV_log[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemma powr_log_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powr (log a x) = x"
   by (simp add: powr_def log_def)
 
 lemma log_powr_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a powr x) = x"
   by (simp add: log_def powr_def)
 
 lemma powr_eq_iff: "\<lbrakk>y>0; a>1\<rbrakk> \<Longrightarrow> a powr x = y \<longleftrightarrow> log a y = x"
   by auto
 
 lemma log_mult:
   "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a (x * y) = log a x + log a y"
   by (simp add: log_def ln_mult divide_inverse distrib_right)
 
 lemma log_eq_div_ln_mult_log:
   "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log a x = (ln b/ln a) * log b x"
   by (simp add: log_def divide_inverse)
 
 text\<open>Base 10 logarithms\<close>
 lemma log_base_10_eq1: "0 < x \<Longrightarrow> log 10 x = (ln (exp 1) / ln 10) * ln x"
   by (simp add: log_def)
 
 lemma log_base_10_eq2: "0 < x \<Longrightarrow> log 10 x = (log 10 (exp 1)) * ln x"
   by (simp add: log_def)
 
 lemma log_one [simp]: "log a 1 = 0"
   by (simp add: log_def)
 
 lemma log_eq_one [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a a = 1"
   by (simp add: log_def)
 
 lemma log_inverse: "0 < x \<Longrightarrow> log a (inverse x) = - log a x"
   using ln_inverse log_def by auto
 
 lemma log_divide: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a (x/y) = log a x - log a y"
   by (simp add: log_mult divide_inverse log_inverse)
 
 lemma powr_gt_zero [simp]: "0 < x powr a \<longleftrightarrow> x \<noteq> 0"
   for a x :: real
   by (simp add: powr_def)
 
 lemma powr_nonneg_iff[simp]: "a powr x \<le> 0 \<longleftrightarrow> a = 0"
   for a x::real
   by (meson not_less powr_gt_zero)
 
 lemma log_add_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log b x + y = log b (x * b powr y)"
   and add_log_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> y + log b x = log b (b powr y * x)"
   and log_minus_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log b x - y = log b (x * b powr -y)"
   and minus_log_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> y - log b x = log b (b powr y / x)"
   by (simp_all add: log_mult log_divide)
 
 lemma log_less_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x < log a y \<longleftrightarrow> x < y"
   using powr_less_cancel_iff [of a] powr_log_cancel [of a x] powr_log_cancel [of a y]
   by (metis less_eq_real_def less_trans not_le zero_less_one)
 
 lemma log_inj:
   assumes "1 < b"
   shows "inj_on (log b) {0 <..}"
 proof (rule inj_onI, simp)
   fix x y
   assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
   show "x = y"
   proof (cases rule: linorder_cases)
     assume "x = y"
     then show ?thesis by simp
   next
     assume "x < y"
     then have "log b x < log b y"
       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
     then show ?thesis using * by simp
   next
     assume "y < x"
     then have "log b y < log b x"
       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
     then show ?thesis using * by simp
   qed
 qed
 
 lemma log_le_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x \<le> log a y \<longleftrightarrow> x \<le> y"
   by (simp flip: linorder_not_less)
 
 lemma log_mono: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> x \<le> y \<Longrightarrow> log a x \<le> log a y"
   by simp
 
 lemma log_less: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> x < y \<Longrightarrow> log a x < log a y"
   by simp
 
 lemma zero_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < log a x \<longleftrightarrow> 1 < x"
   using log_less_cancel_iff[of a 1 x] by simp
 
 lemma zero_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 \<le> log a x \<longleftrightarrow> 1 \<le> x"
   using log_le_cancel_iff[of a 1 x] by simp
 
 lemma log_less_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 0 \<longleftrightarrow> x < 1"
   using log_less_cancel_iff[of a x 1] by simp
 
 lemma log_le_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 0 \<longleftrightarrow> x \<le> 1"
   using log_le_cancel_iff[of a x 1] by simp
 
 lemma one_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 < log a x \<longleftrightarrow> a < x"
   using log_less_cancel_iff[of a a x] by simp
 
 lemma one_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> log a x \<longleftrightarrow> a \<le> x"
   using log_le_cancel_iff[of a a x] by simp
 
 lemma log_less_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 1 \<longleftrightarrow> x < a"
   using log_less_cancel_iff[of a x a] by simp
 
 lemma log_le_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 1 \<longleftrightarrow> x \<le> a"
   using log_le_cancel_iff[of a x a] by simp
 
 lemma le_log_iff:
   fixes b x y :: real
   assumes "1 < b" "x > 0"
   shows "y \<le> log b x \<longleftrightarrow> b powr y \<le> x"
   using assms
   by (metis less_irrefl less_trans powr_le_cancel_iff powr_log_cancel zero_less_one)
 
 lemma less_log_iff:
   assumes "1 < b" "x > 0"
   shows "y < log b x \<longleftrightarrow> b powr y < x"
   by (metis assms dual_order.strict_trans less_irrefl powr_less_cancel_iff
     powr_log_cancel zero_less_one)
 
 lemma
   assumes "1 < b" "x > 0"
   shows log_less_iff: "log b x < y \<longleftrightarrow> x < b powr y"
     and log_le_iff: "log b x \<le> y \<longleftrightarrow> x \<le> b powr y"
   using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
   by auto
 
 lemmas powr_le_iff = le_log_iff[symmetric]
   and powr_less_iff = less_log_iff[symmetric]
   and less_powr_iff = log_less_iff[symmetric]
   and le_powr_iff = log_le_iff[symmetric]
 
 lemma le_log_of_power:
   assumes "b ^ n \<le> m" "1 < b"
   shows "n \<le> log b m"
 proof -
   from assms have "0 < m" by (metis less_trans zero_less_power less_le_trans zero_less_one)
   thus ?thesis using assms by (simp add: le_log_iff powr_realpow)
 qed
 
 lemma le_log2_of_power: "2 ^ n \<le> m \<Longrightarrow> n \<le> log 2 m" for m n :: nat
 using le_log_of_power[of 2] by simp
 
 lemma log_of_power_le: "\<lbrakk> m \<le> b ^ n; b > 1; m > 0 \<rbrakk> \<Longrightarrow> log b (real m) \<le> n"
 by (simp add: log_le_iff powr_realpow)
 
 lemma log2_of_power_le: "\<lbrakk> m \<le> 2 ^ n; m > 0 \<rbrakk> \<Longrightarrow> log 2 m \<le> n" for m n :: nat
 using log_of_power_le[of _ 2] by simp
 
 lemma log_of_power_less: "\<lbrakk> m < b ^ n; b > 1; m > 0 \<rbrakk> \<Longrightarrow> log b (real m) < n"
 by (simp add: log_less_iff powr_realpow)
 
 lemma log2_of_power_less: "\<lbrakk> m < 2 ^ n; m > 0 \<rbrakk> \<Longrightarrow> log 2 m < n" for m n :: nat
 using log_of_power_less[of _ 2] by simp
 
 lemma less_log_of_power:
   assumes "b ^ n < m" "1 < b"
   shows "n < log b m"
 proof -
   have "0 < m" by (metis assms less_trans zero_less_power zero_less_one)
   thus ?thesis using assms by (simp add: less_log_iff powr_realpow)
 qed
 
 lemma less_log2_of_power: "2 ^ n < m \<Longrightarrow> n < log 2 m" for m n :: nat
 using less_log_of_power[of 2] by simp
 
 lemma gr_one_powr[simp]:
   fixes x y :: real shows "\<lbrakk> x > 1; y > 0 \<rbrakk> \<Longrightarrow> 1 < x powr y"
 by(simp add: less_powr_iff)
 
 lemma log_pow_cancel [simp]:
   "a > 0 \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a ^ b) = b"
   by (simp add: ln_realpow log_def)
 
 lemma floor_log_eq_powr_iff: "x > 0 \<Longrightarrow> b > 1 \<Longrightarrow> \<lfloor>log b x\<rfloor> = k \<longleftrightarrow> b powr k \<le> x \<and> x < b powr (k + 1)"
   by (auto simp: floor_eq_iff powr_le_iff less_powr_iff)
 
 lemma floor_log_nat_eq_powr_iff: 
   fixes b n k :: nat
   shows "\<lbrakk> b \<ge> 2; k > 0 \<rbrakk> \<Longrightarrow> floor (log b (real k)) = n \<longleftrightarrow> b^n \<le> k \<and> k < b^(n+1)"
 by (auto simp: floor_log_eq_powr_iff powr_add powr_realpow
                of_nat_power[symmetric] of_nat_mult[symmetric] ac_simps
          simp del: of_nat_power of_nat_mult)
 
 lemma floor_log_nat_eq_if: 
   fixes b n k :: nat
   assumes "b^n \<le> k" "k < b^(n+1)" "b \<ge> 2"
   shows "floor (log b (real k)) = n" 
 proof -
   have "k \<ge> 1"
     using assms linorder_le_less_linear by force
   with assms show ?thesis 
     by(simp add: floor_log_nat_eq_powr_iff)
 qed
 
 lemma ceiling_log_eq_powr_iff: 
   "\<lbrakk> x > 0; b > 1 \<rbrakk> \<Longrightarrow> \<lceil>log b x\<rceil> = int k + 1 \<longleftrightarrow> b powr k < x \<and> x \<le> b powr (k + 1)"
   by (auto simp: ceiling_eq_iff powr_less_iff le_powr_iff)
 
 lemma ceiling_log_nat_eq_powr_iff: 
   fixes b n k :: nat
   shows "\<lbrakk> b \<ge> 2; k > 0 \<rbrakk> \<Longrightarrow> ceiling (log b (real k)) = int n + 1 \<longleftrightarrow> (b^n < k \<and> k \<le> b^(n+1))"
   using ceiling_log_eq_powr_iff
   by (auto simp: powr_add powr_realpow of_nat_power[symmetric] of_nat_mult[symmetric] ac_simps
       simp del: of_nat_power of_nat_mult)
 
 lemma ceiling_log_nat_eq_if: 
   fixes b n k :: nat
   assumes "b^n < k" "k \<le> b^(n+1)" "b \<ge> 2"
   shows "\<lceil>log (real b) (real k)\<rceil> = int n + 1"
   using assms ceiling_log_nat_eq_powr_iff by force
 
 lemma floor_log2_div2: 
   fixes n :: nat 
   assumes "n \<ge> 2"
   shows "\<lfloor>log 2 (real n)\<rfloor> = \<lfloor>log 2 (n div 2)\<rfloor> + 1"
 proof cases
   assume "n=2" thus ?thesis by simp
 next
   let ?m = "n div 2"
   assume "n\<noteq>2"
   hence "1 \<le> ?m" using assms by arith
   then obtain i where i: "2 ^ i \<le> ?m" "?m < 2 ^ (i + 1)"
     using ex_power_ivl1[of 2 ?m] by auto
   have "2^(i+1) \<le> 2*?m" using i(1) by simp
   also have "2*?m \<le> n" by arith
   finally have *: "2^(i+1) \<le> \<dots>" .
   have "n < 2^(i+1+1)" using i(2) by simp
   from floor_log_nat_eq_if[OF * this] floor_log_nat_eq_if[OF i]
   show ?thesis by simp
 qed
 
 lemma ceiling_log2_div2: 
   assumes "n \<ge> 2"
   shows "ceiling(log 2 (real n)) = ceiling(log 2 ((n-1) div 2 + 1)) + 1"
 proof cases
   assume "n=2" thus ?thesis by simp
 next
   let ?m = "(n-1) div 2 + 1"
   assume "n\<noteq>2"
   hence "2 \<le> ?m" using assms by arith
   then obtain i where i: "2 ^ i < ?m" "?m \<le> 2 ^ (i + 1)"
     using ex_power_ivl2[of 2 ?m] by auto
   have "n \<le> 2*?m" by arith
   also have "2*?m \<le> 2 ^ ((i+1)+1)" using i(2) by simp
   finally have *: "n \<le> \<dots>" .
   have "2^(i+1) < n" using i(1) by (auto simp: less_Suc_eq_0_disj)
   from ceiling_log_nat_eq_if[OF this *] ceiling_log_nat_eq_if[OF i]
   show ?thesis by simp
 qed
 
 lemma powr_real_of_int:
   "x > 0 \<Longrightarrow> x powr real_of_int n = (if n \<ge> 0 then x ^ nat n else inverse (x ^ nat (- n)))"
   using powr_realpow[of x "nat n"] powr_realpow[of x "nat (-n)"]
   by (auto simp: field_simps powr_minus)
 
 lemma powr_numeral [simp]: "0 \<le> x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
   by (metis less_le power_zero_numeral powr_0 of_nat_numeral powr_realpow)
 
 lemma powr_int:
   assumes "x > 0"
   shows "x powr i = (if i \<ge> 0 then x ^ nat i else 1/x ^ nat (-i))"
   by (simp add: assms inverse_eq_divide powr_real_of_int)
 
 lemma power_of_nat_log_ge: "b > 1 \<Longrightarrow> b ^ nat \<lceil>log b x\<rceil> \<ge> x"
   by (smt (verit) less_log_of_power of_nat_ceiling)
 
 lemma power_of_nat_log_le:
   assumes "b > 1" "x\<ge>1"
   shows "b ^ nat \<lfloor>log b x\<rfloor> \<le> x"
 proof -
   have "\<lfloor>log b x\<rfloor> \<ge> 0"
     using assms by auto
   then show ?thesis
     by (smt (verit) assms le_log_iff of_int_floor_le powr_int)
 qed
 
 definition powr_real :: "real \<Rightarrow> real \<Rightarrow> real"
   where [code_abbrev, simp]: "powr_real = Transcendental.powr"
 
 lemma compute_powr_real [code]:
   "powr_real b i =
     (if b \<le> 0 then Code.abort (STR ''powr_real with nonpositive base'') (\<lambda>_. powr_real b i)
      else if \<lfloor>i\<rfloor> = i then (if 0 \<le> i then b ^ nat \<lfloor>i\<rfloor> else 1 / b ^ nat \<lfloor>- i\<rfloor>)
      else Code.abort (STR ''powr_real with non-integer exponent'') (\<lambda>_. powr_real b i))"
     for b i :: real
   by (auto simp: powr_int)
 
 lemma powr_one: "0 \<le> x \<Longrightarrow> x powr 1 = x"
   for x :: real
   using powr_realpow [of x 1] by simp
 
 lemma powr_neg_one: "0 < x \<Longrightarrow> x powr - 1 = 1/x"
   for x :: real
   using powr_int [of x "- 1"] by simp
 
 lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr - numeral n = 1/x ^ numeral n"
   for x :: real
   using powr_int [of x "- numeral n"] by simp
 
 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
   by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
 
 lemma ln_powr: "x \<noteq> 0 \<Longrightarrow> ln (x powr y) = y * ln x"
   for x :: real
   by (simp add: powr_def)
 
 lemma ln_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> ln (root n b) =  ln b / n"
   by (simp add: root_powr_inverse ln_powr)
 
 lemma ln_sqrt: "0 < x \<Longrightarrow> ln (sqrt x) = ln x / 2"
   by (simp add: ln_powr ln_powr[symmetric] mult.commute)
 
 lemma log_root: "n > 0 \<Longrightarrow> a > 0 \<Longrightarrow> log b (root n a) =  log b a / n"
   by (simp add: log_def ln_root)
 
 lemma log_powr: "x \<noteq> 0 \<Longrightarrow> log b (x powr y) = y * log b x"
   by (simp add: log_def ln_powr)
 
 (* [simp] is not worth it, interferes with some proofs *)
 lemma log_nat_power: "0 < x \<Longrightarrow> log b (x^n) = real n * log b x"
   by (simp add: log_powr powr_realpow [symmetric])
 
 lemma log_of_power_eq:
   assumes "m = b ^ n" "b > 1"
   shows "n = log b (real m)"
 proof -
   have "n = log b (b ^ n)" using assms(2) by (simp add: log_nat_power)
   also have "\<dots> = log b m" using assms by simp
   finally show ?thesis .
 qed
 
 lemma log2_of_power_eq: "m = 2 ^ n \<Longrightarrow> n = log 2 m" for m n :: nat
 using log_of_power_eq[of _ 2] by simp
 
 lemma log_base_change: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log b x = log a x / log a b"
   by (simp add: log_def)
 
 lemma log_base_pow: "0 < a \<Longrightarrow> log (a ^ n) x = log a x / n"
   by (simp add: log_def ln_realpow)
 
 lemma log_base_powr: "a \<noteq> 0 \<Longrightarrow> log (a powr b) x = log a x / b"
   by (simp add: log_def ln_powr)
 
 lemma log_base_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> log (root n b) x = n * (log b x)"
   by (simp add: log_def ln_root)
 
 lemma ln_bound: "0 < x \<Longrightarrow> ln x \<le> x" for x :: real
   using ln_le_minus_one by force
 
 lemma powr_less_one:
   fixes x::real
   assumes "1 < x" "y < 0"
   shows "x powr y < 1"
 using assms less_log_iff by force
 
 lemma powr_le_one_le: "\<And>x y::real. 0 < x \<Longrightarrow> x \<le> 1 \<Longrightarrow> 1 \<le> y \<Longrightarrow> x powr y \<le> x"
   by (smt (verit) ln_gt_zero_imp_gt_one ln_le_cancel_iff ln_powr mult_le_cancel_right2)
 
 lemma powr_mono:
   fixes x :: real
   assumes "a \<le> b" and "1 \<le> x" shows "x powr a \<le> x powr b"
   using assms less_eq_real_def by auto
 
 lemma ge_one_powr_ge_zero: "1 \<le> x \<Longrightarrow> 0 \<le> a \<Longrightarrow> 1 \<le> x powr a"
   for x :: real
   using powr_mono by fastforce
 
 lemma powr_less_mono2: "0 < a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x < y \<Longrightarrow> x powr a < y powr a"
   for x :: real
   by (simp add: powr_def)
 
 lemma powr_less_mono2_neg: "a < 0 \<Longrightarrow> 0 < x \<Longrightarrow> x < y \<Longrightarrow> y powr a < x powr a"
   for x :: real
   by (simp add: powr_def)
 
 lemma powr_mono2: "x powr a \<le> y powr a" if "0 \<le> a" "0 \<le> x" "x \<le> y"
   for x :: real
   using less_eq_real_def powr_less_mono2 that by auto
 
 lemma powr01_less_one: 
   fixes a::real 
   assumes "0 < a" "a < 1"  
   shows "a powr e < 1 \<longleftrightarrow> e>0"
 proof
   show "a powr e < 1 \<Longrightarrow> e>0"
     using assms not_less_iff_gr_or_eq powr_less_mono2_neg by fastforce
   show "e>0 \<Longrightarrow> a powr e < 1"
     by (metis assms less_eq_real_def powr_less_mono2 powr_one_eq_one)
 qed
 
 lemma powr_le1: "0 \<le> a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> x powr a \<le> 1"
   for x :: real
   using powr_mono2 by fastforce
 
 lemma powr_mono2':
   fixes a x y :: real
   assumes "a \<le> 0" "x > 0" "x \<le> y"
   shows "x powr a \<ge> y powr a"
 proof -
   from assms have "x powr - a \<le> y powr - a"
     by (intro powr_mono2) simp_all
   with assms show ?thesis
     by (auto simp: powr_minus field_simps)
 qed
 
+lemma powr_mono': "a \<le> (b::real) \<Longrightarrow> x \<ge> 0 \<Longrightarrow> x \<le> 1 \<Longrightarrow> x powr b \<le> x powr a"
+  using powr_mono[of "-b" "-a" "inverse x"] by (auto simp: powr_def ln_inverse ln_div field_split_simps)
+
 lemma powr_mono_both:
   fixes x :: real
   assumes "0 \<le> a" "a \<le> b" "1 \<le> x" "x \<le> y"
     shows "x powr a \<le> y powr b"
   by (meson assms order.trans powr_mono powr_mono2 zero_le_one)
 
-lemma powr_mono': "a \<le> (b::real) \<Longrightarrow> x \<ge> 0 \<Longrightarrow> x \<le> 1 \<Longrightarrow> x powr b \<le> x powr a"
-  using powr_mono[of "-b" "-a" "inverse x"] by (auto simp: powr_def ln_inverse ln_div field_split_simps)
+lemma powr_mono_both':
+  fixes x :: real
+  assumes "a \<ge> b" "b\<ge>0" "0 < x" "x \<le> y" "y \<le> 1"
+    shows "x powr a \<le> y powr b"
+  by (meson assms nless_le order.trans powr_mono' powr_mono2)
 
 lemma powr_less_mono':
   assumes "(x::real) > 0" "x < 1" "a < b"
   shows   "x powr b < x powr a"
   by (metis assms log_powr_cancel order.strict_iff_order powr_mono')
 
 lemma powr_inj: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> a powr x = a powr y \<longleftrightarrow> x = y"
   for x :: real
   unfolding powr_def exp_inj_iff by simp
 
 lemma powr_half_sqrt: "0 \<le> x \<Longrightarrow> x powr (1/2) = sqrt x"
   by (simp add: powr_def root_powr_inverse sqrt_def)
 
 lemma powr_half_sqrt_powr: "0 \<le> x \<Longrightarrow> x powr (a/2) = sqrt(x powr a)"
   by (metis divide_inverse mult.left_neutral powr_ge_pzero powr_half_sqrt powr_powr)
 
 lemma square_powr_half [simp]:
   fixes x::real shows "x\<^sup>2 powr (1/2) = \<bar>x\<bar>"
   by (simp add: powr_half_sqrt)
 
 lemma ln_powr_bound: "1 \<le> x \<Longrightarrow> 0 < a \<Longrightarrow> ln x \<le> (x powr a) / a"
   for x :: real
   by (metis exp_gt_zero linear ln_eq_zero_iff ln_exp ln_less_self ln_powr mult.commute
       mult_imp_le_div_pos not_less powr_gt_zero)
 
 lemma ln_powr_bound2:
   fixes x :: real
   assumes "1 < x" and "0 < a"
   shows "(ln x) powr a \<le> (a powr a) * x"
 proof -
   from assms have "ln x \<le> (x powr (1 / a)) / (1 / a)"
     by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
   also have "\<dots> = a * (x powr (1 / a))"
     by simp
   finally have "(ln x) powr a \<le> (a * (x powr (1 / a))) powr a"
     by (metis assms less_imp_le ln_gt_zero powr_mono2)
   also have "\<dots> = (a powr a) * ((x powr (1 / a)) powr a)"
     using assms powr_mult by auto
   also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
     by (rule powr_powr)
   also have "\<dots> = x" using assms
     by auto
   finally show ?thesis .
 qed
 
 lemma tendsto_powr:
   fixes a b :: real
   assumes f: "(f \<longlongrightarrow> a) F"
     and g: "(g \<longlongrightarrow> b) F"
     and a: "a \<noteq> 0"
   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
   unfolding powr_def
 proof (rule filterlim_If)
   from f show "((\<lambda>x. 0) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a))) (inf F (principal {x. f x = 0}))"
     by simp (auto simp: filterlim_iff eventually_inf_principal elim: eventually_mono dest: t1_space_nhds)
   from f g a show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a)))
       (inf F (principal {x. f x \<noteq> 0}))"
     by (auto intro!: tendsto_intros intro: tendsto_mono inf_le1)
 qed
 
 lemma tendsto_powr'[tendsto_intros]:
   fixes a :: real
   assumes f: "(f \<longlongrightarrow> a) F"
     and g: "(g \<longlongrightarrow> b) F"
     and a: "a \<noteq> 0 \<or> (b > 0 \<and> eventually (\<lambda>x. f x \<ge> 0) F)"
   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
 proof -
   from a consider "a \<noteq> 0" | "a = 0" "b > 0" "eventually (\<lambda>x. f x \<ge> 0) F"
     by auto
   then show ?thesis
   proof cases
     case 1
     with f g show ?thesis by (rule tendsto_powr)
   next
     case 2
     have "((\<lambda>x. if f x = 0 then 0 else exp (g x * ln (f x))) \<longlongrightarrow> 0) F"
     proof (intro filterlim_If)
       have "filterlim f (principal {0<..}) (inf F (principal {z. f z \<noteq> 0}))"
         using \<open>eventually (\<lambda>x. f x \<ge> 0) F\<close>
         by (auto simp: filterlim_iff eventually_inf_principal
             eventually_principal elim: eventually_mono)
       moreover have "filterlim f (nhds a) (inf F (principal {z. f z \<noteq> 0}))"
         by (rule tendsto_mono[OF _ f]) simp_all
       ultimately have f: "filterlim f (at_right 0) (inf F (principal {x. f x \<noteq> 0}))"
         by (simp add: at_within_def filterlim_inf \<open>a = 0\<close>)
       have g: "(g \<longlongrightarrow> b) (inf F (principal {z. f z \<noteq> 0}))"
         by (rule tendsto_mono[OF _ g]) simp_all
       show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> 0) (inf F (principal {x. f x \<noteq> 0}))"
         by (rule filterlim_compose[OF exp_at_bot] filterlim_tendsto_pos_mult_at_bot
                  filterlim_compose[OF ln_at_0] f g \<open>b > 0\<close>)+
     qed simp_all
     with \<open>a = 0\<close> show ?thesis
       by (simp add: powr_def)
   qed
 qed
 
 lemma continuous_powr:
   assumes "continuous F f"
     and "continuous F g"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. (f x) powr (g x :: real))"
   using assms unfolding continuous_def by (rule tendsto_powr)
 
 lemma continuous_at_within_powr[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> real"
   assumes "continuous (at a within s) f"
     and "continuous (at a within s) g"
     and "f a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. (f x) powr (g x))"
   using assms unfolding continuous_within by (rule tendsto_powr)
 
 lemma isCont_powr[continuous_intros, simp]:
   fixes f g :: "_ \<Rightarrow> real"
   assumes "isCont f a" "isCont g a" "f a \<noteq> 0"
   shows "isCont (\<lambda>x. (f x) powr g x) a"
   using assms unfolding continuous_at by (rule tendsto_powr)
 
 lemma continuous_on_powr[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> real"
   assumes "continuous_on s f" "continuous_on s g" and "\<forall>x\<in>s. f x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
   using assms unfolding continuous_on_def by (fast intro: tendsto_powr)
 
 lemma tendsto_powr2:
   fixes a :: real
   assumes f: "(f \<longlongrightarrow> a) F"
     and g: "(g \<longlongrightarrow> b) F"
     and "\<forall>\<^sub>F x in F. 0 \<le> f x"
     and b: "0 < b"
   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
   using tendsto_powr'[of f a F g b] assms by auto
 
 lemma has_derivative_powr[derivative_intros]:
   assumes g[derivative_intros]: "(g has_derivative g') (at x within X)"
     and f[derivative_intros]:"(f has_derivative f') (at x within X)"
   assumes pos: "0 < g x" and "x \<in> X"
   shows "((\<lambda>x. g x powr f x::real) has_derivative (\<lambda>h. (g x powr f x) * (f' h * ln (g x) + g' h * f x / g x))) (at x within X)"
 proof -
   have "\<forall>\<^sub>F x in at x within X. g x > 0"
     by (rule order_tendstoD[OF _ pos])
       (rule has_derivative_continuous[OF g, unfolded continuous_within])
   then obtain d where "d > 0" and pos': "\<And>x'. x' \<in> X \<Longrightarrow> dist x' x < d \<Longrightarrow> 0 < g x'"
     using pos unfolding eventually_at by force
   have "((\<lambda>x. exp (f x * ln (g x))) has_derivative
     (\<lambda>h. (g x powr f x) * (f' h * ln (g x) + g' h * f x / g x))) (at x within X)"
     using pos
     by (auto intro!: derivative_eq_intros simp: field_split_simps powr_def)
   then show ?thesis
     by (rule has_derivative_transform_within[OF _ \<open>d > 0\<close> \<open>x \<in> X\<close>]) (auto simp: powr_def dest: pos')
 qed
 
 lemma has_derivative_const_powr [derivative_intros]:
   assumes "\<And>x. (f has_derivative f') (at x)" "a \<noteq> (0::real)"
   shows "((\<lambda>x. a powr (f x)) has_derivative (\<lambda>y. f' y * ln a * a powr (f x))) (at x)"
   using assms
   apply (simp add: powr_def)
   apply (rule assms derivative_eq_intros refl)+
   done
 
 lemma has_real_derivative_const_powr [derivative_intros]:
   assumes "\<And>x. (f has_real_derivative f' x) (at x)"
     "a \<noteq> (0::real)"
   shows "((\<lambda>x. a powr (f x)) has_real_derivative (f' x * ln a * a powr (f x))) (at x)"
   using assms
   apply (simp add: powr_def)
   apply (rule assms derivative_eq_intros refl | simp)+
   done
 
 lemma DERIV_powr:
   fixes r :: real
   assumes g: "DERIV g x :> m"
     and pos: "g x > 0"
     and f: "DERIV f x :> r"
   shows "DERIV (\<lambda>x. g x powr f x) x :> (g x powr f x) * (r * ln (g x) + m * f x / g x)"
   using assms
   by (auto intro!: derivative_eq_intros ext simp: has_field_derivative_def algebra_simps)
 
 lemma DERIV_fun_powr:
   fixes r :: real
   assumes g: "DERIV g x :> m"
     and pos: "g x > 0"
   shows "DERIV (\<lambda>x. (g x) powr r) x :> r * (g x) powr (r - of_nat 1) * m"
   using DERIV_powr[OF g pos DERIV_const, of r] pos
   by (simp add: powr_diff field_simps)
 
 lemma has_real_derivative_powr:
   assumes "z > 0"
   shows "((\<lambda>z. z powr r) has_real_derivative r * z powr (r - 1)) (at z)"
 proof (subst DERIV_cong_ev[OF refl _ refl])
   from assms have "eventually (\<lambda>z. z \<noteq> 0) (nhds z)"
     by (intro t1_space_nhds) auto
   then show "eventually (\<lambda>z. z powr r = exp (r * ln z)) (nhds z)"
     unfolding powr_def by eventually_elim simp
   from assms show "((\<lambda>z. exp (r * ln z)) has_real_derivative r * z powr (r - 1)) (at z)"
     by (auto intro!: derivative_eq_intros simp: powr_def field_simps exp_diff)
 qed
 
 declare has_real_derivative_powr[THEN DERIV_chain2, derivative_intros]
 
 text \<open>A more general version, by Johannes Hölzl\<close>
 lemma has_real_derivative_powr':
   fixes f g :: "real \<Rightarrow> real"
   assumes "(f has_real_derivative f') (at x)"
   assumes "(g has_real_derivative g') (at x)"
   assumes "f x > 0"
   defines "h \<equiv> \<lambda>x. f x powr g x * (g' * ln (f x) + f' * g x / f x)"
   shows   "((\<lambda>x. f x powr g x) has_real_derivative h x) (at x)"
 proof (subst DERIV_cong_ev[OF refl _ refl])
   from assms have "isCont f x"
     by (simp add: DERIV_continuous)
   hence "f \<midarrow>x\<rightarrow> f x" by (simp add: continuous_at)
   with \<open>f x > 0\<close> have "eventually (\<lambda>x. f x > 0) (nhds x)"
     by (auto simp: tendsto_at_iff_tendsto_nhds dest: order_tendstoD)
   thus "eventually (\<lambda>x. f x powr g x = exp (g x * ln (f x))) (nhds x)"
     by eventually_elim (simp add: powr_def)
 next
   from assms show "((\<lambda>x. exp (g x * ln (f x))) has_real_derivative h x) (at x)"
     by (auto intro!: derivative_eq_intros simp: h_def powr_def)
 qed
 
 lemma tendsto_zero_powrI:
   assumes "(f \<longlongrightarrow> (0::real)) F" "(g \<longlongrightarrow> b) F" "\<forall>\<^sub>F x in F. 0 \<le> f x" "0 < b"
   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> 0) F"
   using tendsto_powr2[OF assms] by simp
 
 lemma continuous_on_powr':
   fixes f g :: "_ \<Rightarrow> real"
   assumes "continuous_on s f" "continuous_on s g"
     and "\<forall>x\<in>s. f x \<ge> 0 \<and> (f x = 0 \<longrightarrow> g x > 0)"
   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
   unfolding continuous_on_def
 proof
   fix x
   assume x: "x \<in> s"
   from assms x show "((\<lambda>x. f x powr g x) \<longlongrightarrow> f x powr g x) (at x within s)"
   proof (cases "f x = 0")
     case True
     from assms(3) have "eventually (\<lambda>x. f x \<ge> 0) (at x within s)"
       by (auto simp: at_within_def eventually_inf_principal)
     with True x assms show ?thesis
       by (auto intro!: tendsto_zero_powrI[of f _ g "g x"] simp: continuous_on_def)
   next
     case False
     with assms x show ?thesis
       by (auto intro!: tendsto_powr' simp: continuous_on_def)
   qed
 qed
 
 lemma tendsto_neg_powr:
   assumes "s < 0"
     and f: "LIM x F. f x :> at_top"
   shows "((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
 proof -
   have "((\<lambda>x. exp (s * ln (f x))) \<longlongrightarrow> (0::real)) F" (is "?X")
     by (auto intro!: filterlim_compose[OF exp_at_bot] filterlim_compose[OF ln_at_top]
         filterlim_tendsto_neg_mult_at_bot assms)
   also have "?X \<longleftrightarrow> ((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
     using f filterlim_at_top_dense[of f F]
     by (intro filterlim_cong[OF refl refl]) (auto simp: neq_iff powr_def elim: eventually_mono)
   finally show ?thesis .
 qed
 
 lemma tendsto_exp_limit_at_right: "((\<lambda>y. (1 + x * y) powr (1 / y)) \<longlongrightarrow> exp x) (at_right 0)"
   for x :: real
 proof (cases "x = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "((\<lambda>y. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
     by (auto intro!: derivative_eq_intros)
   then have "((\<lambda>y. ln (1 + x * y) / y) \<longlongrightarrow> x) (at 0)"
     by (auto simp: has_field_derivative_def field_has_derivative_at)
   then have *: "((\<lambda>y. exp (ln (1 + x * y) / y)) \<longlongrightarrow> exp x) (at 0)"
     by (rule tendsto_intros)
   then show ?thesis
   proof (rule filterlim_mono_eventually)
     show "eventually (\<lambda>xa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
       unfolding eventually_at_right[OF zero_less_one]
       using False
       by (intro exI[of _ "1 / \<bar>x\<bar>"]) (auto simp: field_simps powr_def abs_if add_nonneg_eq_0_iff)
   qed (simp_all add: at_eq_sup_left_right)
 qed
 
 lemma tendsto_exp_limit_at_top: "((\<lambda>y. (1 + x / y) powr y) \<longlongrightarrow> exp x) at_top"
   for x :: real
   by (simp add: filterlim_at_top_to_right inverse_eq_divide tendsto_exp_limit_at_right)
 
 lemma tendsto_exp_limit_sequentially: "(\<lambda>n. (1 + x / n) ^ n) \<longlonglongrightarrow> exp x"
   for x :: real
 proof (rule filterlim_mono_eventually)
   from reals_Archimedean2 [of "\<bar>x\<bar>"] obtain n :: nat where *: "real n > \<bar>x\<bar>" ..
   then have "eventually (\<lambda>n :: nat. 0 < 1 + x / real n) at_top"
     by (intro eventually_sequentiallyI [of n]) (auto simp: field_split_simps)
   then show "eventually (\<lambda>n. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
     by (rule eventually_mono) (erule powr_realpow)
   show "(\<lambda>n. (1 + x / real n) powr real n) \<longlonglongrightarrow> exp x"
     by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
 qed auto
 
 
 subsection \<open>Sine and Cosine\<close>
 
 definition sin_coeff :: "nat \<Rightarrow> real"
   where "sin_coeff = (\<lambda>n. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"
 
 definition cos_coeff :: "nat \<Rightarrow> real"
   where "cos_coeff = (\<lambda>n. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"
 
 definition sin :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
   where "sin = (\<lambda>x. \<Sum>n. sin_coeff n *\<^sub>R x^n)"
 
 definition cos :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
   where "cos = (\<lambda>x. \<Sum>n. cos_coeff n *\<^sub>R x^n)"
 
 lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
   unfolding sin_coeff_def by simp
 
 lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
   unfolding cos_coeff_def by simp
 
 lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
   unfolding cos_coeff_def sin_coeff_def
   by (simp del: mult_Suc)
 
 lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
   unfolding cos_coeff_def sin_coeff_def
   by (simp del: mult_Suc) (auto elim: oddE)
 
 lemma summable_norm_sin: "summable (\<lambda>n. norm (sin_coeff n *\<^sub>R x^n))"
   for x :: "'a::{real_normed_algebra_1,banach}"
 proof (rule summable_comparison_test [OF _ summable_norm_exp])
   show "\<exists>N. \<forall>n\<ge>N. norm (norm (sin_coeff n *\<^sub>R x ^ n)) \<le> norm (x ^ n /\<^sub>R fact n)"
     unfolding sin_coeff_def
     by (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
 qed
 
 lemma summable_norm_cos: "summable (\<lambda>n. norm (cos_coeff n *\<^sub>R x^n))"
   for x :: "'a::{real_normed_algebra_1,banach}"
 proof (rule summable_comparison_test [OF _ summable_norm_exp])
   show "\<exists>N. \<forall>n\<ge>N. norm (norm (cos_coeff n *\<^sub>R x ^ n)) \<le> norm (x ^ n /\<^sub>R fact n)"
     unfolding cos_coeff_def
     by (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
 qed
 
 
 lemma sin_converges: "(\<lambda>n. sin_coeff n *\<^sub>R x^n) sums sin x"
   unfolding sin_def
   by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)
 
 lemma cos_converges: "(\<lambda>n. cos_coeff n *\<^sub>R x^n) sums cos x"
   unfolding cos_def
   by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)
 
 lemma sin_of_real: "sin (of_real x) = of_real (sin x)"
   for x :: real
 proof -
   have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R  x^n)) = (\<lambda>n. sin_coeff n *\<^sub>R  (of_real x)^n)"
   proof
     show "of_real (sin_coeff n *\<^sub>R  x^n) = sin_coeff n *\<^sub>R of_real x^n" for n
       by (simp add: scaleR_conv_of_real)
   qed
   also have "\<dots> sums (sin (of_real x))"
     by (rule sin_converges)
   finally have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R x^n)) sums (sin (of_real x))" .
   then show ?thesis
     using sums_unique2 sums_of_real [OF sin_converges] by blast
 qed
 
 corollary sin_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> sin z \<in> \<real>"
   by (metis Reals_cases Reals_of_real sin_of_real)
 
 lemma cos_of_real: "cos (of_real x) = of_real (cos x)"
   for x :: real
 proof -
   have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R  x^n)) = (\<lambda>n. cos_coeff n *\<^sub>R  (of_real x)^n)"
   proof
     show "of_real (cos_coeff n *\<^sub>R  x^n) = cos_coeff n *\<^sub>R of_real x^n" for n
       by (simp add: scaleR_conv_of_real)
   qed
   also have "\<dots> sums (cos (of_real x))"
     by (rule cos_converges)
   finally have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R x^n)) sums (cos (of_real x))" .
   then show ?thesis
     using sums_unique2 sums_of_real [OF cos_converges]
     by blast
 qed
 
 corollary cos_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cos z \<in> \<real>"
   by (metis Reals_cases Reals_of_real cos_of_real)
 
 lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
   by (simp add: diffs_def sin_coeff_Suc del: of_nat_Suc)
 
 lemma diffs_cos_coeff: "diffs cos_coeff = (\<lambda>n. - sin_coeff n)"
   by (simp add: diffs_def cos_coeff_Suc del: of_nat_Suc)
 
 lemma sin_int_times_real: "sin (of_int m * of_real x) = of_real (sin (of_int m * x))"
   by (metis sin_of_real of_real_mult of_real_of_int_eq)
 
 lemma cos_int_times_real: "cos (of_int m * of_real x) = of_real (cos (of_int m * x))"
   by (metis cos_of_real of_real_mult of_real_of_int_eq)
 
 text \<open>Now at last we can get the derivatives of exp, sin and cos.\<close>
 
 lemma DERIV_sin [simp]: "DERIV sin x :> cos x"
   for x :: "'a::{real_normed_field,banach}"
   unfolding sin_def cos_def scaleR_conv_of_real
   apply (rule DERIV_cong)
    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
       apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
               summable_minus_iff scaleR_conv_of_real [symmetric]
               summable_norm_sin [THEN summable_norm_cancel]
               summable_norm_cos [THEN summable_norm_cancel])
   done
 
 declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
   and DERIV_sin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_sin[derivative_intros] = DERIV_sin[THEN DERIV_compose_FDERIV]
 
 lemma DERIV_cos [simp]: "DERIV cos x :> - sin x"
   for x :: "'a::{real_normed_field,banach}"
   unfolding sin_def cos_def scaleR_conv_of_real
   apply (rule DERIV_cong)
    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
       apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
               diffs_sin_coeff diffs_cos_coeff
               summable_minus_iff scaleR_conv_of_real [symmetric]
               summable_norm_sin [THEN summable_norm_cancel]
               summable_norm_cos [THEN summable_norm_cancel])
   done
 
 declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
   and DERIV_cos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_cos[derivative_intros] = DERIV_cos[THEN DERIV_compose_FDERIV]
 
 lemma isCont_sin: "isCont sin x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_sin [THEN DERIV_isCont])
 
 lemma continuous_on_sin_real: "continuous_on {a..b} sin" for a::real
   using continuous_at_imp_continuous_on isCont_sin by blast
 
 lemma isCont_cos: "isCont cos x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_cos [THEN DERIV_isCont])
 
 lemma continuous_on_cos_real: "continuous_on {a..b} cos" for a::real
   using continuous_at_imp_continuous_on isCont_cos by blast
 
 
 context
   fixes f :: "'a::t2_space \<Rightarrow> 'b::{real_normed_field,banach}"
 begin
 
 lemma isCont_sin' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. sin (f x)) a"
   by (rule isCont_o2 [OF _ isCont_sin])
 
 lemma isCont_cos' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. cos (f x)) a"
   by (rule isCont_o2 [OF _ isCont_cos])
 
 lemma tendsto_sin [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. sin (f x)) \<longlongrightarrow> sin a) F"
   by (rule isCont_tendsto_compose [OF isCont_sin])
 
 lemma tendsto_cos [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. cos (f x)) \<longlongrightarrow> cos a) F"
   by (rule isCont_tendsto_compose [OF isCont_cos])
 
 lemma continuous_sin [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sin (f x))"
   unfolding continuous_def by (rule tendsto_sin)
 
 lemma continuous_on_sin [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sin (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_sin)
 
 lemma continuous_cos [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. cos (f x))"
   unfolding continuous_def by (rule tendsto_cos)
 
 lemma continuous_on_cos [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. cos (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_cos)
 
 end
 
 lemma continuous_within_sin: "continuous (at z within s) sin"     
   for z :: "'a::{real_normed_field,banach}"
   by (simp add: continuous_within tendsto_sin)
 
 lemma continuous_within_cos: "continuous (at z within s) cos"
   for z :: "'a::{real_normed_field,banach}"
   by (simp add: continuous_within tendsto_cos)
 
 
 subsection \<open>Properties of Sine and Cosine\<close>
 
 lemma sin_zero [simp]: "sin 0 = 0"
   by (simp add: sin_def sin_coeff_def scaleR_conv_of_real)
 
 lemma cos_zero [simp]: "cos 0 = 1"
   by (simp add: cos_def cos_coeff_def scaleR_conv_of_real)
 
 lemma DERIV_fun_sin: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. sin (g x)) x :> cos (g x) * m"
   by (fact derivative_intros)
 
 lemma DERIV_fun_cos: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. cos(g x)) x :> - sin (g x) * m"
   by (fact derivative_intros)
 
 
 subsection \<open>Deriving the Addition Formulas\<close>
 
 text \<open>The product of two cosine series.\<close>
 lemma cos_x_cos_y:
   fixes x :: "'a::{real_normed_field,banach}"
   shows
     "(\<lambda>p. \<Sum>n\<le>p.
         if even p \<and> even n
         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
       sums (cos x * cos y)"
 proof -
   have "(cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p - n)) =
     (if even p \<and> even n then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p - n)
      else 0)"
     if "n \<le> p" for n p :: nat
   proof -
     from that have *: "even n \<Longrightarrow> even p \<Longrightarrow>
         (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
       by (metis div_add power_add le_add_diff_inverse odd_add)
     with that show ?thesis
       by (auto simp: algebra_simps cos_coeff_def binomial_fact)
   qed
   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> even n
                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
              (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
     by simp
   also have "\<dots> = (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n *\<^sub>R x^n) * (cos_coeff (p - n) *\<^sub>R y^(p-n)))"
     by (simp add: algebra_simps)
   also have "\<dots> sums (cos x * cos y)"
     using summable_norm_cos
     by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
   finally show ?thesis .
 qed
 
 text \<open>The product of two sine series.\<close>
 lemma sin_x_sin_y:
   fixes x :: "'a::{real_normed_field,banach}"
   shows
     "(\<lambda>p. \<Sum>n\<le>p.
         if even p \<and> odd n
         then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
         else 0)
       sums (sin x * sin y)"
 proof -
   have "(sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
     (if even p \<and> odd n
      then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
      else 0)"
     if "n \<le> p" for n p :: nat
   proof -
     have "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
       if np: "odd n" "even p"
     proof -
       have "p > 0"
         using \<open>n \<le> p\<close> neq0_conv that(1) by blast
       then have \<section>: "(- 1::real) ^ (p div 2 - Suc 0) = - ((- 1) ^ (p div 2))"
         using \<open>even p\<close> by (auto simp add: dvd_def power_eq_if)
       from \<open>n \<le> p\<close> np have *: "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) \<le> p"
         by arith+
       have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
         by simp
       with \<open>n \<le> p\<close> np  \<section> * show ?thesis
         by (simp add: flip: div_add power_add)
     qed
     then show ?thesis
       using \<open>n\<le>p\<close> by (auto simp: algebra_simps sin_coeff_def binomial_fact)
   qed
   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> odd n
                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
              (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
     by simp
   also have "\<dots> = (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n *\<^sub>R x^n) * (sin_coeff (p - n) *\<^sub>R y^(p-n)))"
     by (simp add: algebra_simps)
   also have "\<dots> sums (sin x * sin y)"
     using summable_norm_sin
     by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
   finally show ?thesis .
 qed
 
 lemma sums_cos_x_plus_y:
   fixes x :: "'a::{real_normed_field,banach}"
   shows
     "(\<lambda>p. \<Sum>n\<le>p.
         if even p
         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
         else 0)
       sums cos (x + y)"
 proof -
   have
     "(\<Sum>n\<le>p.
       if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
       else 0) = cos_coeff p *\<^sub>R ((x + y) ^ p)"
     for p :: nat
   proof -
     have
       "(\<Sum>n\<le>p. if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
        (if even p then \<Sum>n\<le>p. ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
       by simp
     also have "\<dots> =
        (if even p
         then of_real ((-1) ^ (p div 2) / (fact p)) * (\<Sum>n\<le>p. (p choose n) *\<^sub>R (x^n) * y^(p-n))
         else 0)"
       by (auto simp: sum_distrib_left field_simps scaleR_conv_of_real nonzero_of_real_divide)
     also have "\<dots> = cos_coeff p *\<^sub>R ((x + y) ^ p)"
       by (simp add: cos_coeff_def binomial_ring [of x y]  scaleR_conv_of_real atLeast0AtMost)
     finally show ?thesis .
   qed
   then have
     "(\<lambda>p. \<Sum>n\<le>p.
         if even p
         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
         else 0) = (\<lambda>p. cos_coeff p *\<^sub>R ((x+y)^p))"
     by simp
    also have "\<dots> sums cos (x + y)"
     by (rule cos_converges)
    finally show ?thesis .
 qed
 
 theorem cos_add:
   fixes x :: "'a::{real_normed_field,banach}"
   shows "cos (x + y) = cos x * cos y - sin x * sin y"
 proof -
   have
     "(if even p \<and> even n
       then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) -
      (if even p \<and> odd n
       then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
      (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
     if "n \<le> p" for n p :: nat
     by simp
   then have
     "(\<lambda>p. \<Sum>n\<le>p. (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0))
       sums (cos x * cos y - sin x * sin y)"
     using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
     by (simp add: sum_subtractf [symmetric])
   then show ?thesis
     by (blast intro: sums_cos_x_plus_y sums_unique2)
 qed
 
 lemma sin_minus_converges: "(\<lambda>n. - (sin_coeff n *\<^sub>R (-x)^n)) sums sin x"
 proof -
   have [simp]: "\<And>n. - (sin_coeff n *\<^sub>R (-x)^n) = (sin_coeff n *\<^sub>R x^n)"
     by (auto simp: sin_coeff_def elim!: oddE)
   show ?thesis
     by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
 qed
 
 lemma sin_minus [simp]: "sin (- x) = - sin x"
   for x :: "'a::{real_normed_algebra_1,banach}"
   using sin_minus_converges [of x]
   by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel]
       suminf_minus sums_iff equation_minus_iff)
 
 lemma cos_minus_converges: "(\<lambda>n. (cos_coeff n *\<^sub>R (-x)^n)) sums cos x"
 proof -
   have [simp]: "\<And>n. (cos_coeff n *\<^sub>R (-x)^n) = (cos_coeff n *\<^sub>R x^n)"
     by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
   show ?thesis
     by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
 qed
 
 lemma cos_minus [simp]: "cos (-x) = cos x"
   for x :: "'a::{real_normed_algebra_1,banach}"
   using cos_minus_converges [of x] by (metis cos_def sums_unique)
 
 lemma cos_abs_real [simp]: "cos \<bar>x :: real\<bar> = cos x"
   by (simp add: abs_if)
 
 lemma sin_cos_squared_add [simp]: "(sin x)\<^sup>2 + (cos x)\<^sup>2 = 1"
   for x :: "'a::{real_normed_field,banach}"
   using cos_add [of x "-x"]
   by (simp add: power2_eq_square algebra_simps)
 
 lemma sin_cos_squared_add2 [simp]: "(cos x)\<^sup>2 + (sin x)\<^sup>2 = 1"
   for x :: "'a::{real_normed_field,banach}"
   by (subst add.commute, rule sin_cos_squared_add)
 
 lemma sin_cos_squared_add3 [simp]: "cos x * cos x + sin x * sin x = 1"
   for x :: "'a::{real_normed_field,banach}"
   using sin_cos_squared_add2 [unfolded power2_eq_square] .
 
 lemma sin_squared_eq: "(sin x)\<^sup>2 = 1 - (cos x)\<^sup>2"
   for x :: "'a::{real_normed_field,banach}"
   unfolding eq_diff_eq by (rule sin_cos_squared_add)
 
 lemma cos_squared_eq: "(cos x)\<^sup>2 = 1 - (sin x)\<^sup>2"
   for x :: "'a::{real_normed_field,banach}"
   unfolding eq_diff_eq by (rule sin_cos_squared_add2)
 
 lemma abs_sin_le_one [simp]: "\<bar>sin x\<bar> \<le> 1"
   for x :: real
   by (rule power2_le_imp_le) (simp_all add: sin_squared_eq)
 
 lemma sin_ge_minus_one [simp]: "- 1 \<le> sin x"
   for x :: real
   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
 
 lemma sin_le_one [simp]: "sin x \<le> 1"
   for x :: real
   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
 
 lemma abs_cos_le_one [simp]: "\<bar>cos x\<bar> \<le> 1"
   for x :: real
   by (rule power2_le_imp_le) (simp_all add: cos_squared_eq)
 
 lemma cos_ge_minus_one [simp]: "- 1 \<le> cos x"
   for x :: real
   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
 
 lemma cos_le_one [simp]: "cos x \<le> 1"
   for x :: real
   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
 
 lemma cos_diff: "cos (x - y) = cos x * cos y + sin x * sin y"
   for x :: "'a::{real_normed_field,banach}"
   using cos_add [of x "- y"] by simp
 
 lemma cos_double: "cos(2*x) = (cos x)\<^sup>2 - (sin x)\<^sup>2"
   for x :: "'a::{real_normed_field,banach}"
   using cos_add [where x=x and y=x] by (simp add: power2_eq_square)
 
 lemma sin_cos_le1: "\<bar>sin x * sin y + cos x * cos y\<bar> \<le> 1"
   for x :: real
   using cos_diff [of x y] by (metis abs_cos_le_one add.commute)
 
 lemma DERIV_fun_pow: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
   by (auto intro!: derivative_eq_intros simp:)
 
 lemma DERIV_fun_exp: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. exp (g x)) x :> exp (g x) * m"
   by (auto intro!: derivative_intros)
 
 
 subsection \<open>The Constant Pi\<close>
 
 definition pi :: real
   where "pi = 2 * (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
 
 text \<open>Show that there's a least positive \<^term>\<open>x\<close> with \<^term>\<open>cos x = 0\<close>;
    hence define pi.\<close>
 
 lemma sin_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums  sin x"
   for x :: real
 proof -
   have "(\<lambda>n. \<Sum>k = n*2..<n * 2 + 2. sin_coeff k * x ^ k) sums sin x"
     by (rule sums_group) (use sin_converges [of x, unfolded scaleR_conv_of_real] in auto)
   then show ?thesis
     by (simp add: sin_coeff_def ac_simps)
 qed
 
 lemma sin_gt_zero_02:
   fixes x :: real
   assumes "0 < x" and "x < 2"
   shows "0 < sin x"
 proof -
   let ?f = "\<lambda>n::nat. \<Sum>k = n*2..<n*2+2. (- 1) ^ k / (fact (2*k+1)) * x^(2*k+1)"
   have pos: "\<forall>n. 0 < ?f n"
   proof
     fix n :: nat
     let ?k2 = "real (Suc (Suc (4 * n)))"
     let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
     have "x * x < ?k2 * ?k3"
       using assms by (intro mult_strict_mono', simp_all)
     then have "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
       by (intro mult_strict_right_mono zero_less_power \<open>0 < x\<close>)
     then show "0 < ?f n"
       by (simp add: ac_simps divide_less_eq)
 qed
   have sums: "?f sums sin x"
     by (rule sin_paired [THEN sums_group]) simp
   show "0 < sin x"
     unfolding sums_unique [OF sums] using sums_summable [OF sums] pos by (simp add: suminf_pos)
 qed
 
 lemma cos_double_less_one: "0 < x \<Longrightarrow> x < 2 \<Longrightarrow> cos (2 * x) < 1"
   for x :: real
   using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)
 
 lemma cos_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
   for x :: real
 proof -
   have "(\<lambda>n. \<Sum>k = n * 2..<n * 2 + 2. cos_coeff k * x ^ k) sums cos x"
     by (rule sums_group) (use cos_converges [of x, unfolded scaleR_conv_of_real] in auto)
   then show ?thesis
     by (simp add: cos_coeff_def ac_simps)
 qed
 
 lemma sum_pos_lt_pair:
   fixes f :: "nat \<Rightarrow> real"
   assumes f: "summable f" and fplus: "\<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc (Suc 0) * d) + 1))"
   shows "sum f {..<k} < suminf f"
 proof -
   have "(\<lambda>n. \<Sum>n = n * Suc (Suc 0)..<n * Suc (Suc 0) +  Suc (Suc 0). f (n + k)) 
              sums (\<Sum>n. f (n + k))"
   proof (rule sums_group)
     show "(\<lambda>n. f (n + k)) sums (\<Sum>n. f (n + k))"
       by (simp add: f summable_iff_shift summable_sums)
   qed auto
   with fplus have "0 < (\<Sum>n. f (n + k))"
     apply (simp add: add.commute)
     apply (metis (no_types, lifting) suminf_pos summable_def sums_unique)
     done
   then show ?thesis
     by (simp add: f suminf_minus_initial_segment)
 qed
 
 lemma cos_two_less_zero [simp]: "cos 2 < (0::real)"
 proof -
   note fact_Suc [simp del]
   from sums_minus [OF cos_paired]
   have *: "(\<lambda>n. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
     by simp
   then have sm: "summable (\<lambda>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
     by (rule sums_summable)
   have "0 < (\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
     by (simp add: fact_num_eq_if power_eq_if)
   moreover have "(\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n  * 2 ^ (2 * n) / (fact (2 * n)))) <
     (\<Sum>n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
   proof -
     {
       fix d
       let ?six4d = "Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))"
       have "(4::real) * (fact (?six4d)) < (Suc (Suc (?six4d)) * fact (Suc (?six4d)))"
         unfolding of_nat_mult by (rule mult_strict_mono) (simp_all add: fact_less_mono)
       then have "(4::real) * (fact (?six4d)) < (fact (Suc (Suc (?six4d))))"
         by (simp only: fact_Suc [of "Suc (?six4d)"] of_nat_mult of_nat_fact)
       then have "(4::real) * inverse (fact (Suc (Suc (?six4d)))) < inverse (fact (?six4d))"
         by (simp add: inverse_eq_divide less_divide_eq)
     }
     then show ?thesis
       by (force intro!: sum_pos_lt_pair [OF sm] simp add: divide_inverse algebra_simps)
   qed
   ultimately have "0 < (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
     by (rule order_less_trans)
   moreover from * have "- cos 2 = (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
     by (rule sums_unique)
   ultimately have "(0::real) < - cos 2" by simp
   then show ?thesis by simp
 qed
 
 lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
 lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]
 
 lemma cos_is_zero: "\<exists>!x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
 proof (rule ex_ex1I)
   show "\<exists>x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
     by (rule IVT2) simp_all
 next
   fix a b :: real
   assume ab: "0 \<le> a \<and> a \<le> 2 \<and> cos a = 0" "0 \<le> b \<and> b \<le> 2 \<and> cos b = 0"
   have cosd: "\<And>x::real. cos differentiable (at x)"
     unfolding real_differentiable_def by (auto intro: DERIV_cos)
   show "a = b"
   proof (cases a b rule: linorder_cases)
     case less
     then obtain z where "a < z" "z < b" "(cos has_real_derivative 0) (at z)"
       using Rolle by (metis cosd continuous_on_cos_real ab)
     then have "sin z = 0"
       using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
     then show ?thesis
       by (metis \<open>a < z\<close> \<open>z < b\<close> ab order_less_le_trans less_le sin_gt_zero_02)
   next
     case greater
     then obtain z where "b < z" "z < a" "(cos has_real_derivative 0) (at z)"
       using Rolle by (metis cosd continuous_on_cos_real ab)
     then have "sin z = 0"
       using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
     then show ?thesis
       by (metis \<open>b < z\<close> \<open>z < a\<close> ab order_less_le_trans less_le sin_gt_zero_02)
   qed auto
 qed
 
 lemma pi_half: "pi/2 = (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
   by (simp add: pi_def)
 
 lemma cos_pi_half [simp]: "cos (pi/2) = 0"
   by (simp add: pi_half cos_is_zero [THEN theI'])
 
 lemma cos_of_real_pi_half [simp]: "cos ((of_real pi/2) :: 'a) = 0"
   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
   by (metis cos_pi_half cos_of_real eq_numeral_simps(4)
       nonzero_of_real_divide of_real_0 of_real_numeral)
 
 lemma pi_half_gt_zero [simp]: "0 < pi/2"
 proof -
   have "0 \<le> pi/2"
     by (simp add: pi_half cos_is_zero [THEN theI'])
   then show ?thesis
     by (metis cos_pi_half cos_zero less_eq_real_def one_neq_zero)
 qed
 
 lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
 lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]
 
 lemma pi_half_less_two [simp]: "pi/2 < 2"
 proof -
   have "pi/2 \<le> 2"
     by (simp add: pi_half cos_is_zero [THEN theI'])
   then show ?thesis
     by (metis cos_pi_half cos_two_neq_zero le_less)
 qed
 
 lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
 lemmas pi_half_le_two [simp] =  pi_half_less_two [THEN order_less_imp_le]
 
 lemma pi_gt_zero [simp]: "0 < pi"
   using pi_half_gt_zero by simp
 
 lemma pi_ge_zero [simp]: "0 \<le> pi"
   by (rule pi_gt_zero [THEN order_less_imp_le])
 
 lemma pi_neq_zero [simp]: "pi \<noteq> 0"
   by (rule pi_gt_zero [THEN less_imp_neq, symmetric])
 
 lemma pi_not_less_zero [simp]: "\<not> pi < 0"
   by (simp add: linorder_not_less)
 
 lemma minus_pi_half_less_zero: "-(pi/2) < 0"
   by simp
 
 lemma m2pi_less_pi: "- (2*pi) < pi"
   by simp
 
 lemma sin_pi_half [simp]: "sin(pi/2) = 1"
   using sin_cos_squared_add2 [where x = "pi/2"]
   using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
   by (simp add: power2_eq_1_iff)
 
 lemma sin_of_real_pi_half [simp]: "sin ((of_real pi/2) :: 'a) = 1"
   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
   using sin_pi_half
   by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)
 
 lemma sin_cos_eq: "sin x = cos (of_real pi/2 - x)"
   for x :: "'a::{real_normed_field,banach}"
   by (simp add: cos_diff)
 
 lemma minus_sin_cos_eq: "- sin x = cos (x + of_real pi/2)"
   for x :: "'a::{real_normed_field,banach}"
   by (simp add: cos_add nonzero_of_real_divide)
 
 lemma cos_sin_eq: "cos x = sin (of_real pi/2 - x)"
   for x :: "'a::{real_normed_field,banach}"
   using sin_cos_eq [of "of_real pi/2 - x"] by simp
 
 lemma sin_add: "sin (x + y) = sin x * cos y + cos x * sin y"
   for x :: "'a::{real_normed_field,banach}"
   using cos_add [of "of_real pi/2 - x" "-y"]
   by (simp add: cos_sin_eq) (simp add: sin_cos_eq)
 
 lemma sin_diff: "sin (x - y) = sin x * cos y - cos x * sin y"
   for x :: "'a::{real_normed_field,banach}"
   using sin_add [of x "- y"] by simp
 
 lemma sin_double: "sin(2 * x) = 2 * sin x * cos x"
   for x :: "'a::{real_normed_field,banach}"
   using sin_add [where x=x and y=x] by simp
 
 lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
   using cos_add [where x = "pi/2" and y = "pi/2"]
   by (simp add: cos_of_real)
 
 lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
   using sin_add [where x = "pi/2" and y = "pi/2"]
   by (simp add: sin_of_real)
 
 lemma cos_pi [simp]: "cos pi = -1"
   using cos_add [where x = "pi/2" and y = "pi/2"] by simp
 
 lemma sin_pi [simp]: "sin pi = 0"
   using sin_add [where x = "pi/2" and y = "pi/2"] by simp
 
 lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
   by (simp add: sin_add)
 
 lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
   by (simp add: sin_add)
 
 lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
   by (simp add: cos_add)
 
 lemma cos_periodic_pi2 [simp]: "cos (pi + x) = - cos x"
   by (simp add: cos_add)
 
 lemma sin_periodic [simp]: "sin (x + 2 * pi) = sin x"
   by (simp add: sin_add sin_double cos_double)
 
 lemma cos_periodic [simp]: "cos (x + 2 * pi) = cos x"
   by (simp add: cos_add sin_double cos_double)
 
 lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
   by (induct n) (auto simp: distrib_right)
 
 lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
   by (metis cos_npi mult.commute)
 
 lemma sin_npi [simp]: "sin (real n * pi) = 0"
   for n :: nat
   by (induct n) (auto simp: distrib_right)
 
 lemma sin_npi2 [simp]: "sin (pi * real n) = 0"
   for n :: nat
   by (simp add: mult.commute [of pi])
 
 lemma cos_two_pi [simp]: "cos (2 * pi) = 1"
   by (simp add: cos_double)
 
 lemma sin_two_pi [simp]: "sin (2 * pi) = 0"
   by (simp add: sin_double)
 
 context
   fixes w :: "'a::{real_normed_field,banach}"
 
 begin
 
 lemma sin_times_sin: "sin w * sin z = (cos (w - z) - cos (w + z)) / 2"
   by (simp add: cos_diff cos_add)
 
 lemma sin_times_cos: "sin w * cos z = (sin (w + z) + sin (w - z)) / 2"
   by (simp add: sin_diff sin_add)
 
 lemma cos_times_sin: "cos w * sin z = (sin (w + z) - sin (w - z)) / 2"
   by (simp add: sin_diff sin_add)
 
 lemma cos_times_cos: "cos w * cos z = (cos (w - z) + cos (w + z)) / 2"
   by (simp add: cos_diff cos_add)
 
 lemma cos_double_cos: "cos (2 * w) = 2 * cos w ^ 2 - 1"
   by (simp add: cos_double sin_squared_eq)
 
 lemma cos_double_sin: "cos (2 * w) = 1 - 2 * sin w ^ 2"
   by (simp add: cos_double sin_squared_eq)
 
 end
 
 lemma sin_plus_sin: "sin w + sin z = 2 * sin ((w + z) / 2) * cos ((w - z) / 2)"
   for w :: "'a::{real_normed_field,banach}" 
   apply (simp add: mult.assoc sin_times_cos)
   apply (simp add: field_simps)
   done
 
 lemma sin_diff_sin: "sin w - sin z = 2 * sin ((w - z) / 2) * cos ((w + z) / 2)"
   for w :: "'a::{real_normed_field,banach}"
   apply (simp add: mult.assoc sin_times_cos)
   apply (simp add: field_simps)
   done
 
 lemma cos_plus_cos: "cos w + cos z = 2 * cos ((w + z) / 2) * cos ((w - z) / 2)"
   for w :: "'a::{real_normed_field,banach,field}"
   apply (simp add: mult.assoc cos_times_cos)
   apply (simp add: field_simps)
   done
 
 lemma cos_diff_cos: "cos w - cos z = 2 * sin ((w + z) / 2) * sin ((z - w) / 2)"
   for w :: "'a::{real_normed_field,banach,field}"
   apply (simp add: mult.assoc sin_times_sin)
   apply (simp add: field_simps)
   done
 
 lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
   by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)
 
 lemma cos_pi_minus [simp]: "cos (pi - x) = - (cos x)"
   by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)
 
 lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
   by (simp add: sin_diff)
 
 lemma cos_minus_pi [simp]: "cos (x - pi) = - (cos x)"
   by (simp add: cos_diff)
 
 lemma sin_2pi_minus [simp]: "sin (2 * pi - x) = - (sin x)"
   by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)
 
 lemma cos_2pi_minus [simp]: "cos (2 * pi - x) = cos x"
   by (metis (no_types, opaque_lifting) cos_add cos_minus cos_two_pi sin_minus sin_two_pi
       diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)
 
 lemma sin_gt_zero2: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < sin x"
   by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)
 
 lemma sin_less_zero:
   assumes "- pi/2 < x" and "x < 0"
   shows "sin x < 0"
 proof -
   have "0 < sin (- x)"
     using assms by (simp only: sin_gt_zero2)
   then show ?thesis by simp
 qed
 
 lemma pi_less_4: "pi < 4"
   using pi_half_less_two by auto
 
 lemma cos_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
   by (simp add: cos_sin_eq sin_gt_zero2)
 
 lemma cos_gt_zero_pi: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
   using cos_gt_zero [of x] cos_gt_zero [of "-x"]
   by (cases rule: linorder_cases [of x 0]) auto
 
 lemma cos_ge_zero: "-(pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> 0 \<le> cos x"
   by (auto simp: order_le_less cos_gt_zero_pi)
     (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))
 
 lemma sin_gt_zero: "0 < x \<Longrightarrow> x < pi \<Longrightarrow> 0 < sin x"
   by (simp add: sin_cos_eq cos_gt_zero_pi)
 
 lemma sin_lt_zero: "pi < x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x < 0"
   using sin_gt_zero [of "x - pi"]
   by (simp add: sin_diff)
 
 lemma pi_ge_two: "2 \<le> pi"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have "pi < 2" by auto
   have "\<exists>y > pi. y < 2 \<and> y < 2 * pi"
   proof (cases "2 < 2 * pi")
     case True
     with dense[OF \<open>pi < 2\<close>] show ?thesis by auto
   next
     case False
     have "pi < 2 * pi" by auto
     from dense[OF this] and False show ?thesis by auto
   qed
   then obtain y where "pi < y" and "y < 2" and "y < 2 * pi"
     by blast
   then have "0 < sin y"
     using sin_gt_zero_02 by auto
   moreover have "sin y < 0"
     using sin_gt_zero[of "y - pi"] \<open>pi < y\<close> and \<open>y < 2 * pi\<close> sin_periodic_pi[of "y - pi"]
     by auto
   ultimately show False by auto
 qed
 
 lemma sin_ge_zero: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> sin x"
   by (auto simp: order_le_less sin_gt_zero)
 
 lemma sin_le_zero: "pi \<le> x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x \<le> 0"
   using sin_ge_zero [of "x - pi"] by (simp add: sin_diff)
 
 lemma sin_pi_divide_n_ge_0 [simp]:
   assumes "n \<noteq> 0"
   shows "0 \<le> sin (pi/real n)"
   by (rule sin_ge_zero) (use assms in \<open>simp_all add: field_split_simps\<close>)
 
 lemma sin_pi_divide_n_gt_0:
   assumes "2 \<le> n"
   shows "0 < sin (pi/real n)"
   by (rule sin_gt_zero) (use assms in \<open>simp_all add: field_split_simps\<close>)
 
 text\<open>Proof resembles that of \<open>cos_is_zero\<close> but with \<^term>\<open>pi\<close> for the upper bound\<close>
 lemma cos_total:
   assumes y: "-1 \<le> y" "y \<le> 1"
   shows "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
 proof (rule ex_ex1I)
   show "\<exists>x::real. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
     by (rule IVT2) (simp_all add: y)
 next
   fix a b :: real
   assume ab: "0 \<le> a \<and> a \<le> pi \<and> cos a = y" "0 \<le> b \<and> b \<le> pi \<and> cos b = y"
   have cosd: "\<And>x::real. cos differentiable (at x)"
     unfolding real_differentiable_def by (auto intro: DERIV_cos)
   show "a = b"
   proof (cases a b rule: linorder_cases)
     case less
     then obtain z where "a < z" "z < b" "(cos has_real_derivative 0) (at z)"
       using Rolle by (metis cosd continuous_on_cos_real ab)
     then have "sin z = 0"
       using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
     then show ?thesis
       by (metis \<open>a < z\<close> \<open>z < b\<close> ab order_less_le_trans less_le sin_gt_zero)
   next
     case greater
     then obtain z where "b < z" "z < a" "(cos has_real_derivative 0) (at z)"
       using Rolle by (metis cosd continuous_on_cos_real ab)
     then have "sin z = 0"
       using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
     then show ?thesis
       by (metis \<open>b < z\<close> \<open>z < a\<close> ab order_less_le_trans less_le sin_gt_zero)
   qed auto
 qed
 
 lemma sin_total:
   assumes y: "-1 \<le> y" "y \<le> 1"
   shows "\<exists>!x. - (pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y"
 proof -
   from cos_total [OF y]
   obtain x where x: "0 \<le> x" "x \<le> pi" "cos x = y"
     and uniq: "\<And>x'. 0 \<le> x' \<Longrightarrow> x' \<le> pi \<Longrightarrow> cos x' = y \<Longrightarrow> x' = x "
     by blast
   show ?thesis
     unfolding sin_cos_eq
   proof (rule ex1I [where a="pi/2 - x"])
     show "- (pi/2) \<le> z \<and> z \<le> pi/2 \<and> cos (of_real pi/2 - z) = y \<Longrightarrow>
           z = pi/2 - x" for z
       using uniq [of "pi/2 -z"] by auto
   qed (use x in auto)
 qed
 
 lemma cos_zero_lemma:
   assumes "0 \<le> x" "cos x = 0"
   shows "\<exists>n. odd n \<and> x = of_nat n * (pi/2)"
 proof -
   have xle: "x < (1 + real_of_int \<lfloor>x/pi\<rfloor>) * pi"
     using floor_correct [of "x/pi"]
     by (simp add: add.commute divide_less_eq)
   obtain n where "real n * pi \<le> x" "x < real (Suc n) * pi"
   proof 
     show "real (nat \<lfloor>x / pi\<rfloor>) * pi \<le> x"
       using assms floor_divide_lower [of pi x] by auto
     show "x < real (Suc (nat \<lfloor>x / pi\<rfloor>)) * pi"
       using assms floor_divide_upper [of pi x]  by (simp add: xle)
   qed
   then have x: "0 \<le> x - n * pi" "(x - n * pi) \<le> pi" "cos (x - n * pi) = 0"
     by (auto simp: algebra_simps cos_diff assms)
   then have "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = 0"
     by (auto simp: intro!: cos_total)
   then obtain \<theta> where \<theta>: "0 \<le> \<theta>" "\<theta> \<le> pi" "cos \<theta> = 0"
     and uniq: "\<And>\<phi>. 0 \<le> \<phi> \<Longrightarrow> \<phi> \<le> pi \<Longrightarrow> cos \<phi> = 0 \<Longrightarrow> \<phi> = \<theta>"
     by blast
   then have "x - real n * pi = \<theta>"
     using x by blast
   moreover have "pi/2 = \<theta>"
     using pi_half_ge_zero uniq by fastforce
   ultimately show ?thesis
     by (rule_tac x = "Suc (2 * n)" in exI) (simp add: algebra_simps)
 qed
 
 lemma sin_zero_lemma:
   assumes "0 \<le> x" "sin x = 0"
   shows "\<exists>n::nat. even n \<and> x = real n * (pi/2)"
 proof -
   obtain n where "odd n" and n: "x + pi/2 = of_nat n * (pi/2)" "n > 0"
     using cos_zero_lemma [of "x + pi/2"] assms by (auto simp add: cos_add)
   then have "x = real (n - 1) * (pi/2)"
     by (simp add: algebra_simps of_nat_diff)
   then show ?thesis
     by (simp add: \<open>odd n\<close>)
 qed
 
 lemma cos_zero_iff:
   "cos x = 0 \<longleftrightarrow> ((\<exists>n. odd n \<and> x = real n * (pi/2)) \<or> (\<exists>n. odd n \<and> x = - (real n * (pi/2))))"
   (is "?lhs = ?rhs")
 proof -
   have *: "cos (real n * pi/2) = 0" if "odd n" for n :: nat
   proof -
     from that obtain m where "n = 2 * m + 1" ..
     then show ?thesis
       by (simp add: field_simps) (simp add: cos_add add_divide_distrib)
   qed
   show ?thesis
   proof
     show ?rhs if ?lhs
       using that cos_zero_lemma [of x] cos_zero_lemma [of "-x"] by force
     show ?lhs if ?rhs
       using that by (auto dest: * simp del: eq_divide_eq_numeral1)
   qed
 qed
 
 lemma sin_zero_iff:
   "sin x = 0 \<longleftrightarrow> ((\<exists>n. even n \<and> x = real n * (pi/2)) \<or> (\<exists>n. even n \<and> x = - (real n * (pi/2))))"
   (is "?lhs = ?rhs")
 proof
   show ?rhs if ?lhs
     using that sin_zero_lemma [of x] sin_zero_lemma [of "-x"] by force
   show ?lhs if ?rhs
     using that by (auto elim: evenE)
 qed
 
 lemma sin_zero_pi_iff:
   fixes x::real
   assumes "\<bar>x\<bar> < pi"
   shows "sin x = 0 \<longleftrightarrow> x = 0"
 proof
   show "x = 0" if "sin x = 0"
     using that assms by (auto simp: sin_zero_iff)
 qed auto
 
 lemma cos_zero_iff_int: "cos x = 0 \<longleftrightarrow> (\<exists>i. odd i \<and> x = of_int i * (pi/2))"
 proof -
   have 1: "\<And>n. odd n \<Longrightarrow> \<exists>i. odd i \<and> real n = real_of_int i"
     by (metis even_of_nat_iff of_int_of_nat_eq)
   have 2: "\<And>n. odd n \<Longrightarrow> \<exists>i. odd i \<and> - (real n * pi) = real_of_int i * pi"
     by (metis even_minus even_of_nat_iff mult.commute mult_minus_right of_int_minus of_int_of_nat_eq)
   have 3: "\<lbrakk>odd i;  \<forall>n. even n \<or> real_of_int i \<noteq> - (real n)\<rbrakk>
          \<Longrightarrow> \<exists>n. odd n \<and> real_of_int i = real n" for i
     by (cases i rule: int_cases2) auto
   show ?thesis
     by (force simp: cos_zero_iff intro!: 1 2 3)
 qed
 
 lemma sin_zero_iff_int: "sin x = 0 \<longleftrightarrow> (\<exists>i. even i \<and> x = of_int i * (pi/2))" (is "?lhs = ?rhs")
 proof safe
   assume ?lhs
   then consider (plus) n where "even n" "x = real n * (pi/2)" | (minus) n where "even n"  "x = - (real n * (pi/2))"
     using sin_zero_iff by auto
   then show "\<exists>n. even n \<and> x = of_int n * (pi/2)"
   proof cases
     case plus
     then show ?rhs
       by (metis even_of_nat_iff of_int_of_nat_eq)
   next
     case minus
     then show ?thesis
       by (rule_tac x="- (int n)" in exI) simp
   qed
 next
   fix i :: int
   assume "even i"
   then show "sin (of_int i * (pi/2)) = 0"
     by (cases i rule: int_cases2, simp_all add: sin_zero_iff)
 qed
 
 lemma sin_zero_iff_int2: "sin x = 0 \<longleftrightarrow> (\<exists>i::int. x = of_int i * pi)"
 proof -
   have "sin x = 0 \<longleftrightarrow> (\<exists>i. even i \<and> x = real_of_int i * (pi/2))"
     by (auto simp: sin_zero_iff_int)
   also have "... = (\<exists>j. x = real_of_int (2*j) * (pi/2))"
     using dvd_triv_left by blast
   also have "... = (\<exists>i::int. x = of_int i * pi)"
     by auto
   finally show ?thesis .
 qed
 
 lemma cos_zero_iff_int2:
   fixes x::real
   shows "cos x = 0 \<longleftrightarrow> (\<exists>n::int. x = n * pi +  pi/2)"
   using sin_zero_iff_int2[of "x-pi/2"] unfolding sin_cos_eq 
   by (auto simp add: algebra_simps)
 
 lemma sin_npi_int [simp]: "sin (pi * of_int n) = 0"
   by (simp add: sin_zero_iff_int2)
 
 lemma cos_monotone_0_pi:
   assumes "0 \<le> y" and "y < x" and "x \<le> pi"
   shows "cos x < cos y"
 proof -
   have "- (x - y) < 0" using assms by auto
   from MVT2[OF \<open>y < x\<close> DERIV_cos]
   obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
     by auto
   then have "0 < z" and "z < pi"
     using assms by auto
   then have "0 < sin z"
     using sin_gt_zero by auto
   then have "cos x - cos y < 0"
     unfolding cos_diff minus_mult_commute[symmetric]
     using \<open>- (x - y) < 0\<close> by (rule mult_pos_neg2)
   then show ?thesis by auto
 qed
 
 lemma cos_monotone_0_pi_le:
   assumes "0 \<le> y" and "y \<le> x" and "x \<le> pi"
   shows "cos x \<le> cos y"
 proof (cases "y < x")
   case True
   show ?thesis
     using cos_monotone_0_pi[OF \<open>0 \<le> y\<close> True \<open>x \<le> pi\<close>] by auto
 next
   case False
   then have "y = x" using \<open>y \<le> x\<close> by auto
   then show ?thesis by auto
 qed
 
 lemma cos_monotone_minus_pi_0:
   assumes "- pi \<le> y" and "y < x" and "x \<le> 0"
   shows "cos y < cos x"
 proof -
   have "0 \<le> - x" and "- x < - y" and "- y \<le> pi"
     using assms by auto
   from cos_monotone_0_pi[OF this] show ?thesis
     unfolding cos_minus .
 qed
 
 lemma cos_monotone_minus_pi_0':
   assumes "- pi \<le> y" and "y \<le> x" and "x \<le> 0"
   shows "cos y \<le> cos x"
 proof (cases "y < x")
   case True
   show ?thesis using cos_monotone_minus_pi_0[OF \<open>-pi \<le> y\<close> True \<open>x \<le> 0\<close>]
     by auto
 next
   case False
   then have "y = x" using \<open>y \<le> x\<close> by auto
   then show ?thesis by auto
 qed
 
 lemma sin_monotone_2pi:
   assumes "- (pi/2) \<le> y" and "y < x" and "x \<le> pi/2"
   shows "sin y < sin x"
   unfolding sin_cos_eq
   using assms by (auto intro: cos_monotone_0_pi)
 
 lemma sin_monotone_2pi_le:
   assumes "- (pi/2) \<le> y" and "y \<le> x" and "x \<le> pi/2"
   shows "sin y \<le> sin x"
   by (metis assms le_less sin_monotone_2pi)
 
 lemma sin_x_le_x:
   fixes x :: real
   assumes "x \<ge> 0"
   shows "sin x \<le> x"
 proof -
   let ?f = "\<lambda>x. x - sin x"
   have "\<And>u. \<lbrakk>0 \<le> u; u \<le> x\<rbrakk> \<Longrightarrow> \<exists>y. (?f has_real_derivative 1 - cos u) (at u)"
     by (auto intro!: derivative_eq_intros simp: field_simps)
   then have "?f x \<ge> ?f 0"
     by (metis cos_le_one diff_ge_0_iff_ge DERIV_nonneg_imp_nondecreasing [OF assms])
   then show "sin x \<le> x" by simp
 qed
 
 lemma sin_x_ge_neg_x:
   fixes x :: real
   assumes x: "x \<ge> 0"
   shows "sin x \<ge> - x"
 proof -
   let ?f = "\<lambda>x. x + sin x"
   have \<section>: "\<And>u. \<lbrakk>0 \<le> u; u \<le> x\<rbrakk> \<Longrightarrow> \<exists>y. (?f has_real_derivative 1 + cos u) (at u)"
     by (auto intro!: derivative_eq_intros simp: field_simps)
   have "?f x \<ge> ?f 0"
     by (rule DERIV_nonneg_imp_nondecreasing [OF assms]) (use \<section> real_0_le_add_iff in force)
   then show "sin x \<ge> -x" by simp
 qed
 
 lemma abs_sin_x_le_abs_x: "\<bar>sin x\<bar> \<le> \<bar>x\<bar>"
   for x :: real
   using sin_x_ge_neg_x [of x] sin_x_le_x [of x] sin_x_ge_neg_x [of "-x"] sin_x_le_x [of "-x"]
   by (auto simp: abs_real_def)
 
 
 subsection \<open>More Corollaries about Sine and Cosine\<close>
 
 lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi/2) = (-1) ^ n"
 proof -
   have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
     by (auto simp: algebra_simps sin_add)
   then show ?thesis
     by (simp add: distrib_right add_divide_distrib add.commute mult.commute [of pi])
 qed
 
 lemma cos_2npi [simp]: "cos (2 * real n * pi) = 1"
   for n :: nat
   by (cases "even n") (simp_all add: cos_double mult.assoc)
 
 lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
 proof -
   have "cos (3/2*pi) = cos (pi + pi/2)"
     by simp
   also have "... = 0"
     by (subst cos_add, simp)
   finally show ?thesis .
 qed
 
 lemma sin_2npi [simp]: "sin (2 * real n * pi) = 0"
   for n :: nat
   by (auto simp: mult.assoc sin_double)
 
 lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
 proof -
   have "sin (3/2*pi) = sin (pi + pi/2)"
     by simp
   also have "... = -1"
     by (subst sin_add, simp)
   finally show ?thesis .
 qed
 
 lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
   by (simp only: cos_add sin_add of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)
 
 lemma DERIV_cos_add [simp]: "DERIV (\<lambda>x. cos (x + k)) xa :> - sin (xa + k)"
   by (auto intro!: derivative_eq_intros)
 
 lemma sin_zero_norm_cos_one:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes "sin x = 0"
   shows "norm (cos x) = 1"
   using sin_cos_squared_add [of x, unfolded assms]
   by (simp add: square_norm_one)
 
 lemma sin_zero_abs_cos_one: "sin x = 0 \<Longrightarrow> \<bar>cos x\<bar> = (1::real)"
   using sin_zero_norm_cos_one by fastforce
 
 lemma cos_one_sin_zero:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes "cos x = 1"
   shows "sin x = 0"
   using sin_cos_squared_add [of x, unfolded assms]
   by simp
 
 lemma sin_times_pi_eq_0: "sin (x * pi) = 0 \<longleftrightarrow> x \<in> \<int>"
   by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_of_int)
 
 lemma cos_one_2pi: "cos x = 1 \<longleftrightarrow> (\<exists>n::nat. x = n * 2 * pi) \<or> (\<exists>n::nat. x = - (n * 2 * pi))"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "sin x = 0"
     by (simp add: cos_one_sin_zero)
   then show ?rhs
   proof (simp only: sin_zero_iff, elim exE disjE conjE)
     fix n :: nat
     assume n: "even n" "x = real n * (pi/2)"
     then obtain m where m: "n = 2 * m"
       using dvdE by blast
     then have me: "even m" using \<open>?lhs\<close> n
       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
     show ?rhs
       using m me n
       by (auto simp: field_simps elim!: evenE)
   next
     fix n :: nat
     assume n: "even n" "x = - (real n * (pi/2))"
     then obtain m where m: "n = 2 * m"
       using dvdE by blast
     then have me: "even m" using \<open>?lhs\<close> n
       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
     show ?rhs
       using m me n
       by (auto simp: field_simps elim!: evenE)
   qed
 next
   assume ?rhs
   then show "cos x = 1"
     by (metis cos_2npi cos_minus mult.assoc mult.left_commute)
 qed
 
 lemma cos_one_2pi_int: "cos x = 1 \<longleftrightarrow> (\<exists>n::int. x = n * 2 * pi)" (is "?lhs = ?rhs")
 proof
   assume "cos x = 1"
   then show ?rhs
     by (metis cos_one_2pi mult.commute mult_minus_right of_int_minus of_int_of_nat_eq)
 next
   assume ?rhs
   then show "cos x = 1"
     by (clarsimp simp add: cos_one_2pi) (metis mult_minus_right of_int_of_nat)
 qed
 
 lemma cos_npi_int [simp]:
   fixes n::int shows "cos (pi * of_int n) = (if even n then 1 else -1)"
     by (auto simp: algebra_simps cos_one_2pi_int elim!: oddE evenE)
 
 lemma sin_cos_sqrt: "0 \<le> sin x \<Longrightarrow> sin x = sqrt (1 - (cos(x) ^ 2))"
   using sin_squared_eq real_sqrt_unique by fastforce
 
 lemma sin_eq_0_pi: "- pi < x \<Longrightarrow> x < pi \<Longrightarrow> sin x = 0 \<Longrightarrow> x = 0"
   by (metis sin_gt_zero sin_minus minus_less_iff neg_0_less_iff_less not_less_iff_gr_or_eq)
 
 lemma cos_treble_cos: "cos (3 * x) = 4 * cos x ^ 3 - 3 * cos x"
   for x :: "'a::{real_normed_field,banach}"
 proof -
   have *: "(sin x * (sin x * 3)) = 3 - (cos x * (cos x * 3))"
     by (simp add: mult.assoc [symmetric] sin_squared_eq [unfolded power2_eq_square])
   have "cos(3 * x) = cos(2*x + x)"
     by simp
   also have "\<dots> = 4 * cos x ^ 3 - 3 * cos x"
     unfolding cos_add cos_double sin_double
     by (simp add: * field_simps power2_eq_square power3_eq_cube)
   finally show ?thesis .
 qed
 
 lemma cos_45: "cos (pi/4) = sqrt 2 / 2"
 proof -
   let ?c = "cos (pi/4)"
   let ?s = "sin (pi/4)"
   have nonneg: "0 \<le> ?c"
     by (simp add: cos_ge_zero)
   have "0 = cos (pi/4 + pi/4)"
     by simp
   also have "cos (pi/4 + pi/4) = ?c\<^sup>2 - ?s\<^sup>2"
     by (simp only: cos_add power2_eq_square)
   also have "\<dots> = 2 * ?c\<^sup>2 - 1"
     by (simp add: sin_squared_eq)
   finally have "?c\<^sup>2 = (sqrt 2 / 2)\<^sup>2"
     by (simp add: power_divide)
   then show ?thesis
     using nonneg by (rule power2_eq_imp_eq) simp
 qed
 
 lemma cos_30: "cos (pi/6) = sqrt 3/2"
 proof -
   let ?c = "cos (pi/6)"
   let ?s = "sin (pi/6)"
   have pos_c: "0 < ?c"
     by (rule cos_gt_zero) simp_all
   have "0 = cos (pi/6 + pi/6 + pi/6)"
     by simp
   also have "\<dots> = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
     by (simp only: cos_add sin_add)
   also have "\<dots> = ?c * (?c\<^sup>2 - 3 * ?s\<^sup>2)"
     by (simp add: algebra_simps power2_eq_square)
   finally have "?c\<^sup>2 = (sqrt 3/2)\<^sup>2"
     using pos_c by (simp add: sin_squared_eq power_divide)
   then show ?thesis
     using pos_c [THEN order_less_imp_le]
     by (rule power2_eq_imp_eq) simp
 qed
 
 lemma sin_45: "sin (pi/4) = sqrt 2 / 2"
   by (simp add: sin_cos_eq cos_45)
 
 lemma sin_60: "sin (pi/3) = sqrt 3/2"
   by (simp add: sin_cos_eq cos_30)
 
 lemma cos_60: "cos (pi/3) = 1/2"
 proof -
   have "0 \<le> cos (pi/3)"
     by (rule cos_ge_zero) (use pi_half_ge_zero in \<open>linarith+\<close>)
   then show ?thesis
     by (simp add: cos_squared_eq sin_60 power_divide power2_eq_imp_eq)
 qed
 
 lemma sin_30: "sin (pi/6) = 1/2"
   by (simp add: sin_cos_eq cos_60)
 
 lemma cos_120: "cos (2 * pi/3) = -1/2"
   and sin_120: "sin (2 * pi/3) = sqrt 3 / 2"
   using sin_double[of "pi/3"] cos_double[of "pi/3"]
   by (simp_all add: power2_eq_square sin_60 cos_60)
 
 lemma cos_120': "cos (pi * 2 / 3) = -1/2"
   using cos_120 by (subst mult.commute)
 
 lemma sin_120': "sin (pi * 2 / 3) = sqrt 3 / 2"
   using sin_120 by (subst mult.commute)
 
 lemma cos_integer_2pi: "n \<in> \<int> \<Longrightarrow> cos(2 * pi * n) = 1"
   by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute)
 
 lemma sin_integer_2pi: "n \<in> \<int> \<Longrightarrow> sin(2 * pi * n) = 0"
   by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)
 
 lemma cos_int_2pin [simp]: "cos ((2 * pi) * of_int n) = 1"
   by (simp add: cos_one_2pi_int)
 
 lemma sin_int_2pin [simp]: "sin ((2 * pi) * of_int n) = 0"
   by (metis Ints_of_int sin_integer_2pi)
 
 lemma sin_cos_eq_iff: "sin y = sin x \<and> cos y = cos x \<longleftrightarrow> (\<exists>n::int. y = x + 2 * pi * n)" (is "?L=?R")
 proof
   assume ?L
   then have "cos (y-x) = 1"
     using cos_add [of y "-x"] by simp
   then show ?R
     by (metis cos_one_2pi_int add.commute diff_add_cancel mult.assoc mult.commute) 
 next
   assume ?R
   then show ?L
     by (auto simp: sin_add cos_add)
 qed
 
 lemma sincos_principal_value: "\<exists>y. (- pi < y \<and> y \<le> pi) \<and> (sin y = sin x \<and> cos y = cos x)"
 proof -
   define y where "y \<equiv> pi - (2 * pi) * frac ((pi - x) / (2 * pi))"
   have "-pi < y"" y \<le> pi"
     by (auto simp: field_simps frac_lt_1 y_def)
   moreover
   have "sin y = sin x" "cos y = cos x"
     by (simp_all add: y_def frac_def divide_simps sin_add cos_add mult_of_int_commute)
   ultimately
   show ?thesis by metis
 qed
 
 
 subsection \<open>Tangent\<close>
 
 definition tan :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   where "tan = (\<lambda>x. sin x / cos x)"
 
 lemma tan_of_real: "of_real (tan x) = (tan (of_real x) :: 'a::{real_normed_field,banach})"
   by (simp add: tan_def sin_of_real cos_of_real)
 
 lemma tan_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> tan z \<in> \<real>"
   for z :: "'a::{real_normed_field,banach}"
   by (simp add: tan_def)
 
 lemma tan_zero [simp]: "tan 0 = 0"
   by (simp add: tan_def)
 
 lemma tan_pi [simp]: "tan pi = 0"
   by (simp add: tan_def)
 
 lemma tan_npi [simp]: "tan (real n * pi) = 0"
   for n :: nat
   by (simp add: tan_def)
 
 lemma tan_pi_half [simp]: "tan (pi / 2) = 0"
   by (simp add: tan_def)
 
 lemma tan_minus [simp]: "tan (- x) = - tan x"
   by (simp add: tan_def)
 
 lemma tan_periodic [simp]: "tan (x + 2 * pi) = tan x"
   by (simp add: tan_def)
 
 lemma lemma_tan_add1: "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> 1 - tan x * tan y = cos (x + y)/(cos x * cos y)"
   by (simp add: tan_def cos_add field_simps)
 
 lemma add_tan_eq: "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> tan x + tan y = sin(x + y)/(cos x * cos y)"
   for x :: "'a::{real_normed_field,banach}"
   by (simp add: tan_def sin_add field_simps)
 
 lemma tan_eq_0_cos_sin: "tan x = 0 \<longleftrightarrow> cos x = 0 \<or> sin x = 0"
   by (auto simp: tan_def)
 
 text \<open>Note: half of these zeros would normally be regarded as undefined cases.\<close>
 lemma tan_eq_0_Ex:
   assumes "tan x = 0"
   obtains k::int where "x = (k/2) * pi"
   using assms
   by (metis cos_zero_iff_int mult.commute sin_zero_iff_int tan_eq_0_cos_sin times_divide_eq_left) 
 
 lemma tan_add:
   "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> cos (x + y) \<noteq> 0 \<Longrightarrow> tan (x + y) = (tan x + tan y)/(1 - tan x * tan y)"
   for x :: "'a::{real_normed_field,banach}"
   by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)
 
 lemma tan_double: "cos x \<noteq> 0 \<Longrightarrow> cos (2 * x) \<noteq> 0 \<Longrightarrow> tan (2 * x) = (2 * tan x) / (1 - (tan x)\<^sup>2)"
   for x :: "'a::{real_normed_field,banach}"
   using tan_add [of x x] by (simp add: power2_eq_square)
 
 lemma tan_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < tan x"
   by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
 
 lemma tan_less_zero:
   assumes "- pi/2 < x" and "x < 0"
   shows "tan x < 0"
 proof -
   have "0 < tan (- x)"
     using assms by (simp only: tan_gt_zero)
   then show ?thesis by simp
 qed
 
 lemma tan_half: "tan x = sin (2 * x) / (cos (2 * x) + 1)"
   for x :: "'a::{real_normed_field,banach,field}"
   unfolding tan_def sin_double cos_double sin_squared_eq
   by (simp add: power2_eq_square)
 
 lemma tan_30: "tan (pi/6) = 1 / sqrt 3"
   unfolding tan_def by (simp add: sin_30 cos_30)
 
 lemma tan_45: "tan (pi/4) = 1"
   unfolding tan_def by (simp add: sin_45 cos_45)
 
 lemma tan_60: "tan (pi/3) = sqrt 3"
   unfolding tan_def by (simp add: sin_60 cos_60)
 
 lemma DERIV_tan [simp]: "cos x \<noteq> 0 \<Longrightarrow> DERIV tan x :> inverse ((cos x)\<^sup>2)"
   for x :: "'a::{real_normed_field,banach}"
   unfolding tan_def
   by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)
 
 declare DERIV_tan[THEN DERIV_chain2, derivative_intros]
   and DERIV_tan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_tan[derivative_intros] = DERIV_tan[THEN DERIV_compose_FDERIV]
 
 lemma isCont_tan: "cos x \<noteq> 0 \<Longrightarrow> isCont tan x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_tan [THEN DERIV_isCont])
 
 lemma isCont_tan' [simp,continuous_intros]:
   fixes a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
   shows "isCont f a \<Longrightarrow> cos (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. tan (f x)) a"
   by (rule isCont_o2 [OF _ isCont_tan])
 
 lemma tendsto_tan [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> cos a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. tan (f x)) \<longlongrightarrow> tan a) F"
   by (rule isCont_tendsto_compose [OF isCont_tan])
 
 lemma continuous_tan:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous F f \<Longrightarrow> cos (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. tan (f x))"
   unfolding continuous_def by (rule tendsto_tan)
 
 lemma continuous_on_tan [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. cos (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. tan (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_tan)
 
 lemma continuous_within_tan [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous (at x within s) f \<Longrightarrow>
     cos (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. tan (f x))"
   unfolding continuous_within by (rule tendsto_tan)
 
 lemma LIM_cos_div_sin: "(\<lambda>x. cos(x)/sin(x)) \<midarrow>pi/2\<rightarrow> 0"
   by (rule tendsto_cong_limit, (rule tendsto_intros)+, simp_all)
 
 lemma lemma_tan_total: 
   assumes "0 < y" shows "\<exists>x. 0 < x \<and> x < pi/2 \<and> y < tan x"
 proof -
   obtain s where "0 < s" 
     and s: "\<And>x. \<lbrakk>x \<noteq> pi/2; norm (x - pi/2) < s\<rbrakk> \<Longrightarrow> norm (cos x / sin x - 0) < inverse y"
     using LIM_D [OF LIM_cos_div_sin, of "inverse y"] that assms by force
   obtain e where e: "0 < e" "e < s" "e < pi/2"
     using \<open>0 < s\<close> field_lbound_gt_zero pi_half_gt_zero by blast
   show ?thesis
   proof (intro exI conjI)
     have "0 < sin e" "0 < cos e"
       using e by (auto intro: cos_gt_zero sin_gt_zero2 simp: mult.commute)
     then 
     show "y < tan (pi/2 - e)"
       using s [of "pi/2 - e"] e assms
       by (simp add: tan_def sin_diff cos_diff) (simp add: field_simps split: if_split_asm)
   qed (use e in auto)
 qed
 
 lemma tan_total_pos: 
   assumes "0 \<le> y" shows "\<exists>x. 0 \<le> x \<and> x < pi/2 \<and> tan x = y"
 proof (cases "y = 0")
   case True
   then show ?thesis
     using pi_half_gt_zero tan_zero by blast
 next
   case False
   with assms have "y > 0"
     by linarith
   obtain x where x: "0 < x" "x < pi/2" "y < tan x"
     using lemma_tan_total \<open>0 < y\<close> by blast
   have "\<exists>u\<ge>0. u \<le> x \<and> tan u = y"
   proof (intro IVT allI impI)
     show "isCont tan u" if "0 \<le> u \<and> u \<le> x" for u
     proof -
       have "cos u \<noteq> 0"
         using antisym_conv2 cos_gt_zero that x(2) by fastforce
       with assms show ?thesis
         by (auto intro!: DERIV_tan [THEN DERIV_isCont])
     qed
   qed (use assms x in auto)
   then show ?thesis
     using x(2) by auto
 qed
     
 lemma lemma_tan_total1: "\<exists>x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
 proof (cases "0::real" y rule: le_cases)
   case le
   then show ?thesis
     by (meson less_le_trans minus_pi_half_less_zero tan_total_pos)
 next
   case ge
   with tan_total_pos [of "-y"] obtain x where "0 \<le> x" "x < pi/2" "tan x = - y"
     by force
   then show ?thesis
     by (rule_tac x="-x" in exI) auto
 qed
 
 proposition tan_total: "\<exists>! x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
 proof -
   have "u = v" if u: "- (pi/2) < u" "u < pi/2" and v: "- (pi/2) < v" "v < pi/2"
     and eq: "tan u = tan v" for u v
   proof (cases u v rule: linorder_cases)
     case less
     have "\<And>x. u \<le> x \<and> x \<le> v \<longrightarrow> isCont tan x"
       by (metis cos_gt_zero_pi isCont_tan le_less_trans less_irrefl less_le_trans u(1) v(2))
     then have "continuous_on {u..v} tan"
       by (simp add: continuous_at_imp_continuous_on)
     moreover have "\<And>x. u < x \<and> x < v \<Longrightarrow> tan differentiable (at x)"
       by (metis DERIV_tan cos_gt_zero_pi real_differentiable_def less_numeral_extra(3) order.strict_trans u(1) v(2))
     ultimately obtain z where "u < z" "z < v" "DERIV tan z :> 0"
       by (metis less Rolle eq)
     moreover have "cos z \<noteq> 0"
       by (metis (no_types) \<open>u < z\<close> \<open>z < v\<close> cos_gt_zero_pi less_le_trans linorder_not_less not_less_iff_gr_or_eq u(1) v(2))
     ultimately show ?thesis
       using DERIV_unique [OF _ DERIV_tan] by fastforce
   next
     case greater
     have "\<And>x. v \<le> x \<and> x \<le> u \<Longrightarrow> isCont tan x"
       by (metis cos_gt_zero_pi isCont_tan le_less_trans less_irrefl less_le_trans u(2) v(1))
     then have "continuous_on {v..u} tan"
       by (simp add: continuous_at_imp_continuous_on)
     moreover have "\<And>x. v < x \<and> x < u \<Longrightarrow> tan differentiable (at x)"
       by (metis DERIV_tan cos_gt_zero_pi real_differentiable_def less_numeral_extra(3) order.strict_trans u(2) v(1))
     ultimately obtain z where "v < z" "z < u" "DERIV tan z :> 0"
       by (metis greater Rolle eq)
     moreover have "cos z \<noteq> 0"
       by (metis \<open>v < z\<close> \<open>z < u\<close> cos_gt_zero_pi less_eq_real_def less_le_trans order_less_irrefl u(2) v(1))
     ultimately show ?thesis
       using DERIV_unique [OF _ DERIV_tan] by fastforce
   qed auto
   then have "\<exists>!x. - (pi/2) < x \<and> x < pi/2 \<and> tan x = y" 
     if x: "- (pi/2) < x" "x < pi/2" "tan x = y" for x
     using that by auto
   then show ?thesis
     using lemma_tan_total1 [where y = y]
     by auto
 qed
 
 lemma tan_monotone:
   assumes "- (pi/2) < y" and "y < x" and "x < pi/2"
   shows "tan y < tan x"
 proof -
   have "DERIV tan x' :> inverse ((cos x')\<^sup>2)" if "y \<le> x'" "x' \<le> x" for x'
   proof -
     have "-(pi/2) < x'" and "x' < pi/2"
       using that assms by auto
     with cos_gt_zero_pi have "cos x' \<noteq> 0" by force
     then show "DERIV tan x' :> inverse ((cos x')\<^sup>2)"
       by (rule DERIV_tan)
   qed
   from MVT2[OF \<open>y < x\<close> this]
   obtain z where "y < z" and "z < x"
     and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)\<^sup>2)" by auto
   then have "- (pi/2) < z" and "z < pi/2"
     using assms by auto
   then have "0 < cos z"
     using cos_gt_zero_pi by auto
   then have inv_pos: "0 < inverse ((cos z)\<^sup>2)"
     by auto
   have "0 < x - y" using \<open>y < x\<close> by auto
   with inv_pos have "0 < tan x - tan y"
     unfolding tan_diff by auto
   then show ?thesis by auto
 qed
 
 lemma tan_monotone':
   assumes "- (pi/2) < y"
     and "y < pi/2"
     and "- (pi/2) < x"
     and "x < pi/2"
   shows "y < x \<longleftrightarrow> tan y < tan x"
 proof
   assume "y < x"
   then show "tan y < tan x"
     using tan_monotone and \<open>- (pi/2) < y\<close> and \<open>x < pi/2\<close> by auto
 next
   assume "tan y < tan x"
   show "y < x"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     then have "x \<le> y" by auto
     then have "tan x \<le> tan y"
     proof (cases "x = y")
       case True
       then show ?thesis by auto
     next
       case False
       then have "x < y" using \<open>x \<le> y\<close> by auto
       from tan_monotone[OF \<open>- (pi/2) < x\<close> this \<open>y < pi/2\<close>] show ?thesis
         by auto
     qed
     then show False
       using \<open>tan y < tan x\<close> by auto
   qed
 qed
 
 lemma tan_inverse: "1 / (tan y) = tan (pi/2 - y)"
   unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto
 
 lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
   by (simp add: tan_def)
 
 lemma tan_periodic_nat[simp]: "tan (x + real n * pi) = tan x"
 proof (induct n arbitrary: x)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
     unfolding Suc_eq_plus1 of_nat_add  distrib_right by auto
   show ?case
     unfolding split_pi_off using Suc by auto
 qed
 
 lemma tan_periodic_int[simp]: "tan (x + of_int i * pi) = tan x"
 proof (cases "0 \<le> i")
   case False
   then have i_nat: "of_int i = - of_int (nat (- i))" by auto
   then show ?thesis
     by (smt (verit, best) mult_minus_left of_int_of_nat_eq tan_periodic_nat)
 qed (use zero_le_imp_eq_int in fastforce)
 
 lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
   using tan_periodic_int[of _ "numeral n" ] by simp
 
 lemma tan_minus_45 [simp]: "tan (-(pi/4)) = -1"
   unfolding tan_def by (simp add: sin_45 cos_45)
 
 lemma tan_diff:
   "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> cos (x - y) \<noteq> 0 \<Longrightarrow> tan (x - y) = (tan x - tan y)/(1 + tan x * tan y)"
   for x :: "'a::{real_normed_field,banach}"
   using tan_add [of x "-y"] by simp
 
 lemma tan_pos_pi2_le: "0 \<le> x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 \<le> tan x"
   using less_eq_real_def tan_gt_zero by auto
 
 lemma cos_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> cos x = 1 / sqrt (1 + tan x ^ 2)"
   using cos_gt_zero_pi [of x]
   by (simp add: field_split_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
 
 lemma cos_tan_half: "cos x \<noteq>0 \<Longrightarrow>  cos (2*x) = (1 - (tan x)^2) / (1 + (tan x)^2)"
   unfolding cos_double tan_def by (auto simp add:field_simps )
 
 lemma sin_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> sin x = tan x / sqrt (1 + tan x ^ 2)"
   using cos_gt_zero [of "x"] cos_gt_zero [of "-x"]
   by (force simp: field_split_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
 
 lemma sin_tan_half: "sin (2*x) = 2 * tan x / (1 + (tan x)^2)"
   unfolding sin_double tan_def
   by (cases "cos x=0") (auto simp add:field_simps power2_eq_square)
 
 lemma tan_mono_le: "-(pi/2) < x \<Longrightarrow> x \<le> y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x \<le> tan y"
   using less_eq_real_def tan_monotone by auto
 
 lemma tan_mono_lt_eq:
   "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> -(pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x < tan y \<longleftrightarrow> x < y"
   using tan_monotone' by blast
 
 lemma tan_mono_le_eq:
   "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> -(pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x \<le> tan y \<longleftrightarrow> x \<le> y"
   by (meson tan_mono_le not_le tan_monotone)
 
 lemma tan_bound_pi2: "\<bar>x\<bar> < pi/4 \<Longrightarrow> \<bar>tan x\<bar> < 1"
   using tan_45 tan_monotone [of x "pi/4"] tan_monotone [of "-x" "pi/4"]
   by (auto simp: abs_if split: if_split_asm)
 
 lemma tan_cot: "tan(pi/2 - x) = inverse(tan x)"
   by (simp add: tan_def sin_diff cos_diff)
 
 
 subsection \<open>Cotangent\<close>
 
 definition cot :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   where "cot = (\<lambda>x. cos x / sin x)"
 
 lemma cot_of_real: "of_real (cot x) = (cot (of_real x) :: 'a::{real_normed_field,banach})"
   by (simp add: cot_def sin_of_real cos_of_real)
 
 lemma cot_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cot z \<in> \<real>"
   for z :: "'a::{real_normed_field,banach}"
   by (simp add: cot_def)
 
 lemma cot_zero [simp]: "cot 0 = 0"
   by (simp add: cot_def)
 
 lemma cot_pi [simp]: "cot pi = 0"
   by (simp add: cot_def)
 
 lemma cot_npi [simp]: "cot (real n * pi) = 0"
   for n :: nat
   by (simp add: cot_def)
 
 lemma cot_minus [simp]: "cot (- x) = - cot x"
   by (simp add: cot_def)
 
 lemma cot_periodic [simp]: "cot (x + 2 * pi) = cot x"
   by (simp add: cot_def)
 
 lemma cot_altdef: "cot x = inverse (tan x)"
   by (simp add: cot_def tan_def)
 
 lemma tan_altdef: "tan x = inverse (cot x)"
   by (simp add: cot_def tan_def)
 
 lemma tan_cot': "tan (pi/2 - x) = cot x"
   by (simp add: tan_cot cot_altdef)
 
 lemma cot_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cot x"
   by (simp add: cot_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
 
 lemma cot_less_zero:
   assumes lb: "- pi/2 < x" and "x < 0"
   shows "cot x < 0"
   by (smt (verit) assms cot_gt_zero cot_minus divide_minus_left)
 
 lemma DERIV_cot [simp]: "sin x \<noteq> 0 \<Longrightarrow> DERIV cot x :> -inverse ((sin x)\<^sup>2)"
   for x :: "'a::{real_normed_field,banach}"
   unfolding cot_def using cos_squared_eq[of x]
   by (auto intro!: derivative_eq_intros) (simp add: divide_inverse power2_eq_square)
 
 lemma isCont_cot: "sin x \<noteq> 0 \<Longrightarrow> isCont cot x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_cot [THEN DERIV_isCont])
 
 lemma isCont_cot' [simp,continuous_intros]:
   "isCont f a \<Longrightarrow> sin (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. cot (f x)) a"
   for a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
   by (rule isCont_o2 [OF _ isCont_cot])
 
 lemma tendsto_cot [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> sin a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. cot (f x)) \<longlongrightarrow> cot a) F"
   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   by (rule isCont_tendsto_compose [OF isCont_cot])
 
 lemma continuous_cot:
   "continuous F f \<Longrightarrow> sin (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. cot (f x))"
   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   unfolding continuous_def by (rule tendsto_cot)
 
 lemma continuous_on_cot [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. sin (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. cot (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_cot)
 
 lemma continuous_within_cot [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous (at x within s) f \<Longrightarrow> sin (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. cot (f x))"
   unfolding continuous_within by (rule tendsto_cot)
 
 
 subsection \<open>Inverse Trigonometric Functions\<close>
 
 definition arcsin :: "real \<Rightarrow> real"
   where "arcsin y = (THE x. -(pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y)"
 
 definition arccos :: "real \<Rightarrow> real"
   where "arccos y = (THE x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y)"
 
 definition arctan :: "real \<Rightarrow> real"
   where "arctan y = (THE x. -(pi/2) < x \<and> x < pi/2 \<and> tan x = y)"
 
 lemma arcsin: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi/2 \<and> sin (arcsin y) = y"
   unfolding arcsin_def by (rule theI' [OF sin_total])
 
 lemma arcsin_pi: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi \<and> sin (arcsin y) = y"
   by (drule (1) arcsin) (force intro: order_trans)
 
 lemma sin_arcsin [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> sin (arcsin y) = y"
   by (blast dest: arcsin)
 
 lemma arcsin_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi/2"
   by (blast dest: arcsin)
 
 lemma arcsin_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y"
   by (blast dest: arcsin)
 
 lemma arcsin_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin y \<le> pi/2"
   by (blast dest: arcsin)
 
 lemma arcsin_lt_bounded:
   assumes "- 1 < y" "y < 1"
   shows  "- (pi/2) < arcsin y \<and> arcsin y < pi/2"
 proof -
   have "arcsin y \<noteq> pi/2"
     by (metis arcsin assms not_less not_less_iff_gr_or_eq sin_pi_half)
   moreover have "arcsin y \<noteq> - pi/2"
     by (metis arcsin assms minus_divide_left not_less not_less_iff_gr_or_eq sin_minus sin_pi_half)
   ultimately show ?thesis
     using arcsin_bounded [of y] assms by auto
 qed
 
 lemma arcsin_sin: "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> arcsin (sin x) = x"
   unfolding arcsin_def
   using the1_equality [OF sin_total]  by simp
 
 lemma arcsin_unique:
   assumes "-pi/2 \<le> x" and "x \<le> pi/2" and "sin x = y" shows "arcsin y = x"
   using arcsin_sin[of x] assms by force
 
 lemma arcsin_0 [simp]: "arcsin 0 = 0"
   using arcsin_sin [of 0] by simp
 
 lemma arcsin_1 [simp]: "arcsin 1 = pi/2"
   using arcsin_sin [of "pi/2"] by simp
 
 lemma arcsin_minus_1 [simp]: "arcsin (- 1) = - (pi/2)"
   using arcsin_sin [of "- pi/2"] by simp
 
 lemma arcsin_minus: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin (- x) = - arcsin x"
   by (metis (no_types, opaque_lifting) arcsin arcsin_sin minus_minus neg_le_iff_le sin_minus)
 
 lemma arcsin_one_half [simp]: "arcsin (1/2) = pi / 6"
   and arcsin_minus_one_half [simp]: "arcsin (-(1/2)) = -pi / 6"
   by (intro arcsin_unique; simp add: sin_30 field_simps)+
   
 lemma arcsin_one_over_sqrt_2: "arcsin (1 / sqrt 2) = pi / 4"
   by (rule arcsin_unique) (auto simp: sin_45 field_simps)
 
 lemma arcsin_eq_iff: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x = arcsin y \<longleftrightarrow> x = y"
   by (metis abs_le_iff arcsin minus_le_iff)
 
 lemma cos_arcsin_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> cos (arcsin x) \<noteq> 0"
   using arcsin_lt_bounded cos_gt_zero_pi by force
 
 lemma arccos: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi \<and> cos (arccos y) = y"
   unfolding arccos_def by (rule theI' [OF cos_total])
 
 lemma cos_arccos [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> cos (arccos y) = y"
   by (blast dest: arccos)
 
 lemma arccos_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi"
   by (blast dest: arccos)
 
 lemma arccos_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y"
   by (blast dest: arccos)
 
 lemma arccos_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> pi"
   by (blast dest: arccos)
 
 lemma arccos_lt_bounded: 
   assumes "- 1 < y" "y < 1"
   shows  "0 < arccos y \<and> arccos y < pi"
 proof -
   have "arccos y \<noteq> 0"
     by (metis (no_types) arccos assms(1) assms(2) cos_zero less_eq_real_def less_irrefl)
   moreover have "arccos y \<noteq> -pi"
     by (metis arccos assms(1) assms(2) cos_minus cos_pi not_less not_less_iff_gr_or_eq)
   ultimately show ?thesis
     using arccos_bounded [of y] assms
     by (metis arccos cos_pi not_less not_less_iff_gr_or_eq)
 qed
 
 lemma arccos_cos: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> arccos (cos x) = x"
   by (auto simp: arccos_def intro!: the1_equality cos_total)
 
 lemma arccos_cos2: "x \<le> 0 \<Longrightarrow> - pi \<le> x \<Longrightarrow> arccos (cos x) = -x"
   by (auto simp: arccos_def intro!: the1_equality cos_total)
 
 lemma arccos_unique:
   assumes "0 \<le> x" and "x \<le> pi" and "cos x = y" shows "arccos y = x"
   using arccos_cos assms by blast
 
 lemma cos_arcsin:
   assumes "- 1 \<le> x" "x \<le> 1"
   shows "cos (arcsin x) = sqrt (1 - x\<^sup>2)"
 proof (rule power2_eq_imp_eq)
   show "(cos (arcsin x))\<^sup>2 = (sqrt (1 - x\<^sup>2))\<^sup>2"
     by (simp add: square_le_1 assms cos_squared_eq)
   show "0 \<le> cos (arcsin x)"
     using arcsin assms cos_ge_zero by blast
   show "0 \<le> sqrt (1 - x\<^sup>2)"
     by (simp add: square_le_1 assms)
 qed
 
 lemma sin_arccos:
   assumes "- 1 \<le> x" "x \<le> 1"
   shows "sin (arccos x) = sqrt (1 - x\<^sup>2)"
 proof (rule power2_eq_imp_eq)
   show "(sin (arccos x))\<^sup>2 = (sqrt (1 - x\<^sup>2))\<^sup>2"
     by (simp add: square_le_1 assms sin_squared_eq)
   show "0 \<le> sin (arccos x)"
     by (simp add: arccos_bounded assms sin_ge_zero)
   show "0 \<le> sqrt (1 - x\<^sup>2)"
     by (simp add: square_le_1 assms)
 qed
 
 lemma arccos_0 [simp]: "arccos 0 = pi/2"
   using arccos_cos pi_half_ge_zero by fastforce
 
 lemma arccos_1 [simp]: "arccos 1 = 0"
   using arccos_cos by force
 
 lemma arccos_minus_1 [simp]: "arccos (- 1) = pi"
   by (metis arccos_cos cos_pi order_refl pi_ge_zero)
 
 lemma arccos_minus: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos (- x) = pi - arccos x"
   by (smt (verit, ccfv_threshold) arccos arccos_cos cos_minus cos_minus_pi)
 
 lemma arccos_one_half [simp]: "arccos (1/2) = pi / 3"
   and arccos_minus_one_half [simp]: "arccos (-(1/2)) = 2 * pi / 3"
   by (intro arccos_unique; simp add: cos_60 cos_120)+
 
 lemma arccos_one_over_sqrt_2: "arccos (1 / sqrt 2) = pi / 4"
   by (rule arccos_unique) (auto simp: cos_45 field_simps)
 
 corollary arccos_minus_abs:
   assumes "\<bar>x\<bar> \<le> 1"
   shows "arccos (- x) = pi - arccos x"
 using assms by (simp add: arccos_minus)
 
 lemma sin_arccos_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> sin (arccos x) \<noteq> 0"
   using arccos_lt_bounded sin_gt_zero by force
 
 lemma arctan: "- (pi/2) < arctan y \<and> arctan y < pi/2 \<and> tan (arctan y) = y"
   unfolding arctan_def by (rule theI' [OF tan_total])
 
 lemma tan_arctan: "tan (arctan y) = y"
   by (simp add: arctan)
 
 lemma arctan_bounded: "- (pi/2) < arctan y \<and> arctan y < pi/2"
   by (auto simp only: arctan)
 
 lemma arctan_lbound: "- (pi/2) < arctan y"
   by (simp add: arctan)
 
 lemma arctan_ubound: "arctan y < pi/2"
   by (auto simp only: arctan)
 
 lemma arctan_unique:
   assumes "-(pi/2) < x"
     and "x < pi/2"
     and "tan x = y"
   shows "arctan y = x"
   using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)
 
 lemma arctan_tan: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> arctan (tan x) = x"
   by (rule arctan_unique) simp_all
 
 lemma arctan_zero_zero [simp]: "arctan 0 = 0"
   by (rule arctan_unique) simp_all
 
 lemma arctan_minus: "arctan (- x) = - arctan x"
   using arctan [of "x"] by (auto simp: arctan_unique)
 
 lemma cos_arctan_not_zero [simp]: "cos (arctan x) \<noteq> 0"
   by (intro less_imp_neq [symmetric] cos_gt_zero_pi arctan_lbound arctan_ubound)
 
 lemma tan_eq_arctan_Ex:
   shows "tan x = y \<longleftrightarrow> (\<exists>k::int. x = arctan y + k*pi \<or> (x = pi/2 + k*pi \<and> y=0))"
 proof
   assume lhs: "tan x = y"
   obtain k::int where k:"-pi/2 < x-k*pi" "x-k*pi \<le> pi/2"
   proof 
     define k where "k \<equiv> ceiling (x/pi - 1/2)"
     show "- pi / 2 < x - real_of_int k * pi" 
       using ceiling_divide_lower [of "pi*2" "(x * 2 - pi)"] by (auto simp: k_def field_simps)
     show  "x-k*pi \<le> pi/2"
       using ceiling_divide_upper [of "pi*2" "(x * 2 - pi)"] by (auto simp: k_def field_simps)
   qed
   have "x = arctan y + of_int k * pi" when "x \<noteq> pi/2 + k*pi"
   proof -
     have "tan (x - k * pi) = y" using lhs tan_periodic_int[of _ "-k"] by auto
     then have "arctan y = x - real_of_int k * pi"
       by (smt (verit) arctan_tan lhs divide_minus_left k mult_minus_left of_int_minus tan_periodic_int that)
     then show ?thesis by auto
   qed
   then show "\<exists>k. x = arctan y + of_int k * pi \<or> (x = pi/2 + k*pi \<and> y=0)"
     using lhs k by force
 qed (auto simp: arctan)
 
 lemma arctan_tan_eq_abs_pi:
   assumes "cos \<theta> \<noteq> 0"
   obtains k where "arctan (tan \<theta>) = \<theta> - of_int k * pi"
   by (metis add.commute assms cos_zero_iff_int2 eq_diff_eq tan_eq_arctan_Ex)
 
 lemma tan_eq:
   assumes "tan x = tan y" "tan x \<noteq> 0"
   obtains k::int where "x = y + k * pi"
 proof -
   obtain k0 where k0: "x = arctan (tan y) + real_of_int k0 * pi"
     using assms tan_eq_arctan_Ex[of x "tan y"] by auto
   obtain k1 where k1: "arctan (tan y) = y - of_int k1 * pi"
     using arctan_tan_eq_abs_pi assms tan_eq_0_cos_sin by auto
   have "x = y + (k0-k1)*pi"
     using k0 k1 by (auto simp: algebra_simps)
   with that show ?thesis
     by blast
 qed
 
 lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x\<^sup>2)"
 proof (rule power2_eq_imp_eq)
   have "0 < 1 + x\<^sup>2" by (simp add: add_pos_nonneg)
   show "0 \<le> 1 / sqrt (1 + x\<^sup>2)" by simp
   show "0 \<le> cos (arctan x)"
     by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
   have "(cos (arctan x))\<^sup>2 * (1 + (tan (arctan x))\<^sup>2) = 1"
     unfolding tan_def by (simp add: distrib_left power_divide)
   then show "(cos (arctan x))\<^sup>2 = (1 / sqrt (1 + x\<^sup>2))\<^sup>2"
     using \<open>0 < 1 + x\<^sup>2\<close> by (simp add: arctan power_divide eq_divide_eq)
 qed
 
 lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x\<^sup>2)"
   using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
   using tan_arctan [of x] unfolding tan_def cos_arctan
   by (simp add: eq_divide_eq)
 
 lemma tan_sec: "cos x \<noteq> 0 \<Longrightarrow> 1 + (tan x)\<^sup>2 = (inverse (cos x))\<^sup>2"
   for x :: "'a::{real_normed_field,banach,field}"
   by (simp add: add_divide_eq_iff inverse_eq_divide power2_eq_square tan_def)
 
 lemma arctan_less_iff: "arctan x < arctan y \<longleftrightarrow> x < y"
   by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)
 
 lemma arctan_le_iff: "arctan x \<le> arctan y \<longleftrightarrow> x \<le> y"
   by (simp only: not_less [symmetric] arctan_less_iff)
 
 lemma arctan_eq_iff: "arctan x = arctan y \<longleftrightarrow> x = y"
   by (simp only: eq_iff [where 'a=real] arctan_le_iff)
 
 lemma zero_less_arctan_iff [simp]: "0 < arctan x \<longleftrightarrow> 0 < x"
   using arctan_less_iff [of 0 x] by simp
 
 lemma arctan_less_zero_iff [simp]: "arctan x < 0 \<longleftrightarrow> x < 0"
   using arctan_less_iff [of x 0] by simp
 
 lemma zero_le_arctan_iff [simp]: "0 \<le> arctan x \<longleftrightarrow> 0 \<le> x"
   using arctan_le_iff [of 0 x] by simp
 
 lemma arctan_le_zero_iff [simp]: "arctan x \<le> 0 \<longleftrightarrow> x \<le> 0"
   using arctan_le_iff [of x 0] by simp
 
 lemma arctan_eq_zero_iff [simp]: "arctan x = 0 \<longleftrightarrow> x = 0"
   using arctan_eq_iff [of x 0] by simp
 
 lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
 proof -
   have "continuous_on (sin ` {- pi/2 .. pi/2}) arcsin"
     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
   also have "sin ` {- pi/2 .. pi/2} = {-1 .. 1}"
   proof safe
     fix x :: real
     assume "x \<in> {-1..1}"
     then show "x \<in> sin ` {- pi/2..pi/2}"
       using arcsin_lbound arcsin_ubound
       by (intro image_eqI[where x="arcsin x"]) auto
   qed simp
   finally show ?thesis .
 qed
 
 lemma continuous_on_arcsin [continuous_intros]:
   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. -1 \<le> f x \<and> f x \<le> 1) \<Longrightarrow> continuous_on s (\<lambda>x. arcsin (f x))"
   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arcsin']]
   by (auto simp: comp_def subset_eq)
 
 lemma isCont_arcsin: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arcsin x"
   using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
   by (auto simp: continuous_on_eq_continuous_at subset_eq)
 
 lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
 proof -
   have "continuous_on (cos ` {0 .. pi}) arccos"
     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
   also have "cos ` {0 .. pi} = {-1 .. 1}"
   proof safe
     fix x :: real
     assume "x \<in> {-1..1}"
     then show "x \<in> cos ` {0..pi}"
       using arccos_lbound arccos_ubound
       by (intro image_eqI[where x="arccos x"]) auto
   qed simp
   finally show ?thesis .
 qed
 
 lemma continuous_on_arccos [continuous_intros]:
   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. -1 \<le> f x \<and> f x \<le> 1) \<Longrightarrow> continuous_on s (\<lambda>x. arccos (f x))"
   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arccos']]
   by (auto simp: comp_def subset_eq)
 
 lemma isCont_arccos: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arccos x"
   using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
   by (auto simp: continuous_on_eq_continuous_at subset_eq)
 
 lemma isCont_arctan: "isCont arctan x"
 proof -
   obtain u where u: "- (pi/2) < u" "u < arctan x"
     by (meson arctan arctan_less_iff linordered_field_no_lb)
   obtain v where v: "arctan x < v" "v < pi/2"
     by (meson arctan_less_iff arctan_ubound linordered_field_no_ub)
   have "isCont arctan (tan (arctan x))"
   proof (rule isCont_inverse_function2 [of u "arctan x" v])
     show "\<And>z. \<lbrakk>u \<le> z; z \<le> v\<rbrakk> \<Longrightarrow> arctan (tan z) = z"
       using arctan_unique u(1) v(2) by auto
     then show "\<And>z. \<lbrakk>u \<le> z; z \<le> v\<rbrakk> \<Longrightarrow> isCont tan z"
       by (metis arctan cos_gt_zero_pi isCont_tan less_irrefl)
   qed (use u v in auto)
   then show ?thesis
     by (simp add: arctan)
 qed
 
 lemma tendsto_arctan [tendsto_intros]: "(f \<longlongrightarrow> x) F \<Longrightarrow> ((\<lambda>x. arctan (f x)) \<longlongrightarrow> arctan x) F"
   by (rule isCont_tendsto_compose [OF isCont_arctan])
 
 lemma continuous_arctan [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arctan (f x))"
   unfolding continuous_def by (rule tendsto_arctan)
 
 lemma continuous_on_arctan [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. arctan (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_arctan)
 
 lemma DERIV_arcsin:
   assumes "- 1 < x" "x < 1"
   shows "DERIV arcsin x :> inverse (sqrt (1 - x\<^sup>2))"
 proof (rule DERIV_inverse_function)
   show "(sin has_real_derivative sqrt (1 - x\<^sup>2)) (at (arcsin x))"
     by (rule derivative_eq_intros | use assms cos_arcsin in force)+
   show "sqrt (1 - x\<^sup>2) \<noteq> 0"
     using abs_square_eq_1 assms by force
 qed (use assms isCont_arcsin in auto)
 
 lemma DERIV_arccos:
   assumes "- 1 < x" "x < 1"
   shows "DERIV arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
 proof (rule DERIV_inverse_function)
   show "(cos has_real_derivative - sqrt (1 - x\<^sup>2)) (at (arccos x))"
     by (rule derivative_eq_intros | use assms sin_arccos in force)+
   show "- sqrt (1 - x\<^sup>2) \<noteq> 0"
     using abs_square_eq_1 assms by force
 qed (use assms isCont_arccos in auto)
 
 lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x\<^sup>2)"
 proof (rule DERIV_inverse_function)
   have "inverse ((cos (arctan x))\<^sup>2) = 1 + x\<^sup>2"
     by (metis arctan cos_arctan_not_zero power_inverse tan_sec)
   then show "(tan has_real_derivative 1 + x\<^sup>2) (at (arctan x))"
     by (auto intro!: derivative_eq_intros)
   show "\<And>y. \<lbrakk>x - 1 < y; y < x + 1\<rbrakk> \<Longrightarrow> tan (arctan y) = y"
     using tan_arctan by blast
   show "1 + x\<^sup>2 \<noteq> 0"
     by (metis power_one sum_power2_eq_zero_iff zero_neq_one)
 qed (use isCont_arctan in auto)
 
 declare
   DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
   DERIV_arcsin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
   DERIV_arccos[THEN DERIV_chain2, derivative_intros]
   DERIV_arccos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
   DERIV_arctan[THEN DERIV_chain2, derivative_intros]
   DERIV_arctan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_arctan[derivative_intros] = DERIV_arctan[THEN DERIV_compose_FDERIV]
   and has_derivative_arccos[derivative_intros] = DERIV_arccos[THEN DERIV_compose_FDERIV]
   and has_derivative_arcsin[derivative_intros] = DERIV_arcsin[THEN DERIV_compose_FDERIV]
 
 lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- (pi/2)))"
   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. - pi/2 < x \<and> x < pi/2" and P="\<lambda>x. True" and g=arctan])
      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
            intro!: tan_monotone exI[of _ "pi/2"])
 
 lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
   by (rule filterlim_at_top_at_left[where Q="\<lambda>x. - pi/2 < x \<and> x < pi/2" and P="\<lambda>x. True" and g=arctan])
      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
            intro!: tan_monotone exI[of _ "pi/2"])
 
 lemma tendsto_arctan_at_top: "(arctan \<longlongrightarrow> (pi/2)) at_top"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   define y where "y = pi/2 - min (pi/2) e"
   then have y: "0 \<le> y" "y < pi/2" "pi/2 \<le> e + y"
     using \<open>0 < e\<close> by auto
   show "eventually (\<lambda>x. dist (arctan x) (pi/2) < e) at_top"
   proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
     fix x
     assume "tan y < x"
     then have "arctan (tan y) < arctan x"
       by (simp add: arctan_less_iff)
     with y have "y < arctan x"
       by (subst (asm) arctan_tan) simp_all
     with arctan_ubound[of x, arith] y \<open>0 < e\<close>
     show "dist (arctan x) (pi/2) < e"
       by (simp add: dist_real_def)
   qed
 qed
 
 lemma tendsto_arctan_at_bot: "(arctan \<longlongrightarrow> - (pi/2)) at_bot"
   unfolding filterlim_at_bot_mirror arctan_minus
   by (intro tendsto_minus tendsto_arctan_at_top)
 
 lemma sin_multiple_reduce:
   "sin (x * numeral n :: 'a :: {real_normed_field, banach}) = 
      sin x * cos (x * of_nat (pred_numeral n)) + cos x * sin (x * of_nat (pred_numeral n))"
 proof -
   have "numeral n = of_nat (pred_numeral n) + (1 :: 'a)"
     by (metis add.commute numeral_eq_Suc of_nat_Suc of_nat_numeral)
   also have "sin (x * \<dots>) = sin (x * of_nat (pred_numeral n) + x)"
     unfolding of_nat_Suc by (simp add: ring_distribs)
   finally show ?thesis
     by (simp add: sin_add)
 qed
 
 lemma cos_multiple_reduce:
   "cos (x * numeral n :: 'a :: {real_normed_field, banach}) =
      cos (x * of_nat (pred_numeral n)) * cos x - sin (x * of_nat (pred_numeral n)) * sin x"
 proof -
   have "numeral n = of_nat (pred_numeral n) + (1 :: 'a)"
     by (metis add.commute numeral_eq_Suc of_nat_Suc of_nat_numeral)
   also have "cos (x * \<dots>) = cos (x * of_nat (pred_numeral n) + x)"
     unfolding of_nat_Suc by (simp add: ring_distribs)
   finally show ?thesis
     by (simp add: cos_add)
 qed
 
 lemma arccos_eq_pi_iff: "x \<in> {-1..1} \<Longrightarrow> arccos x = pi \<longleftrightarrow> x = -1"
   by (metis arccos arccos_minus_1 atLeastAtMost_iff cos_pi)
 
 lemma arccos_eq_0_iff: "x \<in> {-1..1} \<Longrightarrow> arccos x = 0 \<longleftrightarrow> x = 1"
   by (metis arccos arccos_1 atLeastAtMost_iff cos_zero)
 
 subsection \<open>Prove Totality of the Trigonometric Functions\<close>
 
 lemma cos_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> cos (arccos y) = y"
   by (simp add: abs_le_iff)
 
 lemma sin_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> sin (arccos y) = sqrt (1 - y\<^sup>2)"
   by (simp add: sin_arccos abs_le_iff)
 
 lemma sin_mono_less_eq:
   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x < sin y \<longleftrightarrow> x < y"
   by (metis not_less_iff_gr_or_eq sin_monotone_2pi)
 
 lemma sin_mono_le_eq:
   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x \<le> sin y \<longleftrightarrow> x \<le> y"
   by (meson leD le_less_linear sin_monotone_2pi sin_monotone_2pi_le)
 
 lemma sin_inj_pi:
   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x = sin y \<Longrightarrow> x = y"
   by (metis arcsin_sin)
 
 lemma arcsin_le_iff:
   assumes "x \<ge> -1" "x \<le> 1" "y \<ge> -pi/2" "y \<le> pi/2"
   shows   "arcsin x \<le> y \<longleftrightarrow> x \<le> sin y"
 proof -
   have "arcsin x \<le> y \<longleftrightarrow> sin (arcsin x) \<le> sin y"
     using arcsin_bounded[of x] assms by (subst sin_mono_le_eq) auto
   also from assms have "sin (arcsin x) = x" by simp
   finally show ?thesis .
 qed
 
 lemma le_arcsin_iff:
   assumes "x \<ge> -1" "x \<le> 1" "y \<ge> -pi/2" "y \<le> pi/2"
   shows   "arcsin x \<ge> y \<longleftrightarrow> x \<ge> sin y"
 proof -
   have "arcsin x \<ge> y \<longleftrightarrow> sin (arcsin x) \<ge> sin y"
     using arcsin_bounded[of x] assms by (subst sin_mono_le_eq) auto
   also from assms have "sin (arcsin x) = x" by simp
   finally show ?thesis .
 qed
 
 lemma cos_mono_less_eq: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x < cos y \<longleftrightarrow> y < x"
   by (meson cos_monotone_0_pi cos_monotone_0_pi_le leD le_less_linear)
 
 lemma cos_mono_le_eq: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x \<le> cos y \<longleftrightarrow> y \<le> x"
   by (metis arccos_cos cos_monotone_0_pi_le eq_iff linear)
 
 lemma cos_inj_pi: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x = cos y \<Longrightarrow> x = y"
   by (metis arccos_cos)
 
 lemma arccos_le_pi2: "\<lbrakk>0 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi/2"
   by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi_le
       cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)
 
 lemma sincos_total_pi_half:
   assumes "0 \<le> x" "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi/2 \<and> x = cos t \<and> y = sin t"
 proof -
   have x1: "x \<le> 1"
     using assms by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2)
   with assms have *: "0 \<le> arccos x" "cos (arccos x) = x"
     by (auto simp: arccos)
   from assms have "y = sqrt (1 - x\<^sup>2)"
     by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
   with x1 * assms arccos_le_pi2 [of x] show ?thesis
     by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
 qed
 
 lemma sincos_total_pi:
   assumes "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi \<and> x = cos t \<and> y = sin t"
 proof (cases rule: le_cases [of 0 x])
   case le
   from sincos_total_pi_half [OF le] show ?thesis
     by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
 next
   case ge
   then have "0 \<le> -x"
     by simp
   then obtain t where t: "t\<ge>0" "t \<le> pi/2" "-x = cos t" "y = sin t"
     using sincos_total_pi_half assms
     by auto (metis \<open>0 \<le> - x\<close> power2_minus)
   show ?thesis
     by (rule exI [where x = "pi -t"]) (use t in auto)
 qed
 
 lemma sincos_total_2pi_le:
   assumes "x\<^sup>2 + y\<^sup>2 = 1"
   shows "\<exists>t. 0 \<le> t \<and> t \<le> 2 * pi \<and> x = cos t \<and> y = sin t"
 proof (cases rule: le_cases [of 0 y])
   case le
   from sincos_total_pi [OF le] show ?thesis
     by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
 next
   case ge
   then have "0 \<le> -y"
     by simp
   then obtain t where t: "t\<ge>0" "t \<le> pi" "x = cos t" "-y = sin t"
     using sincos_total_pi assms
     by auto (metis \<open>0 \<le> - y\<close> power2_minus)
   show ?thesis
     by (rule exI [where x = "2 * pi - t"]) (use t in auto)
 qed
 
 lemma sincos_total_2pi:
   assumes "x\<^sup>2 + y\<^sup>2 = 1"
   obtains t where "0 \<le> t" "t < 2*pi" "x = cos t" "y = sin t"
 proof -
   from sincos_total_2pi_le [OF assms]
   obtain t where t: "0 \<le> t" "t \<le> 2*pi" "x = cos t" "y = sin t"
     by blast
   show ?thesis
     by (cases "t = 2 * pi") (use t that in \<open>force+\<close>)
 qed
 
 lemma arcsin_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x < arcsin y \<longleftrightarrow> x < y"
   by (rule trans [OF sin_mono_less_eq [symmetric]]) (use arcsin_ubound arcsin_lbound in auto)
 
 lemma arcsin_le_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y \<longleftrightarrow> x \<le> y"
   using arcsin_less_mono not_le by blast
 
 lemma arcsin_less_arcsin: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x < arcsin y"
   using arcsin_less_mono by auto
 
 lemma arcsin_le_arcsin: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y"
   using arcsin_le_mono by auto
 
 lemma arcsin_nonneg: "x \<in> {0..1} \<Longrightarrow> arcsin x \<ge> 0"
   using arcsin_le_arcsin[of 0 x] by simp
   
 lemma arccos_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x < arccos y \<longleftrightarrow> y < x"
   by (rule trans [OF cos_mono_less_eq [symmetric]]) (use arccos_ubound arccos_lbound in auto)
 
 lemma arccos_le_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x \<le> arccos y \<longleftrightarrow> y \<le> x"
   using arccos_less_mono [of y x] by (simp add: not_le [symmetric])
 
 lemma arccos_less_arccos: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y < arccos x"
   using arccos_less_mono by auto
 
 lemma arccos_le_arccos: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> arccos x"
   using arccos_le_mono by auto
 
 lemma arccos_eq_iff: "\<bar>x\<bar> \<le> 1 \<and> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x = arccos y \<longleftrightarrow> x = y"
   using cos_arccos_abs by fastforce
 
 
 lemma arccos_cos_eq_abs:
   assumes "\<bar>\<theta>\<bar> \<le> pi"
   shows "arccos (cos \<theta>) = \<bar>\<theta>\<bar>"
   unfolding arccos_def
 proof (intro the_equality conjI; clarify?)
   show "cos \<bar>\<theta>\<bar> = cos \<theta>"
     by (simp add: abs_real_def)
   show "x = \<bar>\<theta>\<bar>" if "cos x = cos \<theta>" "0 \<le> x" "x \<le> pi" for x
     by (simp add: \<open>cos \<bar>\<theta>\<bar> = cos \<theta>\<close> assms cos_inj_pi that)
 qed (use assms in auto)
 
 lemma arccos_cos_eq_abs_2pi:
   obtains k where "arccos (cos \<theta>) = \<bar>\<theta> - of_int k * (2 * pi)\<bar>"
 proof -
   define k where "k \<equiv>  \<lfloor>(\<theta> + pi) / (2 * pi)\<rfloor>"
   have lepi: "\<bar>\<theta> - of_int k * (2 * pi)\<bar> \<le> pi"
     using floor_divide_lower [of "2*pi" "\<theta> + pi"] floor_divide_upper [of "2*pi" "\<theta> + pi"]
     by (auto simp: k_def abs_if algebra_simps)
   have "arccos (cos \<theta>) = arccos (cos (\<theta> - of_int k * (2 * pi)))"
     using cos_int_2pin sin_int_2pin by (simp add: cos_diff mult.commute)
   also have "\<dots> = \<bar>\<theta> - of_int k * (2 * pi)\<bar>"
     using arccos_cos_eq_abs lepi by blast
   finally show ?thesis
     using that by metis
 qed
 
 lemma arccos_arctan:
   assumes "-1 < x" "x < 1"
   shows "arccos x = pi/2 - arctan(x / sqrt(1 - x\<^sup>2))"
 proof -
   have "arctan(x / sqrt(1 - x\<^sup>2)) - (pi/2 - arccos x) = 0"
   proof (rule sin_eq_0_pi)
     show "- pi < arctan (x / sqrt (1 - x\<^sup>2)) - (pi/2 - arccos x)"
       using arctan_lbound [of "x / sqrt(1 - x\<^sup>2)"]  arccos_bounded [of x] assms
       by (simp add: algebra_simps)
   next
     show "arctan (x / sqrt (1 - x\<^sup>2)) - (pi/2 - arccos x) < pi"
       using arctan_ubound [of "x / sqrt(1 - x\<^sup>2)"]  arccos_bounded [of x] assms
       by (simp add: algebra_simps)
   next
     show "sin (arctan (x / sqrt (1 - x\<^sup>2)) - (pi/2 - arccos x)) = 0"
       using assms
       by (simp add: algebra_simps sin_diff cos_add sin_arccos sin_arctan cos_arctan
                     power2_eq_square square_eq_1_iff)
   qed
   then show ?thesis
     by simp
 qed
 
 lemma arcsin_plus_arccos:
   assumes "-1 \<le> x" "x \<le> 1"
     shows "arcsin x + arccos x = pi/2"
 proof -
   have "arcsin x = pi/2 - arccos x"
     apply (rule sin_inj_pi)
     using assms arcsin [OF assms] arccos [OF assms]
     by (auto simp: algebra_simps sin_diff)
   then show ?thesis
     by (simp add: algebra_simps)
 qed
 
 lemma arcsin_arccos_eq: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin x = pi/2 - arccos x"
   using arcsin_plus_arccos by force
 
 lemma arccos_arcsin_eq: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos x = pi/2 - arcsin x"
   using arcsin_plus_arccos by force
 
 lemma arcsin_arctan: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> arcsin x = arctan(x / sqrt(1 - x\<^sup>2))"
   by (simp add: arccos_arctan arcsin_arccos_eq)
 
 lemma arcsin_arccos_sqrt_pos: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin x = arccos(sqrt(1 - x\<^sup>2))"
   by (smt (verit, del_insts) arccos_cos arcsin_0 arcsin_le_arcsin arcsin_pi cos_arcsin)
 
 lemma arcsin_arccos_sqrt_neg: "-1 \<le> x \<Longrightarrow> x \<le> 0 \<Longrightarrow> arcsin x = -arccos(sqrt(1 - x\<^sup>2))"
   using arcsin_arccos_sqrt_pos [of "-x"]
   by (simp add: arcsin_minus)
 
 lemma arccos_arcsin_sqrt_pos: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos x = arcsin(sqrt(1 - x\<^sup>2))"
   by (smt (verit, del_insts) arccos_lbound arccos_le_pi2 arcsin_sin sin_arccos)
 
 lemma arccos_arcsin_sqrt_neg: "-1 \<le> x \<Longrightarrow> x \<le> 0 \<Longrightarrow> arccos x = pi - arcsin(sqrt(1 - x\<^sup>2))"
   using arccos_arcsin_sqrt_pos [of "-x"]
   by (simp add: arccos_minus)
 
 lemma cos_limit_1:
   assumes "(\<lambda>j. cos (\<theta> j)) \<longlonglongrightarrow> 1"
   shows "\<exists>k. (\<lambda>j. \<theta> j - of_int (k j) * (2 * pi)) \<longlonglongrightarrow> 0"
 proof -
   have "\<forall>\<^sub>F j in sequentially. cos (\<theta> j) \<in> {- 1..1}"
     by auto
   then have "(\<lambda>j. arccos (cos (\<theta> j))) \<longlonglongrightarrow> arccos 1"
     using continuous_on_tendsto_compose [OF continuous_on_arccos' assms] by auto
   moreover have "\<And>j. \<exists>k. arccos (cos (\<theta> j)) = \<bar>\<theta> j - of_int k * (2 * pi)\<bar>"
     using arccos_cos_eq_abs_2pi by metis
   then have "\<exists>k. \<forall>j. arccos (cos (\<theta> j)) = \<bar>\<theta> j - of_int (k j) * (2 * pi)\<bar>"
     by metis
   ultimately have "\<exists>k. (\<lambda>j. \<bar>\<theta> j - of_int (k j) * (2 * pi)\<bar>) \<longlonglongrightarrow> 0"
     by auto
   then show ?thesis
     by (simp add: tendsto_rabs_zero_iff)
 qed
 
 lemma cos_diff_limit_1:
   assumes "(\<lambda>j. cos (\<theta> j - \<Theta>)) \<longlonglongrightarrow> 1"
   obtains k where "(\<lambda>j. \<theta> j - of_int (k j) * (2 * pi)) \<longlonglongrightarrow> \<Theta>"
 proof -
   obtain k where "(\<lambda>j. (\<theta> j - \<Theta>) - of_int (k j) * (2 * pi)) \<longlonglongrightarrow> 0"
     using cos_limit_1 [OF assms] by auto
   then have "(\<lambda>j. \<Theta> + ((\<theta> j - \<Theta>) - of_int (k j) * (2 * pi))) \<longlonglongrightarrow> \<Theta> + 0"
     by (rule tendsto_add [OF tendsto_const])
   with that show ?thesis
     by auto
 qed
 
 subsection \<open>Machin's formula\<close>
 
 lemma arctan_one: "arctan 1 = pi/4"
   by (rule arctan_unique) (simp_all add: tan_45 m2pi_less_pi)
 
 lemma tan_total_pi4:
   assumes "\<bar>x\<bar> < 1"
   shows "\<exists>z. - (pi/4) < z \<and> z < pi/4 \<and> tan z = x"
 proof
   show "- (pi/4) < arctan x \<and> arctan x < pi/4 \<and> tan (arctan x) = x"
     unfolding arctan_one [symmetric] arctan_minus [symmetric]
     unfolding arctan_less_iff
     using assms by (auto simp: arctan)
 qed
 
 lemma arctan_add:
   assumes "\<bar>x\<bar> \<le> 1" "\<bar>y\<bar> < 1"
   shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
 proof (rule arctan_unique [symmetric])
   have "- (pi/4) \<le> arctan x" "- (pi/4) < arctan y"
     unfolding arctan_one [symmetric] arctan_minus [symmetric]
     unfolding arctan_le_iff arctan_less_iff
     using assms by auto
   from add_le_less_mono [OF this] show 1: "- (pi/2) < arctan x + arctan y"
     by simp
   have "arctan x \<le> pi/4" "arctan y < pi/4"
     unfolding arctan_one [symmetric]
     unfolding arctan_le_iff arctan_less_iff
     using assms by auto
   from add_le_less_mono [OF this] show 2: "arctan x + arctan y < pi/2"
     by simp
   show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
     using cos_gt_zero_pi [OF 1 2] by (simp add: arctan tan_add)
 qed
 
 lemma arctan_double: "\<bar>x\<bar> < 1 \<Longrightarrow> 2 * arctan x = arctan ((2 * x) / (1 - x\<^sup>2))"
   by (metis arctan_add linear mult_2 not_less power2_eq_square)
 
 theorem machin: "pi/4 = 4 * arctan (1 / 5) - arctan (1/239)"
 proof -
   have "\<bar>1 / 5\<bar> < (1 :: real)"
     by auto
   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (1 / 5) = arctan (5 / 12)"
     by auto
   moreover
   have "\<bar>5 / 12\<bar> < (1 :: real)"
     by auto
   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (5 / 12) = arctan (120 / 119)"
     by auto
   moreover
   have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1/239\<bar> < (1::real)"
     by auto
   from arctan_add[OF this] have "arctan 1 + arctan (1/239) = arctan (120 / 119)"
     by auto
   ultimately have "arctan 1 + arctan (1/239) = 4 * arctan (1 / 5)"
     by auto
   then show ?thesis
     unfolding arctan_one by algebra
 qed
 
 lemma machin_Euler: "5 * arctan (1 / 7) + 2 * arctan (3 / 79) = pi/4"
 proof -
   have 17: "\<bar>1 / 7\<bar> < (1 :: real)" by auto
   with arctan_double have "2 * arctan (1 / 7) = arctan (7 / 24)"
     by simp (simp add: field_simps)
   moreover
   have "\<bar>7 / 24\<bar> < (1 :: real)" by auto
   with arctan_double have "2 * arctan (7 / 24) = arctan (336 / 527)"
     by simp (simp add: field_simps)
   moreover
   have "\<bar>336 / 527\<bar> < (1 :: real)" by auto
   from arctan_add[OF less_imp_le[OF 17] this]
   have "arctan(1/7) + arctan (336 / 527) = arctan (2879 / 3353)"
     by auto
   ultimately have I: "5 * arctan (1 / 7) = arctan (2879 / 3353)" by auto
   have 379: "\<bar>3 / 79\<bar> < (1 :: real)" by auto
   with arctan_double have II: "2 * arctan (3 / 79) = arctan (237 / 3116)"
     by simp (simp add: field_simps)
   have *: "\<bar>2879 / 3353\<bar> < (1 :: real)" by auto
   have "\<bar>237 / 3116\<bar> < (1 :: real)" by auto
   from arctan_add[OF less_imp_le[OF *] this] have "arctan (2879/3353) + arctan (237/3116) = pi/4"
     by (simp add: arctan_one)
   with I II show ?thesis by auto
 qed
 
 (*But could also prove MACHIN_GAUSS:
   12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) = pi/4*)
 
 
 subsection \<open>Introducing the inverse tangent power series\<close>
 
 lemma monoseq_arctan_series:
   fixes x :: real
   assumes "\<bar>x\<bar> \<le> 1"
   shows "monoseq (\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1))"
     (is "monoseq ?a")
 proof (cases "x = 0")
   case True
   then show ?thesis by (auto simp: monoseq_def)
 next
   case False
   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
     using assms by auto
   show "monoseq ?a"
   proof -
     have mono: "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<le>
         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
       if "0 \<le> x" and "x \<le> 1" for n and x :: real
     proof (rule mult_mono)
       show "1 / real (Suc (Suc n * 2)) \<le> 1 / real (Suc (n * 2))"
         by (rule frac_le) simp_all
       show "0 \<le> 1 / real (Suc (n * 2))"
         by auto
       show "x ^ Suc (Suc n * 2) \<le> x ^ Suc (n * 2)"
         by (rule power_decreasing) (simp_all add: \<open>0 \<le> x\<close> \<open>x \<le> 1\<close>)
       show "0 \<le> x ^ Suc (Suc n * 2)"
         by (rule zero_le_power) (simp add: \<open>0 \<le> x\<close>)
     qed
     show ?thesis
     proof (cases "0 \<le> x")
       case True
       from mono[OF this \<open>x \<le> 1\<close>, THEN allI]
       show ?thesis
         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI2)
     next
       case False
       then have "0 \<le> - x" and "- x \<le> 1"
         using \<open>-1 \<le> x\<close> by auto
       from mono[OF this]
       have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<ge>
           1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" for n
         using \<open>0 \<le> -x\<close> by auto
       then show ?thesis
         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
     qed
   qed
 qed
 
 lemma zeroseq_arctan_series:
   fixes x :: real
   assumes "\<bar>x\<bar> \<le> 1"
   shows "(\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1)) \<longlonglongrightarrow> 0"
     (is "?a \<longlonglongrightarrow> 0")
 proof (cases "x = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
     using assms by auto
   show "?a \<longlonglongrightarrow> 0"
   proof (cases "\<bar>x\<bar> < 1")
     case True
     then have "norm x < 1" by auto
     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF \<open>norm x < 1\<close>, THEN LIMSEQ_Suc]]
     have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) \<longlonglongrightarrow> 0"
       unfolding inverse_eq_divide Suc_eq_plus1 by simp
     then show ?thesis
       using pos2 by (rule LIMSEQ_linear)
   next
     case False
     then have "x = -1 \<or> x = 1"
       using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
     then have n_eq: "\<And> n. x ^ (n * 2 + 1) = x"
       unfolding One_nat_def by auto
     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
     show ?thesis
       unfolding n_eq Suc_eq_plus1 by auto
   qed
 qed
 
 lemma summable_arctan_series:
   fixes n :: nat
   assumes "\<bar>x\<bar> \<le> 1"
   shows "summable (\<lambda> k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
     (is "summable (?c x)")
   by (rule summable_Leibniz(1),
       rule zeroseq_arctan_series[OF assms],
       rule monoseq_arctan_series[OF assms])
 
 lemma DERIV_arctan_series:
   assumes "\<bar>x\<bar> < 1"
   shows "DERIV (\<lambda>x'. \<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x' ^ (k * 2 + 1))) x :>
       (\<Sum>k. (-1)^k * x^(k * 2))"
     (is "DERIV ?arctan _ :> ?Int")
 proof -
   let ?f = "\<lambda>n. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"
 
   have n_even: "even n \<Longrightarrow> 2 * (n div 2) = n" for n :: nat
     by presburger
   then have if_eq: "?f n * real (Suc n) * x'^n =
       (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
     for n x'
     by auto
 
   have summable_Integral: "summable (\<lambda> n. (- 1) ^ n * x^(2 * n))" if "\<bar>x\<bar> < 1" for x :: real
   proof -
     from that have "x\<^sup>2 < 1"
       by (simp add: abs_square_less_1)
     have "summable (\<lambda> n. (- 1) ^ n * (x\<^sup>2) ^n)"
       by (rule summable_Leibniz(1))
         (auto intro!: LIMSEQ_realpow_zero monoseq_realpow \<open>x\<^sup>2 < 1\<close> order_less_imp_le[OF \<open>x\<^sup>2 < 1\<close>])
     then show ?thesis
       by (simp only: power_mult)
   qed
 
   have sums_even: "(sums) f = (sums) (\<lambda> n. if even n then f (n div 2) else 0)"
     for f :: "nat \<Rightarrow> real"
   proof -
     have "f sums x = (\<lambda> n. if even n then f (n div 2) else 0) sums x" for x :: real
     proof
       assume "f sums x"
       from sums_if[OF sums_zero this] show "(\<lambda>n. if even n then f (n div 2) else 0) sums x"
         by auto
     next
       assume "(\<lambda> n. if even n then f (n div 2) else 0) sums x"
       from LIMSEQ_linear[OF this[simplified sums_def] pos2, simplified sum_split_even_odd[simplified mult.commute]]
       show "f sums x"
         unfolding sums_def by auto
     qed
     then show ?thesis ..
   qed
 
   have Int_eq: "(\<Sum>n. ?f n * real (Suc n) * x^n) = ?Int"
     unfolding if_eq mult.commute[of _ 2]
       suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * x ^ (2 * n)", symmetric]
     by auto
 
   have arctan_eq: "(\<Sum>n. ?f n * x^(Suc n)) = ?arctan x" for x
   proof -
     have if_eq': "\<And>n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
       (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
       using n_even by auto
     have idx_eq: "\<And>n. n * 2 + 1 = Suc (2 * n)"
       by auto
     then show ?thesis
       unfolding if_eq' idx_eq suminf_def
         sums_even[of "\<lambda> n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
       by auto
   qed
 
   have "DERIV (\<lambda> x. \<Sum> n. ?f n * x^(Suc n)) x :> (\<Sum>n. ?f n * real (Suc n) * x^n)"
   proof (rule DERIV_power_series')
     show "x \<in> {- 1 <..< 1}"
       using \<open>\<bar> x \<bar> < 1\<close> by auto
     show "summable (\<lambda> n. ?f n * real (Suc n) * x'^n)"
       if x'_bounds: "x' \<in> {- 1 <..< 1}" for x' :: real
     proof -
       from that have "\<bar>x'\<bar> < 1" by auto
       then show ?thesis
         using that sums_summable sums_if [OF sums_0 [of "\<lambda>x. 0"] summable_sums [OF summable_Integral]]   
         by (auto simp add: if_distrib [of "\<lambda>x. x * y" for y] cong: if_cong)
     qed
   qed auto
   then show ?thesis
     by (simp only: Int_eq arctan_eq)
 qed
 
 lemma arctan_series:
   assumes "\<bar>x\<bar> \<le> 1"
   shows "arctan x = (\<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x ^ (k * 2 + 1)))"
     (is "_ = suminf (\<lambda> n. ?c x n)")
 proof -
   let ?c' = "\<lambda>x n. (-1)^n * x^(n*2)"
 
   have DERIV_arctan_suminf: "DERIV (\<lambda> x. suminf (?c x)) x :> (suminf (?c' x))"
     if "0 < r" and "r < 1" and "\<bar>x\<bar> < r" for r x :: real
   proof (rule DERIV_arctan_series)
     from that show "\<bar>x\<bar> < 1"
       using \<open>r < 1\<close> and \<open>\<bar>x\<bar> < r\<close> by auto
   qed
 
   {
     fix x :: real
     assume "\<bar>x\<bar> \<le> 1"
     note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
   } note arctan_series_borders = this
 
   have when_less_one: "arctan x = (\<Sum>k. ?c x k)" if "\<bar>x\<bar> < 1" for x :: real
   proof -
     obtain r where "\<bar>x\<bar> < r" and "r < 1"
       using dense[OF \<open>\<bar>x\<bar> < 1\<close>] by blast
     then have "0 < r" and "- r < x" and "x < r" by auto
 
     have suminf_eq_arctan_bounded: "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
       if "-r < a" and "b < r" and "a < b" and "a \<le> x" and "x \<le> b" for x a b
     proof -
       from that have "\<bar>x\<bar> < r" by auto
       show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
       proof (rule DERIV_isconst2[of "a" "b"])
         show "a < b" and "a \<le> x" and "x \<le> b"
           using \<open>a < b\<close> \<open>a \<le> x\<close> \<open>x \<le> b\<close> by auto
         have "\<forall>x. - r < x \<and> x < r \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
         proof (rule allI, rule impI)
           fix x
           assume "-r < x \<and> x < r"
           then have "\<bar>x\<bar> < r" by auto
           with \<open>r < 1\<close> have "\<bar>x\<bar> < 1" by auto
           have "\<bar>- (x\<^sup>2)\<bar> < 1" using abs_square_less_1 \<open>\<bar>x\<bar> < 1\<close> by auto
           then have "(\<lambda>n. (- (x\<^sup>2)) ^ n) sums (1 / (1 - (- (x\<^sup>2))))"
             unfolding real_norm_def[symmetric] by (rule geometric_sums)
           then have "(?c' x) sums (1 / (1 - (- (x\<^sup>2))))"
             unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
           then have suminf_c'_eq_geom: "inverse (1 + x\<^sup>2) = suminf (?c' x)"
             using sums_unique unfolding inverse_eq_divide by auto
           have "DERIV (\<lambda> x. suminf (?c x)) x :> (inverse (1 + x\<^sup>2))"
             unfolding suminf_c'_eq_geom
             by (rule DERIV_arctan_suminf[OF \<open>0 < r\<close> \<open>r < 1\<close> \<open>\<bar>x\<bar> < r\<close>])
           from DERIV_diff [OF this DERIV_arctan] show "DERIV (\<lambda>x. suminf (?c x) - arctan x) x :> 0"
             by auto
         qed
         then have DERIV_in_rball: "\<forall>y. a \<le> y \<and> y \<le> b \<longrightarrow> DERIV (\<lambda>x. suminf (?c x) - arctan x) y :> 0"
           using \<open>-r < a\<close> \<open>b < r\<close> by auto
         then show "\<And>y. \<lbrakk>a < y; y < b\<rbrakk> \<Longrightarrow> DERIV (\<lambda>x. suminf (?c x) - arctan x) y :> 0"
           using \<open>\<bar>x\<bar> < r\<close> by auto
         show "continuous_on {a..b} (\<lambda>x. suminf (?c x) - arctan x)"
           using DERIV_in_rball DERIV_atLeastAtMost_imp_continuous_on by blast
       qed
     qed
 
     have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
       unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
       by auto
 
     have "suminf (?c x) - arctan x = 0"
     proof (cases "x = 0")
       case True
       then show ?thesis
         using suminf_arctan_zero by auto
     next
       case False
       then have "0 < \<bar>x\<bar>" and "- \<bar>x\<bar> < \<bar>x\<bar>"
         by auto
       have "suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>) = suminf (?c 0) - arctan 0"
         by (rule suminf_eq_arctan_bounded[where x1=0 and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>", symmetric])
           (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>-\<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
       moreover
       have "suminf (?c x) - arctan x = suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>)"
         by (rule suminf_eq_arctan_bounded[where x1=x and a1="- \<bar>x\<bar>" and b1="\<bar>x\<bar>"])
            (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>- \<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
       ultimately show ?thesis
         using suminf_arctan_zero by auto
     qed
     then show ?thesis by auto
   qed
 
   show "arctan x = suminf (\<lambda>n. ?c x n)"
   proof (cases "\<bar>x\<bar> < 1")
     case True
     then show ?thesis by (rule when_less_one)
   next
     case False
     then have "\<bar>x\<bar> = 1" using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
     let ?a = "\<lambda>x n. \<bar>1 / real (n * 2 + 1) * x^(n * 2 + 1)\<bar>"
     let ?diff = "\<lambda>x n. \<bar>arctan x - (\<Sum>i<n. ?c x i)\<bar>"
     have "?diff 1 n \<le> ?a 1 n" for n :: nat
     proof -
       have "0 < (1 :: real)" by auto
       moreover
       have "?diff x n \<le> ?a x n" if "0 < x" and "x < 1" for x :: real
       proof -
         from that have "\<bar>x\<bar> \<le> 1" and "\<bar>x\<bar> < 1"
           by auto
         from \<open>0 < x\<close> have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
           by auto
         note bounds = mp[OF arctan_series_borders(2)[OF \<open>\<bar>x\<bar> \<le> 1\<close>] this, unfolded when_less_one[OF \<open>\<bar>x\<bar> < 1\<close>, symmetric], THEN spec]
         have "0 < 1 / real (n*2+1) * x^(n*2+1)"
           by (rule mult_pos_pos) (simp_all only: zero_less_power[OF \<open>0 < x\<close>], auto)
         then have a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
           by (rule abs_of_pos)
         show ?thesis
         proof (cases "even n")
           case True
           then have sgn_pos: "(-1)^n = (1::real)" by auto
           from \<open>even n\<close> obtain m where "n = 2 * m" ..
           then have "2 * m = n" ..
           from bounds[of m, unfolded this atLeastAtMost_iff]
           have "\<bar>arctan x - (\<Sum>i<n. (?c x i))\<bar> \<le> (\<Sum>i<n + 1. (?c x i)) - (\<Sum>i<n. (?c x i))"
             by auto
           also have "\<dots> = ?c x n" by auto
           also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
           finally show ?thesis .
         next
           case False
           then have sgn_neg: "(-1)^n = (-1::real)" by auto
           from \<open>odd n\<close> obtain m where "n = 2 * m + 1" ..
           then have m_def: "2 * m + 1 = n" ..
           then have m_plus: "2 * (m + 1) = n + 1" by auto
           from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
           have "\<bar>arctan x - (\<Sum>i<n. (?c x i))\<bar> \<le> (\<Sum>i<n. (?c x i)) - (\<Sum>i<n+1. (?c x i))" by auto
           also have "\<dots> = - ?c x n" by auto
           also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
           finally show ?thesis .
         qed
       qed
       hence "\<forall>x \<in> { 0 <..< 1 }. 0 \<le> ?a x n - ?diff x n" by auto
       moreover have "isCont (\<lambda> x. ?a x n - ?diff x n) x" for x
         unfolding diff_conv_add_uminus divide_inverse
         by (auto intro!: isCont_add isCont_rabs continuous_ident isCont_minus isCont_arctan
           continuous_at_within_inverse isCont_mult isCont_power continuous_const isCont_sum
           simp del: add_uminus_conv_diff)
       ultimately have "0 \<le> ?a 1 n - ?diff 1 n"
         by (rule LIM_less_bound)
       then show ?thesis by auto
     qed
     have "?a 1 \<longlonglongrightarrow> 0"
       unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
       by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat simp del: of_nat_Suc)
     have "?diff 1 \<longlonglongrightarrow> 0"
     proof (rule LIMSEQ_I)
       fix r :: real
       assume "0 < r"
       obtain N :: nat where N_I: "N \<le> n \<Longrightarrow> ?a 1 n < r" for n
         using LIMSEQ_D[OF \<open>?a 1 \<longlonglongrightarrow> 0\<close> \<open>0 < r\<close>] by auto
       have "norm (?diff 1 n - 0) < r" if "N \<le> n" for n
         using \<open>?diff 1 n \<le> ?a 1 n\<close> N_I[OF that] by auto
       then show "\<exists>N. \<forall> n \<ge> N. norm (?diff 1 n - 0) < r" by blast
     qed
     from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
     have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
     then have "arctan 1 = (\<Sum>i. ?c 1 i)" by (rule sums_unique)
 
     show ?thesis
     proof (cases "x = 1")
       case True
       then show ?thesis by (simp add: \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close>)
     next
       case False
       then have "x = -1" using \<open>\<bar>x\<bar> = 1\<close> by auto
 
       have "- (pi/2) < 0" using pi_gt_zero by auto
       have "- (2 * pi) < 0" using pi_gt_zero by auto
 
       have c_minus_minus: "?c (- 1) i = - ?c 1 i" for i by auto
 
       have "arctan (- 1) = arctan (tan (-(pi/4)))"
         unfolding tan_45 tan_minus ..
       also have "\<dots> = - (pi/4)"
         by (rule arctan_tan) (auto simp: order_less_trans[OF \<open>- (pi/2) < 0\<close> pi_gt_zero])
       also have "\<dots> = - (arctan (tan (pi/4)))"
         unfolding neg_equal_iff_equal
         by (rule arctan_tan[symmetric]) (auto simp: order_less_trans[OF \<open>- (2 * pi) < 0\<close> pi_gt_zero])
       also have "\<dots> = - (arctan 1)"
         unfolding tan_45 ..
       also have "\<dots> = - (\<Sum> i. ?c 1 i)"
         using \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close> by auto
       also have "\<dots> = (\<Sum> i. ?c (- 1) i)"
         using suminf_minus[OF sums_summable[OF \<open>(?c 1) sums (arctan 1)\<close>]]
         unfolding c_minus_minus by auto
       finally show ?thesis using \<open>x = -1\<close> by auto
     qed
   qed
 qed
 
 lemma arctan_half: "arctan x = 2 * arctan (x / (1 + sqrt(1 + x\<^sup>2)))"
   for x :: real
 proof -
   obtain y where low: "- (pi/2) < y" and high: "y < pi/2" and y_eq: "tan y = x"
     using tan_total by blast
   then have low2: "- (pi/2) < y / 2" and high2: "y / 2 < pi/2"
     by auto
 
   have "0 < cos y" by (rule cos_gt_zero_pi[OF low high])
   then have "cos y \<noteq> 0" and cos_sqrt: "sqrt ((cos y)\<^sup>2) = cos y"
     by auto
 
   have "1 + (tan y)\<^sup>2 = 1 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
     unfolding tan_def power_divide ..
   also have "\<dots> = (cos y)\<^sup>2 / (cos y)\<^sup>2 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
     using \<open>cos y \<noteq> 0\<close> by auto
   also have "\<dots> = 1 / (cos y)\<^sup>2"
     unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
   finally have "1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2" .
 
   have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
     unfolding tan_def using \<open>cos y \<noteq> 0\<close> by (simp add: field_simps)
   also have "\<dots> = tan y / (1 + 1 / cos y)"
     using \<open>cos y \<noteq> 0\<close> unfolding add_divide_distrib by auto
   also have "\<dots> = tan y / (1 + 1 / sqrt ((cos y)\<^sup>2))"
     unfolding cos_sqrt ..
   also have "\<dots> = tan y / (1 + sqrt (1 / (cos y)\<^sup>2))"
     unfolding real_sqrt_divide by auto
   finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)\<^sup>2))"
     unfolding \<open>1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2\<close> .
 
   have "arctan x = y"
     using arctan_tan low high y_eq by auto
   also have "\<dots> = 2 * (arctan (tan (y/2)))"
     using arctan_tan[OF low2 high2] by auto
   also have "\<dots> = 2 * (arctan (sin y / (cos y + 1)))"
     unfolding tan_half by auto
   finally show ?thesis
     unfolding eq \<open>tan y = x\<close> .
 qed
 
 lemma arctan_monotone: "x < y \<Longrightarrow> arctan x < arctan y"
   by (simp only: arctan_less_iff)
 
 lemma arctan_monotone': "x \<le> y \<Longrightarrow> arctan x \<le> arctan y"
   by (simp only: arctan_le_iff)
 
 lemma arctan_inverse:
   assumes "x \<noteq> 0"
   shows "arctan (1/x) = sgn x * pi/2 - arctan x"
 proof (rule arctan_unique)
   have \<section>: "x > 0 \<Longrightarrow> arctan x < pi"
     using arctan_bounded [of x] by linarith 
   show "- (pi/2) < sgn x * pi/2 - arctan x"
     using assms by (auto simp: sgn_real_def arctan algebra_simps \<section>)
   show "sgn x * pi/2 - arctan x < pi/2"
     using arctan_bounded [of "- x"] assms
     by (auto simp: algebra_simps sgn_real_def arctan_minus)
   show "tan (sgn x * pi/2 - arctan x) = 1/x"
     unfolding tan_inverse [of "arctan x", unfolded tan_arctan] sgn_real_def
     by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
 qed
 
 theorem pi_series: "pi/4 = (\<Sum>k. (-1)^k * 1 / real (k * 2 + 1))"
   (is "_ = ?SUM")
 proof -
   have "pi/4 = arctan 1"
     using arctan_one by auto
   also have "\<dots> = ?SUM"
     using arctan_series[of 1] by auto
   finally show ?thesis by auto
 qed
 
 
 subsection \<open>Existence of Polar Coordinates\<close>
 
 lemma cos_x_y_le_one: "\<bar>x / sqrt (x\<^sup>2 + y\<^sup>2)\<bar> \<le> 1"
   by (rule power2_le_imp_le [OF _ zero_le_one])
     (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)
 
 lemma polar_Ex: "\<exists>r::real. \<exists>a. x = r * cos a \<and> y = r * sin a"
 proof -
   have polar_ex1: "\<exists>r a. x = r * cos a \<and> y = r * sin a" if "0 < y" for y
   proof -
     have "x = sqrt (x\<^sup>2 + y\<^sup>2) * cos (arccos (x / sqrt (x\<^sup>2 + y\<^sup>2)))"
       by (simp add: cos_arccos_abs [OF cos_x_y_le_one])
     moreover have "y = sqrt (x\<^sup>2 + y\<^sup>2) * sin (arccos (x / sqrt (x\<^sup>2 + y\<^sup>2)))"
       using that
       by (simp add: sin_arccos_abs [OF cos_x_y_le_one] power_divide right_diff_distrib flip: real_sqrt_mult)
     ultimately show ?thesis
       by blast
   qed
   show ?thesis
   proof (cases "0::real" y rule: linorder_cases)
     case less
     then show ?thesis
       by (rule polar_ex1)
   next
     case equal
     then show ?thesis
       by (force simp: intro!: cos_zero sin_zero)
   next
     case greater
     with polar_ex1 [where y="-y"] show ?thesis
       by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
   qed
 qed
 
 
 subsection \<open>Basics about polynomial functions: products, extremal behaviour and root counts\<close>
 
 lemma polynomial_product_nat:
   fixes x :: nat
   assumes m: "\<And>i. i > m \<Longrightarrow> int (a i) = 0"
     and n: "\<And>j. j > n \<Longrightarrow> int (b j) = 0"
   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
          (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
   using polynomial_product [of m a n b x] assms
   by (simp only: of_nat_mult [symmetric] of_nat_power [symmetric]
       of_nat_eq_iff Int.int_sum [symmetric])
 
 lemma polyfun_diff: (*COMPLEX_SUB_POLYFUN in HOL Light*)
   fixes x :: "'a::idom"
   assumes "1 \<le> n"
   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
     (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
 proof -
   have h: "bij_betw (\<lambda>(i,j). (j,i)) ((SIGMA i : atMost n. lessThan i)) (SIGMA j : lessThan n. {Suc j..n})"
     by (auto simp: bij_betw_def inj_on_def)
   have "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) = (\<Sum>i\<le>n. a i * (x^i - y^i))"
     by (simp add: right_diff_distrib sum_subtractf)
   also have "\<dots> = (\<Sum>i\<le>n. a i * (x - y) * (\<Sum>j<i. y^(i - Suc j) * x^j))"
     by (simp add: power_diff_sumr2 mult.assoc)
   also have "\<dots> = (\<Sum>i\<le>n. \<Sum>j<i. a i * (x - y) * (y^(i - Suc j) * x^j))"
     by (simp add: sum_distrib_left)
   also have "\<dots> = (\<Sum>(i,j) \<in> (SIGMA i : atMost n. lessThan i). a i * (x - y) * (y^(i - Suc j) * x^j))"
     by (simp add: sum.Sigma)
   also have "\<dots> = (\<Sum>(j,i) \<in> (SIGMA j : lessThan n. {Suc j..n}). a i * (x - y) * (y^(i - Suc j) * x^j))"
     by (auto simp: sum.reindex_bij_betw [OF h, symmetric] intro: sum.cong_simp)
   also have "\<dots> = (\<Sum>j<n. \<Sum>i=Suc j..n. a i * (x - y) * (y^(i - Suc j) * x^j))"
     by (simp add: sum.Sigma)
   also have "\<dots> = (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
     by (simp add: sum_distrib_left mult_ac)
   finally show ?thesis .
 qed
 
 lemma polyfun_diff_alt: (*COMPLEX_SUB_POLYFUN_ALT in HOL Light*)
   fixes x :: "'a::idom"
   assumes "1 \<le> n"
   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
     (x - y) * ((\<Sum>j<n. \<Sum>k<n-j. a(j + k + 1) * y^k * x^j))"
 proof -
   have "(\<Sum>i=Suc j..n. a i * y^(i - j - 1)) = (\<Sum>k<n-j. a(j+k+1) * y^k)"
     if "j < n" for j :: nat
   proof -
     have "\<And>k. k < n - j \<Longrightarrow> k \<in> (\<lambda>i. i - Suc j) ` {Suc j..n}"
       by (rule_tac x="k + Suc j" in image_eqI, auto)
     then have h: "bij_betw (\<lambda>i. i - (j + 1)) {Suc j..n} (lessThan (n-j))"
       by (auto simp: bij_betw_def inj_on_def)
     then show ?thesis
       by (auto simp: sum.reindex_bij_betw [OF h, symmetric] intro: sum.cong_simp)
   qed
   then show ?thesis
     by (simp add: polyfun_diff [OF assms] sum_distrib_right)
 qed
 
 lemma polyfun_linear_factor:  (*COMPLEX_POLYFUN_LINEAR_FACTOR in HOL Light*)
   fixes a :: "'a::idom"
   shows "\<exists>b. \<forall>z. (\<Sum>i\<le>n. c(i) * z^i) = (z - a) * (\<Sum>i<n. b(i) * z^i) + (\<Sum>i\<le>n. c(i) * a^i)"
 proof (cases "n = 0")
   case True then show ?thesis
     by simp
 next
   case False
   have "(\<exists>b. \<forall>z. (\<Sum>i\<le>n. c i * z^i) = (z - a) * (\<Sum>i<n. b i * z^i) + (\<Sum>i\<le>n. c i * a^i)) \<longleftrightarrow>
         (\<exists>b. \<forall>z. (\<Sum>i\<le>n. c i * z^i) - (\<Sum>i\<le>n. c i * a^i) = (z - a) * (\<Sum>i<n. b i * z^i))"
     by (simp add: algebra_simps)
   also have "\<dots> \<longleftrightarrow>
     (\<exists>b. \<forall>z. (z - a) * (\<Sum>j<n. (\<Sum>i = Suc j..n. c i * a^(i - Suc j)) * z^j) =
       (z - a) * (\<Sum>i<n. b i * z^i))"
     using False by (simp add: polyfun_diff)
   also have "\<dots> = True" by auto
   finally show ?thesis
     by simp
 qed
 
 lemma polyfun_linear_factor_root:  (*COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT in HOL Light*)
   fixes a :: "'a::idom"
   assumes "(\<Sum>i\<le>n. c(i) * a^i) = 0"
   obtains b where "\<And>z. (\<Sum>i\<le>n. c i * z^i) = (z - a) * (\<Sum>i<n. b i * z^i)"
   using polyfun_linear_factor [of c n a] assms by auto
 
 (*The material of this section, up until this point, could go into a new theory of polynomials
   based on Main alone. The remaining material involves limits, continuity, series, etc.*)
 
 lemma isCont_polynom: "isCont (\<lambda>w. \<Sum>i\<le>n. c i * w^i) a"
   for c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   by simp
 
 lemma zero_polynom_imp_zero_coeffs:
   fixes c :: "nat \<Rightarrow> 'a::{ab_semigroup_mult,real_normed_div_algebra}"
   assumes "\<And>w. (\<Sum>i\<le>n. c i * w^i) = 0"  "k \<le> n"
   shows "c k = 0"
   using assms
 proof (induction n arbitrary: c k)
   case 0
   then show ?case
     by simp
 next
   case (Suc n c k)
   have [simp]: "c 0 = 0" using Suc.prems(1) [of 0]
     by simp
   have "(\<Sum>i\<le>Suc n. c i * w^i) = w * (\<Sum>i\<le>n. c (Suc i) * w^i)" for w
   proof -
     have "(\<Sum>i\<le>Suc n. c i * w^i) = (\<Sum>i\<le>n. c (Suc i) * w ^ Suc i)"
       unfolding Set_Interval.sum.atMost_Suc_shift
       by simp
     also have "\<dots> = w * (\<Sum>i\<le>n. c (Suc i) * w^i)"
       by (simp add: sum_distrib_left ac_simps)
     finally show ?thesis .
   qed
   then have w: "\<And>w. w \<noteq> 0 \<Longrightarrow> (\<Sum>i\<le>n. c (Suc i) * w^i) = 0"
     using Suc  by auto
   then have "(\<lambda>h. \<Sum>i\<le>n. c (Suc i) * h^i) \<midarrow>0\<rightarrow> 0"
     by (simp cong: LIM_cong)  \<comment> \<open>the case \<open>w = 0\<close> by continuity\<close>
   then have "(\<Sum>i\<le>n. c (Suc i) * 0^i) = 0"
     using isCont_polynom [of 0 "\<lambda>i. c (Suc i)" n] LIM_unique
     by (force simp: Limits.isCont_iff)
   then have "\<And>w. (\<Sum>i\<le>n. c (Suc i) * w^i) = 0"
     using w by metis
   then have "\<And>i. i \<le> n \<Longrightarrow> c (Suc i) = 0"
     using Suc.IH [of "\<lambda>i. c (Suc i)"] by blast
   then show ?case using \<open>k \<le> Suc n\<close>
     by (cases k) auto
 qed
 
 lemma polyfun_rootbound: (*COMPLEX_POLYFUN_ROOTBOUND in HOL Light*)
   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   assumes "c k \<noteq> 0" "k\<le>n"
   shows "finite {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<and> card {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<le> n"
   using assms
 proof (induction n arbitrary: c k)
   case 0
   then show ?case
     by simp
 next
   case (Suc m c k)
   let ?succase = ?case
   show ?case
   proof (cases "{z. (\<Sum>i\<le>Suc m. c(i) * z^i) = 0} = {}")
     case True
     then show ?succase
       by simp
   next
     case False
     then obtain z0 where z0: "(\<Sum>i\<le>Suc m. c(i) * z0^i) = 0"
       by blast
     then obtain b where b: "\<And>w. (\<Sum>i\<le>Suc m. c i * w^i) = (w - z0) * (\<Sum>i\<le>m. b i * w^i)"
       using polyfun_linear_factor_root [OF z0, unfolded lessThan_Suc_atMost]
       by blast
     then have eq: "{z. (\<Sum>i\<le>Suc m. c i * z^i) = 0} = insert z0 {z. (\<Sum>i\<le>m. b i * z^i) = 0}"
       by auto
     have "\<not> (\<forall>k\<le>m. b k = 0)"
     proof
       assume [simp]: "\<forall>k\<le>m. b k = 0"
       then have "\<And>w. (\<Sum>i\<le>m. b i * w^i) = 0"
         by simp
       then have "\<And>w. (\<Sum>i\<le>Suc m. c i * w^i) = 0"
         using b by simp
       then have "\<And>k. k \<le> Suc m \<Longrightarrow> c k = 0"
         using zero_polynom_imp_zero_coeffs by blast
       then show False using Suc.prems by blast
     qed
     then obtain k' where bk': "b k' \<noteq> 0" "k' \<le> m"
       by blast
     show ?succase
       using Suc.IH [of b k'] bk'
       by (simp add: eq card_insert_if del: sum.atMost_Suc)
     qed
 qed
 
 lemma
   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   assumes "c k \<noteq> 0" "k\<le>n"
   shows polyfun_roots_finite: "finite {z. (\<Sum>i\<le>n. c(i) * z^i) = 0}"
     and polyfun_roots_card: "card {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<le> n"
   using polyfun_rootbound assms by auto
 
 lemma polyfun_finite_roots: (*COMPLEX_POLYFUN_FINITE_ROOTS in HOL Light*)
   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   shows "finite {x. (\<Sum>i\<le>n. c i * x^i) = 0} \<longleftrightarrow> (\<exists>i\<le>n. c i \<noteq> 0)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   moreover have "\<not> finite {x. (\<Sum>i\<le>n. c i * x^i) = 0}" if "\<forall>i\<le>n. c i = 0"
   proof -
     from that have "\<And>x. (\<Sum>i\<le>n. c i * x^i) = 0"
       by simp
     then show ?thesis
       using ex_new_if_finite [OF infinite_UNIV_char_0 [where 'a='a]]
       by auto
   qed
   ultimately show ?rhs by metis
 next
   assume ?rhs
   with polyfun_rootbound show ?lhs by blast
 qed
 
 lemma polyfun_eq_0: "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = 0) \<longleftrightarrow> (\<forall>i\<le>n. c i = 0)"
   for c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   (*COMPLEX_POLYFUN_EQ_0 in HOL Light*)
   using zero_polynom_imp_zero_coeffs by auto
 
 lemma polyfun_eq_coeffs: "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = (\<Sum>i\<le>n. d i * x^i)) \<longleftrightarrow> (\<forall>i\<le>n. c i = d i)"
   for c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
 proof -
   have "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = (\<Sum>i\<le>n. d i * x^i)) \<longleftrightarrow> (\<forall>x. (\<Sum>i\<le>n. (c i - d i) * x^i) = 0)"
     by (simp add: left_diff_distrib Groups_Big.sum_subtractf)
   also have "\<dots> \<longleftrightarrow> (\<forall>i\<le>n. c i - d i = 0)"
     by (rule polyfun_eq_0)
   finally show ?thesis
     by simp
 qed
 
 lemma polyfun_eq_const: (*COMPLEX_POLYFUN_EQ_CONST in HOL Light*)
   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   shows "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = k) \<longleftrightarrow> c 0 = k \<and> (\<forall>i \<in> {1..n}. c i = 0)"
     (is "?lhs = ?rhs")
 proof -
   have *: "\<forall>x. (\<Sum>i\<le>n. (if i=0 then k else 0) * x^i) = k"
     by (induct n) auto
   show ?thesis
   proof
     assume ?lhs
     with * have "(\<forall>i\<le>n. c i = (if i=0 then k else 0))"
       by (simp add: polyfun_eq_coeffs [symmetric])
     then show ?rhs by simp
   next
     assume ?rhs
     then show ?lhs by (induct n) auto
   qed
 qed
 
 lemma root_polyfun:
   fixes z :: "'a::idom"
   assumes "1 \<le> n"
   shows "z^n = a \<longleftrightarrow> (\<Sum>i\<le>n. (if i = 0 then -a else if i=n then 1 else 0) * z^i) = 0"
   using assms by (cases n) (simp_all add: sum.atLeast_Suc_atMost atLeast0AtMost [symmetric])
 
 lemma
   assumes "SORT_CONSTRAINT('a::{idom,real_normed_div_algebra})"
     and "1 \<le> n"
   shows finite_roots_unity: "finite {z::'a. z^n = 1}"
     and card_roots_unity: "card {z::'a. z^n = 1} \<le> n"
   using polyfun_rootbound [of "\<lambda>i. if i = 0 then -1 else if i=n then 1 else 0" n n] assms(2)
   by (auto simp: root_polyfun [OF assms(2)])
 
 
 subsection \<open>Hyperbolic functions\<close>
 
 definition sinh :: "'a :: {banach, real_normed_algebra_1} \<Rightarrow> 'a" where
   "sinh x = (exp x - exp (-x)) /\<^sub>R 2"
 
 definition cosh :: "'a :: {banach, real_normed_algebra_1} \<Rightarrow> 'a" where
   "cosh x = (exp x + exp (-x)) /\<^sub>R 2"
 
 definition tanh :: "'a :: {banach, real_normed_field} \<Rightarrow> 'a" where
   "tanh x = sinh x / cosh x"
 
 definition arsinh :: "'a :: {banach, real_normed_algebra_1, ln} \<Rightarrow> 'a" where
   "arsinh x = ln (x + (x^2 + 1) powr of_real (1/2))"
 
 definition arcosh :: "'a :: {banach, real_normed_algebra_1, ln} \<Rightarrow> 'a" where
   "arcosh x = ln (x + (x^2 - 1) powr of_real (1/2))"
 
 definition artanh :: "'a :: {banach, real_normed_field, ln} \<Rightarrow> 'a" where
   "artanh x = ln ((1 + x) / (1 - x)) / 2"
 
 lemma arsinh_0 [simp]: "arsinh 0 = 0"
   by (simp add: arsinh_def)
 
 lemma arcosh_1 [simp]: "arcosh 1 = 0"
   by (simp add: arcosh_def)
 
 lemma artanh_0 [simp]: "artanh 0 = 0"
   by (simp add: artanh_def)
 
 lemma tanh_altdef:
   "tanh x = (exp x - exp (-x)) / (exp x + exp (-x))"
 proof -
   have "tanh x = (2 *\<^sub>R sinh x) / (2 *\<^sub>R cosh x)"
     by (simp add: tanh_def scaleR_conv_of_real)
   also have "2 *\<^sub>R sinh x = exp x - exp (-x)"
     by (simp add: sinh_def)
   also have "2 *\<^sub>R cosh x = exp x + exp (-x)"
     by (simp add: cosh_def)
   finally show ?thesis .
 qed
 
 lemma tanh_real_altdef: "tanh (x::real) = (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))"
 proof -
   have [simp]: "exp (2 * x) = exp x * exp x" "exp (x * 2) = exp x * exp x"
     by (subst exp_add [symmetric]; simp)+
   have "tanh x = (2 * exp (-x) * sinh x) / (2 * exp (-x) * cosh x)"
     by (simp add: tanh_def)
   also have "2 * exp (-x) * sinh x = 1 - exp (-2*x)"
     by (simp add: exp_minus field_simps sinh_def)
   also have "2 * exp (-x) * cosh x = 1 + exp (-2*x)"
     by (simp add: exp_minus field_simps cosh_def)
   finally show ?thesis .
 qed
 
 
 lemma sinh_converges: "(\<lambda>n. if even n then 0 else x ^ n /\<^sub>R fact n) sums sinh x"
 proof -
   have "(\<lambda>n. (x ^ n /\<^sub>R fact n - (-x) ^ n /\<^sub>R fact n) /\<^sub>R 2) sums sinh x"
     unfolding sinh_def by (intro sums_scaleR_right sums_diff exp_converges)
   also have "(\<lambda>n. (x ^ n /\<^sub>R fact n - (-x) ^ n /\<^sub>R fact n) /\<^sub>R 2) =
                (\<lambda>n. if even n then 0 else x ^ n /\<^sub>R fact n)" by auto
   finally show ?thesis .
 qed
 
 lemma cosh_converges: "(\<lambda>n. if even n then x ^ n /\<^sub>R fact n else 0) sums cosh x"
 proof -
   have "(\<lambda>n. (x ^ n /\<^sub>R fact n + (-x) ^ n /\<^sub>R fact n) /\<^sub>R 2) sums cosh x"
     unfolding cosh_def by (intro sums_scaleR_right sums_add exp_converges)
   also have "(\<lambda>n. (x ^ n /\<^sub>R fact n + (-x) ^ n /\<^sub>R fact n) /\<^sub>R 2) =
                (\<lambda>n. if even n then x ^ n /\<^sub>R fact n else 0)" by auto
   finally show ?thesis .
 qed
 
 lemma sinh_0 [simp]: "sinh 0 = 0"
   by (simp add: sinh_def)
 
 lemma cosh_0 [simp]: "cosh 0 = 1"
 proof -
   have "cosh 0 = (1/2) *\<^sub>R (1 + 1)" by (simp add: cosh_def)
   also have "\<dots> = 1" by (rule scaleR_half_double)
   finally show ?thesis .
 qed
 
 lemma tanh_0 [simp]: "tanh 0 = 0"
   by (simp add: tanh_def)
 
 lemma sinh_minus [simp]: "sinh (- x) = -sinh x"
   by (simp add: sinh_def algebra_simps)
 
 lemma cosh_minus [simp]: "cosh (- x) = cosh x"
   by (simp add: cosh_def algebra_simps)
 
 lemma tanh_minus [simp]: "tanh (-x) = -tanh x"
   by (simp add: tanh_def)
 
 lemma sinh_ln_real: "x > 0 \<Longrightarrow> sinh (ln x :: real) = (x - inverse x) / 2"
   by (simp add: sinh_def exp_minus)
 
 lemma cosh_ln_real: "x > 0 \<Longrightarrow> cosh (ln x :: real) = (x + inverse x) / 2"
   by (simp add: cosh_def exp_minus)
 
 lemma tanh_ln_real:
   "tanh (ln x :: real) = (x ^ 2 - 1) / (x ^ 2 + 1)" if "x > 0"
 proof -
   from that have "(x * 2 - inverse x * 2) * (x\<^sup>2 + 1) =
     (x\<^sup>2 - 1) * (2 * x + 2 * inverse x)"
     by (simp add: field_simps power2_eq_square)
   moreover have "x\<^sup>2 + 1 > 0"
     using that by (simp add: ac_simps add_pos_nonneg)
   moreover have "2 * x + 2 * inverse x > 0"
     using that by (simp add: add_pos_pos)
   ultimately have "(x * 2 - inverse x * 2) /
     (2 * x + 2 * inverse x) =
     (x\<^sup>2 - 1) / (x\<^sup>2 + 1)"
     by (simp add: frac_eq_eq)
   with that show ?thesis
     by (simp add: tanh_def sinh_ln_real cosh_ln_real)
 qed
 
 lemma has_field_derivative_scaleR_right [derivative_intros]:
   "(f has_field_derivative D) F \<Longrightarrow> ((\<lambda>x. c *\<^sub>R f x) has_field_derivative (c *\<^sub>R D)) F"
   unfolding has_field_derivative_def
   using has_derivative_scaleR_right[of f "\<lambda>x. D * x" F c]
   by (simp add: mult_scaleR_left [symmetric] del: mult_scaleR_left)
 
 lemma has_field_derivative_sinh [THEN DERIV_chain2, derivative_intros]:
   "(sinh has_field_derivative cosh x) (at (x :: 'a :: {banach, real_normed_field}))"
   unfolding sinh_def cosh_def by (auto intro!: derivative_eq_intros)
 
 lemma has_field_derivative_cosh [THEN DERIV_chain2, derivative_intros]:
   "(cosh has_field_derivative sinh x) (at (x :: 'a :: {banach, real_normed_field}))"
   unfolding sinh_def cosh_def by (auto intro!: derivative_eq_intros)
 
 lemma has_field_derivative_tanh [THEN DERIV_chain2, derivative_intros]:
   "cosh x \<noteq> 0 \<Longrightarrow> (tanh has_field_derivative 1 - tanh x ^ 2)
                      (at (x :: 'a :: {banach, real_normed_field}))"
   unfolding tanh_def by (auto intro!: derivative_eq_intros simp: power2_eq_square field_split_simps)
 
 lemma has_derivative_sinh [derivative_intros]:
   fixes g :: "'a \<Rightarrow> ('a :: {banach, real_normed_field})"
   assumes "(g has_derivative (\<lambda>x. Db * x)) (at x within s)"
   shows   "((\<lambda>x. sinh (g x)) has_derivative (\<lambda>y. (cosh (g x) * Db) * y)) (at x within s)"
 proof -
   have "((\<lambda>x. - g x) has_derivative (\<lambda>y. -(Db * y))) (at x within s)"
     using assms by (intro derivative_intros)
   also have "(\<lambda>y. -(Db * y)) = (\<lambda>x. (-Db) * x)" by (simp add: fun_eq_iff)
   finally have "((\<lambda>x. sinh (g x)) has_derivative
     (\<lambda>y. (exp (g x) * Db * y - exp (-g x) * (-Db) * y) /\<^sub>R 2)) (at x within s)"
     unfolding sinh_def by (intro derivative_intros assms)
   also have "(\<lambda>y. (exp (g x) * Db * y - exp (-g x) * (-Db) * y) /\<^sub>R 2) = (\<lambda>y. (cosh (g x) * Db) * y)"
     by (simp add: fun_eq_iff cosh_def algebra_simps)
   finally show ?thesis .
 qed
 
 lemma has_derivative_cosh [derivative_intros]:
   fixes g :: "'a \<Rightarrow> ('a :: {banach, real_normed_field})"
   assumes "(g has_derivative (\<lambda>y. Db * y)) (at x within s)"
   shows   "((\<lambda>x. cosh (g x)) has_derivative (\<lambda>y. (sinh (g x) * Db) * y)) (at x within s)"
 proof -
   have "((\<lambda>x. - g x) has_derivative (\<lambda>y. -(Db * y))) (at x within s)"
     using assms by (intro derivative_intros)
   also have "(\<lambda>y. -(Db * y)) = (\<lambda>y. (-Db) * y)" by (simp add: fun_eq_iff)
   finally have "((\<lambda>x. cosh (g x)) has_derivative
     (\<lambda>y. (exp (g x) * Db * y + exp (-g x) * (-Db) * y) /\<^sub>R 2)) (at x within s)"
     unfolding cosh_def by (intro derivative_intros assms)
   also have "(\<lambda>y. (exp (g x) * Db * y + exp (-g x) * (-Db) * y) /\<^sub>R 2) = (\<lambda>y. (sinh (g x) * Db) * y)"
     by (simp add: fun_eq_iff sinh_def algebra_simps)
   finally show ?thesis .
 qed
 
 lemma sinh_plus_cosh: "sinh x + cosh x = exp x"
 proof -
   have "sinh x + cosh x = (1/2) *\<^sub>R (exp x + exp x)"
     by (simp add: sinh_def cosh_def algebra_simps)
   also have "\<dots> = exp x" by (rule scaleR_half_double)
   finally show ?thesis .
 qed
 
 lemma cosh_plus_sinh: "cosh x + sinh x = exp x"
   by (subst add.commute) (rule sinh_plus_cosh)
 
 lemma cosh_minus_sinh: "cosh x - sinh x = exp (-x)"
 proof -
   have "cosh x - sinh x = (1/2) *\<^sub>R (exp (-x) + exp (-x))"
     by (simp add: sinh_def cosh_def algebra_simps)
   also have "\<dots> = exp (-x)" by (rule scaleR_half_double)
   finally show ?thesis .
 qed
 
 lemma sinh_minus_cosh: "sinh x - cosh x = -exp (-x)"
   using cosh_minus_sinh[of x] by (simp add: algebra_simps)
 
 
 context
   fixes x :: "'a :: {real_normed_field, banach}"
 begin
 
 lemma sinh_zero_iff: "sinh x = 0 \<longleftrightarrow> exp x \<in> {1, -1}"
   by (auto simp: sinh_def field_simps exp_minus power2_eq_square square_eq_1_iff)
 
 lemma cosh_zero_iff: "cosh x = 0 \<longleftrightarrow> exp x ^ 2 = -1"
   by (auto simp: cosh_def exp_minus field_simps power2_eq_square eq_neg_iff_add_eq_0)
 
 lemma cosh_square_eq: "cosh x ^ 2 = sinh x ^ 2 + 1"
   by (simp add: cosh_def sinh_def algebra_simps power2_eq_square exp_add [symmetric]
                 scaleR_conv_of_real)
 
 lemma sinh_square_eq: "sinh x ^ 2 = cosh x ^ 2 - 1"
   by (simp add: cosh_square_eq)
 
 lemma hyperbolic_pythagoras: "cosh x ^ 2 - sinh x ^ 2 = 1"
   by (simp add: cosh_square_eq)
 
 lemma sinh_add: "sinh (x + y) = sinh x * cosh y + cosh x * sinh y"
   by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])
 
 lemma sinh_diff: "sinh (x - y) = sinh x * cosh y - cosh x * sinh y"
   by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])
 
 lemma cosh_add: "cosh (x + y) = cosh x * cosh y + sinh x * sinh y"
   by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])
 
 lemma cosh_diff: "cosh (x - y) = cosh x * cosh y - sinh x * sinh y"
   by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])
 
 lemma tanh_add:
   "tanh (x + y) = (tanh x + tanh y) / (1 + tanh x * tanh y)"
   if "cosh x \<noteq> 0" "cosh y \<noteq> 0"
 proof -
   have "(sinh x * cosh y + cosh x * sinh y) * (1 + sinh x * sinh y / (cosh x * cosh y)) =
     (cosh x * cosh y + sinh x * sinh y) * ((sinh x * cosh y + sinh y * cosh x) / (cosh y * cosh x))"
     using that by (simp add: field_split_simps)
   also have "(sinh x * cosh y + sinh y * cosh x) / (cosh y * cosh x) = sinh x / cosh x + sinh y / cosh y"
     using that by (simp add: field_split_simps)
   finally have "(sinh x * cosh y + cosh x * sinh y) * (1 + sinh x * sinh y / (cosh x * cosh y)) =
     (sinh x / cosh x + sinh y / cosh y) * (cosh x * cosh y + sinh x * sinh y)"
     by simp
   then show ?thesis
     using that by (auto simp add: tanh_def sinh_add cosh_add eq_divide_eq)
      (simp_all add: field_split_simps)
 qed
 
 lemma sinh_double: "sinh (2 * x) = 2 * sinh x * cosh x"
   using sinh_add[of x] by simp
 
 lemma cosh_double: "cosh (2 * x) = cosh x ^ 2 + sinh x ^ 2"
   using cosh_add[of x] by (simp add: power2_eq_square)
 
 end
 
 lemma sinh_field_def: "sinh z = (exp z - exp (-z)) / (2 :: 'a :: {banach, real_normed_field})"
   by (simp add: sinh_def scaleR_conv_of_real)
 
 lemma cosh_field_def: "cosh z = (exp z + exp (-z)) / (2 :: 'a :: {banach, real_normed_field})"
   by (simp add: cosh_def scaleR_conv_of_real)
 
 
 subsubsection \<open>More specific properties of the real functions\<close>
 
 lemma plus_inverse_ge_2:
   fixes x :: real
   assumes "x > 0"
   shows   "x + inverse x \<ge> 2"
 proof -
   have "0 \<le> (x - 1) ^ 2" by simp
   also have "\<dots> = x^2 - 2*x + 1" by (simp add: power2_eq_square algebra_simps)
   finally show ?thesis using assms by (simp add: field_simps power2_eq_square)
 qed
 
 lemma sinh_real_nonneg_iff [simp]: "sinh (x :: real) \<ge> 0 \<longleftrightarrow> x \<ge> 0"
   by (simp add: sinh_def)
 
 lemma sinh_real_pos_iff [simp]: "sinh (x :: real) > 0 \<longleftrightarrow> x > 0"
   by (simp add: sinh_def)
 
 lemma sinh_real_nonpos_iff [simp]: "sinh (x :: real) \<le> 0 \<longleftrightarrow> x \<le> 0"
   by (simp add: sinh_def)
 
 lemma sinh_real_neg_iff [simp]: "sinh (x :: real) < 0 \<longleftrightarrow> x < 0"
   by (simp add: sinh_def)
 
 lemma cosh_real_ge_1: "cosh (x :: real) \<ge> 1"
   using plus_inverse_ge_2[of "exp x"] by (simp add: cosh_def exp_minus)
 
 lemma cosh_real_pos [simp]: "cosh (x :: real) > 0"
   using cosh_real_ge_1[of x] by simp
 
 lemma cosh_real_nonneg[simp]: "cosh (x :: real) \<ge> 0"
   using cosh_real_ge_1[of x] by simp
 
 lemma cosh_real_nonzero [simp]: "cosh (x :: real) \<noteq> 0"
   using cosh_real_ge_1[of x] by simp
 
 lemma arsinh_real_def: "arsinh (x::real) = ln (x + sqrt (x^2 + 1))"
   by (simp add: arsinh_def powr_half_sqrt)
 
 lemma arcosh_real_def: "x \<ge> 1 \<Longrightarrow> arcosh (x::real) = ln (x + sqrt (x^2 - 1))"
   by (simp add: arcosh_def powr_half_sqrt)
 
 lemma arsinh_real_aux: "0 < x + sqrt (x ^ 2 + 1 :: real)"
 proof (cases "x < 0")
   case True
   have "(-x) ^ 2 = x ^ 2" by simp
   also have "x ^ 2 < x ^ 2 + 1" by simp
   finally have "sqrt ((-x) ^ 2) < sqrt (x ^ 2 + 1)"
     by (rule real_sqrt_less_mono)
   thus ?thesis using True by simp
 qed (auto simp: add_nonneg_pos)
 
 lemma arsinh_minus_real [simp]: "arsinh (-x::real) = -arsinh x"
 proof -
   have "arsinh (-x) = ln (sqrt (x\<^sup>2 + 1) - x)"
     by (simp add: arsinh_real_def)
   also have "sqrt (x^2 + 1) - x = inverse (sqrt (x^2 + 1) + x)"
     using arsinh_real_aux[of x] by (simp add: field_split_simps algebra_simps power2_eq_square)
   also have "ln \<dots> = -arsinh x"
     using arsinh_real_aux[of x] by (simp add: arsinh_real_def ln_inverse)
   finally show ?thesis .
 qed
 
 lemma artanh_minus_real [simp]:
   assumes "abs x < 1"
   shows   "artanh (-x::real) = -artanh x"
   using assms by (simp add: artanh_def ln_div field_simps)
 
 lemma sinh_less_cosh_real: "sinh (x :: real) < cosh x"
   by (simp add: sinh_def cosh_def)
 
 lemma sinh_le_cosh_real: "sinh (x :: real) \<le> cosh x"
   by (simp add: sinh_def cosh_def)
 
 lemma tanh_real_lt_1: "tanh (x :: real) < 1"
   by (simp add: tanh_def sinh_less_cosh_real)
 
 lemma tanh_real_gt_neg1: "tanh (x :: real) > -1"
 proof -
   have "- cosh x < sinh x" by (simp add: sinh_def cosh_def field_split_simps)
   thus ?thesis by (simp add: tanh_def field_simps)
 qed
 
 lemma tanh_real_bounds: "tanh (x :: real) \<in> {-1<..<1}"
   using tanh_real_lt_1 tanh_real_gt_neg1 by simp
 
 context
   fixes x :: real
 begin
 
 lemma arsinh_sinh_real: "arsinh (sinh x) = x"
   by (simp add: arsinh_real_def powr_def sinh_square_eq sinh_plus_cosh)
 
 lemma arcosh_cosh_real: "x \<ge> 0 \<Longrightarrow> arcosh (cosh x) = x"
   by (simp add: arcosh_real_def powr_def cosh_square_eq cosh_real_ge_1 cosh_plus_sinh)
 
 lemma artanh_tanh_real: "artanh (tanh x) = x"
 proof -
   have "artanh (tanh x) = ln (cosh x * (cosh x + sinh x) / (cosh x * (cosh x - sinh x))) / 2"
     by (simp add: artanh_def tanh_def field_split_simps)
   also have "cosh x * (cosh x + sinh x) / (cosh x * (cosh x - sinh x)) =
                (cosh x + sinh x) / (cosh x - sinh x)" by simp
   also have "\<dots> = (exp x)^2"
     by (simp add: cosh_plus_sinh cosh_minus_sinh exp_minus field_simps power2_eq_square)
   also have "ln ((exp x)^2) / 2 = x" by (simp add: ln_realpow)
   finally show ?thesis .
 qed
 
 lemma sinh_real_zero_iff [simp]: "sinh x = 0 \<longleftrightarrow> x = 0"
   by (metis arsinh_0 arsinh_sinh_real sinh_0)
 
 lemma cosh_real_one_iff [simp]: "cosh x = 1 \<longleftrightarrow> x = 0"
   by (smt (verit, best) Transcendental.arcosh_cosh_real cosh_0 cosh_minus)
 
 lemma tanh_real_nonneg_iff [simp]: "tanh x \<ge> 0 \<longleftrightarrow> x \<ge> 0"
   by (simp add: tanh_def field_simps)
 
 lemma tanh_real_pos_iff [simp]: "tanh x > 0 \<longleftrightarrow> x > 0"
   by (simp add: tanh_def field_simps)
 
 lemma tanh_real_nonpos_iff [simp]: "tanh x \<le> 0 \<longleftrightarrow> x \<le> 0"
   by (simp add: tanh_def field_simps)
 
 lemma tanh_real_neg_iff [simp]: "tanh x < 0 \<longleftrightarrow> x < 0"
   by (simp add: tanh_def field_simps)
 
 lemma tanh_real_zero_iff [simp]: "tanh x = 0 \<longleftrightarrow> x = 0"
   by (simp add: tanh_def field_simps)
 
 end
   
 lemma sinh_real_strict_mono: "strict_mono (sinh :: real \<Rightarrow> real)"
   by (rule pos_deriv_imp_strict_mono derivative_intros)+ auto
 
 lemma cosh_real_strict_mono:
   assumes "0 \<le> x" and "x < (y::real)"
   shows   "cosh x < cosh y"
 proof -
   from assms have "\<exists>z>x. z < y \<and> cosh y - cosh x = (y - x) * sinh z"
     by (intro MVT2) (auto dest: connectedD_interval intro!: derivative_eq_intros)
   then obtain z where z: "z > x" "z < y" "cosh y - cosh x = (y - x) * sinh z" by blast
   note \<open>cosh y - cosh x = (y - x) * sinh z\<close>
   also from \<open>z > x\<close> and assms have "(y - x) * sinh z > 0" by (intro mult_pos_pos) auto
   finally show "cosh x < cosh y" by simp
 qed
 
 lemma tanh_real_strict_mono: "strict_mono (tanh :: real \<Rightarrow> real)"
 proof -
   have *: "tanh x ^ 2 < 1" for x :: real
     using tanh_real_bounds[of x] by (simp add: abs_square_less_1 abs_if)
   show ?thesis
     by (rule pos_deriv_imp_strict_mono) (insert *, auto intro!: derivative_intros)
 qed
 
 lemma sinh_real_abs [simp]: "sinh (abs x :: real) = abs (sinh x)"
   by (simp add: abs_if)
 
 lemma cosh_real_abs [simp]: "cosh (abs x :: real) = cosh x"
   by (simp add: abs_if)
 
 lemma tanh_real_abs [simp]: "tanh (abs x :: real) = abs (tanh x)"
   by (auto simp: abs_if)
 
 lemma sinh_real_eq_iff [simp]: "sinh x = sinh y \<longleftrightarrow> x = (y :: real)"
   using sinh_real_strict_mono by (simp add: strict_mono_eq)
 
 lemma tanh_real_eq_iff [simp]: "tanh x = tanh y \<longleftrightarrow> x = (y :: real)"
   using tanh_real_strict_mono by (simp add: strict_mono_eq)
 
 lemma cosh_real_eq_iff [simp]: "cosh x = cosh y \<longleftrightarrow> abs x = abs (y :: real)"
 proof -
   have "cosh x = cosh y \<longleftrightarrow> x = y" if "x \<ge> 0" "y \<ge> 0" for x y :: real
     using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x] that
     by (cases x y rule: linorder_cases) auto
   from this[of "abs x" "abs y"] show ?thesis by simp
 qed
 
 lemma sinh_real_le_iff [simp]: "sinh x \<le> sinh y \<longleftrightarrow> x \<le> (y::real)"
   using sinh_real_strict_mono by (simp add: strict_mono_less_eq)
 
 lemma cosh_real_nonneg_le_iff: "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> cosh x \<le> cosh y \<longleftrightarrow> x \<le> (y::real)"
   using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x]
   by (cases x y rule: linorder_cases) auto
 
 lemma cosh_real_nonpos_le_iff: "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> cosh x \<le> cosh y \<longleftrightarrow> x \<ge> (y::real)"
   using cosh_real_nonneg_le_iff[of "-x" "-y"] by simp
 
 lemma tanh_real_le_iff [simp]: "tanh x \<le> tanh y \<longleftrightarrow> x \<le> (y::real)"
   using tanh_real_strict_mono by (simp add: strict_mono_less_eq)
 
 
 lemma sinh_real_less_iff [simp]: "sinh x < sinh y \<longleftrightarrow> x < (y::real)"
   using sinh_real_strict_mono by (simp add: strict_mono_less)
 
 lemma cosh_real_nonneg_less_iff: "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> cosh x < cosh y \<longleftrightarrow> x < (y::real)"
   using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x]
   by (cases x y rule: linorder_cases) auto
 
 lemma cosh_real_nonpos_less_iff: "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> cosh x < cosh y \<longleftrightarrow> x > (y::real)"
   using cosh_real_nonneg_less_iff[of "-x" "-y"] by simp
 
 lemma tanh_real_less_iff [simp]: "tanh x < tanh y \<longleftrightarrow> x < (y::real)"
   using tanh_real_strict_mono by (simp add: strict_mono_less)
 
 
 subsubsection \<open>Limits\<close>
 
 lemma sinh_real_at_top: "filterlim (sinh :: real \<Rightarrow> real) at_top at_top"
 proof -
   have *: "((\<lambda>x. - exp (- x)) \<longlongrightarrow> (-0::real)) at_top"
     by (intro tendsto_minus filterlim_compose[OF exp_at_bot] filterlim_uminus_at_bot_at_top)
   have "filterlim (\<lambda>x. (1/2) * (-exp (-x) + exp x) :: real) at_top at_top"
     by (rule filterlim_tendsto_pos_mult_at_top[OF _ _
                filterlim_tendsto_add_at_top[OF *]] tendsto_const)+ (auto simp: exp_at_top)
   also have "(\<lambda>x. (1/2) * (-exp (-x) + exp x) :: real) = sinh"
     by (simp add: fun_eq_iff sinh_def)
   finally show ?thesis .
 qed
 
 lemma sinh_real_at_bot: "filterlim (sinh :: real \<Rightarrow> real) at_bot at_bot"
 proof -
   have "filterlim (\<lambda>x. -sinh x :: real) at_bot at_top"
     by (simp add: filterlim_uminus_at_top [symmetric] sinh_real_at_top)
   also have "(\<lambda>x. -sinh x :: real) = (\<lambda>x. sinh (-x))" by simp
   finally show ?thesis by (subst filterlim_at_bot_mirror)
 qed
 
 lemma cosh_real_at_top: "filterlim (cosh :: real \<Rightarrow> real) at_top at_top"
 proof -
   have *: "((\<lambda>x. exp (- x)) \<longlongrightarrow> (0::real)) at_top"
     by (intro filterlim_compose[OF exp_at_bot] filterlim_uminus_at_bot_at_top)
   have "filterlim (\<lambda>x. (1/2) * (exp (-x) + exp x) :: real) at_top at_top"
     by (rule filterlim_tendsto_pos_mult_at_top[OF _ _
                filterlim_tendsto_add_at_top[OF *]] tendsto_const)+ (auto simp: exp_at_top)
   also have "(\<lambda>x. (1/2) * (exp (-x) + exp x) :: real) = cosh"
     by (simp add: fun_eq_iff cosh_def)
   finally show ?thesis .
 qed
 
 lemma cosh_real_at_bot: "filterlim (cosh :: real \<Rightarrow> real) at_top at_bot"
 proof -
   have "filterlim (\<lambda>x. cosh (-x) :: real) at_top at_top"
     by (simp add: cosh_real_at_top)
   thus ?thesis by (subst filterlim_at_bot_mirror)
 qed
 
 lemma tanh_real_at_top: "(tanh \<longlongrightarrow> (1::real)) at_top"
 proof -
   have "((\<lambda>x::real. (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))) \<longlongrightarrow> (1 - 0) / (1 + 0)) at_top"
     by (intro tendsto_intros filterlim_compose[OF exp_at_bot]
               filterlim_tendsto_neg_mult_at_bot[OF tendsto_const] filterlim_ident) auto
   also have "(\<lambda>x::real. (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))) = tanh"
     by (rule ext) (simp add: tanh_real_altdef)
   finally show ?thesis by simp
 qed
 
 lemma tanh_real_at_bot: "(tanh \<longlongrightarrow> (-1::real)) at_bot"
 proof -
   have "((\<lambda>x::real. -tanh x) \<longlongrightarrow> -1) at_top"
     by (intro tendsto_minus tanh_real_at_top)
   also have "(\<lambda>x. -tanh x :: real) = (\<lambda>x. tanh (-x))" by simp
   finally show ?thesis by (subst filterlim_at_bot_mirror)
 qed
 
 
 subsubsection \<open>Properties of the inverse hyperbolic functions\<close>
 
 lemma isCont_sinh: "isCont sinh (x :: 'a :: {real_normed_field, banach})"
   unfolding sinh_def [abs_def] by (auto intro!: continuous_intros)
 
 lemma isCont_cosh: "isCont cosh (x :: 'a :: {real_normed_field, banach})"
   unfolding cosh_def [abs_def] by (auto intro!: continuous_intros)
 
 lemma isCont_tanh: "cosh x \<noteq> 0 \<Longrightarrow> isCont tanh (x :: 'a :: {real_normed_field, banach})"
   unfolding tanh_def [abs_def]
   by (auto intro!: continuous_intros isCont_divide isCont_sinh isCont_cosh)
 
 lemma continuous_on_sinh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous_on A f"
   shows   "continuous_on A (\<lambda>x. sinh (f x))"
   unfolding sinh_def using assms by (intro continuous_intros)
 
 lemma continuous_on_cosh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous_on A f"
   shows   "continuous_on A (\<lambda>x. cosh (f x))"
   unfolding cosh_def using assms by (intro continuous_intros)
 
 lemma continuous_sinh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous F f"
   shows   "continuous F (\<lambda>x. sinh (f x))"
   unfolding sinh_def using assms by (intro continuous_intros)
 
 lemma continuous_cosh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous F f"
   shows   "continuous F (\<lambda>x. cosh (f x))"
   unfolding cosh_def using assms by (intro continuous_intros)
 
 lemma continuous_on_tanh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous_on A f" "\<And>x. x \<in> A \<Longrightarrow> cosh (f x) \<noteq> 0"
   shows   "continuous_on A (\<lambda>x. tanh (f x))"
   unfolding tanh_def using assms by (intro continuous_intros) auto
 
 lemma continuous_at_within_tanh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous (at x within A) f" "cosh (f x) \<noteq> 0"
   shows   "continuous (at x within A) (\<lambda>x. tanh (f x))"
   unfolding tanh_def using assms by (intro continuous_intros continuous_divide) auto
 
 lemma continuous_tanh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous F f" "cosh (f (Lim F (\<lambda>x. x))) \<noteq> 0"
   shows   "continuous F (\<lambda>x. tanh (f x))"
   unfolding tanh_def using assms by (intro continuous_intros continuous_divide) auto
 
 lemma tendsto_sinh [tendsto_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. sinh (f x)) \<longlongrightarrow> sinh a) F"
   by (rule isCont_tendsto_compose [OF isCont_sinh])
 
 lemma tendsto_cosh [tendsto_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. cosh (f x)) \<longlongrightarrow> cosh a) F"
   by (rule isCont_tendsto_compose [OF isCont_cosh])
 
 lemma tendsto_tanh [tendsto_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> cosh a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. tanh (f x)) \<longlongrightarrow> tanh a) F"
   by (rule isCont_tendsto_compose [OF isCont_tanh])
 
 
 lemma arsinh_real_has_field_derivative [derivative_intros]:
   fixes x :: real
   shows "(arsinh has_field_derivative (1 / (sqrt (x ^ 2 + 1)))) (at x within A)"
 proof -
   have pos: "1 + x ^ 2 > 0" by (intro add_pos_nonneg) auto
   from pos arsinh_real_aux[of x] show ?thesis unfolding arsinh_def [abs_def]
     by (auto intro!: derivative_eq_intros simp: powr_minus powr_half_sqrt field_split_simps)
 qed
 
 lemma arcosh_real_has_field_derivative [derivative_intros]:
   fixes x :: real
   assumes "x > 1"
   shows   "(arcosh has_field_derivative (1 / (sqrt (x ^ 2 - 1)))) (at x within A)"
 proof -
   from assms have "x + sqrt (x\<^sup>2 - 1) > 0" by (simp add: add_pos_pos)
   thus ?thesis using assms unfolding arcosh_def [abs_def]
     by (auto intro!: derivative_eq_intros
              simp: powr_minus powr_half_sqrt field_split_simps power2_eq_1_iff)
 qed
 
 lemma artanh_real_has_field_derivative [derivative_intros]:
   "(artanh has_field_derivative (1 / (1 - x ^ 2))) (at x within A)" if
     "\<bar>x\<bar> < 1" for x :: real
 proof -
   from that have "- 1 < x" "x < 1" by linarith+
   hence "(artanh has_field_derivative (4 - 4 * x) / ((1 + x) * (1 - x) * (1 - x) * 4))
            (at x within A)" unfolding artanh_def [abs_def]
     by (auto intro!: derivative_eq_intros simp: powr_minus powr_half_sqrt)
   also have "(4 - 4 * x) / ((1 + x) * (1 - x) * (1 - x) * 4) = 1 / ((1 + x) * (1 - x))"
     using \<open>-1 < x\<close> \<open>x < 1\<close> by (simp add: frac_eq_eq)
   also have "(1 + x) * (1 - x) = 1 - x ^ 2"
     by (simp add: algebra_simps power2_eq_square)
   finally show ?thesis .
 qed
 
 lemma cosh_double_cosh: "cosh (2 * x :: 'a :: {banach, real_normed_field}) = 2 * (cosh x)\<^sup>2 - 1"
   using cosh_double[of x] by (simp add: sinh_square_eq)
 
 lemma sinh_multiple_reduce:
   "sinh (x * numeral n :: 'a :: {real_normed_field, banach}) = 
      sinh x * cosh (x * of_nat (pred_numeral n)) + cosh x * sinh (x * of_nat (pred_numeral n))"
 proof -
   have "numeral n = of_nat (pred_numeral n) + (1 :: 'a)"
     by (metis add.commute numeral_eq_Suc of_nat_Suc of_nat_numeral)
   also have "sinh (x * \<dots>) = sinh (x * of_nat (pred_numeral n) + x)"
     unfolding of_nat_Suc by (simp add: ring_distribs)
   finally show ?thesis
     by (simp add: sinh_add)
 qed
 
 lemma cosh_multiple_reduce:
   "cosh (x * numeral n :: 'a :: {real_normed_field, banach}) =
      cosh (x * of_nat (pred_numeral n)) * cosh x + sinh (x * of_nat (pred_numeral n)) * sinh x"
 proof -
   have "numeral n = of_nat (pred_numeral n) + (1 :: 'a)"
     by (metis add.commute numeral_eq_Suc of_nat_Suc of_nat_numeral)
   also have "cosh (x * \<dots>) = cosh (x * of_nat (pred_numeral n) + x)"
     unfolding of_nat_Suc by (simp add: ring_distribs)
   finally show ?thesis
     by (simp add: cosh_add)
 qed
 
 lemma cosh_arcosh_real [simp]:
   assumes "x \<ge> (1 :: real)"
   shows   "cosh (arcosh x) = x"
 proof -
   have "eventually (\<lambda>t::real. cosh t \<ge> x) at_top"
     using cosh_real_at_top by (simp add: filterlim_at_top)
   then obtain t where "t \<ge> 1" "cosh t \<ge> x"
     by (metis eventually_at_top_linorder linorder_not_le order_le_less)
   moreover have "isCont cosh (y :: real)" for y
     by (intro continuous_intros)
   ultimately obtain y where "y \<ge> 0" "x = cosh y"
     using IVT[of cosh 0 x t] assms by auto
   thus ?thesis
     by (simp add: arcosh_cosh_real)
 qed
 
 lemma arcosh_eq_0_iff_real [simp]: "x \<ge> 1 \<Longrightarrow> arcosh x = 0 \<longleftrightarrow> x = (1 :: real)"
   using cosh_arcosh_real by fastforce
 
 lemma arcosh_nonneg_real [simp]:
   assumes "x \<ge> 1"
   shows   "arcosh (x :: real) \<ge> 0"
 proof -
   have "1 + 0 \<le> x + (x\<^sup>2 - 1) powr (1 / 2)"
     using assms by (intro add_mono) auto
   thus ?thesis unfolding arcosh_def by simp
 qed
 
 lemma arcosh_real_strict_mono:
   fixes x y :: real
   assumes "1 \<le> x" "x < y"
   shows   "arcosh x < arcosh y"
 proof -
   have "cosh (arcosh x) < cosh (arcosh y)"
     by (subst (1 2) cosh_arcosh_real) (use assms in auto)
   thus ?thesis
     using assms by (subst (asm) cosh_real_nonneg_less_iff) auto
 qed
 
 lemma arcosh_less_iff_real [simp]:
   fixes x y :: real
   assumes "1 \<le> x" "1 \<le> y"
   shows   "arcosh x < arcosh y \<longleftrightarrow> x < y"
   using arcosh_real_strict_mono[of x y] arcosh_real_strict_mono[of y x] assms
   by (cases x y rule: linorder_cases) auto
 
 lemma arcosh_real_gt_1_iff [simp]: "x \<ge> 1 \<Longrightarrow> arcosh x > 0 \<longleftrightarrow> x \<noteq> (1 :: real)"
   using arcosh_less_iff_real[of 1 x] by (auto simp del: arcosh_less_iff_real)
 
 lemma sinh_arcosh_real: "x \<ge> 1 \<Longrightarrow> sinh (arcosh x) = sqrt (x\<^sup>2 - 1)"
   by (rule sym, rule real_sqrt_unique) (auto simp: sinh_square_eq)
 
 
 lemma sinh_arsinh_real [simp]: "sinh (arsinh x :: real) = x"
 proof -
   have "eventually (\<lambda>t::real. sinh t \<ge> x) at_top"
     using sinh_real_at_top by (simp add: filterlim_at_top)
   then obtain t where "sinh t \<ge> x"
     by (metis eventually_at_top_linorder linorder_not_le order_le_less)
   moreover have "eventually (\<lambda>t::real. sinh t \<le> x) at_bot"
     using sinh_real_at_bot by (simp add: filterlim_at_bot)
   then obtain t' where "t' \<le> t" "sinh t' \<le> x"
     by (metis eventually_at_bot_linorder nle_le)
   moreover have "isCont sinh (y :: real)" for y
     by (intro continuous_intros)
   ultimately obtain y where "x = sinh y"
     using IVT[of sinh t' x t] by auto
   thus ?thesis
     by (simp add: arsinh_sinh_real)
 qed
 
 lemma arsinh_real_strict_mono:
   fixes x y :: real
   assumes "x < y"
   shows   "arsinh x < arsinh y"
 proof -
   have "sinh (arsinh x) < sinh (arsinh y)"
     by (subst (1 2) sinh_arsinh_real) (use assms in auto)
   thus ?thesis
     using assms by (subst (asm) sinh_real_less_iff) auto
 qed
 
 lemma arsinh_less_iff_real [simp]:
   fixes x y :: real
   shows "arsinh x < arsinh y \<longleftrightarrow> x < y"
   using arsinh_real_strict_mono[of x y] arsinh_real_strict_mono[of y x]
   by (cases x y rule: linorder_cases) auto
 
 lemma arsinh_real_eq_0_iff [simp]: "arsinh x = 0 \<longleftrightarrow> x = (0 :: real)"
   by (metis arsinh_0 sinh_arsinh_real)
 
 lemma arsinh_real_pos_iff [simp]: "arsinh x > 0 \<longleftrightarrow> x > (0 :: real)"
   using arsinh_less_iff_real[of 0 x] by (simp del: arsinh_less_iff_real)
 
 lemma arsinh_real_neg_iff [simp]: "arsinh x < 0 \<longleftrightarrow> x < (0 :: real)"
   using arsinh_less_iff_real[of x 0] by (simp del: arsinh_less_iff_real)
 
 lemma cosh_arsinh_real: "cosh (arsinh x) = sqrt (x\<^sup>2 + 1)"
   by (rule sym, rule real_sqrt_unique) (auto simp: cosh_square_eq)
 
 lemma continuous_on_arsinh [continuous_intros]: "continuous_on A (arsinh :: real \<Rightarrow> real)"
   by (rule DERIV_continuous_on derivative_intros)+
 
 lemma continuous_on_arcosh [continuous_intros]:
   assumes "A \<subseteq> {1..}"
   shows   "continuous_on A (arcosh :: real \<Rightarrow> real)"
 proof -
   have pos: "x + sqrt (x ^ 2 - 1) > 0" if "x \<ge> 1" for x
     using that by (intro add_pos_nonneg) auto
   show ?thesis
   unfolding arcosh_def [abs_def]
   by (intro continuous_on_subset [OF _ assms] continuous_on_ln continuous_on_add
                continuous_on_id continuous_on_powr')
      (auto dest: pos simp: powr_half_sqrt intro!: continuous_intros)
 qed
 
 lemma continuous_on_artanh [continuous_intros]:
   assumes "A \<subseteq> {-1<..<1}"
   shows   "continuous_on A (artanh :: real \<Rightarrow> real)"
   unfolding artanh_def [abs_def]
   by (intro continuous_on_subset [OF _ assms]) (auto intro!: continuous_intros)
 
 lemma continuous_on_arsinh' [continuous_intros]:
   fixes f :: "real \<Rightarrow> real"
   assumes "continuous_on A f"
   shows   "continuous_on A (\<lambda>x. arsinh (f x))"
   by (rule continuous_on_compose2[OF continuous_on_arsinh assms]) auto
 
 lemma continuous_on_arcosh' [continuous_intros]:
   fixes f :: "real \<Rightarrow> real"
   assumes "continuous_on A f" "\<And>x. x \<in> A \<Longrightarrow> f x \<ge> 1"
   shows   "continuous_on A (\<lambda>x. arcosh (f x))"
   by (rule continuous_on_compose2[OF continuous_on_arcosh assms(1) order.refl])
      (use assms(2) in auto)
 
 lemma continuous_on_artanh' [continuous_intros]:
   fixes f :: "real \<Rightarrow> real"
   assumes "continuous_on A f" "\<And>x. x \<in> A \<Longrightarrow> f x \<in> {-1<..<1}"
   shows   "continuous_on A (\<lambda>x. artanh (f x))"
   by (rule continuous_on_compose2[OF continuous_on_artanh assms(1) order.refl])
      (use assms(2) in auto)
 
 lemma isCont_arsinh [continuous_intros]: "isCont arsinh (x :: real)"
   using continuous_on_arsinh[of UNIV] by (auto simp: continuous_on_eq_continuous_at)
 
 lemma isCont_arcosh [continuous_intros]:
   assumes "x > 1"
   shows   "isCont arcosh (x :: real)"
 proof -
   have "continuous_on {1::real<..} arcosh"
     by (rule continuous_on_arcosh) auto
   with assms show ?thesis by (auto simp: continuous_on_eq_continuous_at)
 qed
 
 lemma isCont_artanh [continuous_intros]:
   assumes "x > -1" "x < 1"
   shows   "isCont artanh (x :: real)"
 proof -
   have "continuous_on {-1<..<(1::real)} artanh"
     by (rule continuous_on_artanh) auto
   with assms show ?thesis by (auto simp: continuous_on_eq_continuous_at)
 qed
 
 lemma tendsto_arsinh [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. arsinh (f x)) \<longlongrightarrow> arsinh a) F"
   for f :: "_ \<Rightarrow> real"
   by (rule isCont_tendsto_compose [OF isCont_arsinh])
 
 lemma tendsto_arcosh_strong [tendsto_intros]:
   fixes f :: "_ \<Rightarrow> real"
   assumes "(f \<longlongrightarrow> a) F" "a \<ge> 1" "eventually (\<lambda>x. f x \<ge> 1) F"
   shows   "((\<lambda>x. arcosh (f x)) \<longlongrightarrow> arcosh a) F"
   by (rule continuous_on_tendsto_compose[OF continuous_on_arcosh[OF order.refl]])
      (use assms in auto)
 
 lemma tendsto_arcosh:
   fixes f :: "_ \<Rightarrow> real"
   assumes "(f \<longlongrightarrow> a) F" "a > 1"
   shows "((\<lambda>x. arcosh (f x)) \<longlongrightarrow> arcosh a) F"
   by (rule isCont_tendsto_compose [OF isCont_arcosh]) (use assms in auto)
 
 lemma tendsto_arcosh_at_left_1: "(arcosh \<longlongrightarrow> 0) (at_right (1::real))"
 proof -
   have "(arcosh \<longlongrightarrow> arcosh 1) (at_right (1::real))"
     by (rule tendsto_arcosh_strong) (auto simp: eventually_at intro!: exI[of _ 1])
   thus ?thesis by simp
 qed
 
 lemma tendsto_artanh [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> real"
   assumes "(f \<longlongrightarrow> a) F" "a > -1" "a < 1"
   shows   "((\<lambda>x. artanh (f x)) \<longlongrightarrow> artanh a) F"
   by (rule isCont_tendsto_compose [OF isCont_artanh]) (use assms in auto)
 
 lemma continuous_arsinh [continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arsinh (f x :: real))"
   unfolding continuous_def by (rule tendsto_arsinh)
 
 (* TODO: This rule does not work for one-sided continuity at 1 *)
 lemma continuous_arcosh_strong [continuous_intros]:
   assumes "continuous F f" "eventually (\<lambda>x. f x \<ge> 1) F"
   shows   "continuous F (\<lambda>x. arcosh (f x :: real))"
 proof (cases "F = bot")
   case False
   show ?thesis
     unfolding continuous_def
   proof (intro tendsto_arcosh_strong)
     show "1 \<le> f (Lim F (\<lambda>x. x))"
       using assms False unfolding continuous_def by (rule tendsto_lowerbound)
   qed (insert assms, auto simp: continuous_def)
 qed auto
 
 lemma continuous_arcosh:
   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) > 1 \<Longrightarrow> continuous F (\<lambda>x. arcosh (f x :: real))"
   unfolding continuous_def by (rule tendsto_arcosh) auto
 
 lemma continuous_artanh [continuous_intros]:
   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) \<in> {-1<..<1} \<Longrightarrow> continuous F (\<lambda>x. artanh (f x :: real))"
   unfolding continuous_def by (rule tendsto_artanh) auto
 
 lemma arsinh_real_at_top:
   "filterlim (arsinh :: real \<Rightarrow> real) at_top at_top"
 proof (subst filterlim_cong[OF refl refl])
   show "filterlim (\<lambda>x. ln (x + sqrt (1 + x\<^sup>2))) at_top at_top"
     by (intro filterlim_compose[OF ln_at_top filterlim_at_top_add_at_top] filterlim_ident
               filterlim_compose[OF sqrt_at_top] filterlim_tendsto_add_at_top[OF tendsto_const]
               filterlim_pow_at_top) auto
 qed (auto intro!: eventually_mono[OF eventually_ge_at_top[of 1]] simp: arsinh_real_def add_ac)
 
 lemma arsinh_real_at_bot:
   "filterlim (arsinh :: real \<Rightarrow> real) at_bot at_bot"
 proof -
   have "filterlim (\<lambda>x::real. -arsinh x) at_bot at_top"
     by (subst filterlim_uminus_at_top [symmetric]) (rule arsinh_real_at_top)
   also have "(\<lambda>x::real. -arsinh x) = (\<lambda>x. arsinh (-x))" by simp
   finally show ?thesis
     by (subst filterlim_at_bot_mirror)
 qed
 
 lemma arcosh_real_at_top:
   "filterlim (arcosh :: real \<Rightarrow> real) at_top at_top"
 proof (subst filterlim_cong[OF refl refl])
   show "filterlim (\<lambda>x. ln (x + sqrt (-1 + x\<^sup>2))) at_top at_top"
     by (intro filterlim_compose[OF ln_at_top filterlim_at_top_add_at_top] filterlim_ident
               filterlim_compose[OF sqrt_at_top] filterlim_tendsto_add_at_top[OF tendsto_const]
               filterlim_pow_at_top) auto
 qed (auto intro!: eventually_mono[OF eventually_ge_at_top[of 1]] simp: arcosh_real_def)
 
 lemma artanh_real_at_left_1:
   "filterlim (artanh :: real \<Rightarrow> real) at_top (at_left 1)"
 proof -
   have *: "filterlim (\<lambda>x::real. (1 + x) / (1 - x)) at_top (at_left 1)"
     by (rule LIM_at_top_divide)
        (auto intro!: tendsto_eq_intros eventually_mono[OF eventually_at_left_real[of 0]])
   have "filterlim (\<lambda>x::real. (1/2) * ln ((1 + x) / (1 - x))) at_top (at_left 1)"
     by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const] *
                  filterlim_compose[OF ln_at_top]) auto
   also have "(\<lambda>x::real. (1/2) * ln ((1 + x) / (1 - x))) = artanh"
     by (simp add: artanh_def [abs_def])
   finally show ?thesis .
 qed
 
 lemma artanh_real_at_right_1:
   "filterlim (artanh :: real \<Rightarrow> real) at_bot (at_right (-1))"
 proof -
   have "?thesis \<longleftrightarrow> filterlim (\<lambda>x::real. -artanh x) at_top (at_right (-1))"
     by (simp add: filterlim_uminus_at_bot)
   also have "\<dots> \<longleftrightarrow> filterlim (\<lambda>x::real. artanh (-x)) at_top (at_right (-1))"
     by (intro filterlim_cong refl eventually_mono[OF eventually_at_right_real[of "-1" "1"]]) auto
   also have "\<dots> \<longleftrightarrow> filterlim (artanh :: real \<Rightarrow> real) at_top (at_left 1)"
     by (simp add: filterlim_at_left_to_right)
   also have \<dots> by (rule artanh_real_at_left_1)
   finally show ?thesis .
 qed
 
 
 subsection \<open>Simprocs for root and power literals\<close>
 
 lemma numeral_powr_numeral_real [simp]:
   "numeral m powr numeral n = (numeral m ^ numeral n :: real)"
   by (simp add: powr_numeral)
 
 context
 begin
 
 private lemma sqrt_numeral_simproc_aux:
   assumes "m * m \<equiv> n"
   shows   "sqrt (numeral n :: real) \<equiv> numeral m"
 proof -
   have "numeral n \<equiv> numeral m * (numeral m :: real)" by (simp add: assms [symmetric])
   moreover have "sqrt \<dots> \<equiv> numeral m" by (subst real_sqrt_abs2) simp
   ultimately show "sqrt (numeral n :: real) \<equiv> numeral m" by simp
 qed
 
 private lemma root_numeral_simproc_aux:
   assumes "Num.pow m n \<equiv> x"
   shows   "root (numeral n) (numeral x :: real) \<equiv> numeral m"
   by (subst assms [symmetric], subst numeral_pow, subst real_root_pos2) simp_all
 
 private lemma powr_numeral_simproc_aux:
   assumes "Num.pow y n = x"
   shows   "numeral x powr (m / numeral n :: real) \<equiv> numeral y powr m"
   by (subst assms [symmetric], subst numeral_pow, subst powr_numeral [symmetric])
      (simp, subst powr_powr, simp_all)
 
 private lemma numeral_powr_inverse_eq:
   "numeral x powr (inverse (numeral n)) = numeral x powr (1 / numeral n :: real)"
   by simp
 
 
 ML \<open>
 
 signature ROOT_NUMERAL_SIMPROC = sig
 
 val sqrt : int option -> int -> int option
 val sqrt' : int option -> int -> int option
 val nth_root : int option -> int -> int -> int option
 val nth_root' : int option -> int -> int -> int option
 val sqrt_proc : Simplifier.proc
 val root_proc : int * int -> Simplifier.proc
 val powr_proc : int * int -> Simplifier.proc
 
 end
 
 structure Root_Numeral_Simproc : ROOT_NUMERAL_SIMPROC = struct
 
 fun iterate NONE p f x =
       let
         fun go x = if p x then x else go (f x)
       in
         SOME (go x)
       end
   | iterate (SOME threshold) p f x =
       let
         fun go (threshold, x) = 
           if p x then SOME x else if threshold = 0 then NONE else go (threshold - 1, f x)
       in
         go (threshold, x)
       end  
 
 
 fun nth_root _ 1 x = SOME x
   | nth_root _ _ 0 = SOME 0
   | nth_root _ _ 1 = SOME 1
   | nth_root threshold n x =
   let
     fun newton_step y = ((n - 1) * y + x div Integer.pow (n - 1) y) div n
     fun is_root y = Integer.pow n y <= x andalso x < Integer.pow n (y + 1)
   in
     if x < n then
       SOME 1
     else if x < Integer.pow n 2 then 
       SOME 1 
     else 
       let
         val y = Real.floor (Math.pow (Real.fromInt x, Real.fromInt 1 / Real.fromInt n))
       in
         if is_root y then
           SOME y
         else
           iterate threshold is_root newton_step ((x + n - 1) div n)
       end
   end
 
 fun nth_root' _ 1 x = SOME x
   | nth_root' _ _ 0 = SOME 0
   | nth_root' _ _ 1 = SOME 1
   | nth_root' threshold n x = if x < n then NONE else if x < Integer.pow n 2 then NONE else
       case nth_root threshold n x of
         NONE => NONE
       | SOME y => if Integer.pow n y = x then SOME y else NONE
 
 fun sqrt _ 0 = SOME 0
   | sqrt _ 1 = SOME 1
   | sqrt threshold n =
     let
       fun aux (a, b) = if n >= b * b then aux (b, b * b) else (a, b)
       val (lower_root, lower_n) = aux (1, 2)
       fun newton_step x = (x + n div x) div 2
       fun is_sqrt r = r*r <= n andalso n < (r+1)*(r+1)
       val y = Real.floor (Math.sqrt (Real.fromInt n))
     in
       if is_sqrt y then 
         SOME y
       else
         Option.mapPartial (iterate threshold is_sqrt newton_step o (fn x => x * lower_root)) 
           (sqrt threshold (n div lower_n))
     end
 
 fun sqrt' threshold x =
   case sqrt threshold x of
     NONE => NONE
   | SOME y => if y * y = x then SOME y else NONE
 
 fun sqrt_proc ctxt ct =
   let
     val n = ct |> Thm.term_of |> dest_comb |> snd |> dest_comb |> snd |> HOLogic.dest_numeral
   in
     case sqrt' (SOME 10000) n of
       NONE => NONE
     | SOME m => 
         SOME (Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt o HOLogic.mk_numeral) [m, n])
                   @{thm sqrt_numeral_simproc_aux})
   end
     handle TERM _ => NONE
 
 fun root_proc (threshold1, threshold2) ctxt ct =
   let
     val [n, x] = 
       ct |> Thm.term_of |> strip_comb |> snd |> map (dest_comb #> snd #> HOLogic.dest_numeral)
   in
     if n > threshold1 orelse x > threshold2 then NONE else
       case nth_root' (SOME 100) n x of
         NONE => NONE
       | SOME m => 
           SOME (Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt o HOLogic.mk_numeral) [m, n, x])
             @{thm root_numeral_simproc_aux})
   end
     handle TERM _ => NONE
          | Match => NONE
 
 fun powr_proc (threshold1, threshold2) ctxt ct =
   let
     val eq_thm = Conv.try_conv (Conv.rewr_conv @{thm numeral_powr_inverse_eq}) ct
     val ct = Thm.dest_equals_rhs (Thm.cprop_of eq_thm)
     val (_, [x, t]) = strip_comb (Thm.term_of ct)
     val (_, [m, n]) = strip_comb t
     val [x, n] = map (dest_comb #> snd #> HOLogic.dest_numeral) [x, n]
   in
     if n > threshold1 orelse x > threshold2 then NONE else
       case nth_root' (SOME 100) n x of
         NONE => NONE
       | SOME y => 
           let
             val [y, n, x] = map HOLogic.mk_numeral [y, n, x]
             val thm = Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt) [y, n, x, m])
               @{thm powr_numeral_simproc_aux}
           in
             SOME (@{thm transitive} OF [eq_thm, thm])
           end
   end
     handle TERM _ => NONE
          | Match => NONE
 
 end
 \<close>
 
 end
 
 simproc_setup sqrt_numeral ("sqrt (numeral n)") = 
   \<open>K Root_Numeral_Simproc.sqrt_proc\<close>
   
 simproc_setup root_numeral ("root (numeral n) (numeral x)") = 
   \<open>K (Root_Numeral_Simproc.root_proc (200, Integer.pow 200 2))\<close>
 
 simproc_setup powr_divide_numeral 
   ("numeral x powr (m / numeral n :: real)" | "numeral x powr (inverse (numeral n) :: real)") = 
     \<open>K (Root_Numeral_Simproc.powr_proc (200, Integer.pow 200 2))\<close>
 
 
 lemma "root 100 1267650600228229401496703205376 = 2"
   by simp
     
 lemma "sqrt 196 = 14" 
   by simp
 
 lemma "256 powr (7 / 4 :: real) = 16384"
   by simp
     
 lemma "27 powr (inverse 3) = (3::real)"
   by simp
 
 end