diff --git a/src/HOL/Analysis/Convex_Euclidean_Space.thy b/src/HOL/Analysis/Convex_Euclidean_Space.thy
--- a/src/HOL/Analysis/Convex_Euclidean_Space.thy
+++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy
@@ -1,2126 +1,2151 @@
 (* Title:      HOL/Analysis/Convex_Euclidean_Space.thy
    Author:     L C Paulson, University of Cambridge
    Author:     Robert Himmelmann, TU Muenchen
    Author:     Bogdan Grechuk, University of Edinburgh
    Author:     Armin Heller, TU Muenchen
    Author:     Johannes Hoelzl, TU Muenchen
 *)
 
 section \<open>Convex Sets and Functions on (Normed) Euclidean Spaces\<close>
 
 theory Convex_Euclidean_Space
 imports
   Convex
   Topology_Euclidean_Space
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Topological Properties of Convex Sets and Functions\<close>
 
 lemma aff_dim_cball:
   fixes a :: "'n::euclidean_space"
   assumes "e > 0"
   shows "aff_dim (cball a e) = int (DIM('n))"
 proof -
   have "(\<lambda>x. a + x) ` (cball 0 e) \<subseteq> cball a e"
     unfolding cball_def dist_norm by auto
   then have "aff_dim (cball (0 :: 'n::euclidean_space) e) \<le> aff_dim (cball a e)"
     using aff_dim_translation_eq[of a "cball 0 e"]
           aff_dim_subset[of "(+) a ` cball 0 e" "cball a e"]
     by auto
   moreover have "aff_dim (cball (0 :: 'n::euclidean_space) e) = int (DIM('n))"
     using hull_inc[of "(0 :: 'n::euclidean_space)" "cball 0 e"]
       centre_in_cball[of "(0 :: 'n::euclidean_space)"] assms
     by (simp add: dim_cball[of e] aff_dim_zero[of "cball 0 e"])
   ultimately show ?thesis
     using aff_dim_le_DIM[of "cball a e"] by auto
 qed
 
 lemma aff_dim_open:
   fixes S :: "'n::euclidean_space set"
   assumes "open S"
     and "S \<noteq> {}"
   shows "aff_dim S = int (DIM('n))"
 proof -
   obtain x where "x \<in> S"
     using assms by auto
   then obtain e where e: "e > 0" "cball x e \<subseteq> S"
     using open_contains_cball[of S] assms by auto
   then have "aff_dim (cball x e) \<le> aff_dim S"
     using aff_dim_subset by auto
   with e show ?thesis
     using aff_dim_cball[of e x] aff_dim_le_DIM[of S] by auto
 qed
 
 lemma low_dim_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "\<not> aff_dim S = int (DIM('n))"
   shows "interior S = {}"
 proof -
   have "aff_dim(interior S) \<le> aff_dim S"
     using interior_subset aff_dim_subset[of "interior S" S] by auto
   then show ?thesis
     using aff_dim_open[of "interior S"] aff_dim_le_DIM[of S] assms by auto
 qed
 
 corollary empty_interior_lowdim:
   fixes S :: "'n::euclidean_space set"
   shows "dim S < DIM ('n) \<Longrightarrow> interior S = {}"
 by (metis low_dim_interior affine_hull_UNIV dim_affine_hull less_not_refl dim_UNIV)
 
 corollary aff_dim_nonempty_interior:
   fixes S :: "'a::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> aff_dim S = DIM('a)"
 by (metis low_dim_interior)
 
 
 subsection \<open>Relative interior of a set\<close>
 
 definition\<^marker>\<open>tag important\<close> "rel_interior S =
   {x. \<exists>T. openin (top_of_set (affine hull S)) T \<and> x \<in> T \<and> T \<subseteq> S}"
 
 lemma rel_interior_mono:
    "\<lbrakk>S \<subseteq> T; affine hull S = affine hull T\<rbrakk>
    \<Longrightarrow> (rel_interior S) \<subseteq> (rel_interior T)"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior_maximal:
    "\<lbrakk>T \<subseteq> S; openin(top_of_set (affine hull S)) T\<rbrakk> \<Longrightarrow> T \<subseteq> (rel_interior S)"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior: "rel_interior S = {x \<in> S. \<exists>T. open T \<and> x \<in> T \<and> T \<inter> affine hull S \<subseteq> S}"
        (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (force simp add: rel_interior_def openin_open)
   { fix x T
     assume *: "x \<in> S" "open T" "x \<in> T" "T \<inter> affine hull S \<subseteq> S"
     then have **: "x \<in> T \<inter> affine hull S"
       using hull_inc by auto
     with * have "\<exists>Tb. (\<exists>Ta. open Ta \<and> Tb = affine hull S \<inter> Ta) \<and> x \<in> Tb \<and> Tb \<subseteq> S"
       by (rule_tac x = "T \<inter> (affine hull S)" in exI) auto
   }
   then show "?rhs \<subseteq> ?lhs"
     by (force simp add: rel_interior_def openin_open)
 qed
 
 lemma mem_rel_interior: "x \<in> rel_interior S \<longleftrightarrow> (\<exists>T. open T \<and> x \<in> T \<inter> S \<and> T \<inter> affine hull S \<subseteq> S)"
   by (auto simp: rel_interior)
 
 lemma mem_rel_interior_ball:
   "x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S)"
   (is "?lhs = ?rhs")
 proof
   assume ?rhs then show ?lhs
   by (simp add: rel_interior) (meson Elementary_Metric_Spaces.open_ball centre_in_ball)
 qed (force simp: rel_interior open_contains_ball)
 
 lemma rel_interior_ball:
   "rel_interior S = {x \<in> S. \<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S}"
   using mem_rel_interior_ball [of _ S] by auto
 
 lemma mem_rel_interior_cball:
   "x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S)"
   (is "?lhs = ?rhs")
 proof
   assume ?rhs then obtain e where "x \<in> S" "e > 0" "cball x e \<inter> affine hull S \<subseteq> S"
     by (auto simp: rel_interior)
   then have "ball x e \<inter> affine hull S \<subseteq> S"
     by auto
   then show ?lhs
     using \<open>0 < e\<close> \<open>x \<in> S\<close> rel_interior_ball by auto
 qed (force simp: rel_interior open_contains_cball)
 
 lemma rel_interior_cball:
   "rel_interior S = {x \<in> S. \<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S}"
   using mem_rel_interior_cball [of _ S] by auto
 
 lemma rel_interior_empty [simp]: "rel_interior {} = {}"
    by (auto simp: rel_interior_def)
 
 lemma affine_hull_sing [simp]: "affine hull {a :: 'n::euclidean_space} = {a}"
   by (metis affine_hull_eq affine_sing)
 
 lemma rel_interior_sing [simp]:
   fixes a :: "'n::euclidean_space"  shows "rel_interior {a} = {a}"
 proof -
   have "\<exists>x::real. 0 < x"
     using zero_less_one by blast
   then show ?thesis
     by (auto simp: rel_interior_ball)
 qed
 
 lemma subset_rel_interior:
   fixes S T :: "'n::euclidean_space set"
   assumes "S \<subseteq> T"
     and "affine hull S = affine hull T"
   shows "rel_interior S \<subseteq> rel_interior T"
   using assms by (auto simp: rel_interior_def)
 
 lemma rel_interior_subset: "rel_interior S \<subseteq> S"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior_subset_closure: "rel_interior S \<subseteq> closure S"
   using rel_interior_subset by (auto simp: closure_def)
 
 lemma interior_subset_rel_interior: "interior S \<subseteq> rel_interior S"
   by (auto simp: rel_interior interior_def)
 
 lemma interior_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "aff_dim S = int(DIM('n))"
   shows "rel_interior S = interior S"
 proof -
   have "affine hull S = UNIV"
     using assms affine_hull_UNIV[of S] by auto
   then show ?thesis
     unfolding rel_interior interior_def by auto
 qed
 
 lemma rel_interior_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "affine hull S = UNIV"
   shows "rel_interior S = interior S"
   using assms unfolding rel_interior interior_def by auto
 
 lemma rel_interior_open:
   fixes S :: "'n::euclidean_space set"
   assumes "open S"
   shows "rel_interior S = S"
   by (metis assms interior_eq interior_subset_rel_interior rel_interior_subset set_eq_subset)
 
 lemma interior_rel_interior_gen:
   fixes S :: "'n::euclidean_space set"
   shows "interior S = (if aff_dim S = int(DIM('n)) then rel_interior S else {})"
   by (metis interior_rel_interior low_dim_interior)
 
 lemma rel_interior_nonempty_interior:
   fixes S :: "'n::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> rel_interior S = interior S"
 by (metis interior_rel_interior_gen)
 
 lemma affine_hull_nonempty_interior:
   fixes S :: "'n::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> affine hull S = UNIV"
 by (metis affine_hull_UNIV interior_rel_interior_gen)
 
 lemma rel_interior_affine_hull [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "rel_interior (affine hull S) = affine hull S"
 proof -
   have *: "rel_interior (affine hull S) \<subseteq> affine hull S"
     using rel_interior_subset by auto
   {
     fix x
     assume x: "x \<in> affine hull S"
     define e :: real where "e = 1"
     then have "e > 0" "ball x e \<inter> affine hull (affine hull S) \<subseteq> affine hull S"
       using hull_hull[of _ S] by auto
     then have "x \<in> rel_interior (affine hull S)"
       using x rel_interior_ball[of "affine hull S"] by auto
   }
   then show ?thesis using * by auto
 qed
 
 lemma rel_interior_UNIV [simp]: "rel_interior (UNIV :: ('n::euclidean_space) set) = UNIV"
   by (metis open_UNIV rel_interior_open)
 
 lemma rel_interior_convex_shrink:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "c \<in> rel_interior S"
     and "x \<in> S"
     and "0 < e"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> rel_interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<inter> affine hull S \<subseteq> S"
     using assms(2) unfolding  mem_rel_interior_ball by auto
   {
     fix y
     assume as: "dist (x - e *\<^sub>R (x - c)) y < e * d" "y \<in> affine hull S"
     have *: "y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x"
       using \<open>e > 0\<close> by (auto simp: scaleR_left_diff_distrib scaleR_right_diff_distrib)
     have "x \<in> affine hull S"
       using assms hull_subset[of S] by auto
     moreover have "1 / e + - ((1 - e) / e) = 1"
       using \<open>e > 0\<close> left_diff_distrib[of "1" "(1-e)" "1/e"] by auto
     ultimately have **: "(1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x \<in> affine hull S"
       using as affine_affine_hull[of S] mem_affine[of "affine hull S" y x "(1 / e)" "-((1 - e) / e)"]
       by (simp add: algebra_simps)
     have "c - ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = (1 / e) *\<^sub>R (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)"
       using \<open>e > 0\<close>
       by (auto simp: euclidean_eq_iff[where 'a='a] field_simps inner_simps)
     then have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = \<bar>1/e\<bar> * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)"
       unfolding dist_norm norm_scaleR[symmetric] by auto
     also have "\<dots> = \<bar>1/e\<bar> * norm (x - e *\<^sub>R (x - c) - y)"
       by (auto intro!:arg_cong[where f=norm] simp add: algebra_simps)
     also have "\<dots> < d"
       using as[unfolded dist_norm] and \<open>e > 0\<close>
       by (auto simp:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute)
     finally have "(1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x \<in> S"
       using "**"  d by auto
     then have "y \<in> S"
       using * convexD [OF \<open>convex S\<close>] assms(3-5)
       by (metis diff_add_cancel diff_ge_0_iff_ge le_add_same_cancel1 less_eq_real_def)
   }
   then have "ball (x - e *\<^sub>R (x - c)) (e*d) \<inter> affine hull S \<subseteq> S"
     by auto
   moreover have "e * d > 0"
     using \<open>e > 0\<close> \<open>d > 0\<close> by simp
   moreover have c: "c \<in> S"
     using assms rel_interior_subset by auto
   moreover from c have "x - e *\<^sub>R (x - c) \<in> S"
     using convexD_alt[of S x c e] assms
     by (metis  diff_add_eq diff_diff_eq2 less_eq_real_def scaleR_diff_left scaleR_one scale_right_diff_distrib)
   ultimately show ?thesis
     using mem_rel_interior_ball[of "x - e *\<^sub>R (x - c)" S] \<open>e > 0\<close> by auto
 qed
 
 lemma interior_real_atLeast [simp]:
   fixes a :: real
   shows "interior {a..} = {a<..}"
 proof -
   {
     fix y
     have "ball y (y - a) \<subseteq> {a..}"
       by (auto simp: dist_norm)
     moreover assume "a < y"
     ultimately have "y \<in> interior {a..}"
       by (force simp add: mem_interior)
   }
   moreover
   {
     fix y
     assume "y \<in> interior {a..}"
     then obtain e where e: "e > 0" "cball y e \<subseteq> {a..}"
       using mem_interior_cball[of y "{a..}"] by auto
     moreover from e have "y - e \<in> cball y e"
       by (auto simp: cball_def dist_norm)
     ultimately have "a \<le> y - e" by blast
     then have "a < y" using e by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma continuous_ge_on_Ioo:
   assumes "continuous_on {c..d} g" "\<And>x. x \<in> {c<..<d} \<Longrightarrow> g x \<ge> a" "c < d" "x \<in> {c..d}"
   shows "g (x::real) \<ge> (a::real)"
 proof-
   from assms(3) have "{c..d} = closure {c<..<d}" by (rule closure_greaterThanLessThan[symmetric])
   also from assms(2) have "{c<..<d} \<subseteq> (g -` {a..} \<inter> {c..d})" by auto
   hence "closure {c<..<d} \<subseteq> closure (g -` {a..} \<inter> {c..d})" by (rule closure_mono)
   also from assms(1) have "closed (g -` {a..} \<inter> {c..d})"
     by (auto simp: continuous_on_closed_vimage)
   hence "closure (g -` {a..} \<inter> {c..d}) = g -` {a..} \<inter> {c..d}" by simp
   finally show ?thesis using \<open>x \<in> {c..d}\<close> by auto
 qed
 
 lemma interior_real_atMost [simp]:
   fixes a :: real
   shows "interior {..a} = {..<a}"
 proof -
   {
     fix y
     have "ball y (a - y) \<subseteq> {..a}"
       by (auto simp: dist_norm)
     moreover assume "a > y"
     ultimately have "y \<in> interior {..a}"
       by (force simp add: mem_interior)
   }
   moreover
   {
     fix y
     assume "y \<in> interior {..a}"
     then obtain e where e: "e > 0" "cball y e \<subseteq> {..a}"
       using mem_interior_cball[of y "{..a}"] by auto
     moreover from e have "y + e \<in> cball y e"
       by (auto simp: cball_def dist_norm)
     ultimately have "a \<ge> y + e" by auto
     then have "a > y" using e by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma interior_atLeastAtMost_real [simp]: "interior {a..b} = {a<..<b :: real}"
 proof-
   have "{a..b} = {a..} \<inter> {..b}" by auto
   also have "interior \<dots> = {a<..} \<inter> {..<b}"
     by (simp)
   also have "\<dots> = {a<..<b}" by auto
   finally show ?thesis .
 qed
 
 lemma interior_atLeastLessThan [simp]:
   fixes a::real shows "interior {a..<b} = {a<..<b}"
   by (metis atLeastLessThan_def greaterThanLessThan_def interior_atLeastAtMost_real interior_Int interior_interior interior_real_atLeast)
 
 lemma interior_lessThanAtMost [simp]:
   fixes a::real shows "interior {a<..b} = {a<..<b}"
   by (metis atLeastAtMost_def greaterThanAtMost_def interior_atLeastAtMost_real interior_Int
             interior_interior interior_real_atLeast)
 
 lemma interior_greaterThanLessThan_real [simp]: "interior {a<..<b} = {a<..<b :: real}"
   by (metis interior_atLeastAtMost_real interior_interior)
 
 lemma frontier_real_atMost [simp]:
   fixes a :: real
   shows "frontier {..a} = {a}"
   unfolding frontier_def by auto
 
 lemma frontier_real_atLeast [simp]: "frontier {a..} = {a::real}"
   by (auto simp: frontier_def)
 
 lemma frontier_real_greaterThan [simp]: "frontier {a<..} = {a::real}"
   by (auto simp: interior_open frontier_def)
 
 lemma frontier_real_lessThan [simp]: "frontier {..<a} = {a::real}"
   by (auto simp: interior_open frontier_def)
 
 lemma rel_interior_real_box [simp]:
   fixes a b :: real
   assumes "a < b"
   shows "rel_interior {a .. b} = {a <..< b}"
 proof -
   have "box a b \<noteq> {}"
     using assms
     unfolding set_eq_iff
     by (auto intro!: exI[of _ "(a + b) / 2"] simp: box_def)
   then show ?thesis
     using interior_rel_interior_gen[of "cbox a b", symmetric]
     by (simp split: if_split_asm del: box_real add: box_real[symmetric])
 qed
 
 lemma rel_interior_real_semiline [simp]:
   fixes a :: real
   shows "rel_interior {a..} = {a<..}"
 proof -
   have *: "{a<..} \<noteq> {}"
     unfolding set_eq_iff by (auto intro!: exI[of _ "a + 1"])
   then show ?thesis using interior_real_atLeast interior_rel_interior_gen[of "{a..}"]
     by (auto split: if_split_asm)
 qed
 
 subsubsection \<open>Relative open sets\<close>
 
 definition\<^marker>\<open>tag important\<close> "rel_open S \<longleftrightarrow> rel_interior S = S"
 
 lemma rel_open: "rel_open S \<longleftrightarrow> openin (top_of_set (affine hull S)) S" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding rel_open_def rel_interior_def
     using openin_subopen[of "top_of_set (affine hull S)" S] by auto
 qed (auto simp:  rel_open_def rel_interior_def)
 
 lemma openin_rel_interior: "openin (top_of_set (affine hull S)) (rel_interior S)"
   using openin_subopen by (fastforce simp add: rel_interior_def)
 
 lemma openin_set_rel_interior:
    "openin (top_of_set S) (rel_interior S)"
 by (rule openin_subset_trans [OF openin_rel_interior rel_interior_subset hull_subset])
 
 lemma affine_rel_open:
   fixes S :: "'n::euclidean_space set"
   assumes "affine S"
   shows "rel_open S"
   unfolding rel_open_def
   using assms rel_interior_affine_hull[of S] affine_hull_eq[of S]
   by metis
 
 lemma affine_closed:
   fixes S :: "'n::euclidean_space set"
   assumes "affine S"
   shows "closed S"
 proof -
   {
     assume "S \<noteq> {}"
     then obtain L where L: "subspace L" "affine_parallel S L"
       using assms affine_parallel_subspace[of S] by auto
     then obtain a where a: "S = ((+) a ` L)"
       using affine_parallel_def[of L S] affine_parallel_commut by auto
     from L have "closed L" using closed_subspace by auto
     then have "closed S"
       using closed_translation a by auto
   }
   then show ?thesis by auto
 qed
 
 lemma closure_affine_hull:
   fixes S :: "'n::euclidean_space set"
   shows "closure S \<subseteq> affine hull S"
   by (intro closure_minimal hull_subset affine_closed affine_affine_hull)
 
 lemma closed_affine_hull [iff]:
   fixes S :: "'n::euclidean_space set"
   shows "closed (affine hull S)"
   by (metis affine_affine_hull affine_closed)
 
 lemma closure_same_affine_hull [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "affine hull (closure S) = affine hull S"
 proof -
   have "affine hull (closure S) \<subseteq> affine hull S"
     using hull_mono[of "closure S" "affine hull S" "affine"]
       closure_affine_hull[of S] hull_hull[of "affine" S]
     by auto
   moreover have "affine hull (closure S) \<supseteq> affine hull S"
     using hull_mono[of "S" "closure S" "affine"] closure_subset by auto
   ultimately show ?thesis by auto
 qed
 
 lemma closure_aff_dim [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "aff_dim (closure S) = aff_dim S"
 proof -
   have "aff_dim S \<le> aff_dim (closure S)"
     using aff_dim_subset closure_subset by auto
   moreover have "aff_dim (closure S) \<le> aff_dim (affine hull S)"
     using aff_dim_subset closure_affine_hull by blast
   moreover have "aff_dim (affine hull S) = aff_dim S"
     using aff_dim_affine_hull by auto
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_closure_convex_shrink:
   fixes S :: "_::euclidean_space set"
   assumes "convex S"
     and "c \<in> rel_interior S"
     and "x \<in> closure S"
     and "e > 0"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> rel_interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<inter> affine hull S \<subseteq> S"
     using assms(2) unfolding mem_rel_interior_ball by auto
   have "\<exists>y \<in> S. norm (y - x) * (1 - e) < e * d"
   proof (cases "x \<in> S")
     case True
     then show ?thesis using \<open>e > 0\<close> \<open>d > 0\<close> by force
   next
     case False
     then have x: "x islimpt S"
       using assms(3)[unfolded closure_def] by auto
     show ?thesis
     proof (cases "e = 1")
       case True
       obtain y where "y \<in> S" "y \<noteq> x" "dist y x < 1"
         using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
       then show ?thesis
         unfolding True using \<open>d > 0\<close> by (force simp add: )
     next
       case False
       then have "0 < e * d / (1 - e)" and *: "1 - e > 0"
         using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by auto
       then obtain y where "y \<in> S" "y \<noteq> x" "dist y x < e * d / (1 - e)"
         using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
       then show ?thesis
         unfolding dist_norm using pos_less_divide_eq[OF *] by force
     qed
   qed
   then obtain y where "y \<in> S" and y: "norm (y - x) * (1 - e) < e * d"
     by auto
   define z where "z = c + ((1 - e) / e) *\<^sub>R (x - y)"
   have *: "x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)"
     unfolding z_def using \<open>e > 0\<close>
     by (auto simp: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
   have zball: "z \<in> ball c d"
     using mem_ball z_def dist_norm[of c]
     using y and assms(4,5)
     by (simp add: norm_minus_commute) (simp add: field_simps)
   have "x \<in> affine hull S"
     using closure_affine_hull assms by auto
   moreover have "y \<in> affine hull S"
     using \<open>y \<in> S\<close> hull_subset[of S] by auto
   moreover have "c \<in> affine hull S"
     using assms rel_interior_subset hull_subset[of S] by auto
   ultimately have "z \<in> affine hull S"
     using z_def affine_affine_hull[of S]
       mem_affine_3_minus [of "affine hull S" c x y "(1 - e) / e"]
       assms
     by simp
   then have "z \<in> S" using d zball by auto
   obtain d1 where "d1 > 0" and d1: "ball z d1 \<le> ball c d"
     using zball open_ball[of c d] openE[of "ball c d" z] by auto
   then have "ball z d1 \<inter> affine hull S \<subseteq> ball c d \<inter> affine hull S"
     by auto
   then have "ball z d1 \<inter> affine hull S \<subseteq> S"
     using d by auto
   then have "z \<in> rel_interior S"
     using mem_rel_interior_ball using \<open>d1 > 0\<close> \<open>z \<in> S\<close> by auto
   then have "y - e *\<^sub>R (y - z) \<in> rel_interior S"
     using rel_interior_convex_shrink[of S z y e] assms \<open>y \<in> S\<close> by auto
   then show ?thesis using * by auto
 qed
 
 lemma rel_interior_eq:
    "rel_interior s = s \<longleftrightarrow> openin(top_of_set (affine hull s)) s"
 using rel_open rel_open_def by blast
 
 lemma rel_interior_openin:
    "openin(top_of_set (affine hull s)) s \<Longrightarrow> rel_interior s = s"
 by (simp add: rel_interior_eq)
 
 lemma rel_interior_affine:
   fixes S :: "'n::euclidean_space set"
   shows  "affine S \<Longrightarrow> rel_interior S = S"
 using affine_rel_open rel_open_def by auto
 
 lemma rel_interior_eq_closure:
   fixes S :: "'n::euclidean_space set"
   shows "rel_interior S = closure S \<longleftrightarrow> affine S"
 proof (cases "S = {}")
   case True
  then show ?thesis
     by auto
 next
   case False show ?thesis
   proof
     assume eq: "rel_interior S = closure S"
     have "openin (top_of_set (affine hull S)) S"
       by (metis eq closure_subset openin_rel_interior rel_interior_subset subset_antisym)
     moreover have "closedin (top_of_set (affine hull S)) S"
       by (metis closed_subset closure_subset_eq eq hull_subset rel_interior_subset)
     ultimately have "S = {} \<or> S = affine hull S"
       using convex_connected connected_clopen convex_affine_hull by metis
     with False have "affine hull S = S"
       by auto
     then show "affine S"
       by (metis affine_hull_eq)
   next
     assume "affine S"
     then show "rel_interior S = closure S"
       by (simp add: rel_interior_affine affine_closed)
   qed
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Relative interior preserves under linear transformations\<close>
 
 lemma rel_interior_translation_aux:
   fixes a :: "'n::euclidean_space"
   shows "((\<lambda>x. a + x) ` rel_interior S) \<subseteq> rel_interior ((\<lambda>x. a + x) ` S)"
 proof -
   {
     fix x
     assume x: "x \<in> rel_interior S"
     then obtain T where "open T" "x \<in> T \<inter> S" "T \<inter> affine hull S \<subseteq> S"
       using mem_rel_interior[of x S] by auto
     then have "open ((\<lambda>x. a + x) ` T)"
       and "a + x \<in> ((\<lambda>x. a + x) ` T) \<inter> ((\<lambda>x. a + x) ` S)"
       and "((\<lambda>x. a + x) ` T) \<inter> affine hull ((\<lambda>x. a + x) ` S) \<subseteq> (\<lambda>x. a + x) ` S"
       using affine_hull_translation[of a S] open_translation[of T a] x by auto
     then have "a + x \<in> rel_interior ((\<lambda>x. a + x) ` S)"
       using mem_rel_interior[of "a+x" "((\<lambda>x. a + x) ` S)"] by auto
   }
   then show ?thesis by auto
 qed
 
 lemma rel_interior_translation:
   fixes a :: "'n::euclidean_space"
   shows "rel_interior ((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` rel_interior S"
 proof -
   have "(\<lambda>x. (-a) + x) ` rel_interior ((\<lambda>x. a + x) ` S) \<subseteq> rel_interior S"
     using rel_interior_translation_aux[of "-a" "(\<lambda>x. a + x) ` S"]
       translation_assoc[of "-a" "a"]
     by auto
   then have "((\<lambda>x. a + x) ` rel_interior S) \<supseteq> rel_interior ((\<lambda>x. a + x) ` S)"
     using translation_inverse_subset[of a "rel_interior ((+) a ` S)" "rel_interior S"]
     by auto
   then show ?thesis
     using rel_interior_translation_aux[of a S] by auto
 qed
 
 
 lemma affine_hull_linear_image:
   assumes "bounded_linear f"
   shows "f ` (affine hull s) = affine hull f ` s"
 proof -
   interpret f: bounded_linear f by fact
   have "affine {x. f x \<in> affine hull f ` s}"
     unfolding affine_def
     by (auto simp: f.scaleR f.add affine_affine_hull[unfolded affine_def, rule_format])
   moreover have "affine {x. x \<in> f ` (affine hull s)}"
     using affine_affine_hull[unfolded affine_def, of s]
     unfolding affine_def by (auto simp: f.scaleR [symmetric] f.add [symmetric])
   ultimately show ?thesis
     by (auto simp: hull_inc elim!: hull_induct)
 qed 
 
 
 lemma rel_interior_injective_on_span_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
     and S :: "'m::euclidean_space set"
   assumes "bounded_linear f"
     and "inj_on f (span S)"
   shows "rel_interior (f ` S) = f ` (rel_interior S)"
 proof -
   {
     fix z
     assume z: "z \<in> rel_interior (f ` S)"
     then have "z \<in> f ` S"
       using rel_interior_subset[of "f ` S"] by auto
     then obtain x where x: "x \<in> S" "f x = z" by auto
     obtain e2 where e2: "e2 > 0" "cball z e2 \<inter> affine hull (f ` S) \<subseteq> (f ` S)"
       using z rel_interior_cball[of "f ` S"] by auto
     obtain K where K: "K > 0" "\<And>x. norm (f x) \<le> norm x * K"
      using assms Real_Vector_Spaces.bounded_linear.pos_bounded[of f] by auto
     define e1 where "e1 = 1 / K"
     then have e1: "e1 > 0" "\<And>x. e1 * norm (f x) \<le> norm x"
       using K pos_le_divide_eq[of e1] by auto
     define e where "e = e1 * e2"
     then have "e > 0" using e1 e2 by auto
     {
       fix y
       assume y: "y \<in> cball x e \<inter> affine hull S"
       then have h1: "f y \<in> affine hull (f ` S)"
         using affine_hull_linear_image[of f S] assms by auto
       from y have "norm (x-y) \<le> e1 * e2"
         using cball_def[of x e] dist_norm[of x y] e_def by auto
       moreover have "f x - f y = f (x - y)"
         using assms linear_diff[of f x y] linear_conv_bounded_linear[of f] by auto
       moreover have "e1 * norm (f (x-y)) \<le> norm (x - y)"
         using e1 by auto
       ultimately have "e1 * norm ((f x)-(f y)) \<le> e1 * e2"
         by auto
       then have "f y \<in> cball z e2"
         using cball_def[of "f x" e2] dist_norm[of "f x" "f y"] e1 x by auto
       then have "f y \<in> f ` S"
         using y e2 h1 by auto
       then have "y \<in> S"
         using assms y hull_subset[of S] affine_hull_subset_span
           inj_on_image_mem_iff [OF \<open>inj_on f (span S)\<close>]
         by (metis Int_iff span_superset subsetCE)
     }
     then have "z \<in> f ` (rel_interior S)"
       using mem_rel_interior_cball[of x S] \<open>e > 0\<close> x by auto
   }
   moreover
   {
     fix x
     assume x: "x \<in> rel_interior S"
     then obtain e2 where e2: "e2 > 0" "cball x e2 \<inter> affine hull S \<subseteq> S"
       using rel_interior_cball[of S] by auto
     have "x \<in> S" using x rel_interior_subset by auto
     then have *: "f x \<in> f ` S" by auto
     have "\<forall>x\<in>span S. f x = 0 \<longrightarrow> x = 0"
       using assms subspace_span linear_conv_bounded_linear[of f]
         linear_injective_on_subspace_0[of f "span S"]
       by auto
     then obtain e1 where e1: "e1 > 0" "\<forall>x \<in> span S. e1 * norm x \<le> norm (f x)"
       using assms injective_imp_isometric[of "span S" f]
         subspace_span[of S] closed_subspace[of "span S"]
       by auto
     define e where "e = e1 * e2"
     hence "e > 0" using e1 e2 by auto
     {
       fix y
       assume y: "y \<in> cball (f x) e \<inter> affine hull (f ` S)"
       then have "y \<in> f ` (affine hull S)"
         using affine_hull_linear_image[of f S] assms by auto
       then obtain xy where xy: "xy \<in> affine hull S" "f xy = y" by auto
       with y have "norm (f x - f xy) \<le> e1 * e2"
         using cball_def[of "f x" e] dist_norm[of "f x" y] e_def by auto
       moreover have "f x - f xy = f (x - xy)"
         using assms linear_diff[of f x xy] linear_conv_bounded_linear[of f] by auto
       moreover have *: "x - xy \<in> span S"
         using subspace_diff[of "span S" x xy] subspace_span \<open>x \<in> S\<close> xy
           affine_hull_subset_span[of S] span_superset
         by auto
       moreover from * have "e1 * norm (x - xy) \<le> norm (f (x - xy))"
         using e1 by auto
       ultimately have "e1 * norm (x - xy) \<le> e1 * e2"
         by auto
       then have "xy \<in> cball x e2"
         using cball_def[of x e2] dist_norm[of x xy] e1 by auto
       then have "y \<in> f ` S"
         using xy e2 by auto
     }
     then have "f x \<in> rel_interior (f ` S)"
       using mem_rel_interior_cball[of "(f x)" "(f ` S)"] * \<open>e > 0\<close> by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_injective_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "bounded_linear f"
     and "inj f"
   shows "rel_interior (f ` S) = f ` (rel_interior S)"
   using assms rel_interior_injective_on_span_linear_image[of f S]
     subset_inj_on[of f "UNIV" "span S"]
   by auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Openness and compactness are preserved by convex hull operation\<close>
 
 lemma open_convex_hull[intro]:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open (convex hull S)"
 proof (clarsimp simp: open_contains_cball convex_hull_explicit)
   fix T and u :: "'a\<Rightarrow>real"
   assume obt: "finite T" "T\<subseteq>S" "\<forall>x\<in>T. 0 \<le> u x" "sum u T = 1" 
 
   from assms[unfolded open_contains_cball] obtain b
     where b: "\<And>x. x\<in>S \<Longrightarrow> 0 < b x \<and> cball x (b x) \<subseteq> S" by metis
   have "b ` T \<noteq> {}"
     using obt by auto
   define i where "i = b ` T"
   let ?\<Phi> = "\<lambda>y. \<exists>F. finite F \<and> F \<subseteq> S \<and> (\<exists>u. (\<forall>x\<in>F. 0 \<le> u x) \<and> sum u F = 1 \<and> (\<Sum>v\<in>F. u v *\<^sub>R v) = y)"
   let ?a = "\<Sum>v\<in>T. u v *\<^sub>R v"
   show "\<exists>e > 0. cball ?a e \<subseteq> {y. ?\<Phi> y}"
   proof (intro exI subsetI conjI)
     show "0 < Min i"
       unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] \<open>b ` T\<noteq>{}\<close>]
       using b \<open>T\<subseteq>S\<close> by auto
   next
     fix y
     assume "y \<in> cball ?a (Min i)"
     then have y: "norm (?a - y) \<le> Min i"
       unfolding dist_norm[symmetric] by auto
     { fix x
       assume "x \<in> T"
       then have "Min i \<le> b x"
         by (simp add: i_def obt(1))
       then have "x + (y - ?a) \<in> cball x (b x)"
         using y unfolding mem_cball dist_norm by auto
       moreover have "x \<in> S"
         using \<open>x\<in>T\<close> \<open>T\<subseteq>S\<close> by auto
       ultimately have "x + (y - ?a) \<in> S"
         using y b by blast
     }
     moreover
     have *: "inj_on (\<lambda>v. v + (y - ?a)) T"
       unfolding inj_on_def by auto
     have "(\<Sum>v\<in>(\<lambda>v. v + (y - ?a)) ` T. u (v - (y - ?a)) *\<^sub>R v) = y"
       unfolding sum.reindex[OF *] o_def using obt(4)
       by (simp add: sum.distrib sum_subtractf scaleR_left.sum[symmetric] scaleR_right_distrib)
     ultimately show "y \<in> {y. ?\<Phi> y}"
     proof (intro CollectI exI conjI)
       show "finite ((\<lambda>v. v + (y - ?a)) ` T)"
         by (simp add: obt(1))
       show "sum (\<lambda>v. u (v - (y - ?a))) ((\<lambda>v. v + (y - ?a)) ` T) = 1"
         unfolding sum.reindex[OF *] o_def using obt(4) by auto
     qed (use obt(1, 3) in auto)
   qed
 qed
 
 lemma compact_convex_combinations:
   fixes S T :: "'a::real_normed_vector set"
   assumes "compact S" "compact T"
   shows "compact { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T}"
 proof -
   let ?X = "{0..1} \<times> S \<times> T"
   let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
   have *: "{ (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T} = ?h ` ?X"
     by force
   have "continuous_on ?X (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
     unfolding continuous_on by (rule ballI) (intro tendsto_intros)
   with assms show ?thesis
     by (simp add: * compact_Times compact_continuous_image)
 qed
 
 lemma finite_imp_compact_convex_hull:
   fixes S :: "'a::real_normed_vector set"
   assumes "finite S"
   shows "compact (convex hull S)"
 proof (cases "S = {}")
   case True
   then show ?thesis by simp
 next
   case False
   with assms show ?thesis
   proof (induct rule: finite_ne_induct)
     case (singleton x)
     show ?case by simp
   next
     case (insert x A)
     let ?f = "\<lambda>(u, y::'a). u *\<^sub>R x + (1 - u) *\<^sub>R y"
     let ?T = "{0..1::real} \<times> (convex hull A)"
     have "continuous_on ?T ?f"
       unfolding split_def continuous_on by (intro ballI tendsto_intros)
     moreover have "compact ?T"
       by (intro compact_Times compact_Icc insert)
     ultimately have "compact (?f ` ?T)"
       by (rule compact_continuous_image)
     also have "?f ` ?T = convex hull (insert x A)"
       unfolding convex_hull_insert [OF \<open>A \<noteq> {}\<close>]
       apply safe
       apply (rule_tac x=a in exI, simp)
       apply (rule_tac x="1 - a" in exI, simp, fast)
       apply (rule_tac x="(u, b)" in image_eqI, simp_all)
       done
     finally show "compact (convex hull (insert x A))" .
   qed
 qed
 
 lemma compact_convex_hull:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S"
   shows "compact (convex hull S)"
 proof (cases "S = {}")
   case True
   then show ?thesis using compact_empty by simp
 next
   case False
   then obtain w where "w \<in> S" by auto
   show ?thesis
     unfolding caratheodory[of S]
   proof (induct ("DIM('a) + 1"))
     case 0
     have *: "{x.\<exists>sa. finite sa \<and> sa \<subseteq> S \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
       using compact_empty by auto
     from 0 show ?case unfolding * by simp
   next
     case (Suc n)
     show ?case
     proof (cases "n = 0")
       case True
       have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} = S"
         unfolding set_eq_iff and mem_Collect_eq
       proof (rule, rule)
         fix x
         assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
         then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T"
           by auto
         show "x \<in> S"
         proof (cases "card T = 0")
           case True
           then show ?thesis
             using T(4) unfolding card_0_eq[OF T(1)] by simp
         next
           case False
           then have "card T = Suc 0" using T(3) \<open>n=0\<close> by auto
           then obtain a where "T = {a}" unfolding card_Suc_eq by auto
           then show ?thesis using T(2,4) by simp
         qed
       next
         fix x assume "x\<in>S"
         then show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
           by (rule_tac x="{x}" in exI) (use convex_hull_singleton in auto)
       qed
       then show ?thesis using assms by simp
     next
       case False
       have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} =
         {(1 - u) *\<^sub>R x + u *\<^sub>R y | x y u.
           0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> {x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> x \<in> convex hull T}}"
         unfolding set_eq_iff and mem_Collect_eq
       proof (rule, rule)
         fix x
         assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
           0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)"
         then obtain u v c T where obt: "x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
           "0 \<le> c \<and> c \<le> 1" "u \<in> S" "finite T" "T \<subseteq> S" "card T \<le> n"  "v \<in> convex hull T"
           by auto
         moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u T"
           by (meson convexD_alt convex_convex_hull hull_inc hull_mono in_mono insertCI obt(2) obt(7) subset_insertI)
         ultimately show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
           by (rule_tac x="insert u T" in exI) (auto simp: card_insert_if)
       next
         fix x
         assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
         then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T"
           by auto
         show "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
           0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)"
         proof (cases "card T = Suc n")
           case False
           then have "card T \<le> n" using T(3) by auto
           then show ?thesis
             using \<open>w\<in>S\<close> and T
             by (rule_tac x=w in exI, rule_tac x=x in exI, rule_tac x=1 in exI) auto
         next
           case True
           then obtain a u where au: "T = insert a u" "a\<notin>u"
             by (metis card_le_Suc_iff order_refl)
           show ?thesis
           proof (cases "u = {}")
             case True
             then have "x = a" using T(4)[unfolded au] by auto
             show ?thesis unfolding \<open>x = a\<close>
               using T \<open>n \<noteq> 0\<close> unfolding au              
               by (rule_tac x=a in exI, rule_tac x=a in exI, rule_tac x=1 in exI) force
           next
             case False
             obtain ux vx b where obt: "ux\<ge>0" "vx\<ge>0" "ux + vx = 1"
               "b \<in> convex hull u" "x = ux *\<^sub>R a + vx *\<^sub>R b"
               using T(4)[unfolded au convex_hull_insert[OF False]]
               by auto
             have *: "1 - vx = ux" using obt(3) by auto
             show ?thesis
               using obt T(1-3) card_insert_disjoint[OF _ au(2)] unfolding au *  
               by (rule_tac x=a in exI, rule_tac x=b in exI, rule_tac x=vx in exI) force
           qed
         qed
       qed
       then show ?thesis
         using compact_convex_combinations[OF assms Suc] by simp
     qed
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Extremal points of a simplex are some vertices\<close>
 
 lemma dist_increases_online:
   fixes a b d :: "'a::real_inner"
   assumes "d \<noteq> 0"
   shows "dist a (b + d) > dist a b \<or> dist a (b - d) > dist a b"
 proof (cases "inner a d - inner b d > 0")
   case True
   then have "0 < inner d d + (inner a d * 2 - inner b d * 2)"
     using assms
     by (intro add_pos_pos) auto
   then show ?thesis
     unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
     by (simp add: algebra_simps inner_commute)
 next
   case False
   then have "0 < inner d d + (inner b d * 2 - inner a d * 2)"
     using assms
     by (intro add_pos_nonneg) auto
   then show ?thesis
     unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
     by (simp add: algebra_simps inner_commute)
 qed
 
 lemma norm_increases_online:
   fixes d :: "'a::real_inner"
   shows "d \<noteq> 0 \<Longrightarrow> norm (a + d) > norm a \<or> norm(a - d) > norm a"
   using dist_increases_online[of d a 0] unfolding dist_norm by auto
 
 lemma simplex_furthest_lt:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
   shows "\<forall>x \<in> convex hull S.  x \<notin> S \<longrightarrow> (\<exists>y \<in> convex hull S. norm (x - a) < norm(y - a))"
   using assms
 proof induct
   fix x S
   assume as: "finite S" "x\<notin>S" "\<forall>x\<in>convex hull S. x \<notin> S \<longrightarrow> (\<exists>y\<in>convex hull S. norm (x - a) < norm (y - a))"
   show "\<forall>xa\<in>convex hull insert x S. xa \<notin> insert x S \<longrightarrow>
     (\<exists>y\<in>convex hull insert x S. norm (xa - a) < norm (y - a))"
   proof (intro impI ballI, cases "S = {}")
     case False
     fix y
     assume y: "y \<in> convex hull insert x S" "y \<notin> insert x S"
     obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull S" "y = u *\<^sub>R x + v *\<^sub>R b"
       using y(1)[unfolded convex_hull_insert[OF False]] by auto
     show "\<exists>z\<in>convex hull insert x S. norm (y - a) < norm (z - a)"
     proof (cases "y \<in> convex hull S")
       case True
       then obtain z where "z \<in> convex hull S" "norm (y - a) < norm (z - a)"
         using as(3)[THEN bspec[where x=y]] and y(2) by auto
       then show ?thesis
         by (meson hull_mono subsetD subset_insertI)
     next
       case False
       show ?thesis
       proof (cases "u = 0 \<or> v = 0")
         case True
         with False show ?thesis
           using obt y by auto
       next
         case False
         then obtain w where w: "w>0" "w<u" "w<v"
           using field_lbound_gt_zero[of u v] and obt(1,2) by auto
         have "x \<noteq> b"
         proof
           assume "x = b"
           then have "y = b" unfolding obt(5)
             using obt(3) by (auto simp: scaleR_left_distrib[symmetric])
           then show False using obt(4) and False
             using \<open>x = b\<close> y(2) by blast
         qed
         then have *: "w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto
         show ?thesis
           using dist_increases_online[OF *, of a y]
         proof (elim disjE)
           assume "dist a y < dist a (y + w *\<^sub>R (x - b))"
           then have "norm (y - a) < norm ((u + w) *\<^sub>R x + (v - w) *\<^sub>R b - a)"
             unfolding dist_commute[of a]
             unfolding dist_norm obt(5)
             by (simp add: algebra_simps)
           moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x S"
             unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>]
           proof (intro CollectI conjI exI)
             show "u + w \<ge> 0" "v - w \<ge> 0"
               using obt(1) w by auto
           qed (use obt in auto)
           ultimately show ?thesis by auto
         next
           assume "dist a y < dist a (y - w *\<^sub>R (x - b))"
           then have "norm (y - a) < norm ((u - w) *\<^sub>R x + (v + w) *\<^sub>R b - a)"
             unfolding dist_commute[of a]
             unfolding dist_norm obt(5)
             by (simp add: algebra_simps)
           moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x S"
             unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>]
           proof (intro CollectI conjI exI)
             show "u - w \<ge> 0" "v + w \<ge> 0"
               using obt(1) w by auto
           qed (use obt in auto)
           ultimately show ?thesis by auto
         qed
       qed
     qed
   qed auto
 qed (auto simp: assms)
 
 lemma simplex_furthest_le:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
     and "S \<noteq> {}"
   shows "\<exists>y\<in>S. \<forall>x\<in> convex hull S. norm (x - a) \<le> norm (y - a)"
 proof -
   have "convex hull S \<noteq> {}"
     using hull_subset[of S convex] and assms(2) by auto
   then obtain x where x: "x \<in> convex hull S" "\<forall>y\<in>convex hull S. norm (y - a) \<le> norm (x - a)"
     using distance_attains_sup[OF finite_imp_compact_convex_hull[OF \<open>finite S\<close>], of a]
     unfolding dist_commute[of a]
     unfolding dist_norm
     by auto
   show ?thesis
   proof (cases "x \<in> S")
     case False
     then obtain y where "y \<in> convex hull S" "norm (x - a) < norm (y - a)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1)
       by auto
     then show ?thesis
       using x(2)[THEN bspec[where x=y]] by auto
   next
     case True
     with x show ?thesis by auto
   qed
 qed
 
 lemma simplex_furthest_le_exists:
   fixes S :: "('a::real_inner) set"
   shows "finite S \<Longrightarrow> \<forall>x\<in>(convex hull S). \<exists>y\<in>S. norm (x - a) \<le> norm (y - a)"
   using simplex_furthest_le[of S] by (cases "S = {}") auto
 
 lemma simplex_extremal_le:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
     and "S \<noteq> {}"
   shows "\<exists>u\<in>S. \<exists>v\<in>S. \<forall>x\<in>convex hull S. \<forall>y \<in> convex hull S. norm (x - y) \<le> norm (u - v)"
 proof -
   have "convex hull S \<noteq> {}"
     using hull_subset[of S convex] and assms(2) by auto
   then obtain u v where obt: "u \<in> convex hull S" "v \<in> convex hull S"
     "\<forall>x\<in>convex hull S. \<forall>y\<in>convex hull S. norm (x - y) \<le> norm (u - v)"
     using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]]
     by (auto simp: dist_norm)
   then show ?thesis
   proof (cases "u\<notin>S \<or> v\<notin>S", elim disjE)
     assume "u \<notin> S"
     then obtain y where "y \<in> convex hull S" "norm (u - v) < norm (y - v)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1)
       by auto
     then show ?thesis
       using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2)
       by auto
   next
     assume "v \<notin> S"
     then obtain y where "y \<in> convex hull S" "norm (v - u) < norm (y - u)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2)
       by auto
     then show ?thesis
       using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1)
       by (auto simp: norm_minus_commute)
   qed auto
 qed
 
 lemma simplex_extremal_le_exists:
   fixes S :: "'a::real_inner set"
   shows "finite S \<Longrightarrow> x \<in> convex hull S \<Longrightarrow> y \<in> convex hull S \<Longrightarrow>
     \<exists>u\<in>S. \<exists>v\<in>S. norm (x - y) \<le> norm (u - v)"
   using convex_hull_empty simplex_extremal_le[of S]
   by(cases "S = {}") auto
 
 
 subsection \<open>Closest point of a convex set is unique, with a continuous projection\<close>
 
 definition\<^marker>\<open>tag important\<close> closest_point :: "'a::{real_inner,heine_borel} set \<Rightarrow> 'a \<Rightarrow> 'a"
   where "closest_point S a = (SOME x. x \<in> S \<and> (\<forall>y\<in>S. dist a x \<le> dist a y))"
 
 lemma closest_point_exists:
   assumes "closed S"
     and "S \<noteq> {}"
   shows closest_point_in_set: "closest_point S a \<in> S"
     and "\<forall>y\<in>S. dist a (closest_point S a) \<le> dist a y"
   unfolding closest_point_def
   by (rule_tac someI2_ex, auto intro: distance_attains_inf[OF assms(1,2), of a])+
 
 lemma closest_point_le: "closed S \<Longrightarrow> x \<in> S \<Longrightarrow> dist a (closest_point S a) \<le> dist a x"
   using closest_point_exists[of S] by auto
 
 lemma closest_point_self:
   assumes "x \<in> S"
   shows "closest_point S x = x"
   unfolding closest_point_def
   by (rule some1_equality, rule ex1I[of _ x]) (use assms in auto)
 
 lemma closest_point_refl: "closed S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> closest_point S x = x \<longleftrightarrow> x \<in> S"
   using closest_point_in_set[of S x] closest_point_self[of x S]
   by auto
 
 lemma closer_points_lemma:
   assumes "inner y z > 0"
   shows "\<exists>u>0. \<forall>v>0. v \<le> u \<longrightarrow> norm(v *\<^sub>R z - y) < norm y"
 proof -
   have z: "inner z z > 0"
     unfolding inner_gt_zero_iff using assms by auto
   have "norm (v *\<^sub>R z - y) < norm y"
     if "0 < v" and "v \<le> inner y z / inner z z" for v
     unfolding norm_lt using z assms that
     by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ \<open>0<v\<close>])
   then show ?thesis
     using assms z
     by (rule_tac x = "inner y z / inner z z" in exI) auto
 qed
 
 lemma closer_point_lemma:
   assumes "inner (y - x) (z - x) > 0"
   shows "\<exists>u>0. u \<le> 1 \<and> dist (x + u *\<^sub>R (z - x)) y < dist x y"
 proof -
   obtain u where "u > 0"
     and u: "\<And>v. \<lbrakk>0<v; v \<le> u\<rbrakk> \<Longrightarrow> norm (v *\<^sub>R (z - x) - (y - x)) < norm (y - x)"
     using closer_points_lemma[OF assms] by auto
   show ?thesis
     using u[of "min u 1"] and \<open>u > 0\<close>
     by (metis diff_diff_add dist_commute dist_norm less_eq_real_def not_less u zero_less_one)
 qed
 
 lemma any_closest_point_dot:
   assumes "convex S" "closed S" "x \<in> S" "y \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z"
   shows "inner (a - x) (y - x) \<le> 0"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then obtain u where u: "u>0" "u\<le>1" "dist (x + u *\<^sub>R (y - x)) a < dist x a"
     using closer_point_lemma[of a x y] by auto
   let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y"
   have "?z \<in> S"
     using convexD_alt[OF assms(1,3,4), of u] using u by auto
   then show False
     using assms(5)[THEN bspec[where x="?z"]] and u(3)
     by (auto simp: dist_commute algebra_simps)
 qed
 
 lemma any_closest_point_unique:
   fixes x :: "'a::real_inner"
   assumes "convex S" "closed S" "x \<in> S" "y \<in> S"
     "\<forall>z\<in>S. dist a x \<le> dist a z" "\<forall>z\<in>S. dist a y \<le> dist a z"
   shows "x = y"
   using any_closest_point_dot[OF assms(1-4,5)] and any_closest_point_dot[OF assms(1-2,4,3,6)]
   unfolding norm_pths(1) and norm_le_square
   by (auto simp: algebra_simps)
 
 lemma closest_point_unique:
   assumes "convex S" "closed S" "x \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z"
   shows "x = closest_point S a"
   using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point S a"]
   using closest_point_exists[OF assms(2)] and assms(3) by auto
 
 lemma closest_point_dot:
   assumes "convex S" "closed S" "x \<in> S"
   shows "inner (a - closest_point S a) (x - closest_point S a) \<le> 0"
   using any_closest_point_dot[OF assms(1,2) _ assms(3)]
   by (metis assms(2) assms(3) closest_point_in_set closest_point_le empty_iff)
 
 lemma closest_point_lt:
   assumes "convex S" "closed S" "x \<in> S" "x \<noteq> closest_point S a"
   shows "dist a (closest_point S a) < dist a x"
   using closest_point_unique[where a=a] closest_point_le[where a=a] assms by fastforce
 
 lemma setdist_closest_point:
     "\<lbrakk>closed S; S \<noteq> {}\<rbrakk> \<Longrightarrow> setdist {a} S = dist a (closest_point S a)"
   by (metis closest_point_exists(2) closest_point_in_set emptyE insert_iff setdist_unique)
 
 lemma closest_point_lipschitz:
   assumes "convex S"
     and "closed S" "S \<noteq> {}"
   shows "dist (closest_point S x) (closest_point S y) \<le> dist x y"
 proof -
   have "inner (x - closest_point S x) (closest_point S y - closest_point S x) \<le> 0"
     and "inner (y - closest_point S y) (closest_point S x - closest_point S y) \<le> 0"
     by (simp_all add: assms closest_point_dot closest_point_in_set)
   then show ?thesis unfolding dist_norm and norm_le
     using inner_ge_zero[of "(x - closest_point S x) - (y - closest_point S y)"]
     by (simp add: inner_add inner_diff inner_commute)
 qed
 
 lemma continuous_at_closest_point:
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
   shows "continuous (at x) (closest_point S)"
   unfolding continuous_at_eps_delta
   using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto
 
 lemma continuous_on_closest_point:
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
   shows "continuous_on t (closest_point S)"
   by (metis continuous_at_imp_continuous_on continuous_at_closest_point[OF assms])
 
 proposition closest_point_in_rel_interior:
   assumes "closed S" "S \<noteq> {}" and x: "x \<in> affine hull S"
     shows "closest_point S x \<in> rel_interior S \<longleftrightarrow> x \<in> rel_interior S"
 proof (cases "x \<in> S")
   case True
   then show ?thesis
     by (simp add: closest_point_self)
 next
   case False
   then have "False" if asm: "closest_point S x \<in> rel_interior S"
   proof -
     obtain e where "e > 0" and clox: "closest_point S x \<in> S"
                and e: "cball (closest_point S x) e \<inter> affine hull S \<subseteq> S"
       using asm mem_rel_interior_cball by blast
     then have clo_notx: "closest_point S x \<noteq> x"
       using \<open>x \<notin> S\<close> by auto
     define y where "y \<equiv> closest_point S x -
                         (min 1 (e / norm(closest_point S x - x))) *\<^sub>R (closest_point S x - x)"
     have "x - y = (1 - min 1 (e / norm (closest_point S x - x))) *\<^sub>R (x - closest_point S x)"
       by (simp add: y_def algebra_simps)
     then have "norm (x - y) = abs ((1 - min 1 (e / norm (closest_point S x - x)))) * norm(x - closest_point S x)"
       by simp
     also have "\<dots> < norm(x - closest_point S x)"
       using clo_notx \<open>e > 0\<close>
       by (auto simp: mult_less_cancel_right2 field_split_simps)
     finally have no_less: "norm (x - y) < norm (x - closest_point S x)" .
     have "y \<in> affine hull S"
       unfolding y_def
       by (meson affine_affine_hull clox hull_subset mem_affine_3_minus2 subsetD x)
     moreover have "dist (closest_point S x) y \<le> e"
       using \<open>e > 0\<close> by (auto simp: y_def min_mult_distrib_right)
     ultimately have "y \<in> S"
       using subsetD [OF e] by simp
     then have "dist x (closest_point S x) \<le> dist x y"
       by (simp add: closest_point_le \<open>closed S\<close>)
     with no_less show False
       by (simp add: dist_norm)
   qed
   moreover have "x \<notin> rel_interior S"
     using rel_interior_subset False by blast
   ultimately show ?thesis by blast
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Various point-to-set separating/supporting hyperplane theorems\<close>
 
 lemma supporting_hyperplane_closed_point:
   fixes z :: "'a::{real_inner,heine_borel}"
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
     and "z \<notin> S"
   shows "\<exists>a b. \<exists>y\<in>S. inner a z < b \<and> inner a y = b \<and> (\<forall>x\<in>S. inner a x \<ge> b)"
 proof -
   obtain y where "y \<in> S" and y: "\<forall>x\<in>S. dist z y \<le> dist z x"
     by (metis distance_attains_inf[OF assms(2-3)])
   show ?thesis
   proof (intro exI bexI conjI ballI)
     show "(y - z) \<bullet> z < (y - z) \<bullet> y"
       by (metis \<open>y \<in> S\<close> assms(4) diff_gt_0_iff_gt inner_commute inner_diff_left inner_gt_zero_iff right_minus_eq)
     show "(y - z) \<bullet> y \<le> (y - z) \<bullet> x" if "x \<in> S" for x
     proof (rule ccontr)
       have *: "\<And>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> dist z y \<le> dist z ((1 - u) *\<^sub>R y + u *\<^sub>R x)"
         using assms(1)[unfolded convex_alt] and y and \<open>x\<in>S\<close> and \<open>y\<in>S\<close> by auto
       assume "\<not> (y - z) \<bullet> y \<le> (y - z) \<bullet> x"
       then obtain v where "v > 0" "v \<le> 1" "dist (y + v *\<^sub>R (x - y)) z < dist y z"
         using closer_point_lemma[of z y x] by (auto simp: inner_diff)
       then show False
         using *[of v] by (auto simp: dist_commute algebra_simps)
     qed
   qed (use \<open>y \<in> S\<close> in auto)
 qed
 
 lemma separating_hyperplane_closed_point:
   fixes z :: "'a::{real_inner,heine_borel}"
   assumes "convex S"
     and "closed S"
     and "z \<notin> S"
   shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>S. inner a x > b)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: gt_ex)
 next
   case False
   obtain y where "y \<in> S" and y: "\<And>x. x \<in> S \<Longrightarrow> dist z y \<le> dist z x"
     by (metis distance_attains_inf[OF assms(2) False])
   show ?thesis
   proof (intro exI conjI ballI)
     show "(y - z) \<bullet> z < inner (y - z) z + (norm (y - z))\<^sup>2 / 2"
       using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto
   next
     fix x
     assume "x \<in> S"
     have "False" if *: "0 < inner (z - y) (x - y)"
     proof -
       obtain u where "u > 0" "u \<le> 1" "dist (y + u *\<^sub>R (x - y)) z < dist y z"
         using * closer_point_lemma by blast
       then show False using y[of "y + u *\<^sub>R (x - y)"] convexD_alt [OF \<open>convex S\<close>]
         using \<open>x\<in>S\<close> \<open>y\<in>S\<close> by (auto simp: dist_commute algebra_simps)
     qed
     moreover have "0 < (norm (y - z))\<^sup>2"
       using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto
     then have "0 < inner (y - z) (y - z)"
       unfolding power2_norm_eq_inner by simp
     ultimately show "(y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2 < (y - z) \<bullet> x"
       by (force simp: field_simps power2_norm_eq_inner inner_commute inner_diff)
   qed 
 qed
 
 lemma separating_hyperplane_closed_0:
   assumes "convex (S::('a::euclidean_space) set)"
     and "closed S"
     and "0 \<notin> S"
   shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>S. inner a x > b)"
 proof (cases "S = {}")
   case True
   have "(SOME i. i\<in>Basis) \<noteq> (0::'a)"
     by (metis Basis_zero SOME_Basis)
   then show ?thesis
     using True zero_less_one by blast
 next
   case False
   then show ?thesis
     using False using separating_hyperplane_closed_point[OF assms]
     by (metis all_not_in_conv inner_zero_left inner_zero_right less_eq_real_def not_le)
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Now set-to-set for closed/compact sets\<close>
 
 lemma separating_hyperplane_closed_compact:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "closed S"
     and "convex T"
     and "compact T"
     and "T \<noteq> {}"
     and "S \<inter> T = {}"
   shows "\<exists>a b. (\<forall>x\<in>S. inner a x < b) \<and> (\<forall>x\<in>T. inner a x > b)"
 proof (cases "S = {}")
   case True
   obtain b where b: "b > 0" "\<forall>x\<in>T. norm x \<le> b"
     using compact_imp_bounded[OF assms(4)] unfolding bounded_pos by auto
   obtain z :: 'a where z: "norm z = b + 1"
     using vector_choose_size[of "b + 1"] and b(1) by auto
   then have "z \<notin> T" using b(2)[THEN bspec[where x=z]] by auto
   then obtain a b where ab: "inner a z < b" "\<forall>x\<in>T. b < inner a x"
     using separating_hyperplane_closed_point[OF assms(3) compact_imp_closed[OF assms(4)], of z]
     by auto
   then show ?thesis
     using True by auto
 next
   case False
   then obtain y where "y \<in> S" by auto
   obtain a b where "0 < b" and \<section>: "\<And>x. x \<in> (\<Union>x\<in> S. \<Union>y \<in> T. {x - y}) \<Longrightarrow> b < inner a x"
     using separating_hyperplane_closed_point[OF convex_differences[OF assms(1,3)], of 0]
     using closed_compact_differences assms by fastforce 
   have ab: "b + inner a y < inner a x" if "x\<in>S" "y\<in>T" for x y
     using \<section> [of "x-y"] that by (auto simp add: inner_diff_right less_diff_eq)
   define k where "k = (SUP x\<in>T. a \<bullet> x)"
   have "k + b / 2 < a \<bullet> x" if "x \<in> S" for x
   proof -
     have "k \<le> inner a x - b"
       unfolding k_def
       using \<open>T \<noteq> {}\<close> ab that by (fastforce intro: cSUP_least)
     then show ?thesis
       using \<open>0 < b\<close> by auto
   qed
   moreover
   have "- (k + b / 2) < - a \<bullet> x" if "x \<in> T" for x
   proof -
     have "inner a x - b / 2 < k"
       unfolding k_def
     proof (subst less_cSUP_iff)
       show "T \<noteq> {}" by fact
       show "bdd_above ((\<bullet>) a ` T)"
         using ab[rule_format, of y] \<open>y \<in> S\<close>
         by (intro bdd_aboveI2[where M="inner a y - b"]) (auto simp: field_simps intro: less_imp_le)
       show "\<exists>y\<in>T. a \<bullet> x - b / 2 < a \<bullet> y"
         using \<open>0 < b\<close> that by force
     qed 
     then show ?thesis
       by auto
   qed
   ultimately show ?thesis
     by (metis inner_minus_left neg_less_iff_less)
 qed
 
 lemma separating_hyperplane_compact_closed:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "compact S"
     and "S \<noteq> {}"
     and "convex T"
     and "closed T"
     and "S \<inter> T = {}"
   shows "\<exists>a b. (\<forall>x\<in>S. inner a x < b) \<and> (\<forall>x\<in>T. inner a x > b)"
 proof -
   obtain a b where "(\<forall>x\<in>T. inner a x < b) \<and> (\<forall>x\<in>S. b < inner a x)"
     by (metis disjoint_iff_not_equal separating_hyperplane_closed_compact assms)
   then show ?thesis
     by (metis inner_minus_left neg_less_iff_less)
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>General case without assuming closure and getting non-strict separation\<close>
 
 lemma separating_hyperplane_set_0:
   assumes "convex S" "(0::'a::euclidean_space) \<notin> S"
   shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>S. 0 \<le> inner a x)"
 proof -
   let ?k = "\<lambda>c. {x::'a. 0 \<le> inner c x}"
   have *: "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" if as: "f \<subseteq> ?k ` S" "finite f" for f
   proof -
     obtain c where c: "f = ?k ` c" "c \<subseteq> S" "finite c"
       using finite_subset_image[OF as(2,1)] by auto
     then obtain a b where ab: "a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x"
       using separating_hyperplane_closed_0[OF convex_convex_hull, of c]
       using finite_imp_compact_convex_hull[OF c(3), THEN compact_imp_closed] and assms(2)
       using subset_hull[of convex, OF assms(1), symmetric, of c]
       by force
     have "norm (a /\<^sub>R norm a) = 1"
       by (simp add: ab(1))
     moreover have "(\<forall>y\<in>c. 0 \<le> y \<bullet> (a /\<^sub>R norm a))"
       using hull_subset[of c convex] ab by (force simp: inner_commute)
     ultimately have "\<exists>x. norm x = 1 \<and> (\<forall>y\<in>c. 0 \<le> inner y x)"
       by blast
     then show "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}"
       unfolding c(1) frontier_cball sphere_def dist_norm by auto
   qed
   have "frontier (cball 0 1) \<inter> (\<Inter>(?k ` S)) \<noteq> {}"
     by (rule compact_imp_fip) (use * closed_halfspace_ge in auto)
   then obtain x where "norm x = 1" "\<forall>y\<in>S. x\<in>?k y"
     unfolding frontier_cball dist_norm sphere_def by auto
   then show ?thesis
     by (metis inner_commute mem_Collect_eq norm_eq_zero zero_neq_one)
 qed
 
 lemma separating_hyperplane_sets:
   fixes S T :: "'a::euclidean_space set"
   assumes "convex S"
     and "convex T"
     and "S \<noteq> {}"
     and "T \<noteq> {}"
     and "S \<inter> T = {}"
   shows "\<exists>a b. a \<noteq> 0 \<and> (\<forall>x\<in>S. inner a x \<le> b) \<and> (\<forall>x\<in>T. inner a x \<ge> b)"
 proof -
   from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
   obtain a where "a \<noteq> 0" "\<forall>x\<in>{x - y |x y. x \<in> T \<and> y \<in> S}. 0 \<le> inner a x"
     using assms(3-5) by force
   then have *: "\<And>x y. x \<in> T \<Longrightarrow> y \<in> S \<Longrightarrow> inner a y \<le> inner a x"
     by (force simp: inner_diff)
   then have bdd: "bdd_above (((\<bullet>) a)`S)"
     using \<open>T \<noteq> {}\<close> by (auto intro: bdd_aboveI2[OF *])
   show ?thesis
     using \<open>a\<noteq>0\<close>
     by (intro exI[of _ a] exI[of _ "SUP x\<in>S. a \<bullet> x"])
        (auto intro!: cSUP_upper bdd cSUP_least \<open>a \<noteq> 0\<close> \<open>S \<noteq> {}\<close> *)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More convexity generalities\<close>
 
 lemma convex_closure [intro,simp]:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S"
   shows "convex (closure S)"
   apply (rule convexI)
   unfolding closure_sequential
   apply (elim exE)
   subgoal for x y u v f g
     by (rule_tac x="\<lambda>n. u *\<^sub>R f n + v *\<^sub>R g n" in exI) (force intro: tendsto_intros dest: convexD [OF assms])
   done
 
 lemma convex_interior [intro,simp]:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S"
   shows "convex (interior S)"
   unfolding convex_alt Ball_def mem_interior
 proof clarify
   fix x y u
   assume u: "0 \<le> u" "u \<le> (1::real)"
   fix e d
   assume ed: "ball x e \<subseteq> S" "ball y d \<subseteq> S" "0<d" "0<e"
   show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> S"
   proof (intro exI conjI subsetI)
     fix z
     assume z: "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)"
     have "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> S"
     proof (rule_tac assms[unfolded convex_alt, rule_format])
        show "z - u *\<^sub>R (y - x) \<in> S" "z + (1 - u) *\<^sub>R (y - x) \<in> S"
          using ed z u by (auto simp add: algebra_simps dist_norm)
     qed (use u in auto)
     then show "z \<in> S"
       using u by (auto simp: algebra_simps)
   qed(use u ed in auto)
 qed
 
 lemma convex_hull_eq_empty[simp]: "convex hull S = {} \<longleftrightarrow> S = {}"
   using hull_subset[of S convex] convex_hull_empty by auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convex set as intersection of halfspaces\<close>
 
 lemma convex_halfspace_intersection:
   fixes S :: "('a::euclidean_space) set"
   assumes "closed S" "convex S"
   shows "S = \<Inter>{h. S \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}"
 proof -
   { fix z
     assume "\<forall>T. S \<subseteq> T \<and> (\<exists>a b. T = {x. inner a x \<le> b}) \<longrightarrow> z \<in> T"  "z \<notin> S"
     then have \<section>: "\<And>a b. S \<subseteq> {x. inner a x \<le> b} \<Longrightarrow> z \<in> {x. inner a x \<le> b}"
       by blast
     obtain a b where "inner a z < b" "(\<forall>x\<in>S. inner a x > b)"
       using \<open>z \<notin> S\<close> assms separating_hyperplane_closed_point by blast
     then have False
       using \<section> [of "-a" "-b"] by fastforce
   }
   then show ?thesis
     by force
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity of general and special intervals\<close>
 
 lemma is_interval_convex:
   fixes S :: "'a::euclidean_space set"
   assumes "is_interval S"
   shows "convex S"
 proof (rule convexI)
   fix x y and u v :: real
   assume "x \<in> S" "y \<in> S" and uv: "0 \<le> u" "0 \<le> v" "u + v = 1"
   then have *: "u = 1 - v" "1 - v \<ge> 0" and **: "v = 1 - u" "1 - u \<ge> 0"
     by auto
   {
     fix a b
     assume "\<not> b \<le> u * a + v * b"
     then have "u * a < (1 - v) * b"
       unfolding not_le using \<open>0 \<le> v\<close>by (auto simp: field_simps)
     then have "a < b"
       using "*"(1) less_eq_real_def uv(1) by auto
     then have "a \<le> u * a + v * b"
       unfolding * using \<open>0 \<le> v\<close>
       by (auto simp: field_simps intro!:mult_right_mono)
   }
   moreover
   {
     fix a b
     assume "\<not> u * a + v * b \<le> a"
     then have "v * b > (1 - u) * a"
       unfolding not_le using \<open>0 \<le> v\<close> by (auto simp: field_simps)
     then have "a < b"
       unfolding * using \<open>0 \<le> v\<close>
       by (rule_tac mult_left_less_imp_less) (auto simp: field_simps)
     then have "u * a + v * b \<le> b"
       unfolding **
       using **(2) \<open>0 \<le> u\<close> by (auto simp: algebra_simps mult_right_mono)
   }
   ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> S"
     using DIM_positive[where 'a='a]
     by (intro mem_is_intervalI [OF assms \<open>x \<in> S\<close> \<open>y \<in> S\<close>]) (auto simp: inner_simps)
 qed
 
 lemma is_interval_connected:
   fixes S :: "'a::euclidean_space set"
   shows "is_interval S \<Longrightarrow> connected S"
   using is_interval_convex convex_connected by auto
 
 lemma convex_box [simp]: "convex (cbox a b)" "convex (box a (b::'a::euclidean_space))"
   by (auto simp add: is_interval_convex)
 
 text\<open>A non-singleton connected set is perfect (i.e. has no isolated points). \<close>
 lemma connected_imp_perfect:
   fixes a :: "'a::metric_space"
   assumes "connected S" "a \<in> S" and S: "\<And>x. S \<noteq> {x}"
   shows "a islimpt S"
 proof -
   have False if "a \<in> T" "open T" "\<And>y. \<lbrakk>y \<in> S; y \<in> T\<rbrakk> \<Longrightarrow> y = a" for T
   proof -
     obtain e where "e > 0" and e: "cball a e \<subseteq> T"
       using \<open>open T\<close> \<open>a \<in> T\<close> by (auto simp: open_contains_cball)
     have "openin (top_of_set S) {a}"
       unfolding openin_open using that \<open>a \<in> S\<close> by blast
     moreover have "closedin (top_of_set S) {a}"
       by (simp add: assms)
     ultimately show "False"
       using \<open>connected S\<close> connected_clopen S by blast
   qed
   then show ?thesis
     unfolding islimpt_def by blast
 qed
 
+lemma islimpt_Ioc [simp]:
+  fixes a :: real
+  assumes "a<b" 
+  shows "x islimpt {a<..b} \<longleftrightarrow> x \<in> {a..b}"  (is "?lhs = ?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (metis assms closed_atLeastAtMost closed_limpt closure_greaterThanAtMost closure_subset islimpt_subset)
+next
+  assume ?rhs
+  then have "x \<in> closure {a<..<b}"
+    using assms closure_greaterThanLessThan by blast
+  then show ?lhs
+    by (metis (no_types) Diff_empty Diff_insert0 interior_lessThanAtMost interior_limit_point interior_subset islimpt_in_closure islimpt_subset)
+qed
+
+lemma islimpt_Ico [simp]:
+  fixes a :: real
+  assumes "a<b" shows "x islimpt {a..<b} \<longleftrightarrow> x \<in> {a..b}"
+  by (metis assms closure_atLeastLessThan closure_greaterThanAtMost islimpt_Ioc limpt_of_closure) 
+
+lemma islimpt_Icc [simp]:
+  fixes a :: real
+  assumes "a<b" shows "x islimpt {a..b} \<longleftrightarrow> x \<in> {a..b}"
+  by (metis assms closure_atLeastLessThan islimpt_Ico limpt_of_closure)
+
 lemma connected_imp_perfect_aff_dim:
      "\<lbrakk>connected S; aff_dim S \<noteq> 0; a \<in> S\<rbrakk> \<Longrightarrow> a islimpt S"
   using aff_dim_sing connected_imp_perfect by blast
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>On \<open>real\<close>, \<open>is_interval\<close>, \<open>convex\<close> and \<open>connected\<close> are all equivalent\<close>
 
 lemma mem_is_interval_1_I:
   fixes a b c::real
   assumes "is_interval S"
   assumes "a \<in> S" "c \<in> S"
   assumes "a \<le> b" "b \<le> c"
   shows "b \<in> S"
   using assms is_interval_1 by blast
 
 lemma is_interval_connected_1:
   fixes S :: "real set"
   shows "is_interval S \<longleftrightarrow> connected S"
   by (meson connected_iff_interval is_interval_1)
 
 lemma is_interval_convex_1:
   fixes S :: "real set"
   shows "is_interval S \<longleftrightarrow> convex S"
   by (metis is_interval_convex convex_connected is_interval_connected_1)
 
 lemma connected_compact_interval_1:
      "connected S \<and> compact S \<longleftrightarrow> (\<exists>a b. S = {a..b::real})"
   by (auto simp: is_interval_connected_1 [symmetric] is_interval_compact)
 
 lemma connected_convex_1:
   fixes S :: "real set"
   shows "connected S \<longleftrightarrow> convex S"
   by (metis is_interval_convex convex_connected is_interval_connected_1)
 
 lemma connected_convex_1_gen:
   fixes S :: "'a :: euclidean_space set"
   assumes "DIM('a) = 1"
   shows "connected S \<longleftrightarrow> convex S"
 proof -
   obtain f:: "'a \<Rightarrow> real" where linf: "linear f" and "inj f"
     using subspace_isomorphism[OF subspace_UNIV subspace_UNIV,
         where 'a='a and 'b=real]
     unfolding Euclidean_Space.dim_UNIV
     by (auto simp: assms)
   then have "f -` (f ` S) = S"
     by (simp add: inj_vimage_image_eq)
   then show ?thesis
     by (metis connected_convex_1 convex_linear_vimage linf convex_connected connected_linear_image)
 qed
 
 lemma [simp]:
   fixes r s::real
   shows is_interval_io: "is_interval {..<r}"
     and is_interval_oi: "is_interval {r<..}"
     and is_interval_oo: "is_interval {r<..<s}"
     and is_interval_oc: "is_interval {r<..s}"
     and is_interval_co: "is_interval {r..<s}"
   by (simp_all add: is_interval_convex_1)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Another intermediate value theorem formulation\<close>
 
 lemma ivt_increasing_component_on_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a \<le> b"
     and "continuous_on {a..b} f"
     and "(f a)\<bullet>k \<le> y" "y \<le> (f b)\<bullet>k"
   shows "\<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
 proof -
   have "f a \<in> f ` cbox a b" "f b \<in> f ` cbox a b"
     using \<open>a \<le> b\<close> by auto
   then show ?thesis
     using connected_ivt_component[of "f ` cbox a b" "f a" "f b" k y]
     by (simp add: connected_continuous_image assms)
 qed
 
 lemma ivt_increasing_component_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow>
     f a\<bullet>k \<le> y \<Longrightarrow> y \<le> f b\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   by (rule ivt_increasing_component_on_1) (auto simp: continuous_at_imp_continuous_on)
 
 lemma ivt_decreasing_component_on_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a \<le> b"
     and "continuous_on {a..b} f"
     and "(f b)\<bullet>k \<le> y"
     and "y \<le> (f a)\<bullet>k"
   shows "\<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   using ivt_increasing_component_on_1[of a b "\<lambda>x. - f x" k "- y"] neg_equal_iff_equal
   using assms continuous_on_minus by force
 
 lemma ivt_decreasing_component_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow>
     f b\<bullet>k \<le> y \<Longrightarrow> y \<le> f a\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   by (rule ivt_decreasing_component_on_1) (auto simp: continuous_at_imp_continuous_on)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A bound within an interval\<close>
 
 lemma convex_hull_eq_real_cbox:
   fixes x y :: real assumes "x \<le> y"
   shows "convex hull {x, y} = cbox x y"
 proof (rule hull_unique)
   show "{x, y} \<subseteq> cbox x y" using \<open>x \<le> y\<close> by auto
   show "convex (cbox x y)"
     by (rule convex_box)
 next
   fix S assume "{x, y} \<subseteq> S" and "convex S"
   then show "cbox x y \<subseteq> S"
     unfolding is_interval_convex_1 [symmetric] is_interval_def Basis_real_def
     by - (clarify, simp (no_asm_use), fast)
 qed
 
 lemma unit_interval_convex_hull:
   "cbox (0::'a::euclidean_space) One = convex hull {x. \<forall>i\<in>Basis. (x\<bullet>i = 0) \<or> (x\<bullet>i = 1)}"
   (is "?int = convex hull ?points")
 proof -
   have One[simp]: "\<And>i. i \<in> Basis \<Longrightarrow> One \<bullet> i = 1"
     by (simp add: inner_sum_left sum.If_cases inner_Basis)
   have "?int = {x. \<forall>i\<in>Basis. x \<bullet> i \<in> cbox 0 1}"
     by (auto simp: cbox_def)
   also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` cbox 0 1)"
     by (simp only: box_eq_set_sum_Basis)
   also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` (convex hull {0, 1}))"
     by (simp only: convex_hull_eq_real_cbox zero_le_one)
   also have "\<dots> = (\<Sum>i\<in>Basis. convex hull ((\<lambda>x. x *\<^sub>R i) ` {0, 1}))"
     by (simp add: convex_hull_linear_image)
   also have "\<dots> = convex hull (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` {0, 1})"
     by (simp only: convex_hull_set_sum)
   also have "\<dots> = convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}}"
     by (simp only: box_eq_set_sum_Basis)
   also have "convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}} = convex hull ?points"
     by simp
   finally show ?thesis .
 qed
 
 text \<open>And this is a finite set of vertices.\<close>
 
 lemma unit_cube_convex_hull:
   obtains S :: "'a::euclidean_space set"
   where "finite S" and "cbox 0 (\<Sum>Basis) = convex hull S"
 proof
   show "finite {x::'a. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}"
   proof (rule finite_subset, clarify)
     show "finite ((\<lambda>S. \<Sum>i\<in>Basis. (if i \<in> S then 1 else 0) *\<^sub>R i) ` Pow Basis)"
       using finite_Basis by blast
     fix x :: 'a
     assume x: "\<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1"
     show "x \<in> (\<lambda>S. \<Sum>i\<in>Basis. (if i\<in>S then 1 else 0) *\<^sub>R i) ` Pow Basis"
       apply (rule image_eqI[where x="{i. i \<in> Basis \<and> x\<bullet>i = 1}"])
       using x
       by (subst euclidean_eq_iff, auto)
   qed
   show "cbox 0 One = convex hull {x. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}"
     using unit_interval_convex_hull by blast
 qed 
 
 text \<open>Hence any cube (could do any nonempty interval).\<close>
 
 lemma cube_convex_hull:
   assumes "d > 0"
   obtains S :: "'a::euclidean_space set" where
     "finite S" and "cbox (x - (\<Sum>i\<in>Basis. d*\<^sub>Ri)) (x + (\<Sum>i\<in>Basis. d*\<^sub>Ri)) = convex hull S"
 proof -
   let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a"
   have *: "cbox (x - ?d) (x + ?d) = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 (\<Sum>Basis)"
   proof (intro set_eqI iffI)
     fix y
     assume "y \<in> cbox (x - ?d) (x + ?d)"
     then have "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> cbox 0 (\<Sum>Basis)"
       using assms by (simp add: mem_box inner_simps) (simp add: field_simps)
     with \<open>0 < d\<close> show "y \<in> (\<lambda>y. x - sum ((*\<^sub>R) d) Basis + (2 * d) *\<^sub>R y) ` cbox 0 One"
       by (auto intro: image_eqI[where x= "inverse (2 * d) *\<^sub>R (y - (x - ?d))"])
   next
     fix y
     assume "y \<in> (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 One"
     then obtain z where z: "z \<in> cbox 0 One" "y = x - ?d + (2*d) *\<^sub>R z"
       by auto
     then show "y \<in> cbox (x - ?d) (x + ?d)"
       using z assms by (auto simp: mem_box inner_simps)
   qed
   obtain S where "finite S" "cbox 0 (\<Sum>Basis::'a) = convex hull S"
     using unit_cube_convex_hull by auto
   then show ?thesis
     by (rule_tac that[of "(\<lambda>y. x - ?d + (2 * d) *\<^sub>R y)` S"]) (auto simp: convex_hull_affinity *)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Representation of any interval as a finite convex hull\<close>
 
 lemma image_stretch_interval:
   "(\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k)) *\<^sub>R k) ` cbox a (b::'a::euclidean_space) =
   (if (cbox a b) = {} then {} else
     cbox (\<Sum>k\<in>Basis. (min (m k * (a\<bullet>k)) (m k * (b\<bullet>k))) *\<^sub>R k::'a)
      (\<Sum>k\<in>Basis. (max (m k * (a\<bullet>k)) (m k * (b\<bullet>k))) *\<^sub>R k))"
 proof cases
   assume *: "cbox a b \<noteq> {}"
   show ?thesis
     unfolding box_ne_empty if_not_P[OF *]
     apply (simp add: cbox_def image_Collect set_eq_iff euclidean_eq_iff[where 'a='a] ball_conj_distrib[symmetric])
     apply (subst choice_Basis_iff[symmetric])
   proof (intro allI ball_cong refl)
     fix x i :: 'a assume "i \<in> Basis"
     with * have a_le_b: "a \<bullet> i \<le> b \<bullet> i"
       unfolding box_ne_empty by auto
     show "(\<exists>xa. x \<bullet> i = m i * xa \<and> a \<bullet> i \<le> xa \<and> xa \<le> b \<bullet> i) \<longleftrightarrow>
         min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) \<le> x \<bullet> i \<and> x \<bullet> i \<le> max (m i * (a \<bullet> i)) (m i * (b \<bullet> i))"
     proof (cases "m i = 0")
       case True
       with a_le_b show ?thesis by auto
     next
       case False
       then have *: "\<And>a b. a = m i * b \<longleftrightarrow> b = a / m i"
         by (auto simp: field_simps)
       from False have
           "min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (a \<bullet> i) else m i * (b \<bullet> i))"
           "max (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (b \<bullet> i) else m i * (a \<bullet> i))"
         using a_le_b by (auto simp: min_def max_def mult_le_cancel_left)
       with False show ?thesis using a_le_b *
         by (simp add: le_divide_eq divide_le_eq) (simp add: ac_simps)
     qed
   qed
 qed simp
 
 lemma interval_image_stretch_interval:
   "\<exists>u v. (\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k) ` cbox a (b::'a::euclidean_space) = cbox u (v::'a::euclidean_space)"
   unfolding image_stretch_interval by auto
 
 lemma cbox_translation: "cbox (c + a) (c + b) = image (\<lambda>x. c + x) (cbox a b)"
   using image_affinity_cbox [of 1 c a b]
   using box_ne_empty [of "a+c" "b+c"]  box_ne_empty [of a b]
   by (auto simp: inner_left_distrib add.commute)
 
 lemma cbox_image_unit_interval:
   fixes a :: "'a::euclidean_space"
   assumes "cbox a b \<noteq> {}"
     shows "cbox a b =
            (+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` cbox 0 One"
 using assms
 apply (simp add: box_ne_empty image_stretch_interval cbox_translation [symmetric])
 apply (simp add: min_def max_def algebra_simps sum_subtractf euclidean_representation)
 done
 
 lemma closed_interval_as_convex_hull:
   fixes a :: "'a::euclidean_space"
   obtains S where "finite S" "cbox a b = convex hull S"
 proof (cases "cbox a b = {}")
   case True with convex_hull_empty that show ?thesis
     by blast
 next
   case False
   obtain S::"'a set" where "finite S" and eq: "cbox 0 One = convex hull S"
     by (blast intro: unit_cube_convex_hull)
   let ?S = "((+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` S)"
   show thesis
   proof
     show "finite ?S"
       by (simp add: \<open>finite S\<close>)
     have lin: "linear (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k)"
       by (rule linear_compose_sum) (auto simp: algebra_simps linearI)
     show "cbox a b = convex hull ?S"
       using convex_hull_linear_image [OF lin] 
       by (simp add: convex_hull_translation eq cbox_image_unit_interval [OF False])
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Bounded convex function on open set is continuous\<close>
 
 lemma convex_on_bounded_continuous:
   fixes S :: "('a::real_normed_vector) set"
   assumes "open S"
     and "convex_on S f"
     and "\<forall>x\<in>S. \<bar>f x\<bar> \<le> b"
   shows "continuous_on S f"
 proof -
   have "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e" if "x \<in> S" "e > 0" for x and e :: real
   proof -
     define B where "B = \<bar>b\<bar> + 1"
     then have B:  "0 < B""\<And>x. x\<in>S \<Longrightarrow> \<bar>f x\<bar> \<le> B"
       using assms(3) by auto 
     obtain k where "k > 0" and k: "cball x k \<subseteq> S"
       using \<open>x \<in> S\<close> assms(1) open_contains_cball_eq by blast
     show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e"
     proof (intro exI conjI allI impI)
       fix y
       assume as: "norm (y - x) < min (k / 2) (e / (2 * B) * k)"
       show "\<bar>f y - f x\<bar> < e"
       proof (cases "y = x")
         case False
         define t where "t = k / norm (y - x)"
         have "2 < t" "0<t"
           unfolding t_def using as False and \<open>k>0\<close>
           by (auto simp:field_simps)
         have "y \<in> S"
           apply (rule k[THEN subsetD])
           unfolding mem_cball dist_norm
           apply (rule order_trans[of _ "2 * norm (x - y)"])
           using as
           by (auto simp: field_simps norm_minus_commute)
         {
           define w where "w = x + t *\<^sub>R (y - x)"
           have "w \<in> S"
             using \<open>k>0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD])
           have "(1 / t) *\<^sub>R x + - x + ((t - 1) / t) *\<^sub>R x = (1 / t - 1 + (t - 1) / t) *\<^sub>R x"
             by (auto simp: algebra_simps)
           also have "\<dots> = 0"
             using \<open>t > 0\<close> by (auto simp:field_simps)
           finally have w: "(1 / t) *\<^sub>R w + ((t - 1) / t) *\<^sub>R x = y"
             unfolding w_def using False and \<open>t > 0\<close>
             by (auto simp: algebra_simps)
           have 2: "2 * B < e * t"
             unfolding t_def using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False
             by (auto simp:field_simps)
           have "f y - f x \<le> (f w - f x) / t"
             using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w]
             using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>x \<in> S\<close> \<open>w \<in> S\<close>
             by (auto simp:field_simps)
           also have "... < e"
             using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>x\<in>S\<close>] 2 \<open>t > 0\<close> by (auto simp: field_simps)
           finally have th1: "f y - f x < e" .
         }
         moreover
         {
           define w where "w = x - t *\<^sub>R (y - x)"
           have "w \<in> S"
             using \<open>k > 0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD])
           have "(1 / (1 + t)) *\<^sub>R x + (t / (1 + t)) *\<^sub>R x = (1 / (1 + t) + t / (1 + t)) *\<^sub>R x"
             by (auto simp: algebra_simps)
           also have "\<dots> = x"
             using \<open>t > 0\<close> by (auto simp:field_simps)
           finally have w: "(1 / (1+t)) *\<^sub>R w + (t / (1 + t)) *\<^sub>R y = x"
             unfolding w_def using False and \<open>t > 0\<close>
             by (auto simp: algebra_simps)
           have "2 * B < e * t"
             unfolding t_def
             using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False
             by (auto simp:field_simps)
           then have *: "(f w - f y) / t < e"
             using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>y\<in>S\<close>]
             using \<open>t > 0\<close>
             by (auto simp:field_simps)
           have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y"
             using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w]
             using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>y \<in> S\<close> \<open>w \<in> S\<close>
             by (auto simp:field_simps)
           also have "\<dots> = (f w + t * f y) / (1 + t)"
             using \<open>t > 0\<close> by (simp add: add_divide_distrib) 
           also have "\<dots> < e + f y"
             using \<open>t > 0\<close> * \<open>e > 0\<close> by (auto simp: field_simps)
           finally have "f x - f y < e" by auto
         }
         ultimately show ?thesis by auto
       qed (use \<open>0<e\<close> in auto)
     qed (use \<open>0<e\<close> \<open>0<k\<close> \<open>0<B\<close> in \<open>auto simp: field_simps\<close>)
   qed
   then show ?thesis
     by (metis continuous_on_iff dist_norm real_norm_def)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Upper bound on a ball implies upper and lower bounds\<close>
 
 lemma convex_bounds_lemma:
   fixes x :: "'a::real_normed_vector"
   assumes "convex_on (cball x e) f"
     and "\<forall>y \<in> cball x e. f y \<le> b" and y: "y \<in> cball x e"
   shows "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
 proof (cases "0 \<le> e")
   case True
   define z where "z = 2 *\<^sub>R x - y"
   have *: "x - (2 *\<^sub>R x - y) = y - x"
     by (simp add: scaleR_2)
   have z: "z \<in> cball x e"
     using y unfolding z_def mem_cball dist_norm * by (auto simp: norm_minus_commute)
   have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x"
     unfolding z_def by (auto simp: algebra_simps)
   then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
     using assms(1)[unfolded convex_on_def,rule_format, OF y z, of "1/2" "1/2"]
     using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z]
     by (auto simp:field_simps)
 next
   case False
   have "dist x y < 0"
     using False y unfolding mem_cball not_le by (auto simp del: dist_not_less_zero)
   then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
     using zero_le_dist[of x y] by auto
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Hence a convex function on an open set is continuous\<close>
 
 lemma real_of_nat_ge_one_iff: "1 \<le> real (n::nat) \<longleftrightarrow> 1 \<le> n"
   by auto
 
 lemma convex_on_continuous:
   assumes "open (s::('a::euclidean_space) set)" "convex_on s f"
   shows "continuous_on s f"
   unfolding continuous_on_eq_continuous_at[OF assms(1)]
 proof
   note dimge1 = DIM_positive[where 'a='a]
   fix x
   assume "x \<in> s"
   then obtain e where e: "cball x e \<subseteq> s" "e > 0"
     using assms(1) unfolding open_contains_cball by auto
   define d where "d = e / real DIM('a)"
   have "0 < d"
     unfolding d_def using \<open>e > 0\<close> dimge1 by auto
   let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a"
   obtain c
     where c: "finite c"
     and c1: "convex hull c \<subseteq> cball x e"
     and c2: "cball x d \<subseteq> convex hull c"
   proof
     define c where "c = (\<Sum>i\<in>Basis. (\<lambda>a. a *\<^sub>R i) ` {x\<bullet>i - d, x\<bullet>i + d})"
     show "finite c"
       unfolding c_def by (simp add: finite_set_sum)
     have "\<And>i. i \<in> Basis \<Longrightarrow> convex hull {x \<bullet> i - d, x \<bullet> i + d} = cbox (x \<bullet> i - d) (x \<bullet> i + d)"
       using \<open>0 < d\<close> convex_hull_eq_real_cbox by auto
     then have 1: "convex hull c = {a. \<forall>i\<in>Basis. a \<bullet> i \<in> cbox (x \<bullet> i - d) (x \<bullet> i + d)}"
       unfolding box_eq_set_sum_Basis c_def convex_hull_set_sum 
       apply (subst convex_hull_linear_image [symmetric])
       by (force simp add: linear_iff scaleR_add_left)+
     then have 2: "convex hull c = {a. \<forall>i\<in>Basis. a \<bullet> i \<in> cball (x \<bullet> i) d}"
       by (simp add: dist_norm abs_le_iff algebra_simps)
     show "cball x d \<subseteq> convex hull c"
       unfolding 2
       by (clarsimp simp: dist_norm) (metis inner_commute inner_diff_right norm_bound_Basis_le)
     have e': "e = (\<Sum>(i::'a)\<in>Basis. d)"
       by (simp add: d_def)
     show "convex hull c \<subseteq> cball x e"
       unfolding 2
     proof clarsimp
       show "dist x y \<le> e" if "\<forall>i\<in>Basis. dist (x \<bullet> i) (y \<bullet> i) \<le> d" for y
       proof -
         have "\<And>i. i \<in> Basis \<Longrightarrow> 0 \<le> dist (x \<bullet> i) (y \<bullet> i)"
           by simp
         have "(\<Sum>i\<in>Basis. dist (x \<bullet> i) (y \<bullet> i)) \<le> e"
           using e' sum_mono that by fastforce
         then show ?thesis
           by (metis (mono_tags) euclidean_dist_l2 order_trans [OF L2_set_le_sum] zero_le_dist)
       qed
     qed
   qed
   define k where "k = Max (f ` c)"
   have "convex_on (convex hull c) f"
     using assms(2) c1 convex_on_subset e(1) by blast
   then have k: "\<forall>y\<in>convex hull c. f y \<le> k"
     using c convex_on_convex_hull_bound k_def by fastforce
   have "e \<le> e * real DIM('a)"
     using e(2) real_of_nat_ge_one_iff by auto
   then have "d \<le> e"
     by (simp add: d_def field_split_simps)
   then have dsube: "cball x d \<subseteq> cball x e"
     by (rule subset_cball)
   have conv: "convex_on (cball x d) f"
     using \<open>convex_on (convex hull c) f\<close> c2 convex_on_subset by blast
   then have "\<And>y. y\<in>cball x d \<Longrightarrow> \<bar>f y\<bar> \<le> k + 2 * \<bar>f x\<bar>"
     by (rule convex_bounds_lemma) (use c2 k in blast)
   then have "continuous_on (ball x d) f"
     by (meson Elementary_Metric_Spaces.open_ball ball_subset_cball conv convex_on_bounded_continuous 
               convex_on_subset mem_ball_imp_mem_cball)
   then show "continuous (at x) f"
     unfolding continuous_on_eq_continuous_at[OF open_ball]
     using \<open>d > 0\<close> by auto
 qed
 
 end
diff --git a/src/HOL/Analysis/Derivative.thy b/src/HOL/Analysis/Derivative.thy
--- a/src/HOL/Analysis/Derivative.thy
+++ b/src/HOL/Analysis/Derivative.thy
@@ -1,3475 +1,3504 @@
 (*  Title:      HOL/Analysis/Derivative.thy
     Author:     John Harrison
     Author:     Robert Himmelmann, TU Muenchen (translation from HOL Light); tidied by LCP
 *)
 
 section \<open>Derivative\<close>
 
 theory Derivative
   imports
     Bounded_Linear_Function
     Line_Segment
     Convex_Euclidean_Space
 begin
 
 declare bounded_linear_inner_left [intro]
 
 declare has_derivative_bounded_linear[dest]
 
 subsection \<open>Derivatives\<close>
 
 lemma has_derivative_add_const:
   "(f has_derivative f') net \<Longrightarrow> ((\<lambda>x. f x + c) has_derivative f') net"
   by (intro derivative_eq_intros) auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Derivative with composed bilinear function\<close>
 
 text \<open>More explicit epsilon-delta forms.\<close>
 
 proposition has_derivative_within':
   "(f has_derivative f')(at x within s) \<longleftrightarrow>
     bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>x'\<in>s. 0 < norm (x' - x) \<and> norm (x' - x) < d \<longrightarrow>
       norm (f x' - f x - f'(x' - x)) / norm (x' - x) < e)"
   unfolding has_derivative_within Lim_within dist_norm
   by (simp add: diff_diff_eq)
 
 lemma has_derivative_at':
   "(f has_derivative f') (at x) 
    \<longleftrightarrow> bounded_linear f' \<and>
        (\<forall>e>0. \<exists>d>0. \<forall>x'. 0 < norm (x' - x) \<and> norm (x' - x) < d \<longrightarrow>
         norm (f x' - f x - f'(x' - x)) / norm (x' - x) < e)"
   using has_derivative_within' [of f f' x UNIV] by simp
 
 lemma has_derivative_componentwise_within:
    "(f has_derivative f') (at a within S) \<longleftrightarrow>
     (\<forall>i \<in> Basis. ((\<lambda>x. f x \<bullet> i) has_derivative (\<lambda>x. f' x \<bullet> i)) (at a within S))"
   apply (simp add: has_derivative_within)
   apply (subst tendsto_componentwise_iff)
   apply (simp add: bounded_linear_componentwise_iff [symmetric] ball_conj_distrib)
   apply (simp add: algebra_simps)
   done
 
 lemma has_derivative_at_withinI:
   "(f has_derivative f') (at x) \<Longrightarrow> (f has_derivative f') (at x within s)"
   unfolding has_derivative_within' has_derivative_at'
   by blast
 
 lemma has_derivative_right:
   fixes f :: "real \<Rightarrow> real"
     and y :: "real"
   shows "(f has_derivative ((*) y)) (at x within ({x <..} \<inter> I)) \<longleftrightarrow>
          ((\<lambda>t. (f x - f t) / (x - t)) \<longlongrightarrow> y) (at x within ({x <..} \<inter> I))"
 proof -
   have "((\<lambda>t. (f t - (f x + y * (t - x))) / \<bar>t - x\<bar>) \<longlongrightarrow> 0) (at x within ({x<..} \<inter> I)) \<longleftrightarrow>
     ((\<lambda>t. (f t - f x) / (t - x) - y) \<longlongrightarrow> 0) (at x within ({x<..} \<inter> I))"
     by (intro Lim_cong_within) (auto simp add: diff_divide_distrib add_divide_distrib)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. (f t - f x) / (t - x)) \<longlongrightarrow> y) (at x within ({x<..} \<inter> I))"
     by (simp add: Lim_null[symmetric])
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. (f x - f t) / (x - t)) \<longlongrightarrow> y) (at x within ({x<..} \<inter> I))"
     by (intro Lim_cong_within) (simp_all add: field_simps)
   finally show ?thesis
     by (simp add: bounded_linear_mult_right has_derivative_within)
 qed
 
 subsubsection \<open>Caratheodory characterization\<close>
 
 lemma DERIV_caratheodory_within:
   "(f has_field_derivative l) (at x within S) \<longleftrightarrow>
    (\<exists>g. (\<forall>z. f z - f x = g z * (z - x)) \<and> continuous (at x within S) g \<and> g x = l)"
       (is "?lhs = ?rhs")
 proof
   assume ?lhs
   show ?rhs
   proof (intro exI conjI)
     let ?g = "(%z. if z = x then l else (f z - f x) / (z-x))"
     show "\<forall>z. f z - f x = ?g z * (z-x)" by simp
     show "continuous (at x within S) ?g" using \<open>?lhs\<close>
       by (auto simp add: continuous_within has_field_derivative_iff cong: Lim_cong_within)
     show "?g x = l" by simp
   qed
 next
   assume ?rhs
   then obtain g where
     "(\<forall>z. f z - f x = g z * (z-x))" and "continuous (at x within S) g" and "g x = l" by blast
   thus ?lhs
     by (auto simp add: continuous_within has_field_derivative_iff cong: Lim_cong_within)
 qed
 
 subsection \<open>Differentiability\<close>
 
 definition\<^marker>\<open>tag important\<close>
   differentiable_on :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a set \<Rightarrow> bool"
     (infix "differentiable'_on" 50)
   where "f differentiable_on s \<longleftrightarrow> (\<forall>x\<in>s. f differentiable (at x within s))"
 
 lemma differentiableI: "(f has_derivative f') net \<Longrightarrow> f differentiable net"
   unfolding differentiable_def
   by auto
 
 lemma differentiable_onD: "\<lbrakk>f differentiable_on S; x \<in> S\<rbrakk> \<Longrightarrow> f differentiable (at x within S)"
   using differentiable_on_def by blast
 
 lemma differentiable_at_withinI: "f differentiable (at x) \<Longrightarrow> f differentiable (at x within s)"
   unfolding differentiable_def
   using has_derivative_at_withinI
   by blast
 
 lemma differentiable_at_imp_differentiable_on:
   "(\<And>x. x \<in> s \<Longrightarrow> f differentiable at x) \<Longrightarrow> f differentiable_on s"
   by (metis differentiable_at_withinI differentiable_on_def)
 
 corollary\<^marker>\<open>tag unimportant\<close> differentiable_iff_scaleR:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   shows "f differentiable F \<longleftrightarrow> (\<exists>d. (f has_derivative (\<lambda>x. x *\<^sub>R d)) F)"
   by (auto simp: differentiable_def dest: has_derivative_linear linear_imp_scaleR)
 
 lemma differentiable_on_eq_differentiable_at:
   "open s \<Longrightarrow> f differentiable_on s \<longleftrightarrow> (\<forall>x\<in>s. f differentiable at x)"
   unfolding differentiable_on_def
   by (metis at_within_interior interior_open)
 
 lemma differentiable_transform_within:
   assumes "f differentiable (at x within s)"
     and "0 < d"
     and "x \<in> s"
     and "\<And>x'. \<lbrakk>x'\<in>s; dist x' x < d\<rbrakk> \<Longrightarrow> f x' = g x'"
   shows "g differentiable (at x within s)"
    using assms has_derivative_transform_within unfolding differentiable_def
    by blast
 
 lemma differentiable_on_ident [simp, derivative_intros]: "(\<lambda>x. x) differentiable_on S"
   by (simp add: differentiable_at_imp_differentiable_on)
 
 lemma differentiable_on_id [simp, derivative_intros]: "id differentiable_on S"
   by (simp add: id_def)
 
 lemma differentiable_on_const [simp, derivative_intros]: "(\<lambda>z. c) differentiable_on S"
   by (simp add: differentiable_on_def)
 
 lemma differentiable_on_mult [simp, derivative_intros]:
   fixes f :: "'M::real_normed_vector \<Rightarrow> 'a::real_normed_algebra"
   shows "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z * g z) differentiable_on S"
   unfolding differentiable_on_def differentiable_def
   using differentiable_def differentiable_mult by blast
 
 lemma differentiable_on_compose:
    "\<lbrakk>g differentiable_on S; f differentiable_on (g ` S)\<rbrakk> \<Longrightarrow> (\<lambda>x. f (g x)) differentiable_on S"
 by (simp add: differentiable_in_compose differentiable_on_def)
 
 lemma bounded_linear_imp_differentiable_on: "bounded_linear f \<Longrightarrow> f differentiable_on S"
   by (simp add: differentiable_on_def bounded_linear_imp_differentiable)
 
 lemma linear_imp_differentiable_on:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> f differentiable_on S"
 by (simp add: differentiable_on_def linear_imp_differentiable)
 
 lemma differentiable_on_minus [simp, derivative_intros]:
    "f differentiable_on S \<Longrightarrow> (\<lambda>z. -(f z)) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_add [simp, derivative_intros]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z + g z) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_diff [simp, derivative_intros]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z - g z) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_inverse [simp, derivative_intros]:
   fixes f :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   shows "f differentiable_on S \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> f x \<noteq> 0) \<Longrightarrow> (\<lambda>x. inverse (f x)) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_scaleR [derivative_intros, simp]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>x. f x *\<^sub>R g x) differentiable_on S"
   unfolding differentiable_on_def
   by (blast intro: differentiable_scaleR)
 
 lemma has_derivative_sqnorm_at [derivative_intros, simp]:
   "((\<lambda>x. (norm x)\<^sup>2) has_derivative (\<lambda>x. 2 *\<^sub>R (a \<bullet> x))) (at a)"
   using bounded_bilinear.FDERIV  [of "(\<bullet>)" id id a _ id id]
   by (auto simp: inner_commute dot_square_norm bounded_bilinear_inner)
 
 lemma differentiable_sqnorm_at [derivative_intros, simp]:
   fixes a :: "'a :: {real_normed_vector,real_inner}"
   shows "(\<lambda>x. (norm x)\<^sup>2) differentiable (at a)"
 by (force simp add: differentiable_def intro: has_derivative_sqnorm_at)
 
 lemma differentiable_on_sqnorm [derivative_intros, simp]:
   fixes S :: "'a :: {real_normed_vector,real_inner} set"
   shows "(\<lambda>x. (norm x)\<^sup>2) differentiable_on S"
 by (simp add: differentiable_at_imp_differentiable_on)
 
 lemma differentiable_norm_at [derivative_intros, simp]:
   fixes a :: "'a :: {real_normed_vector,real_inner}"
   shows "a \<noteq> 0 \<Longrightarrow> norm differentiable (at a)"
 using differentiableI has_derivative_norm by blast
 
 lemma differentiable_on_norm [derivative_intros, simp]:
   fixes S :: "'a :: {real_normed_vector,real_inner} set"
   shows "0 \<notin> S \<Longrightarrow> norm differentiable_on S"
 by (metis differentiable_at_imp_differentiable_on differentiable_norm_at)
 
 
 subsection \<open>Frechet derivative and Jacobian matrix\<close>
 
 definition "frechet_derivative f net = (SOME f'. (f has_derivative f') net)"
 
 proposition frechet_derivative_works:
   "f differentiable net \<longleftrightarrow> (f has_derivative (frechet_derivative f net)) net"
   unfolding frechet_derivative_def differentiable_def
   unfolding some_eq_ex[of "\<lambda> f' . (f has_derivative f') net"] ..
 
 lemma linear_frechet_derivative: "f differentiable net \<Longrightarrow> linear (frechet_derivative f net)"
   unfolding frechet_derivative_works has_derivative_def
   by (auto intro: bounded_linear.linear)
 
 lemma frechet_derivative_const [simp]: "frechet_derivative (\<lambda>x. c) (at a) = (\<lambda>x. 0)"
   using differentiable_const frechet_derivative_works has_derivative_const has_derivative_unique by blast
 
 lemma frechet_derivative_id [simp]: "frechet_derivative id (at a) = id"
   using differentiable_def frechet_derivative_works has_derivative_id has_derivative_unique by blast
 
 lemma frechet_derivative_ident [simp]: "frechet_derivative (\<lambda>x. x) (at a) = (\<lambda>x. x)"
   by (metis eq_id_iff frechet_derivative_id)
 
 
 subsection \<open>Differentiability implies continuity\<close>
 
 proposition differentiable_imp_continuous_within:
   "f differentiable (at x within s) \<Longrightarrow> continuous (at x within s) f"
   by (auto simp: differentiable_def intro: has_derivative_continuous)
 
 lemma differentiable_imp_continuous_on:
   "f differentiable_on s \<Longrightarrow> continuous_on s f"
   unfolding differentiable_on_def continuous_on_eq_continuous_within
   using differentiable_imp_continuous_within by blast
 
 lemma differentiable_on_subset:
   "f differentiable_on t \<Longrightarrow> s \<subseteq> t \<Longrightarrow> f differentiable_on s"
   unfolding differentiable_on_def
   using differentiable_within_subset
   by blast
 
 lemma differentiable_on_empty: "f differentiable_on {}"
   unfolding differentiable_on_def
   by auto
 
 lemma has_derivative_continuous_on:
   "(\<And>x. x \<in> s \<Longrightarrow> (f has_derivative f' x) (at x within s)) \<Longrightarrow> continuous_on s f"
   by (auto intro!: differentiable_imp_continuous_on differentiableI simp: differentiable_on_def)
 
 text \<open>Results about neighborhoods filter.\<close>
 
 lemma eventually_nhds_metric_le:
   "eventually P (nhds a) = (\<exists>d>0. \<forall>x. dist x a \<le> d \<longrightarrow> P x)"
   unfolding eventually_nhds_metric by (safe, rule_tac x="d / 2" in exI, auto)
 
 lemma le_nhds: "F \<le> nhds a \<longleftrightarrow> (\<forall>S. open S \<and> a \<in> S \<longrightarrow> eventually (\<lambda>x. x \<in> S) F)"
   unfolding le_filter_def eventually_nhds by (fast elim: eventually_mono)
 
 lemma le_nhds_metric: "F \<le> nhds a \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist x a < e) F)"
   unfolding le_filter_def eventually_nhds_metric by (fast elim: eventually_mono)
 
 lemma le_nhds_metric_le: "F \<le> nhds a \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist x a \<le> e) F)"
   unfolding le_filter_def eventually_nhds_metric_le by (fast elim: eventually_mono)
 
 text \<open>Several results are easier using a "multiplied-out" variant.
 (I got this idea from Dieudonne's proof of the chain rule).\<close>
 
 lemma has_derivative_within_alt:
   "(f has_derivative f') (at x within s) \<longleftrightarrow> bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>y\<in>s. norm(y - x) < d \<longrightarrow> norm (f y - f x - f' (y - x)) \<le> e * norm (y - x))"
   unfolding has_derivative_within filterlim_def le_nhds_metric_le eventually_filtermap
     eventually_at dist_norm diff_diff_eq
   by (force simp add: linear_0 bounded_linear.linear pos_divide_le_eq)
 
 lemma has_derivative_within_alt2:
   "(f has_derivative f') (at x within s) \<longleftrightarrow> bounded_linear f' \<and>
     (\<forall>e>0. eventually (\<lambda>y. norm (f y - f x - f' (y - x)) \<le> e * norm (y - x)) (at x within s))"
   unfolding has_derivative_within filterlim_def le_nhds_metric_le eventually_filtermap
     eventually_at dist_norm diff_diff_eq
   by (force simp add: linear_0 bounded_linear.linear pos_divide_le_eq)
 
 lemma has_derivative_at_alt:
   "(f has_derivative f') (at x) \<longleftrightarrow>
     bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>y. norm(y - x) < d \<longrightarrow> norm (f y - f x - f'(y - x)) \<le> e * norm (y - x))"
   using has_derivative_within_alt[where s=UNIV]
   by simp
 
 
 subsection \<open>The chain rule\<close>
 
 proposition diff_chain_within[derivative_intros]:
   assumes "(f has_derivative f') (at x within s)"
     and "(g has_derivative g') (at (f x) within (f ` s))"
   shows "((g \<circ> f) has_derivative (g' \<circ> f'))(at x within s)"
   using has_derivative_in_compose[OF assms]
   by (simp add: comp_def)
 
 lemma diff_chain_at[derivative_intros]:
   "(f has_derivative f') (at x) \<Longrightarrow>
     (g has_derivative g') (at (f x)) \<Longrightarrow> ((g \<circ> f) has_derivative (g' \<circ> f')) (at x)"
   using has_derivative_compose[of f f' x UNIV g g']
   by (simp add: comp_def)
 
 lemma has_vector_derivative_within_open:
   "a \<in> S \<Longrightarrow> open S \<Longrightarrow>
     (f has_vector_derivative f') (at a within S) \<longleftrightarrow> (f has_vector_derivative f') (at a)"
   by (simp only: at_within_interior interior_open)
 
 lemma field_vector_diff_chain_within:
  assumes Df: "(f has_vector_derivative f') (at x within S)"
      and Dg: "(g has_field_derivative g') (at (f x) within f ` S)"
  shows "((g \<circ> f) has_vector_derivative (f' * g')) (at x within S)"
 using diff_chain_within[OF Df[unfolded has_vector_derivative_def]
                        Dg [unfolded has_field_derivative_def]]
  by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 lemma vector_derivative_diff_chain_within:
   assumes Df: "(f has_vector_derivative f') (at x within S)"
      and Dg: "(g has_derivative g') (at (f x) within f`S)"
   shows "((g \<circ> f) has_vector_derivative (g' f')) (at x within S)"
 using diff_chain_within[OF Df[unfolded has_vector_derivative_def] Dg]
   linear.scaleR[OF has_derivative_linear[OF Dg]]
   unfolding has_vector_derivative_def o_def
   by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Composition rules stated just for differentiability\<close>
 
 lemma differentiable_chain_at:
   "f differentiable (at x) \<Longrightarrow>
     g differentiable (at (f x)) \<Longrightarrow> (g \<circ> f) differentiable (at x)"
   unfolding differentiable_def
   by (meson diff_chain_at)
 
 lemma differentiable_chain_within:
   "f differentiable (at x within S) \<Longrightarrow>
     g differentiable (at(f x) within (f ` S)) \<Longrightarrow> (g \<circ> f) differentiable (at x within S)"
   unfolding differentiable_def
   by (meson diff_chain_within)
 
 
 subsection \<open>Uniqueness of derivative\<close>
 
 
 text\<^marker>\<open>tag important\<close> \<open>
  The general result is a bit messy because we need approachability of the
  limit point from any direction. But OK for nontrivial intervals etc.
 \<close>
 
 proposition frechet_derivative_unique_within:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes 1: "(f has_derivative f') (at x within S)"
     and 2: "(f has_derivative f'') (at x within S)"
     and S: "\<And>i e. \<lbrakk>i\<in>Basis; e>0\<rbrakk> \<Longrightarrow> \<exists>d. 0 < \<bar>d\<bar> \<and> \<bar>d\<bar> < e \<and> (x + d *\<^sub>R i) \<in> S"
   shows "f' = f''"
 proof -
   note as = assms(1,2)[unfolded has_derivative_def]
   then interpret f': bounded_linear f' by auto
   from as interpret f'': bounded_linear f'' by auto
   have "x islimpt S" unfolding islimpt_approachable
   proof (intro allI impI)
     fix e :: real
     assume "e > 0"
     obtain d where "0 < \<bar>d\<bar>" and "\<bar>d\<bar> < e" and "x + d *\<^sub>R (SOME i. i \<in> Basis) \<in> S"
       using assms(3) SOME_Basis \<open>e>0\<close> by blast
     then show "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
       by (rule_tac x="x + d *\<^sub>R (SOME i. i \<in> Basis)" in bexI) (auto simp: dist_norm SOME_Basis nonzero_Basis)  qed
   then have *: "netlimit (at x within S) = x"
     by (simp add: Lim_ident_at trivial_limit_within)
   show ?thesis
   proof (rule linear_eq_stdbasis)
     show "linear f'" "linear f''"
       unfolding linear_conv_bounded_linear using as by auto
   next
     fix i :: 'a
     assume i: "i \<in> Basis"
     define e where "e = norm (f' i - f'' i)"
     show "f' i = f'' i"
     proof (rule ccontr)
       assume "f' i \<noteq> f'' i"
       then have "e > 0"
         unfolding e_def by auto
       obtain d where d:
         "0 < d"
         "(\<And>y. y\<in>S \<longrightarrow> 0 < dist y x \<and> dist y x < d \<longrightarrow>
           dist ((f y - f x - f' (y - x)) /\<^sub>R norm (y - x) -
               (f y - f x - f'' (y - x)) /\<^sub>R norm (y - x)) (0 - 0) < e)"
         using tendsto_diff [OF as(1,2)[THEN conjunct2]]
         unfolding * Lim_within
         using \<open>e>0\<close> by blast
       obtain c where c: "0 < \<bar>c\<bar>" "\<bar>c\<bar> < d \<and> x + c *\<^sub>R i \<in> S"
         using assms(3) i d(1) by blast
       have *: "norm (- ((1 / \<bar>c\<bar>) *\<^sub>R f' (c *\<^sub>R i)) + (1 / \<bar>c\<bar>) *\<^sub>R f'' (c *\<^sub>R i)) =
         norm ((1 / \<bar>c\<bar>) *\<^sub>R (- (f' (c *\<^sub>R i)) + f'' (c *\<^sub>R i)))"
         unfolding scaleR_right_distrib by auto
       also have "\<dots> = norm ((1 / \<bar>c\<bar>) *\<^sub>R (c *\<^sub>R (- (f' i) + f'' i)))"
         unfolding f'.scaleR f''.scaleR
         unfolding scaleR_right_distrib scaleR_minus_right
         by auto
       also have "\<dots> = e"
         unfolding e_def
         using c(1)
         using norm_minus_cancel[of "f' i - f'' i"]
         by auto
       finally show False
         using c
         using d(2)[of "x + c *\<^sub>R i"]
         unfolding dist_norm
         unfolding f'.scaleR f''.scaleR f'.add f''.add f'.diff f''.diff
           scaleR_scaleR scaleR_right_diff_distrib scaleR_right_distrib
         using i
         by (auto simp: inverse_eq_divide)
     qed
   qed
 qed
 
 proposition frechet_derivative_unique_within_closed_interval:
   fixes f::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes ab: "\<And>i. i\<in>Basis \<Longrightarrow> a\<bullet>i < b\<bullet>i"
     and x: "x \<in> cbox a b"
     and "(f has_derivative f' ) (at x within cbox a b)"
     and "(f has_derivative f'') (at x within cbox a b)"
   shows "f' = f''"
 proof (rule frechet_derivative_unique_within)
   fix e :: real
   fix i :: 'a
   assume "e > 0" and i: "i \<in> Basis"
   then show "\<exists>d. 0 < \<bar>d\<bar> \<and> \<bar>d\<bar> < e \<and> x + d *\<^sub>R i \<in> cbox a b"
   proof (cases "x\<bullet>i = a\<bullet>i")
     case True
     with ab[of i] \<open>e>0\<close> x i show ?thesis
       by (rule_tac x="(min (b\<bullet>i - a\<bullet>i) e) / 2" in exI)
          (auto simp add: mem_box field_simps inner_simps inner_Basis)
   next
     case False
     moreover have "a \<bullet> i < x \<bullet> i"
       using False i mem_box(2) x by force
     moreover {
       have "a \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e \<le> a\<bullet>i *2 + x\<bullet>i - a\<bullet>i"
         by auto
       also have "\<dots> = a\<bullet>i + x\<bullet>i"
         by auto
       also have "\<dots> \<le> 2 * (x\<bullet>i)"
         using \<open>a \<bullet> i < x \<bullet> i\<close> by auto
       finally have "a \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e \<le> x \<bullet> i * 2"
         by auto
     }
     moreover have "min (x \<bullet> i - a \<bullet> i) e \<ge> 0"
       by (simp add: \<open>0 < e\<close> \<open>a \<bullet> i < x \<bullet> i\<close> less_eq_real_def)
     then have "x \<bullet> i * 2 \<le> b \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e"
       using i mem_box(2) x by force
     ultimately show ?thesis
     using ab[of i] \<open>e>0\<close> x i 
       by (rule_tac x="- (min (x\<bullet>i - a\<bullet>i) e) / 2" in exI)
          (auto simp add: mem_box field_simps inner_simps inner_Basis)
   qed
 qed (use assms in auto)
 
 lemma frechet_derivative_unique_within_open_interval:
   fixes f::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes x: "x \<in> box a b"
     and f: "(f has_derivative f' ) (at x within box a b)" "(f has_derivative f'') (at x within box a b)"
   shows "f' = f''"
 proof -
   have "at x within box a b = at x"
     by (metis x at_within_interior interior_open open_box)
   with f show "f' = f''"
     by (simp add: has_derivative_unique)
 qed
 
 lemma frechet_derivative_at:
   "(f has_derivative f') (at x) \<Longrightarrow> f' = frechet_derivative f (at x)"
   using differentiable_def frechet_derivative_works has_derivative_unique by blast
 
 lemma frechet_derivative_compose:
   "frechet_derivative (f o g) (at x) = frechet_derivative (f) (at (g x)) o frechet_derivative g (at x)"
   if "g differentiable at x" "f differentiable at (g x)"
   by (metis diff_chain_at frechet_derivative_at frechet_derivative_works that)
 
 lemma frechet_derivative_within_cbox:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>i. i\<in>Basis \<Longrightarrow> a\<bullet>i < b\<bullet>i"
     and "x \<in> cbox a b"
     and "(f has_derivative f') (at x within cbox a b)"
   shows "frechet_derivative f (at x within cbox a b) = f'"
   using assms
   by (metis Derivative.differentiableI frechet_derivative_unique_within_closed_interval frechet_derivative_works)
 
 lemma frechet_derivative_transform_within_open:
   "frechet_derivative f (at x) = frechet_derivative g (at x)"
   if "f differentiable at x" "open X" "x \<in> X" "\<And>x. x \<in> X \<Longrightarrow> f x = g x"
   by (meson frechet_derivative_at frechet_derivative_works has_derivative_transform_within_open that)
 
 
 subsection \<open>Derivatives of local minima and maxima are zero\<close>
 
 lemma has_derivative_local_min:
   fixes f :: "'a::real_normed_vector \<Rightarrow> real"
   assumes deriv: "(f has_derivative f') (at x)"
   assumes min: "eventually (\<lambda>y. f x \<le> f y) (at x)"
   shows "f' = (\<lambda>h. 0)"
 proof
   fix h :: 'a
   interpret f': bounded_linear f'
     using deriv by (rule has_derivative_bounded_linear)
   show "f' h = 0"
   proof (cases "h = 0")
     case False
     from min obtain d where d1: "0 < d" and d2: "\<forall>y\<in>ball x d. f x \<le> f y"
       unfolding eventually_at by (force simp: dist_commute)
     have "FDERIV (\<lambda>r. x + r *\<^sub>R h) 0 :> (\<lambda>r. r *\<^sub>R h)"
       by (intro derivative_eq_intros) auto
     then have "FDERIV (\<lambda>r. f (x + r *\<^sub>R h)) 0 :> (\<lambda>k. f' (k *\<^sub>R h))"
       by (rule has_derivative_compose, simp add: deriv)
     then have "DERIV (\<lambda>r. f (x + r *\<^sub>R h)) 0 :> f' h"
       unfolding has_field_derivative_def by (simp add: f'.scaleR mult_commute_abs)
     moreover have "0 < d / norm h" using d1 and \<open>h \<noteq> 0\<close> by simp
     moreover have "\<forall>y. \<bar>0 - y\<bar> < d / norm h \<longrightarrow> f (x + 0 *\<^sub>R h) \<le> f (x + y *\<^sub>R h)"
       using \<open>h \<noteq> 0\<close> by (auto simp add: d2 dist_norm pos_less_divide_eq)
     ultimately show "f' h = 0"
       by (rule DERIV_local_min)
   qed simp
 qed
 
 lemma has_derivative_local_max:
   fixes f :: "'a::real_normed_vector \<Rightarrow> real"
   assumes "(f has_derivative f') (at x)"
   assumes "eventually (\<lambda>y. f y \<le> f x) (at x)"
   shows "f' = (\<lambda>h. 0)"
   using has_derivative_local_min [of "\<lambda>x. - f x" "\<lambda>h. - f' h" "x"]
   using assms unfolding fun_eq_iff by simp
 
 lemma differential_zero_maxmin:
   fixes f::"'a::real_normed_vector \<Rightarrow> real"
   assumes "x \<in> S"
     and "open S"
     and deriv: "(f has_derivative f') (at x)"
     and mono: "(\<forall>y\<in>S. f y \<le> f x) \<or> (\<forall>y\<in>S. f x \<le> f y)"
   shows "f' = (\<lambda>v. 0)"
   using mono
 proof
   assume "\<forall>y\<in>S. f y \<le> f x"
   with \<open>x \<in> S\<close> and \<open>open S\<close> have "eventually (\<lambda>y. f y \<le> f x) (at x)"
     unfolding eventually_at_topological by auto
   with deriv show ?thesis
     by (rule has_derivative_local_max)
 next
   assume "\<forall>y\<in>S. f x \<le> f y"
   with \<open>x \<in> S\<close> and \<open>open S\<close> have "eventually (\<lambda>y. f x \<le> f y) (at x)"
     unfolding eventually_at_topological by auto
   with deriv show ?thesis
     by (rule has_derivative_local_min)
 qed
 
 lemma differential_zero_maxmin_component:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes k: "k \<in> Basis"
     and ball: "0 < e" "(\<forall>y \<in> ball x e. (f y)\<bullet>k \<le> (f x)\<bullet>k) \<or> (\<forall>y\<in>ball x e. (f x)\<bullet>k \<le> (f y)\<bullet>k)"
     and diff: "f differentiable (at x)"
   shows "(\<Sum>j\<in>Basis. (frechet_derivative f (at x) j \<bullet> k) *\<^sub>R j) = (0::'a)" (is "?D k = 0")
 proof -
   let ?f' = "frechet_derivative f (at x)"
   have "x \<in> ball x e" using \<open>0 < e\<close> by simp
   moreover have "open (ball x e)" by simp
   moreover have "((\<lambda>x. f x \<bullet> k) has_derivative (\<lambda>h. ?f' h \<bullet> k)) (at x)"
     using bounded_linear_inner_left diff[unfolded frechet_derivative_works]
     by (rule bounded_linear.has_derivative)
   ultimately have "(\<lambda>h. frechet_derivative f (at x) h \<bullet> k) = (\<lambda>v. 0)"
     using ball(2) by (rule differential_zero_maxmin)
   then show ?thesis
     unfolding fun_eq_iff by simp
 qed
 
 subsection \<open>One-dimensional mean value theorem\<close>
 
 lemma mvt_simple:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b"
     and derf: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x within {a..b})"
   shows "\<exists>x\<in>{a<..<b}. f b - f a = f' x (b - a)"
 proof (rule mvt)
   have "f differentiable_on {a..b}"
     using derf unfolding differentiable_on_def differentiable_def by force
   then show "continuous_on {a..b} f"
     by (rule differentiable_imp_continuous_on)
   show "(f has_derivative f' x) (at x)" if "a < x" "x < b" for x
     by (metis at_within_Icc_at derf leI order.asym that)
 qed (use assms in auto)
 
 lemma mvt_very_simple:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<le> b"
     and derf: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x within {a..b})"
   shows "\<exists>x\<in>{a..b}. f b - f a = f' x (b - a)"
 proof (cases "a = b")
   interpret bounded_linear "f' b"
     using assms(2) assms(1) by auto
   case True
   then show ?thesis
     by force
 next
   case False
   then show ?thesis
     using mvt_simple[OF _ derf]
     by (metis \<open>a \<le> b\<close> atLeastAtMost_iff dual_order.order_iff_strict greaterThanLessThan_iff)
 qed
 
 text \<open>A nice generalization (see Havin's proof of 5.19 from Rudin's book).\<close>
 
 lemma mvt_general:
   fixes f :: "real \<Rightarrow> 'a::real_inner"
   assumes "a < b"
     and contf: "continuous_on {a..b} f"
     and derf: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x)"
   shows "\<exists>x\<in>{a<..<b}. norm (f b - f a) \<le> norm (f' x (b - a))"
 proof -
   have "\<exists>x\<in>{a<..<b}. (f b - f a) \<bullet> f b - (f b - f a) \<bullet> f a = (f b - f a) \<bullet> f' x (b - a)"
     apply (rule mvt [OF \<open>a < b\<close>, where f = "\<lambda>x. (f b - f a) \<bullet> f x"])
     apply (intro continuous_intros contf)
     using derf apply (auto intro: has_derivative_inner_right)
     done
   then obtain x where x: "x \<in> {a<..<b}"
     "(f b - f a) \<bullet> f b - (f b - f a) \<bullet> f a = (f b - f a) \<bullet> f' x (b - a)" ..
   show ?thesis
   proof (cases "f a = f b")
     case False
     have "norm (f b - f a) * norm (f b - f a) = (norm (f b - f a))\<^sup>2"
       by (simp add: power2_eq_square)
     also have "\<dots> = (f b - f a) \<bullet> (f b - f a)"
       unfolding power2_norm_eq_inner ..
     also have "\<dots> = (f b - f a) \<bullet> f' x (b - a)"
       using x(2) by (simp only: inner_diff_right)
     also have "\<dots> \<le> norm (f b - f a) * norm (f' x (b - a))"
       by (rule norm_cauchy_schwarz)
     finally show ?thesis
       using False x(1)
       by (auto simp add: mult_left_cancel)
   next
     case True
     then show ?thesis
       using \<open>a < b\<close> by (rule_tac x="(a + b) /2" in bexI) auto
   qed
 qed
 
 
 subsection \<open>More general bound theorems\<close>
 
 proposition differentiable_bound_general:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "a < b"
     and f_cont: "continuous_on {a..b} f"
     and phi_cont: "continuous_on {a..b} \<phi>"
     and f': "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
     and phi': "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (\<phi> has_vector_derivative \<phi>' x) (at x)"
     and bnd: "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> norm (f' x) \<le> \<phi>' x"
   shows "norm (f b - f a) \<le> \<phi> b - \<phi> a"
 proof -
   {
     fix x assume x: "a < x" "x < b"
     have "0 \<le> norm (f' x)" by simp
     also have "\<dots> \<le> \<phi>' x" using x by (auto intro!: bnd)
     finally have "0 \<le> \<phi>' x" .
   } note phi'_nonneg = this
   note f_tendsto = assms(2)[simplified continuous_on_def, rule_format]
   note phi_tendsto = assms(3)[simplified continuous_on_def, rule_format]
   {
     fix e::real assume "e > 0"
     define e2 where "e2 = e / 2"
     with \<open>e > 0\<close> have "e2 > 0" by simp
     let ?le = "\<lambda>x1. norm (f x1 - f a) \<le> \<phi> x1 - \<phi> a + e * (x1 - a) + e"
     define A where "A = {x2. a \<le> x2 \<and> x2 \<le> b \<and> (\<forall>x1\<in>{a ..< x2}. ?le x1)}"
     have A_subset: "A \<subseteq> {a..b}" by (auto simp: A_def)
     {
       fix x2
       assume a: "a \<le> x2" "x2 \<le> b" and le: "\<forall>x1\<in>{a..<x2}. ?le x1"
       have "?le x2" using \<open>e > 0\<close>
       proof cases
         assume "x2 \<noteq> a" with a have "a < x2" by simp
         have "at x2 within {a <..<x2}\<noteq> bot"
           using \<open>a < x2\<close>
           by (auto simp: trivial_limit_within islimpt_in_closure)
         moreover
         have "((\<lambda>x1. (\<phi> x1 - \<phi> a) + e * (x1 - a) + e) \<longlongrightarrow> (\<phi> x2 - \<phi> a) + e * (x2 - a) + e) (at x2 within {a <..<x2})"
           "((\<lambda>x1. norm (f x1 - f a)) \<longlongrightarrow> norm (f x2 - f a)) (at x2 within {a <..<x2})"
           using a
           by (auto intro!: tendsto_eq_intros f_tendsto phi_tendsto
             intro: tendsto_within_subset[where S="{a..b}"])
         moreover
         have "eventually (\<lambda>x. x > a) (at x2 within {a <..<x2})"
           by (auto simp: eventually_at_filter)
         hence "eventually ?le (at x2 within {a <..<x2})"
           unfolding eventually_at_filter
           by eventually_elim (insert le, auto)
         ultimately
         show ?thesis
           by (rule tendsto_le)
       qed simp
     } note le_cont = this
     have "a \<in> A"
       using assms by (auto simp: A_def)
     hence [simp]: "A \<noteq> {}" by auto
     have A_ivl: "\<And>x1 x2. x2 \<in> A \<Longrightarrow> x1 \<in> {a ..x2} \<Longrightarrow> x1 \<in> A"
       by (simp add: A_def)
     have [simp]: "bdd_above A" by (auto simp: A_def)
     define y where "y = Sup A"
     have "y \<le> b"
       unfolding y_def
       by (simp add: cSup_le_iff) (simp add: A_def)
      have leI: "\<And>x x1. a \<le> x1 \<Longrightarrow> x \<in> A \<Longrightarrow> x1 < x \<Longrightarrow> ?le x1"
        by (auto simp: A_def intro!: le_cont)
     have y_all_le: "\<forall>x1\<in>{a..<y}. ?le x1"
       by (auto simp: y_def less_cSup_iff leI)
     have "a \<le> y"
       by (metis \<open>a \<in> A\<close> \<open>bdd_above A\<close> cSup_upper y_def)
     have "y \<in> A"
       using y_all_le \<open>a \<le> y\<close> \<open>y \<le> b\<close>
       by (auto simp: A_def)
     hence "A = {a .. y}"
       using A_subset by (auto simp: subset_iff y_def cSup_upper intro: A_ivl)
     from le_cont[OF \<open>a \<le> y\<close> \<open>y \<le> b\<close> y_all_le] have le_y: "?le y" .
     have "y = b"
     proof (cases "a = y")
       case True
       with \<open>a < b\<close> have "y < b" by simp
       with \<open>a = y\<close> f_cont phi_cont \<open>e2 > 0\<close>
       have 1: "\<forall>\<^sub>F x in at y within {y..b}. dist (f x) (f y) < e2"
        and 2: "\<forall>\<^sub>F x in at y within {y..b}. dist (\<phi> x) (\<phi> y) < e2"
         by (auto simp: continuous_on_def tendsto_iff)
       have 3: "eventually (\<lambda>x. y < x) (at y within {y..b})"
         by (auto simp: eventually_at_filter)
       have 4: "eventually (\<lambda>x::real. x < b) (at y within {y..b})"
         using _ \<open>y < b\<close>
         by (rule order_tendstoD) (auto intro!: tendsto_eq_intros)
       from 1 2 3 4
       have eventually_le: "eventually (\<lambda>x. ?le x) (at y within {y .. b})"
       proof eventually_elim
         case (elim x1)
         have "norm (f x1 - f a) = norm (f x1 - f y)"
           by (simp add: \<open>a = y\<close>)
         also have "norm (f x1 - f y) \<le> e2"
           using elim \<open>a = y\<close> by (auto simp : dist_norm intro!:  less_imp_le)
         also have "\<dots> \<le> e2 + (\<phi> x1 - \<phi> a + e2 + e * (x1 - a))"
           using \<open>0 < e\<close> elim
           by (intro add_increasing2[OF add_nonneg_nonneg order.refl])
             (auto simp: \<open>a = y\<close> dist_norm intro!: mult_nonneg_nonneg)
         also have "\<dots> = \<phi> x1 - \<phi> a + e * (x1 - a) + e"
           by (simp add: e2_def)
         finally show "?le x1" .
       qed
       from this[unfolded eventually_at_topological] \<open>?le y\<close>
       obtain S where S: "open S" "y \<in> S" "\<And>x. x\<in>S \<Longrightarrow> x \<in> {y..b} \<Longrightarrow> ?le x"
         by metis
       from \<open>open S\<close> obtain d where d: "\<And>x. dist x y < d \<Longrightarrow> x \<in> S" "d > 0"
         by (force simp: dist_commute open_dist ball_def dest!: bspec[OF _ \<open>y \<in> S\<close>])
       define d' where "d' = min b (y + (d/2))"
       have "d' \<in> A"
         unfolding A_def
       proof safe
         show "a \<le> d'" using \<open>a = y\<close> \<open>0 < d\<close> \<open>y < b\<close> by (simp add: d'_def)
         show "d' \<le> b" by (simp add: d'_def)
         fix x1
         assume "x1 \<in> {a..<d'}"
         hence "x1 \<in> S" "x1 \<in> {y..b}"
           by (auto simp: \<open>a = y\<close> d'_def dist_real_def intro!: d )
         thus "?le x1"
           by (rule S)
       qed
       hence "d' \<le> y"
         unfolding y_def
         by (rule cSup_upper) simp
       then show "y = b" using \<open>d > 0\<close> \<open>y < b\<close>
         by (simp add: d'_def)
     next
       case False
       with \<open>a \<le> y\<close> have "a < y" by simp
       show "y = b"
       proof (rule ccontr)
         assume "y \<noteq> b"
         hence "y < b" using \<open>y \<le> b\<close> by simp
         let ?F = "at y within {y..<b}"
         from f' phi'
         have "(f has_vector_derivative f' y) ?F"
           and "(\<phi> has_vector_derivative \<phi>' y) ?F"
           using \<open>a < y\<close> \<open>y < b\<close>
           by (auto simp add: at_within_open[of _ "{a<..<b}"] has_vector_derivative_def
             intro!: has_derivative_subset[where s="{a<..<b}" and t="{y..<b}"])
         hence "\<forall>\<^sub>F x1 in ?F. norm (f x1 - f y - (x1 - y) *\<^sub>R f' y) \<le> e2 * \<bar>x1 - y\<bar>"
             "\<forall>\<^sub>F x1 in ?F. norm (\<phi> x1 - \<phi> y - (x1 - y) *\<^sub>R \<phi>' y) \<le> e2 * \<bar>x1 - y\<bar>"
           using \<open>e2 > 0\<close>
           by (auto simp: has_derivative_within_alt2 has_vector_derivative_def)
         moreover
         have "\<forall>\<^sub>F x1 in ?F. y \<le> x1" "\<forall>\<^sub>F x1 in ?F. x1 < b"
           by (auto simp: eventually_at_filter)
         ultimately
         have "\<forall>\<^sub>F x1 in ?F. norm (f x1 - f y) \<le> (\<phi> x1 - \<phi> y) + e * \<bar>x1 - y\<bar>"
           (is "\<forall>\<^sub>F x1 in ?F. ?le' x1")
         proof eventually_elim
           case (elim x1)
           from norm_triangle_ineq2[THEN order_trans, OF elim(1)]
           have "norm (f x1 - f y) \<le> norm (f' y) * \<bar>x1 - y\<bar> + e2 * \<bar>x1 - y\<bar>"
             by (simp add: ac_simps)
           also have "norm (f' y) \<le> \<phi>' y" using bnd \<open>a < y\<close> \<open>y < b\<close> by simp
           also have "\<phi>' y * \<bar>x1 - y\<bar> \<le> \<phi> x1 - \<phi> y + e2 * \<bar>x1 - y\<bar>"
             using elim by (simp add: ac_simps)
           finally
           have "norm (f x1 - f y) \<le> \<phi> x1 - \<phi> y + e2 * \<bar>x1 - y\<bar> + e2 * \<bar>x1 - y\<bar>"
             by (auto simp: mult_right_mono)
           thus ?case by (simp add: e2_def)
         qed
         moreover have "?le' y" by simp
         ultimately obtain S
         where S: "open S" "y \<in> S" "\<And>x. x\<in>S \<Longrightarrow> x \<in> {y..<b} \<Longrightarrow> ?le' x"
           unfolding eventually_at_topological
           by metis
         from \<open>open S\<close> obtain d where d: "\<And>x. dist x y < d \<Longrightarrow> x \<in> S" "d > 0"
           by (force simp: dist_commute open_dist ball_def dest!: bspec[OF _ \<open>y \<in> S\<close>])
         define d' where "d' = min ((y + b)/2) (y + (d/2))"
         have "d' \<in> A"
           unfolding A_def
         proof safe
           show "a \<le> d'" using \<open>a < y\<close> \<open>0 < d\<close> \<open>y < b\<close> by (simp add: d'_def)
           show "d' \<le> b" using \<open>y < b\<close> by (simp add: d'_def min_def)
           fix x1
           assume x1: "x1 \<in> {a..<d'}"
           show "?le x1"
           proof (cases "x1 < y")
             case True
             then show ?thesis
               using \<open>y \<in> A\<close> local.leI x1 by auto
           next
             case False
             hence x1': "x1 \<in> S" "x1 \<in> {y..<b}" using x1
               by (auto simp: d'_def dist_real_def intro!: d)
             have "norm (f x1 - f a) \<le> norm (f x1 - f y) + norm (f y - f a)"
               by (rule order_trans[OF _ norm_triangle_ineq]) simp
             also note S(3)[OF x1']
             also note le_y
             finally show "?le x1"
               using False by (auto simp: algebra_simps)
           qed
         qed
         hence "d' \<le> y"
           unfolding y_def by (rule cSup_upper) simp
         thus False using \<open>d > 0\<close> \<open>y < b\<close>
           by (simp add: d'_def min_def split: if_split_asm)
       qed
     qed
     with le_y have "norm (f b - f a) \<le> \<phi> b - \<phi> a + e * (b - a + 1)"
       by (simp add: algebra_simps)
   } note * = this
   show ?thesis
   proof (rule field_le_epsilon)
     fix e::real assume "e > 0"
     then show "norm (f b - f a) \<le> \<phi> b - \<phi> a + e"
       using *[of "e / (b - a + 1)"] \<open>a < b\<close> by simp
   qed
 qed
 
 lemma differentiable_bound:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and derf: "\<And>x. x\<in>S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and B: "\<And>x. x \<in> S \<Longrightarrow> onorm (f' x) \<le> B"
     and x: "x \<in> S"
     and y: "y \<in> S"
   shows "norm (f x - f y) \<le> B * norm (x - y)"
 proof -
   let ?p = "\<lambda>u. x + u *\<^sub>R (y - x)"
   let ?\<phi> = "\<lambda>h. h * B * norm (x - y)"
   have *: "x + u *\<^sub>R (y - x) \<in> S" if "u \<in> {0..1}" for u
   proof -
     have "u *\<^sub>R y = u *\<^sub>R (y - x) + u *\<^sub>R x"
       by (simp add: scale_right_diff_distrib)
     then show "x + u *\<^sub>R (y - x) \<in> S"
       using that \<open>convex S\<close> x y by (simp add: convex_alt)
         (metis pth_b(2) pth_c(1) scaleR_collapse)
   qed
   have "\<And>z. z \<in> (\<lambda>u. x + u *\<^sub>R (y - x)) ` {0..1} \<Longrightarrow>
           (f has_derivative f' z) (at z within (\<lambda>u. x + u *\<^sub>R (y - x)) ` {0..1})"
     by (auto intro: * has_derivative_subset [OF derf])
   then have "continuous_on (?p ` {0..1}) f"
     unfolding continuous_on_eq_continuous_within
     by (meson has_derivative_continuous)
   with * have 1: "continuous_on {0 .. 1} (f \<circ> ?p)"
     by (intro continuous_intros)+
   {
     fix u::real assume u: "u \<in>{0 <..< 1}"
     let ?u = "?p u"
     interpret linear "(f' ?u)"
       using u by (auto intro!: has_derivative_linear derf *)
     have "(f \<circ> ?p has_derivative (f' ?u) \<circ> (\<lambda>u. 0 + u *\<^sub>R (y - x))) (at u within box 0 1)"
       by (intro derivative_intros has_derivative_subset [OF derf]) (use u * in auto)
     hence "((f \<circ> ?p) has_vector_derivative f' ?u (y - x)) (at u)"
       by (simp add: at_within_open[OF u open_greaterThanLessThan] scaleR has_vector_derivative_def o_def)
   } note 2 = this
   have 3: "continuous_on {0..1} ?\<phi>"
     by (rule continuous_intros)+
   have 4: "(?\<phi> has_vector_derivative B * norm (x - y)) (at u)" for u
     by (auto simp: has_vector_derivative_def intro!: derivative_eq_intros)
   {
     fix u::real assume u: "u \<in>{0 <..< 1}"
     let ?u = "?p u"
     interpret bounded_linear "(f' ?u)"
       using u by (auto intro!: has_derivative_bounded_linear derf *)
     have "norm (f' ?u (y - x)) \<le> onorm (f' ?u) * norm (y - x)"
       by (rule onorm) (rule bounded_linear)
     also have "onorm (f' ?u) \<le> B"
       using u by (auto intro!: assms(3)[rule_format] *)
     finally have "norm ((f' ?u) (y - x)) \<le> B * norm (x - y)"
       by (simp add: mult_right_mono norm_minus_commute)
   } note 5 = this
   have "norm (f x - f y) = norm ((f \<circ> (\<lambda>u. x + u *\<^sub>R (y - x))) 1 - (f \<circ> (\<lambda>u. x + u *\<^sub>R (y - x))) 0)"
     by (auto simp add: norm_minus_commute)
   also
   from differentiable_bound_general[OF zero_less_one 1, OF 3 2 4 5]
   have "norm ((f \<circ> ?p) 1 - (f \<circ> ?p) 0) \<le> B * norm (x - y)"
     by simp
   finally show ?thesis .
 qed
 
 lemma field_differentiable_bound:
   fixes S :: "'a::real_normed_field set"
   assumes cvs: "convex S"
       and df:  "\<And>z. z \<in> S \<Longrightarrow> (f has_field_derivative f' z) (at z within S)"
       and dn:  "\<And>z. z \<in> S \<Longrightarrow> norm (f' z) \<le> B"
       and "x \<in> S"  "y \<in> S"
     shows "norm(f x - f y) \<le> B * norm(x - y)"
   apply (rule differentiable_bound [OF cvs])
   apply (erule df [unfolded has_field_derivative_def])
   apply (rule onorm_le, simp_all add: norm_mult mult_right_mono assms)
   done
 
 lemma
   differentiable_bound_segment:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>t. t \<in> {0..1} \<Longrightarrow> x0 + t *\<^sub>R a \<in> G"
   assumes f': "\<And>x. x \<in> G \<Longrightarrow> (f has_derivative f' x) (at x within G)"
   assumes B: "\<And>x. x \<in> {0..1} \<Longrightarrow> onorm (f' (x0 + x *\<^sub>R a)) \<le> B"
   shows "norm (f (x0 + a) - f x0) \<le> norm a * B"
 proof -
   let ?G = "(\<lambda>x. x0 + x *\<^sub>R a) ` {0..1}"
   have "?G = (+) x0 ` (\<lambda>x. x *\<^sub>R a) ` {0..1}" by auto
   also have "convex \<dots>"
     by (intro convex_translation convex_scaled convex_real_interval)
   finally have "convex ?G" .
   moreover have "?G \<subseteq> G" "x0 \<in> ?G" "x0 + a \<in> ?G" using assms by (auto intro: image_eqI[where x=1])
   ultimately show ?thesis
     using has_derivative_subset[OF f' \<open>?G \<subseteq> G\<close>] B
       differentiable_bound[of "(\<lambda>x. x0 + x *\<^sub>R a) ` {0..1}" f f' B "x0 + a" x0]
     by (force simp: ac_simps)
 qed
 
 lemma differentiable_bound_linearization:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes S: "\<And>t. t \<in> {0..1} \<Longrightarrow> a + t *\<^sub>R (b - a) \<in> S"
   assumes f'[derivative_intros]: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   assumes B: "\<And>x. x \<in> S \<Longrightarrow> onorm (f' x - f' x0) \<le> B"
   assumes "x0 \<in> S"
   shows "norm (f b - f a - f' x0 (b - a)) \<le> norm (b - a) * B"
 proof -
   define g where [abs_def]: "g x = f x - f' x0 x" for x
   have g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative (\<lambda>i. f' x i - f' x0 i)) (at x within S)"
     unfolding g_def using assms
     by (auto intro!: derivative_eq_intros
       bounded_linear.has_derivative[OF has_derivative_bounded_linear, OF f'])
   from B have "\<forall>x\<in>{0..1}. onorm (\<lambda>i. f' (a + x *\<^sub>R (b - a)) i - f' x0 i) \<le> B"
     using assms by (auto simp: fun_diff_def)
   with differentiable_bound_segment[OF S g] \<open>x0 \<in> S\<close>
   show ?thesis
     by (simp add: g_def field_simps linear_diff[OF has_derivative_linear[OF f']])
 qed
 
 lemma vector_differentiable_bound_linearization:
   fixes f::"real \<Rightarrow> 'b::real_normed_vector"
   assumes f': "\<And>x. x \<in> S \<Longrightarrow> (f has_vector_derivative f' x) (at x within S)"
   assumes "closed_segment a b \<subseteq> S"
   assumes B: "\<And>x. x \<in> S \<Longrightarrow> norm (f' x - f' x0) \<le> B"
   assumes "x0 \<in> S"
   shows "norm (f b - f a - (b - a) *\<^sub>R f' x0) \<le> norm (b - a) * B"
   using assms
   by (intro differentiable_bound_linearization[of a b S f "\<lambda>x h. h *\<^sub>R f' x" x0 B])
     (force simp: closed_segment_real_eq has_vector_derivative_def
       scaleR_diff_right[symmetric] mult.commute[of B]
       intro!: onorm_le mult_left_mono)+
 
 
 text \<open>In particular.\<close>
 
 lemma has_derivative_zero_constant:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex s"
     and "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within s)"
   shows "\<exists>c. \<forall>x\<in>s. f x = c"
 proof -
   { fix x y assume "x \<in> s" "y \<in> s"
     then have "norm (f x - f y) \<le> 0 * norm (x - y)"
       using assms by (intro differentiable_bound[of s]) (auto simp: onorm_zero)
     then have "f x = f y"
       by simp }
   then show ?thesis
     by metis
 qed
 
 lemma has_field_derivative_zero_constant:
   assumes "convex s" "\<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative 0) (at x within s)"
   shows   "\<exists>c. \<forall>x\<in>s. f (x) = (c :: 'a :: real_normed_field)"
 proof (rule has_derivative_zero_constant)
   have A: "(*) 0 = (\<lambda>_. 0 :: 'a)" by (intro ext) simp
   fix x assume "x \<in> s" thus "(f has_derivative (\<lambda>h. 0)) (at x within s)"
     using assms(2)[of x] by (simp add: has_field_derivative_def A)
 qed fact
 
 lemma
   has_vector_derivative_zero_constant:
   assumes "convex s"
   assumes "\<And>x. x \<in> s \<Longrightarrow> (f has_vector_derivative 0) (at x within s)"
   obtains c where "\<And>x. x \<in> s \<Longrightarrow> f x = c"
   using has_derivative_zero_constant[of s f] assms
   by (auto simp: has_vector_derivative_def)
 
 lemma has_derivative_zero_unique:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex s"
     and "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within s)"
     and "x \<in> s" "y \<in> s"
   shows "f x = f y"
   using has_derivative_zero_constant[OF assms(1,2)] assms(3-) by force
 
 lemma has_derivative_zero_unique_connected:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "open s" "connected s"
   assumes f: "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>x. 0)) (at x)"
   assumes "x \<in> s" "y \<in> s"
   shows "f x = f y"
 proof (rule connected_local_const[where f=f, OF \<open>connected s\<close> \<open>x\<in>s\<close> \<open>y\<in>s\<close>])
   show "\<forall>a\<in>s. eventually (\<lambda>b. f a = f b) (at a within s)"
   proof
     fix a assume "a \<in> s"
     with \<open>open s\<close> obtain e where "0 < e" "ball a e \<subseteq> s"
       by (rule openE)
     then have "\<exists>c. \<forall>x\<in>ball a e. f x = c"
       by (intro has_derivative_zero_constant)
          (auto simp: at_within_open[OF _ open_ball] f)
     with \<open>0<e\<close> have "\<forall>x\<in>ball a e. f a = f x"
       by auto
     then show "eventually (\<lambda>b. f a = f b) (at a within s)"
       using \<open>0<e\<close> unfolding eventually_at_topological
       by (intro exI[of _ "ball a e"]) auto
   qed
 qed
 
 subsection \<open>Differentiability of inverse function (most basic form)\<close>
 
 lemma has_derivative_inverse_basic:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes derf: "(f has_derivative f') (at (g y))"
     and ling': "bounded_linear g'"
     and "g' \<circ> f' = id"
     and contg: "continuous (at y) g"
     and "open T"
     and "y \<in> T"
     and fg: "\<And>z. z \<in> T \<Longrightarrow> f (g z) = z"
   shows "(g has_derivative g') (at y)"
 proof -
   interpret f': bounded_linear f'
     using assms unfolding has_derivative_def by auto
   interpret g': bounded_linear g'
     using assms by auto
   obtain C where C: "0 < C" "\<And>x. norm (g' x) \<le> norm x * C"
     using bounded_linear.pos_bounded[OF assms(2)] by blast
   have lem1: "\<forall>e>0. \<exists>d>0. \<forall>z.
     norm (z - y) < d \<longrightarrow> norm (g z - g y - g'(z - y)) \<le> e * norm (g z - g y)"
   proof (intro allI impI)
     fix e :: real
     assume "e > 0"
     with C(1) have *: "e / C > 0" by auto
     obtain d0 where  "0 < d0" and d0:
         "\<And>u. norm (u - g y) < d0 \<Longrightarrow> norm (f u - f (g y) - f' (u - g y)) \<le> e / C * norm (u - g y)"
       using derf * unfolding has_derivative_at_alt by blast
     obtain d1 where "0 < d1" and d1: "\<And>x. \<lbrakk>0 < dist x y; dist x y < d1\<rbrakk> \<Longrightarrow> dist (g x) (g y) < d0"
       using contg \<open>0 < d0\<close> unfolding continuous_at Lim_at by blast
     obtain d2 where "0 < d2" and d2: "\<And>u. dist u y < d2 \<Longrightarrow> u \<in> T"
       using \<open>open T\<close> \<open>y \<in> T\<close> unfolding open_dist by blast
     obtain d where d: "0 < d" "d < d1" "d < d2"
       using field_lbound_gt_zero[OF \<open>0 < d1\<close> \<open>0 < d2\<close>] by blast
     show "\<exists>d>0. \<forall>z. norm (z - y) < d \<longrightarrow> norm (g z - g y - g' (z - y)) \<le> e * norm (g z - g y)"
     proof (intro exI allI impI conjI)
       fix z
       assume as: "norm (z - y) < d"
       then have "z \<in> T"
         using d2 d unfolding dist_norm by auto
       have "norm (g z - g y - g' (z - y)) \<le> norm (g' (f (g z) - y - f' (g z - g y)))"
         unfolding g'.diff f'.diff
         unfolding assms(3)[unfolded o_def id_def, THEN fun_cong] fg[OF \<open>z\<in>T\<close>]
         by (simp add: norm_minus_commute)
       also have "\<dots> \<le> norm (f (g z) - y - f' (g z - g y)) * C"
         by (rule C(2))
       also have "\<dots> \<le> (e / C) * norm (g z - g y) * C"
       proof -
         have "norm (g z - g y) < d0"
           by (metis as cancel_comm_monoid_add_class.diff_cancel d(2) \<open>0 < d0\<close> d1 diff_gt_0_iff_gt diff_strict_mono dist_norm dist_self zero_less_dist_iff)
         then show ?thesis
           by (metis C(1) \<open>y \<in> T\<close> d0 fg mult_le_cancel_iff1)
       qed
       also have "\<dots> \<le> e * norm (g z - g y)"
         using C by (auto simp add: field_simps)
       finally show "norm (g z - g y - g' (z - y)) \<le> e * norm (g z - g y)"
         by simp
     qed (use d in auto)
   qed
   have *: "(0::real) < 1 / 2"
     by auto
   obtain d where "0 < d" and d:
       "\<And>z. norm (z - y) < d \<Longrightarrow> norm (g z - g y - g' (z - y)) \<le> 1/2 * norm (g z - g y)"
     using lem1 * by blast
   define B where "B = C * 2"
   have "B > 0"
     unfolding B_def using C by auto
   have lem2: "norm (g z - g y) \<le> B * norm (z - y)" if z: "norm(z - y) < d" for z
   proof -
     have "norm (g z - g y) \<le> norm(g' (z - y)) + norm ((g z - g y) - g'(z - y))"
       by (rule norm_triangle_sub)
     also have "\<dots> \<le> norm (g' (z - y)) + 1 / 2 * norm (g z - g y)"
       by (rule add_left_mono) (use d z in auto)
     also have "\<dots> \<le> norm (z - y) * C + 1 / 2 * norm (g z - g y)"
       by (rule add_right_mono) (use C in auto)
     finally show "norm (g z - g y) \<le> B * norm (z - y)"
       unfolding B_def
       by (auto simp add: field_simps)
   qed
   show ?thesis
     unfolding has_derivative_at_alt
   proof (intro conjI assms allI impI)
     fix e :: real
     assume "e > 0"
     then have *: "e / B > 0" by (metis \<open>B > 0\<close> divide_pos_pos)
     obtain d' where "0 < d'" and d':
         "\<And>z. norm (z - y) < d' \<Longrightarrow> norm (g z - g y - g' (z - y)) \<le> e / B * norm (g z - g y)"
       using lem1 * by blast
     obtain k where k: "0 < k" "k < d" "k < d'"
       using field_lbound_gt_zero[OF \<open>0 < d\<close> \<open>0 < d'\<close>] by blast
     show "\<exists>d>0. \<forall>ya. norm (ya - y) < d \<longrightarrow> norm (g ya - g y - g' (ya - y)) \<le> e * norm (ya - y)"
     proof (intro exI allI impI conjI)
       fix z
       assume as: "norm (z - y) < k"
       then have "norm (g z - g y - g' (z - y)) \<le> e / B * norm(g z - g y)"
         using d' k by auto
       also have "\<dots> \<le> e * norm (z - y)"
         unfolding times_divide_eq_left pos_divide_le_eq[OF \<open>B>0\<close>]
         using lem2[of z] k as \<open>e > 0\<close>
         by (auto simp add: field_simps)
       finally show "norm (g z - g y - g' (z - y)) \<le> e * norm (z - y)"
         by simp
     qed (use k in auto)
   qed
 qed
 
 text\<^marker>\<open>tag unimportant\<close>\<open>Inverse function theorem for complex derivatives\<close>
 lemma has_field_derivative_inverse_basic:
   shows "DERIV f (g y) :> f' \<Longrightarrow>
         f' \<noteq> 0 \<Longrightarrow>
         continuous (at y) g \<Longrightarrow>
         open t \<Longrightarrow>
         y \<in> t \<Longrightarrow>
         (\<And>z. z \<in> t \<Longrightarrow> f (g z) = z)
         \<Longrightarrow> DERIV g y :> inverse (f')"
   unfolding has_field_derivative_def
   apply (rule has_derivative_inverse_basic)
   apply (auto simp:  bounded_linear_mult_right)
   done
 
 text \<open>Simply rewrite that based on the domain point x.\<close>
 
 lemma has_derivative_inverse_basic_x:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
     and "continuous (at (f x)) g"
     and "g (f x) = x"
     and "open T"
     and "f x \<in> T"
     and "\<And>y. y \<in> T \<Longrightarrow> f (g y) = y"
   shows "(g has_derivative g') (at (f x))"
   by (rule has_derivative_inverse_basic) (use assms in auto)
 
 text \<open>This is the version in Dieudonne', assuming continuity of f and g.\<close>
 
 lemma has_derivative_inverse_dieudonne:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "open S"
     and "open (f ` S)"
     and "continuous_on S f"
     and "continuous_on (f ` S) g"
     and "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and "x \<in> S"
     and "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
   shows "(g has_derivative g') (at (f x))"
   apply (rule has_derivative_inverse_basic_x[OF assms(7-9) _ _ assms(2)])
   using assms(3-6)
   unfolding continuous_on_eq_continuous_at[OF assms(1)] continuous_on_eq_continuous_at[OF assms(2)]
   apply auto
   done
 
 text \<open>Here's the simplest way of not assuming much about g.\<close>
 
 proposition has_derivative_inverse:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "compact S"
     and "x \<in> S"
     and fx: "f x \<in> interior (f ` S)"
     and "continuous_on S f"
     and gf: "\<And>y. y \<in> S \<Longrightarrow> g (f y) = y"
     and "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
   shows "(g has_derivative g') (at (f x))"
 proof -
   have *: "\<And>y. y \<in> interior (f ` S) \<Longrightarrow> f (g y) = y"
     by (metis gf image_iff interior_subset subsetCE)
   show ?thesis
     apply (rule has_derivative_inverse_basic_x[OF assms(6-8), where T = "interior (f ` S)"])
     apply (rule continuous_on_interior[OF _ fx])
     apply (rule continuous_on_inv)
     apply (simp_all add: assms *)
     done
 qed
 
 
 text \<open>Invertible derivative continuous at a point implies local
 injectivity. It's only for this we need continuity of the derivative,
 except of course if we want the fact that the inverse derivative is
 also continuous. So if we know for some other reason that the inverse
 function exists, it's OK.\<close>
 
 proposition has_derivative_locally_injective:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes "a \<in> S"
       and "open S"
       and bling: "bounded_linear g'"
       and "g' \<circ> f' a = id"
       and derf: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x)"
       and "\<And>e. e > 0 \<Longrightarrow> \<exists>d>0. \<forall>x. dist a x < d \<longrightarrow> onorm (\<lambda>v. f' x v - f' a v) < e"
   obtains r where "r > 0" "ball a r \<subseteq> S" "inj_on f (ball a r)"
 proof -
   interpret bounded_linear g'
     using assms by auto
   note f'g' = assms(4)[unfolded id_def o_def,THEN cong]
   have "g' (f' a (\<Sum>Basis)) = (\<Sum>Basis)" "(\<Sum>Basis) \<noteq> (0::'n)"
     using f'g' by auto
   then have *: "0 < onorm g'"
     unfolding onorm_pos_lt[OF assms(3)]
     by fastforce
   define k where "k = 1 / onorm g' / 2"
   have *: "k > 0"
     unfolding k_def using * by auto
   obtain d1 where d1:
       "0 < d1"
       "\<And>x. dist a x < d1 \<Longrightarrow> onorm (\<lambda>v. f' x v - f' a v) < k"
     using assms(6) * by blast
   from \<open>open S\<close> obtain d2 where "d2 > 0" "ball a d2 \<subseteq> S"
     using \<open>a\<in>S\<close> ..
   obtain d2 where d2: "0 < d2" "ball a d2 \<subseteq> S"
     using \<open>0 < d2\<close> \<open>ball a d2 \<subseteq> S\<close> by blast
   obtain d where d: "0 < d" "d < d1" "d < d2"
     using field_lbound_gt_zero[OF d1(1) d2(1)] by blast
   show ?thesis
   proof
     show "0 < d" by (fact d)
     show "ball a d \<subseteq> S"
       using \<open>d < d2\<close> \<open>ball a d2 \<subseteq> S\<close> by auto
     show "inj_on f (ball a d)"
     unfolding inj_on_def
     proof (intro strip)
       fix x y
       assume as: "x \<in> ball a d" "y \<in> ball a d" "f x = f y"
       define ph where [abs_def]: "ph w = w - g' (f w - f x)" for w
       have ph':"ph = g' \<circ> (\<lambda>w. f' a w - (f w - f x))"
         unfolding ph_def o_def  by (simp add: diff f'g')
       have "norm (ph x - ph y) \<le> (1 / 2) * norm (x - y)"
       proof (rule differentiable_bound[OF convex_ball _ _ as(1-2)])
         fix u
         assume u: "u \<in> ball a d"
         then have "u \<in> S"
           using d d2 by auto
         have *: "(\<lambda>v. v - g' (f' u v)) = g' \<circ> (\<lambda>w. f' a w - f' u w)"
           unfolding o_def and diff
           using f'g' by auto
         have blin: "bounded_linear (f' a)"
           using \<open>a \<in> S\<close> derf by blast
         show "(ph has_derivative (\<lambda>v. v - g' (f' u v))) (at u within ball a d)"
           unfolding ph' * comp_def
           by (rule \<open>u \<in> S\<close> derivative_eq_intros has_derivative_at_withinI [OF derf] bounded_linear.has_derivative [OF blin]  bounded_linear.has_derivative [OF bling] |simp)+
         have **: "bounded_linear (\<lambda>x. f' u x - f' a x)" "bounded_linear (\<lambda>x. f' a x - f' u x)"
           using \<open>u \<in> S\<close> blin bounded_linear_sub derf by auto
         then have "onorm (\<lambda>v. v - g' (f' u v)) \<le> onorm g' * onorm (\<lambda>w. f' a w - f' u w)"
           by (simp add: "*" bounded_linear_axioms onorm_compose)
         also have "\<dots> \<le> onorm g' * k"
           apply (rule mult_left_mono)
           using d1(2)[of u]
           using onorm_neg[where f="\<lambda>x. f' u x - f' a x"] d u onorm_pos_le[OF bling] apply (auto simp: algebra_simps)
           done
         also have "\<dots> \<le> 1 / 2"
           unfolding k_def by auto
         finally show "onorm (\<lambda>v. v - g' (f' u v)) \<le> 1 / 2" .
       qed
       moreover have "norm (ph y - ph x) = norm (y - x)"
         by (simp add: as(3) ph_def)
       ultimately show "x = y"
         unfolding norm_minus_commute by auto
     qed
   qed
 qed
 
 
 subsection \<open>Uniformly convergent sequence of derivatives\<close>
 
 lemma has_derivative_sequence_lipschitz_lemma:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and derf: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>n x h. \<lbrakk>n\<ge>N; x \<in> S\<rbrakk> \<Longrightarrow> norm (f' n x h - g' x h) \<le> e * norm h"
     and "0 \<le> e"
   shows "\<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm ((f m x - f n x) - (f m y - f n y)) \<le> 2 * e * norm (x - y)"
 proof clarify
   fix m n x y
   assume as: "N \<le> m" "N \<le> n" "x \<in> S" "y \<in> S"
   show "norm ((f m x - f n x) - (f m y - f n y)) \<le> 2 * e * norm (x - y)"
   proof (rule differentiable_bound[where f'="\<lambda>x h. f' m x h - f' n x h", OF \<open>convex S\<close> _ _ as(3-4)])
     fix x
     assume "x \<in> S"
     show "((\<lambda>a. f m a - f n a) has_derivative (\<lambda>h. f' m x h - f' n x h)) (at x within S)"
       by (rule derivative_intros derf \<open>x\<in>S\<close>)+
     show "onorm (\<lambda>h. f' m x h - f' n x h) \<le> 2 * e"
     proof (rule onorm_bound)
       fix h
       have "norm (f' m x h - f' n x h) \<le> norm (f' m x h - g' x h) + norm (f' n x h - g' x h)"
         using norm_triangle_ineq[of "f' m x h - g' x h" "- f' n x h + g' x h"]
         by (auto simp add: algebra_simps norm_minus_commute)
       also have "\<dots> \<le> e * norm h + e * norm h"
         using nle[OF \<open>N \<le> m\<close> \<open>x \<in> S\<close>, of h] nle[OF \<open>N \<le> n\<close> \<open>x \<in> S\<close>, of h]
         by (auto simp add: field_simps)
       finally show "norm (f' m x h - f' n x h) \<le> 2 * e * norm h"
         by auto
     qed (simp add: \<open>0 \<le> e\<close>)
   qed
 qed
 
 lemma has_derivative_sequence_Lipschitz:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
     and "e > 0"
   shows "\<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S.
     norm ((f m x - f n x) - (f m y - f n y)) \<le> e * norm (x - y)"
 proof -
   have *: "2 * (e/2) = e"
     using \<open>e > 0\<close> by auto
   obtain N where "\<forall>n\<ge>N. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> (e/2) * norm h"
     using nle \<open>e > 0\<close>
     unfolding eventually_sequentially
     by (metis less_divide_eq_numeral1(1) mult_zero_left)
   then show "\<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f m x - f n x - (f m y - f n y)) \<le> e * norm (x - y)"
     apply (rule_tac x=N in exI)
     apply (rule has_derivative_sequence_lipschitz_lemma[where e="e/2", unfolded *])
     using assms \<open>e > 0\<close>
     apply auto
     done
 qed
 
 proposition has_derivative_sequence:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and derf: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
     and "x0 \<in> S"
     and lim: "((\<lambda>n. f n x0) \<longlongrightarrow> l) sequentially"
   shows "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) \<longlonglongrightarrow> g x \<and> (g has_derivative g'(x)) (at x within S)"
 proof -
   have lem1: "\<And>e. e > 0 \<Longrightarrow> \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S.
       norm ((f m x - f n x) - (f m y - f n y)) \<le> e * norm (x - y)"
     using assms(1,2,3) by (rule has_derivative_sequence_Lipschitz)
   have "\<exists>g. \<forall>x\<in>S. ((\<lambda>n. f n x) \<longlongrightarrow> g x) sequentially"
   proof (intro ballI bchoice)
     fix x
     assume "x \<in> S"
     show "\<exists>y. (\<lambda>n. f n x) \<longlonglongrightarrow> y"
     unfolding convergent_eq_Cauchy
     proof (cases "x = x0")
       case True
       then show "Cauchy (\<lambda>n. f n x)"
         using LIMSEQ_imp_Cauchy[OF lim] by auto
     next
       case False
       show "Cauchy (\<lambda>n. f n x)"
         unfolding Cauchy_def
       proof (intro allI impI)
         fix e :: real
         assume "e > 0"
         hence *: "e / 2 > 0" "e / 2 / norm (x - x0) > 0" using False by auto
         obtain M where M: "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m x0) (f n x0) < e / 2"
           using LIMSEQ_imp_Cauchy[OF lim] * unfolding Cauchy_def by blast
         obtain N where N:
           "\<forall>m\<ge>N. \<forall>n\<ge>N.
             \<forall>u\<in>S. \<forall>y\<in>S. norm (f m u - f n u - (f m y - f n y)) \<le>
               e / 2 / norm (x - x0) * norm (u - y)"
         using lem1 *(2) by blast
         show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m x) (f n x) < e"
         proof (intro exI allI impI)
           fix m n
           assume as: "max M N \<le>m" "max M N\<le>n"
           have "dist (f m x) (f n x) \<le> norm (f m x0 - f n x0) + norm (f m x - f n x - (f m x0 - f n x0))"
             unfolding dist_norm
             by (rule norm_triangle_sub)
           also have "\<dots> \<le> norm (f m x0 - f n x0) + e / 2"
             using N \<open>x\<in>S\<close> \<open>x0\<in>S\<close> as False by fastforce
           also have "\<dots> < e / 2 + e / 2"
             by (rule add_strict_right_mono) (use as M in \<open>auto simp: dist_norm\<close>)
           finally show "dist (f m x) (f n x) < e"
             by auto
         qed
       qed
     qed
   qed
   then obtain g where g: "\<forall>x\<in>S. (\<lambda>n. f n x) \<longlonglongrightarrow> g x" ..
   have lem2: "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm ((f n x - f n y) - (g x - g y)) \<le> e * norm (x - y)" if "e > 0" for e
   proof -
     obtain N where
       N: "\<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f m x - f n x - (f m y - f n y)) \<le> e * norm (x - y)"
       using lem1 \<open>e > 0\<close> by blast
     show "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f n x - f n y - (g x - g y)) \<le> e * norm (x - y)"
     proof (intro exI ballI allI impI)
       fix n x y
       assume as: "N \<le> n" "x \<in> S" "y \<in> S"
       have "((\<lambda>m. norm (f n x - f n y - (f m x - f m y))) \<longlongrightarrow> norm (f n x - f n y - (g x - g y))) sequentially"
         by (intro tendsto_intros g[rule_format] as)
       moreover have "eventually (\<lambda>m. norm (f n x - f n y - (f m x - f m y)) \<le> e * norm (x - y)) sequentially"
         unfolding eventually_sequentially
       proof (intro exI allI impI)
         fix m
         assume "N \<le> m"
         then show "norm (f n x - f n y - (f m x - f m y)) \<le> e * norm (x - y)"
           using N as by (auto simp add: algebra_simps)
       qed
       ultimately show "norm (f n x - f n y - (g x - g y)) \<le> e * norm (x - y)"
         by (simp add: tendsto_upperbound)
     qed
   qed
   have "\<forall>x\<in>S. ((\<lambda>n. f n x) \<longlongrightarrow> g x) sequentially \<and> (g has_derivative g' x) (at x within S)"
     unfolding has_derivative_within_alt2
   proof (intro ballI conjI allI impI)
     fix x
     assume "x \<in> S"
     then show "(\<lambda>n. f n x) \<longlonglongrightarrow> g x"
       by (simp add: g)
     have tog': "(\<lambda>n. f' n x u) \<longlonglongrightarrow> g' x u" for u
       unfolding filterlim_def le_nhds_metric_le eventually_filtermap dist_norm
     proof (intro allI impI)
       fix e :: real
       assume "e > 0"
       show "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e) sequentially"
       proof (cases "u = 0")
         case True
         have "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e * norm u) sequentially"
           using nle \<open>0 < e\<close> \<open>x \<in> S\<close> by (fast elim: eventually_mono)
         then show ?thesis
           using \<open>u = 0\<close> \<open>0 < e\<close> by (auto elim: eventually_mono)
       next
         case False
         with \<open>0 < e\<close> have "0 < e / norm u" by simp
         then have "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e / norm u * norm u) sequentially"
           using nle \<open>x \<in> S\<close> by (fast elim: eventually_mono)
         then show ?thesis
           using \<open>u \<noteq> 0\<close> by simp
       qed
     qed
     show "bounded_linear (g' x)"
     proof
       fix x' y z :: 'a
       fix c :: real
       note lin = assms(2)[rule_format,OF \<open>x\<in>S\<close>,THEN has_derivative_bounded_linear]
       show "g' x (c *\<^sub>R x') = c *\<^sub>R g' x x'"
         apply (rule tendsto_unique[OF trivial_limit_sequentially tog'])
         unfolding lin[THEN bounded_linear.linear, THEN linear_cmul]
         apply (intro tendsto_intros tog')
         done
       show "g' x (y + z) = g' x y + g' x z"
         apply (rule tendsto_unique[OF trivial_limit_sequentially tog'])
         unfolding lin[THEN bounded_linear.linear, THEN linear_add]
         apply (rule tendsto_add)
         apply (rule tog')+
         done
       obtain N where N: "\<forall>h. norm (f' N x h - g' x h) \<le> 1 * norm h"
         using nle \<open>x \<in> S\<close> unfolding eventually_sequentially by (fast intro: zero_less_one)
       have "bounded_linear (f' N x)"
         using derf \<open>x \<in> S\<close> by fast
       from bounded_linear.bounded [OF this]
       obtain K where K: "\<forall>h. norm (f' N x h) \<le> norm h * K" ..
       {
         fix h
         have "norm (g' x h) = norm (f' N x h - (f' N x h - g' x h))"
           by simp
         also have "\<dots> \<le> norm (f' N x h) + norm (f' N x h - g' x h)"
           by (rule norm_triangle_ineq4)
         also have "\<dots> \<le> norm h * K + 1 * norm h"
           using N K by (fast intro: add_mono)
         finally have "norm (g' x h) \<le> norm h * (K + 1)"
           by (simp add: ring_distribs)
       }
       then show "\<exists>K. \<forall>h. norm (g' x h) \<le> norm h * K" by fast
     qed
     show "eventually (\<lambda>y. norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)) (at x within S)"
       if "e > 0" for e
     proof -
       have *: "e / 3 > 0"
         using that by auto
       obtain N1 where N1: "\<forall>n\<ge>N1. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e / 3 * norm h"
         using nle * unfolding eventually_sequentially by blast
       obtain N2 where
           N2[rule_format]: "\<forall>n\<ge>N2. \<forall>x\<in>S. \<forall>y\<in>S. norm (f n x - f n y - (g x - g y)) \<le> e / 3 * norm (x - y)"
         using lem2 * by blast
       let ?N = "max N1 N2"
       have "eventually (\<lambda>y. norm (f ?N y - f ?N x - f' ?N x (y - x)) \<le> e / 3 * norm (y - x)) (at x within S)"
         using derf[unfolded has_derivative_within_alt2] and \<open>x \<in> S\<close> and * by fast
       moreover have "eventually (\<lambda>y. y \<in> S) (at x within S)"
         unfolding eventually_at by (fast intro: zero_less_one)
       ultimately show "\<forall>\<^sub>F y in at x within S. norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)"
       proof (rule eventually_elim2)
         fix y
         assume "y \<in> S"
         assume "norm (f ?N y - f ?N x - f' ?N x (y - x)) \<le> e / 3 * norm (y - x)"
         moreover have "norm (g y - g x - (f ?N y - f ?N x)) \<le> e / 3 * norm (y - x)"
           using N2[OF _ \<open>y \<in> S\<close> \<open>x \<in> S\<close>]
           by (simp add: norm_minus_commute)
         ultimately have "norm (g y - g x - f' ?N x (y - x)) \<le> 2 * e / 3 * norm (y - x)"
           using norm_triangle_le[of "g y - g x - (f ?N y - f ?N x)" "f ?N y - f ?N x - f' ?N x (y - x)" "2 * e / 3 * norm (y - x)"]
           by (auto simp add: algebra_simps)
         moreover
         have " norm (f' ?N x (y - x) - g' x (y - x)) \<le> e / 3 * norm (y - x)"
           using N1 \<open>x \<in> S\<close> by auto
         ultimately show "norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)"
           using norm_triangle_le[of "g y - g x - f' (max N1 N2) x (y - x)" "f' (max N1 N2) x (y - x) - g' x (y - x)"]
           by (auto simp add: algebra_simps)
       qed
     qed
   qed
   then show ?thesis by fast
 qed
 
 text \<open>Can choose to line up antiderivatives if we want.\<close>
 
 lemma has_antiderivative_sequence:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and der: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and no: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially.
        \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
   shows "\<exists>g. \<forall>x\<in>S. (g has_derivative g' x) (at x within S)"
 proof (cases "S = {}")
   case False
   then obtain a where "a \<in> S"
     by auto
   have *: "\<And>P Q. \<exists>g. \<forall>x\<in>S. P g x \<and> Q g x \<Longrightarrow> \<exists>g. \<forall>x\<in>S. Q g x"
     by auto
   show ?thesis
     apply (rule *)
     apply (rule has_derivative_sequence [OF \<open>convex S\<close> _ no, of "\<lambda>n x. f n x + (f 0 a - f n a)"])
        apply (metis assms(2) has_derivative_add_const)
     using \<open>a \<in> S\<close> 
       apply auto
     done
 qed auto
 
 lemma has_antiderivative_limit:
   fixes g' :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'b::banach"
   assumes "convex S"
     and "\<And>e. e>0 \<Longrightarrow> \<exists>f f'. \<forall>x\<in>S.
            (f has_derivative (f' x)) (at x within S) \<and> (\<forall>h. norm (f' x h - g' x h) \<le> e * norm h)"
   shows "\<exists>g. \<forall>x\<in>S. (g has_derivative g' x) (at x within S)"
 proof -
   have *: "\<forall>n. \<exists>f f'. \<forall>x\<in>S.
     (f has_derivative (f' x)) (at x within S) \<and>
     (\<forall>h. norm(f' x h - g' x h) \<le> inverse (real (Suc n)) * norm h)"
     by (simp add: assms(2))
   obtain f where
     *: "\<And>x. \<exists>f'. \<forall>xa\<in>S. (f x has_derivative f' xa) (at xa within S) \<and>
         (\<forall>h. norm (f' xa h - g' xa h) \<le> inverse (real (Suc x)) * norm h)"
     using * by metis
   obtain f' where
     f': "\<And>x. \<forall>z\<in>S. (f x has_derivative f' x z) (at z within S) \<and>
             (\<forall>h. norm (f' x z h - g' z h) \<le> inverse (real (Suc x)) * norm h)"
     using * by metis
   show ?thesis
   proof (rule has_antiderivative_sequence[OF \<open>convex S\<close>, of f f'])
     fix e :: real
     assume "e > 0"
     obtain N where N: "inverse (real (Suc N)) < e"
       using reals_Archimedean[OF \<open>e>0\<close>] ..
     show "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>S.  \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
         unfolding eventually_sequentially
     proof (intro exI allI ballI impI)
       fix n x h
       assume n: "N \<le> n" and x: "x \<in> S"
       have *: "inverse (real (Suc n)) \<le> e"
         apply (rule order_trans[OF _ N[THEN less_imp_le]])
         using n apply (auto simp add: field_simps)
         done
       show "norm (f' n x h - g' x h) \<le> e * norm h"
         by (meson "*" mult_right_mono norm_ge_zero order.trans x f')
     qed
   qed (use f' in auto)
 qed
 
 
 subsection \<open>Differentiation of a series\<close>
 
 proposition has_derivative_series:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and "\<And>e. e>0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (sum (\<lambda>i. f' i x h) {..<n} - g' x h) \<le> e * norm h"
     and "x \<in> S"
     and "(\<lambda>n. f n x) sums l"
   shows "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums (g x) \<and> (g has_derivative g' x) (at x within S)"
   unfolding sums_def
   apply (rule has_derivative_sequence[OF assms(1) _ assms(3)])
   apply (metis assms(2) has_derivative_sum)
   using assms(4-5)
   unfolding sums_def
   apply auto
   done
 
 lemma has_field_derivative_series:
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x within S)"
   assumes "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)"
   shows   "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
 unfolding has_field_derivative_def
 proof (rule has_derivative_series)
   show "\<forall>\<^sub>F n in sequentially.
        \<forall>x\<in>S. \<forall>h. norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" if "e > 0" for e
     unfolding eventually_sequentially
   proof -
     from that assms(3) obtain N where N: "\<And>n x. n \<ge> N \<Longrightarrow> x \<in> S \<Longrightarrow> norm ((\<Sum>i<n. f' i x) - g' x) < e"
       unfolding uniform_limit_iff eventually_at_top_linorder dist_norm by blast
     {
       fix n :: nat and x h :: 'a assume nx: "n \<ge> N" "x \<in> S"
       have "norm ((\<Sum>i<n. f' i x * h) - g' x * h) = norm ((\<Sum>i<n. f' i x) - g' x) * norm h"
         by (simp add: norm_mult [symmetric] ring_distribs sum_distrib_right)
       also from N[OF nx] have "norm ((\<Sum>i<n. f' i x) - g' x) \<le> e" by simp
       hence "norm ((\<Sum>i<n. f' i x) - g' x) * norm h \<le> e * norm h"
         by (intro mult_right_mono) simp_all
       finally have "norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" .
     }
     thus "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>h. norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" by blast
   qed
 qed (use assms in \<open>auto simp: has_field_derivative_def\<close>)
 
 lemma has_field_derivative_series':
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x within S)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" "x \<in> interior S"
   shows   "summable (\<lambda>n. f n x)" "((\<lambda>x. \<Sum>n. f n x) has_field_derivative (\<Sum>n. f' n x)) (at x)"
 proof -
   from \<open>x \<in> interior S\<close> have "x \<in> S" using interior_subset by blast
   define g' where [abs_def]: "g' x = (\<Sum>i. f' i x)" for x
   from assms(3) have "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
     by (simp add: uniformly_convergent_uniform_limit_iff suminf_eq_lim g'_def)
   from has_field_derivative_series[OF assms(1,2) this assms(4,5)] obtain g where g:
     "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
     "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
   from g(1)[OF \<open>x \<in> S\<close>] show "summable (\<lambda>n. f n x)" by (simp add: sums_iff)
   from g(2)[OF \<open>x \<in> S\<close>] \<open>x \<in> interior S\<close> have "(g has_field_derivative g' x) (at x)"
     by (simp add: at_within_interior[of x S])
   also have "(g has_field_derivative g' x) (at x) \<longleftrightarrow>
                 ((\<lambda>x. \<Sum>n. f n x) has_field_derivative g' x) (at x)"
     using eventually_nhds_in_nhd[OF \<open>x \<in> interior S\<close>] interior_subset[of S] g(1)
     by (intro DERIV_cong_ev) (auto elim!: eventually_mono simp: sums_iff)
   finally show "((\<lambda>x. \<Sum>n. f n x) has_field_derivative g' x) (at x)" .
 qed
 
 lemma differentiable_series:
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S" "open S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" and x: "x \<in> S"
   shows   "summable (\<lambda>n. f n x)" and "(\<lambda>x. \<Sum>n. f n x) differentiable (at x)"
 proof -
   from assms(4) obtain g' where A: "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
     unfolding uniformly_convergent_on_def by blast
   from x and \<open>open S\<close> have S: "at x within S = at x" by (rule at_within_open)
   have "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
     by (intro has_field_derivative_series[of S f f' g' x0] assms A has_field_derivative_at_within)
   then obtain g where g: "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
     "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
   from g[OF x] show "summable (\<lambda>n. f n x)" by (auto simp: summable_def)
   from g(2)[OF x] have g': "(g has_derivative (*) (g' x)) (at x)"
     by (simp add: has_field_derivative_def S)
   have "((\<lambda>x. \<Sum>n. f n x) has_derivative (*) (g' x)) (at x)"
     by (rule has_derivative_transform_within_open[OF g' \<open>open S\<close> x])
        (insert g, auto simp: sums_iff)
   thus "(\<lambda>x. \<Sum>n. f n x) differentiable (at x)" unfolding differentiable_def
     by (auto simp: summable_def differentiable_def has_field_derivative_def)
 qed
 
 lemma differentiable_series':
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S" "open S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)"
   shows   "(\<lambda>x. \<Sum>n. f n x) differentiable (at x0)"
   using differentiable_series[OF assms, of x0] \<open>x0 \<in> S\<close> by blast+
 
 subsection \<open>Derivative as a vector\<close>
 
 text \<open>Considering derivative \<^typ>\<open>real \<Rightarrow> 'b::real_normed_vector\<close> as a vector.\<close>
 
 definition "vector_derivative f net = (SOME f'. (f has_vector_derivative f') net)"
 
 lemma vector_derivative_unique_within:
   assumes not_bot: "at x within S \<noteq> bot"
     and f': "(f has_vector_derivative f') (at x within S)"
     and f'': "(f has_vector_derivative f'') (at x within S)"
   shows "f' = f''"
 proof -
   have "(\<lambda>x. x *\<^sub>R f') = (\<lambda>x. x *\<^sub>R f'')"
   proof (rule frechet_derivative_unique_within, simp_all)
     show "\<exists>d. d \<noteq> 0 \<and> \<bar>d\<bar> < e \<and> x + d \<in> S" if "0 < e"  for e
     proof -
       from that
       obtain x' where "x' \<in> S" "x' \<noteq> x" "\<bar>x' - x\<bar> < e"
         using islimpt_approachable_real[of x S] not_bot
         by (auto simp add: trivial_limit_within)
       then show ?thesis
         using eq_iff_diff_eq_0 by fastforce
     qed
   qed (use f' f'' in \<open>auto simp: has_vector_derivative_def\<close>)
   then show ?thesis
     unfolding fun_eq_iff by (metis scaleR_one)
 qed
 
 lemma vector_derivative_unique_at:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> (f has_vector_derivative f'') (at x) \<Longrightarrow> f' = f''"
   by (rule vector_derivative_unique_within) auto
 
 lemma differentiableI_vector: "(f has_vector_derivative y) F \<Longrightarrow> f differentiable F"
   by (auto simp: differentiable_def has_vector_derivative_def)
 
 proposition vector_derivative_works:
   "f differentiable net \<longleftrightarrow> (f has_vector_derivative (vector_derivative f net)) net"
     (is "?l = ?r")
 proof
   assume ?l
   obtain f' where f': "(f has_derivative f') net"
     using \<open>?l\<close> unfolding differentiable_def ..
   then interpret bounded_linear f'
     by auto
   show ?r
     unfolding vector_derivative_def has_vector_derivative_def
     by (rule someI[of _ "f' 1"]) (simp add: scaleR[symmetric] f')
 qed (auto simp: vector_derivative_def has_vector_derivative_def differentiable_def)
 
 lemma vector_derivative_within:
   assumes not_bot: "at x within S \<noteq> bot" and y: "(f has_vector_derivative y) (at x within S)"
   shows "vector_derivative f (at x within S) = y"
   using y
   by (intro vector_derivative_unique_within[OF not_bot vector_derivative_works[THEN iffD1] y])
      (auto simp: differentiable_def has_vector_derivative_def)
 
 lemma frechet_derivative_eq_vector_derivative:
   assumes "f differentiable (at x)"
     shows  "(frechet_derivative f (at x)) = (\<lambda>r. r *\<^sub>R vector_derivative f (at x))"
 using assms
 by (auto simp: differentiable_iff_scaleR vector_derivative_def has_vector_derivative_def
          intro: someI frechet_derivative_at [symmetric])
 
 lemma has_real_derivative:
   fixes f :: "real \<Rightarrow> real"
   assumes "(f has_derivative f') F"
   obtains c where "(f has_real_derivative c) F"
 proof -
   obtain c where "f' = (\<lambda>x. x * c)"
     by (metis assms has_derivative_bounded_linear real_bounded_linear)
   then show ?thesis
     by (metis assms that has_field_derivative_def mult_commute_abs)
 qed
 
 lemma has_real_derivative_iff:
   fixes f :: "real \<Rightarrow> real"
   shows "(\<exists>c. (f has_real_derivative c) F) = (\<exists>D. (f has_derivative D) F)"
   by (metis has_field_derivative_def has_real_derivative)
 
 lemma has_vector_derivative_cong_ev:
   assumes *: "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x = g x) (nhds x)" "f x = g x"
   shows "(f has_vector_derivative f') (at x within S) = (g has_vector_derivative f') (at x within S)"
   unfolding has_vector_derivative_def has_derivative_def
   using *
   apply (cases "at x within S \<noteq> bot")
   apply (intro refl conj_cong filterlim_cong)
   apply (auto simp: Lim_ident_at eventually_at_filter elim: eventually_mono)
   done
 
 lemma islimpt_closure_open:
   fixes s :: "'a::perfect_space set"
   assumes "open s" and t: "t = closure s" "x \<in> t"
   shows "x islimpt t"
 proof cases
   assume "x \<in> s"
   { fix T assume "x \<in> T" "open T"
     then have "open (s \<inter> T)"
       using \<open>open s\<close> by auto
     then have "s \<inter> T \<noteq> {x}"
       using not_open_singleton[of x] by auto
     with \<open>x \<in> T\<close> \<open>x \<in> s\<close> have "\<exists>y\<in>t. y \<in> T \<and> y \<noteq> x"
       using closure_subset[of s] by (auto simp: t) }
   then show ?thesis
     by (auto intro!: islimptI)
 next
   assume "x \<notin> s" with t show ?thesis
     unfolding t closure_def by (auto intro: islimpt_subset)
 qed
 
 lemma vector_derivative_unique_within_closed_interval:
   assumes ab: "a < b" "x \<in> cbox a b"
   assumes D: "(f has_vector_derivative f') (at x within cbox a b)" "(f has_vector_derivative f'') (at x within cbox a b)"
   shows "f' = f''"
   using ab
   by (intro vector_derivative_unique_within[OF _ D])
      (auto simp: trivial_limit_within intro!: islimpt_closure_open[where s="{a <..< b}"])
 
 lemma vector_derivative_at:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> vector_derivative f (at x) = f'"
   by (intro vector_derivative_within at_neq_bot)
 
 lemma has_vector_derivative_id_at [simp]: "vector_derivative (\<lambda>x. x) (at a) = 1"
   by (simp add: vector_derivative_at)
 
 lemma vector_derivative_minus_at [simp]:
   "f differentiable at a
    \<Longrightarrow> vector_derivative (\<lambda>x. - f x) (at a) = - vector_derivative f (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_minus vector_derivative_works [symmetric])
 
 lemma vector_derivative_add_at [simp]:
   "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x + g x) (at a) = vector_derivative f (at a) + vector_derivative g (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_add vector_derivative_works [symmetric])
 
 lemma vector_derivative_diff_at [simp]:
   "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x - g x) (at a) = vector_derivative f (at a) - vector_derivative g (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_diff vector_derivative_works [symmetric])
 
 lemma vector_derivative_mult_at [simp]:
   fixes f g :: "real \<Rightarrow> 'a :: real_normed_algebra"
   shows  "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x * g x) (at a) = f a * vector_derivative g (at a) + vector_derivative f (at a) * g a"
   by (simp add: vector_derivative_at has_vector_derivative_mult vector_derivative_works [symmetric])
 
 lemma vector_derivative_scaleR_at [simp]:
     "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x *\<^sub>R g x) (at a) = f a *\<^sub>R vector_derivative g (at a) + vector_derivative f (at a) *\<^sub>R g a"
 apply (rule vector_derivative_at)
 apply (rule has_vector_derivative_scaleR)
 apply (auto simp: vector_derivative_works has_vector_derivative_def has_field_derivative_def mult_commute_abs)
 done
 
 lemma vector_derivative_within_cbox:
   assumes ab: "a < b" "x \<in> cbox a b"
   assumes f: "(f has_vector_derivative f') (at x within cbox a b)"
   shows "vector_derivative f (at x within cbox a b) = f'"
   by (intro vector_derivative_unique_within_closed_interval[OF ab _ f]
             vector_derivative_works[THEN iffD1] differentiableI_vector)
      fact
 
 lemma vector_derivative_within_closed_interval:
   fixes f::"real \<Rightarrow> 'a::euclidean_space"
   assumes "a < b" and "x \<in> {a..b}"
   assumes "(f has_vector_derivative f') (at x within {a..b})"
   shows "vector_derivative f (at x within {a..b}) = f'"
   using assms vector_derivative_within_cbox
   by fastforce
 
 lemma has_vector_derivative_within_subset:
   "(f has_vector_derivative f') (at x within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f has_vector_derivative f') (at x within T)"
   by (auto simp: has_vector_derivative_def intro: has_derivative_subset)
 
 lemma has_vector_derivative_at_within:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> (f has_vector_derivative f') (at x within S)"
   unfolding has_vector_derivative_def
   by (rule has_derivative_at_withinI)
 
 lemma has_vector_derivative_weaken:
   fixes x D and f g S T
   assumes f: "(f has_vector_derivative D) (at x within T)"
     and "x \<in> S" "S \<subseteq> T"
     and "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   shows "(g has_vector_derivative D) (at x within S)"
 proof -
   have "(f has_vector_derivative D) (at x within S) \<longleftrightarrow> (g has_vector_derivative D) (at x within S)"
     unfolding has_vector_derivative_def has_derivative_iff_norm
     using assms by (intro conj_cong Lim_cong_within refl) auto
   then show ?thesis
     using has_vector_derivative_within_subset[OF f \<open>S \<subseteq> T\<close>] by simp
 qed
 
 lemma has_vector_derivative_transform_within:
   assumes "(f has_vector_derivative f') (at x within S)"
     and "0 < d"
     and "x \<in> S"
     and "\<And>x'. \<lbrakk>x'\<in>S; dist x' x < d\<rbrakk> \<Longrightarrow> f x' = g x'"
     shows "(g has_vector_derivative f') (at x within S)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform_within)
 
 lemma has_vector_derivative_transform_within_open:
   assumes "(f has_vector_derivative f') (at x)"
     and "open S"
     and "x \<in> S"
     and "\<And>y. y\<in>S \<Longrightarrow> f y = g y"
   shows "(g has_vector_derivative f') (at x)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform_within_open)
 
 lemma has_vector_derivative_transform:
   assumes "x \<in> S" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   assumes f': "(f has_vector_derivative f') (at x within S)"
   shows "(g has_vector_derivative f') (at x within S)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform)
 
 lemma vector_diff_chain_at:
   assumes "(f has_vector_derivative f') (at x)"
     and "(g has_vector_derivative g') (at (f x))"
   shows "((g \<circ> f) has_vector_derivative (f' *\<^sub>R g')) (at x)"
   using assms has_vector_derivative_at_within has_vector_derivative_def vector_derivative_diff_chain_within by blast
 
 lemma vector_diff_chain_within:
   assumes "(f has_vector_derivative f') (at x within s)"
     and "(g has_vector_derivative g') (at (f x) within f ` s)"
   shows "((g \<circ> f) has_vector_derivative (f' *\<^sub>R g')) (at x within s)"
   using assms has_vector_derivative_def vector_derivative_diff_chain_within by blast
 
 lemma vector_derivative_const_at [simp]: "vector_derivative (\<lambda>x. c) (at a) = 0"
   by (simp add: vector_derivative_at)
 
 lemma vector_derivative_at_within_ivl:
   "(f has_vector_derivative f') (at x) \<Longrightarrow>
     a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> a<b \<Longrightarrow> vector_derivative f (at x within {a..b}) = f'"
   using has_vector_derivative_at_within vector_derivative_within_cbox by fastforce
 
 lemma vector_derivative_chain_at:
   assumes "f differentiable at x" "(g differentiable at (f x))"
   shows "vector_derivative (g \<circ> f) (at x) =
          vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x))"
 by (metis vector_diff_chain_at vector_derivative_at vector_derivative_works assms)
 
 lemma field_vector_diff_chain_at:  (*thanks to Wenda Li*)
  assumes Df: "(f has_vector_derivative f') (at x)"
      and Dg: "(g has_field_derivative g') (at (f x))"
  shows "((g \<circ> f) has_vector_derivative (f' * g')) (at x)"
 using diff_chain_at[OF Df[unfolded has_vector_derivative_def]
                        Dg [unfolded has_field_derivative_def]]
  by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 lemma vector_derivative_chain_within: 
   assumes "at x within S \<noteq> bot" "f differentiable (at x within S)" 
     "(g has_derivative g') (at (f x) within f ` S)" 
   shows "vector_derivative (g \<circ> f) (at x within S) =
         g' (vector_derivative f (at x within S)) "
   apply (rule vector_derivative_within [OF \<open>at x within S \<noteq> bot\<close>])
   apply (rule vector_derivative_diff_chain_within)
   using assms(2-3) vector_derivative_works
   by auto
 
 subsection \<open>Field differentiability\<close>
 
 definition\<^marker>\<open>tag important\<close> field_differentiable :: "['a \<Rightarrow> 'a::real_normed_field, 'a filter] \<Rightarrow> bool"
            (infixr "(field'_differentiable)" 50)
   where "f field_differentiable F \<equiv> \<exists>f'. (f has_field_derivative f') F"
 
 lemma field_differentiable_imp_differentiable:
   "f field_differentiable F \<Longrightarrow> f differentiable F"
   unfolding field_differentiable_def differentiable_def 
   using has_field_derivative_imp_has_derivative by auto
 
 lemma field_differentiable_imp_continuous_at:
     "f field_differentiable (at x within S) \<Longrightarrow> continuous (at x within S) f"
   by (metis DERIV_continuous field_differentiable_def)
 
 lemma field_differentiable_within_subset:
     "\<lbrakk>f field_differentiable (at x within S); T \<subseteq> S\<rbrakk> \<Longrightarrow> f field_differentiable (at x within T)"
   by (metis DERIV_subset field_differentiable_def)
 
 lemma field_differentiable_at_within:
     "\<lbrakk>f field_differentiable (at x)\<rbrakk>
      \<Longrightarrow> f field_differentiable (at x within S)"
   unfolding field_differentiable_def
   by (metis DERIV_subset top_greatest)
 
 lemma field_differentiable_linear [simp,derivative_intros]: "((*) c) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def mult_commute_abs
   by (force intro: has_derivative_mult_right)
 
 lemma field_differentiable_const [simp,derivative_intros]: "(\<lambda>z. c) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def
   using DERIV_const has_field_derivative_imp_has_derivative by blast
 
 lemma field_differentiable_ident [simp,derivative_intros]: "(\<lambda>z. z) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def
   using DERIV_ident has_field_derivative_def by blast
 
 lemma field_differentiable_id [simp,derivative_intros]: "id field_differentiable F"
   unfolding id_def by (rule field_differentiable_ident)
 
 lemma field_differentiable_minus [derivative_intros]:
   "f field_differentiable F \<Longrightarrow> (\<lambda>z. - (f z)) field_differentiable F"
   unfolding field_differentiable_def
   by (metis field_differentiable_minus)
 
 lemma field_differentiable_add [derivative_intros]:
   assumes "f field_differentiable F" "g field_differentiable F"
     shows "(\<lambda>z. f z + g z) field_differentiable F"
   using assms unfolding field_differentiable_def
   by (metis field_differentiable_add)
 
 lemma field_differentiable_add_const [simp,derivative_intros]:
      "(+) c field_differentiable F"
   by (simp add: field_differentiable_add)
 
 lemma field_differentiable_sum [derivative_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i) field_differentiable F) \<Longrightarrow> (\<lambda>z. \<Sum>i\<in>I. f i z) field_differentiable F"
   by (induct I rule: infinite_finite_induct)
      (auto intro: field_differentiable_add field_differentiable_const)
 
 lemma field_differentiable_diff [derivative_intros]:
   assumes "f field_differentiable F" "g field_differentiable F"
     shows "(\<lambda>z. f z - g z) field_differentiable F"
   using assms unfolding field_differentiable_def
   by (metis field_differentiable_diff)
 
 lemma field_differentiable_inverse [derivative_intros]:
   assumes "f field_differentiable (at a within S)" "f a \<noteq> 0"
   shows "(\<lambda>z. inverse (f z)) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_inverse_fun)
 
 lemma field_differentiable_mult [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at a within S)"
     shows "(\<lambda>z. f z * g z) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_mult [of f _ a S g])
 
 lemma field_differentiable_divide [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at a within S)"
           "g a \<noteq> 0"
     shows "(\<lambda>z. f z / g z) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_divide [of f _ a S g])
 
 lemma field_differentiable_power [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
     shows "(\<lambda>z. f z ^ n) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_power)
 
 lemma field_differentiable_transform_within:
   "0 < d \<Longrightarrow>
         x \<in> S \<Longrightarrow>
         (\<And>x'. x' \<in> S \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x') \<Longrightarrow>
         f field_differentiable (at x within S)
         \<Longrightarrow> g field_differentiable (at x within S)"
   unfolding field_differentiable_def has_field_derivative_def
   by (blast intro: has_derivative_transform_within)
 
 lemma field_differentiable_compose_within:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at (f a) within f`S)"
     shows "(g o f) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_image_chain)
 
 lemma field_differentiable_compose:
   "f field_differentiable at z \<Longrightarrow> g field_differentiable at (f z)
           \<Longrightarrow> (g o f) field_differentiable at z"
 by (metis field_differentiable_at_within field_differentiable_compose_within)
 
 lemma field_differentiable_within_open:
      "\<lbrakk>a \<in> S; open S\<rbrakk> \<Longrightarrow> f field_differentiable at a within S \<longleftrightarrow>
                           f field_differentiable at a"
   unfolding field_differentiable_def
   by (metis at_within_open)
 
 lemma exp_scaleR_has_vector_derivative_right:
   "((\<lambda>t. exp (t *\<^sub>R A)) has_vector_derivative exp (t *\<^sub>R A) * A) (at t within T)"
   unfolding has_vector_derivative_def
 proof (rule has_derivativeI)
   let ?F = "at t within (T \<inter> {t - 1 <..< t + 1})"
   have *: "at t within T = ?F"
     by (rule at_within_nhd[where S="{t - 1 <..< t + 1}"]) auto
   let ?e = "\<lambda>i x. (inverse (1 + real i) * inverse (fact i) * (x - t) ^ i) *\<^sub>R (A * A ^ i)"
   have "\<forall>\<^sub>F n in sequentially.
       \<forall>x\<in>T \<inter> {t - 1<..<t + 1}. norm (?e n x) \<le> norm (A ^ (n + 1) /\<^sub>R fact (n + 1))"
     apply (auto simp: algebra_split_simps intro!: eventuallyI)
     apply (rule mult_left_mono)
      apply (auto simp add: field_simps power_abs intro!: divide_right_mono power_le_one)
     done
   then have "uniform_limit (T \<inter> {t - 1<..<t + 1}) (\<lambda>n x. \<Sum>i<n. ?e i x) (\<lambda>x. \<Sum>i. ?e i x) sequentially"
     by (rule Weierstrass_m_test_ev) (intro summable_ignore_initial_segment summable_norm_exp)
   moreover
   have "\<forall>\<^sub>F x in sequentially. x > 0"
     by (metis eventually_gt_at_top)
   then have
     "\<forall>\<^sub>F n in sequentially. ((\<lambda>x. \<Sum>i<n. ?e i x) \<longlongrightarrow> A) ?F"
     by eventually_elim
       (auto intro!: tendsto_eq_intros
         simp: power_0_left if_distrib if_distribR
         cong: if_cong)
   ultimately
   have [tendsto_intros]: "((\<lambda>x. \<Sum>i. ?e i x) \<longlongrightarrow> A) ?F"
     by (auto intro!: swap_uniform_limit[where f="\<lambda>n x. \<Sum>i < n. ?e i x" and F = sequentially])
   have [tendsto_intros]: "((\<lambda>x. if x = t then 0 else 1) \<longlongrightarrow> 1) ?F"
     by (rule tendsto_eventually) (simp add: eventually_at_filter)
   have "((\<lambda>y. ((y - t) / abs (y - t)) *\<^sub>R ((\<Sum>n. ?e n y) - A)) \<longlongrightarrow> 0) (at t within T)"
     unfolding *
     by (rule tendsto_norm_zero_cancel) (auto intro!: tendsto_eq_intros)
 
   moreover have "\<forall>\<^sub>F x in at t within T. x \<noteq> t"
     by (simp add: eventually_at_filter)
   then have "\<forall>\<^sub>F x in at t within T. ((x - t) / \<bar>x - t\<bar>) *\<^sub>R ((\<Sum>n. ?e n x) - A) =
     (exp ((x - t) *\<^sub>R A) - 1 - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t)"
   proof eventually_elim
     case (elim x)
     have "(exp ((x - t) *\<^sub>R A) - 1 - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t) =
       ((\<Sum>n. (x - t) *\<^sub>R ?e n x) - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t)"
       unfolding exp_first_term
       by (simp add: ac_simps)
     also
     have "summable (\<lambda>n. ?e n x)"
     proof -
       from elim have "?e n x = (((x - t) *\<^sub>R A) ^ (n + 1)) /\<^sub>R fact (n + 1) /\<^sub>R (x - t)" for n
         by simp
       then show ?thesis
         by (auto simp only:
           intro!: summable_scaleR_right summable_ignore_initial_segment summable_exp_generic)
     qed
     then have "(\<Sum>n. (x - t) *\<^sub>R ?e n x) = (x - t) *\<^sub>R (\<Sum>n. ?e n x)"
       by (rule suminf_scaleR_right[symmetric])
     also have "(\<dots> - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t) = (x - t) *\<^sub>R ((\<Sum>n. ?e n x) - A) /\<^sub>R norm (x - t)"
       by (simp add: algebra_simps)
     finally show ?case
       by simp (simp add: field_simps)
   qed
 
   ultimately have "((\<lambda>y. (exp ((y - t) *\<^sub>R A) - 1 - (y - t) *\<^sub>R A) /\<^sub>R norm (y - t)) \<longlongrightarrow> 0) (at t within T)"
     by (rule Lim_transform_eventually)
   from tendsto_mult_right_zero[OF this, where c="exp (t *\<^sub>R A)"]
   show "((\<lambda>y. (exp (y *\<^sub>R A) - exp (t *\<^sub>R A) - (y - t) *\<^sub>R (exp (t *\<^sub>R A) * A)) /\<^sub>R norm (y - t)) \<longlongrightarrow> 0)
       (at t within T)"
     by (rule Lim_transform_eventually)
       (auto simp: field_split_simps exp_add_commuting[symmetric])
 qed (rule bounded_linear_scaleR_left)
 
 lemma exp_times_scaleR_commute: "exp (t *\<^sub>R A) * A = A * exp (t *\<^sub>R A)"
   using exp_times_arg_commute[symmetric, of "t *\<^sub>R A"]
   by (auto simp: algebra_simps)
 
 lemma exp_scaleR_has_vector_derivative_left: "((\<lambda>t. exp (t *\<^sub>R A)) has_vector_derivative A * exp (t *\<^sub>R A)) (at t)"
   using exp_scaleR_has_vector_derivative_right[of A t]
   by (simp add: exp_times_scaleR_commute)
 
 lemma field_differentiable_series:
   fixes f :: "nat \<Rightarrow> 'a::{real_normed_field,banach} \<Rightarrow> 'a"
   assumes "convex S" "open S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" and x: "x \<in> S"
   shows  "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x)"
 proof -
   from assms(4) obtain g' where A: "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
     unfolding uniformly_convergent_on_def by blast
   from x and \<open>open S\<close> have S: "at x within S = at x" by (rule at_within_open)
   have "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
     by (intro has_field_derivative_series[of S f f' g' x0] assms A has_field_derivative_at_within)
   then obtain g where g: "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
     "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
   from g(2)[OF x] have g': "(g has_derivative (*) (g' x)) (at x)"
     by (simp add: has_field_derivative_def S)
   have "((\<lambda>x. \<Sum>n. f n x) has_derivative (*) (g' x)) (at x)"
     by (rule has_derivative_transform_within_open[OF g' \<open>open S\<close> x])
        (insert g, auto simp: sums_iff)
   thus "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x)" unfolding differentiable_def
     by (auto simp: summable_def field_differentiable_def has_field_derivative_def)
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Caratheodory characterization\<close>
 
 lemma field_differentiable_caratheodory_at:
   "f field_differentiable (at z) \<longleftrightarrow>
          (\<exists>g. (\<forall>w. f(w) - f(z) = g(w) * (w - z)) \<and> continuous (at z) g)"
   using CARAT_DERIV [of f]
   by (simp add: field_differentiable_def has_field_derivative_def)
 
 lemma field_differentiable_caratheodory_within:
   "f field_differentiable (at z within s) \<longleftrightarrow>
          (\<exists>g. (\<forall>w. f(w) - f(z) = g(w) * (w - z)) \<and> continuous (at z within s) g)"
   using DERIV_caratheodory_within [of f]
   by (simp add: field_differentiable_def has_field_derivative_def)
 
 
 subsection \<open>Field derivative\<close>
 
 definition\<^marker>\<open>tag important\<close> deriv :: "('a \<Rightarrow> 'a::real_normed_field) \<Rightarrow> 'a \<Rightarrow> 'a" where
   "deriv f x \<equiv> SOME D. DERIV f x :> D"
 
 lemma DERIV_imp_deriv: "DERIV f x :> f' \<Longrightarrow> deriv f x = f'"
   unfolding deriv_def by (metis some_equality DERIV_unique)
 
 lemma DERIV_deriv_iff_has_field_derivative:
   "DERIV f x :> deriv f x \<longleftrightarrow> (\<exists>f'. (f has_field_derivative f') (at x))"
   by (auto simp: has_field_derivative_def DERIV_imp_deriv)
 
 lemma DERIV_deriv_iff_real_differentiable:
   fixes x :: real
   shows "DERIV f x :> deriv f x \<longleftrightarrow> f differentiable at x"
   unfolding differentiable_def by (metis DERIV_imp_deriv has_real_derivative_iff)
 
 lemma deriv_cong_ev:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)" "x = y"
   shows   "deriv f x = deriv g y"
 proof -
   have "(\<lambda>D. (f has_field_derivative D) (at x)) = (\<lambda>D. (g has_field_derivative D) (at y))"
     by (intro ext DERIV_cong_ev refl assms)
   thus ?thesis by (simp add: deriv_def assms)
 qed
 
 lemma higher_deriv_cong_ev:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)" "x = y"
   shows   "(deriv ^^ n) f x = (deriv ^^ n) g y"
 proof -
   from assms(1) have "eventually (\<lambda>x. (deriv ^^ n) f x = (deriv ^^ n) g x) (nhds x)"
   proof (induction n arbitrary: f g)
     case (Suc n)
     from Suc.prems have "eventually (\<lambda>y. eventually (\<lambda>z. f z = g z) (nhds y)) (nhds x)"
       by (simp add: eventually_eventually)
     hence "eventually (\<lambda>x. deriv f x = deriv g x) (nhds x)"
       by eventually_elim (rule deriv_cong_ev, simp_all)
     thus ?case by (auto intro!: deriv_cong_ev Suc simp: funpow_Suc_right simp del: funpow.simps)
   qed auto
   from eventually_nhds_x_imp_x[OF this] assms(2) show ?thesis by simp
 qed
 
 lemma real_derivative_chain:
   fixes x :: real
   shows "f differentiable at x \<Longrightarrow> g differentiable at (f x)
     \<Longrightarrow> deriv (g o f) x = deriv g (f x) * deriv f x"
   by (metis DERIV_deriv_iff_real_differentiable DERIV_chain DERIV_imp_deriv)
 lemma field_derivative_eq_vector_derivative:
    "(deriv f x) = vector_derivative f (at x)"
 by (simp add: mult.commute deriv_def vector_derivative_def has_vector_derivative_def has_field_derivative_def)
 
 proposition field_differentiable_derivI:
     "f field_differentiable (at x) \<Longrightarrow> (f has_field_derivative deriv f x) (at x)"
 by (simp add: field_differentiable_def DERIV_deriv_iff_has_field_derivative)
 
 lemma vector_derivative_chain_at_general:
   assumes "f differentiable at x" "g field_differentiable at (f x)"
   shows "vector_derivative (g \<circ> f) (at x) = vector_derivative f (at x) * deriv g (f x)"
   apply (rule vector_derivative_at [OF field_vector_diff_chain_at])
   using assms vector_derivative_works by (auto simp: field_differentiable_derivI)
 
 lemma DERIV_deriv_iff_field_differentiable:
   "DERIV f x :> deriv f x \<longleftrightarrow> f field_differentiable at x"
   unfolding field_differentiable_def by (metis DERIV_imp_deriv)
 
 lemma deriv_chain:
   "f field_differentiable at x \<Longrightarrow> g field_differentiable at (f x)
     \<Longrightarrow> deriv (g o f) x = deriv g (f x) * deriv f x"
   by (metis DERIV_deriv_iff_field_differentiable DERIV_chain DERIV_imp_deriv)
 
 lemma deriv_linear [simp]: "deriv (\<lambda>w. c * w) = (\<lambda>z. c)"
   by (metis DERIV_imp_deriv DERIV_cmult_Id)
 
 lemma deriv_uminus [simp]: "deriv (\<lambda>w. -w) = (\<lambda>z. -1)"
   using deriv_linear[of "-1"] by (simp del: deriv_linear)
 
 lemma deriv_ident [simp]: "deriv (\<lambda>w. w) = (\<lambda>z. 1)"
   by (metis DERIV_imp_deriv DERIV_ident)
 
 lemma deriv_id [simp]: "deriv id = (\<lambda>z. 1)"
   by (simp add: id_def)
 
 lemma deriv_const [simp]: "deriv (\<lambda>w. c) = (\<lambda>z. 0)"
   by (metis DERIV_imp_deriv DERIV_const)
 
 lemma deriv_add [simp]:
   "\<lbrakk>f field_differentiable at z; g field_differentiable at z\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. f w + g w) z = deriv f z + deriv g z"
   unfolding DERIV_deriv_iff_field_differentiable[symmetric]
   by (auto intro!: DERIV_imp_deriv derivative_intros)
 
 lemma deriv_diff [simp]:
   "\<lbrakk>f field_differentiable at z; g field_differentiable at z\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. f w - g w) z = deriv f z - deriv g z"
   unfolding DERIV_deriv_iff_field_differentiable[symmetric]
   by (auto intro!: DERIV_imp_deriv derivative_intros)
 
 lemma deriv_mult [simp]:
   "\<lbrakk>f field_differentiable at z; g field_differentiable at z\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. f w * g w) z = f z * deriv g z + deriv f z * g z"
   unfolding DERIV_deriv_iff_field_differentiable[symmetric]
   by (auto intro!: DERIV_imp_deriv derivative_eq_intros)
 
 lemma deriv_cmult:
   "f field_differentiable at z \<Longrightarrow> deriv (\<lambda>w. c * f w) z = c * deriv f z"
   by simp
 
 lemma deriv_cmult_right:
   "f field_differentiable at z \<Longrightarrow> deriv (\<lambda>w. f w * c) z = deriv f z * c"
   by simp
 
 lemma deriv_inverse [simp]:
   "\<lbrakk>f field_differentiable at z; f z \<noteq> 0\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. inverse (f w)) z = - deriv f z / f z ^ 2"
   unfolding DERIV_deriv_iff_field_differentiable[symmetric]
   by (safe intro!: DERIV_imp_deriv derivative_eq_intros) (auto simp: field_split_simps power2_eq_square)
 
 lemma deriv_divide [simp]:
   "\<lbrakk>f field_differentiable at z; g field_differentiable at z; g z \<noteq> 0\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. f w / g w) z = (deriv f z * g z - f z * deriv g z) / g z ^ 2"
   by (simp add: field_class.field_divide_inverse field_differentiable_inverse)
      (simp add: field_split_simps power2_eq_square)
 
 lemma deriv_cdivide_right:
   "f field_differentiable at z \<Longrightarrow> deriv (\<lambda>w. f w / c) z = deriv f z / c"
   by (simp add: field_class.field_divide_inverse)
 
 lemma deriv_compose_linear:
   "f field_differentiable at (c * z) \<Longrightarrow> deriv (\<lambda>w. f (c * w)) z = c * deriv f (c * z)"
 apply (rule DERIV_imp_deriv)
   unfolding DERIV_deriv_iff_field_differentiable [symmetric]
   by (metis (full_types) DERIV_chain2 DERIV_cmult_Id mult.commute)
 
 
 lemma nonzero_deriv_nonconstant:
   assumes df: "DERIV f \<xi> :> df" and S: "open S" "\<xi> \<in> S" and "df \<noteq> 0"
     shows "\<not> f constant_on S"
 unfolding constant_on_def
 by (metis \<open>df \<noteq> 0\<close> has_field_derivative_transform_within_open [OF df S] DERIV_const DERIV_unique)
 
 
 subsection \<open>Relation between convexity and derivative\<close>
 
 (* TODO: Generalise to real vector spaces? *)
 proposition convex_on_imp_above_tangent:
   assumes convex: "convex_on A f" and connected: "connected A"
   assumes c: "c \<in> interior A" and x : "x \<in> A"
   assumes deriv: "(f has_field_derivative f') (at c within A)"
   shows   "f x - f c \<ge> f' * (x - c)"
 proof (cases x c rule: linorder_cases)
   assume xc: "x > c"
   let ?A' = "interior A \<inter> {c<..}"
   from c have "c \<in> interior A \<inter> closure {c<..}" by auto
   also have "\<dots> \<subseteq> closure (interior A \<inter> {c<..})" by (intro open_Int_closure_subset) auto
   finally have "at c within ?A' \<noteq> bot" by (subst at_within_eq_bot_iff) auto
   moreover from deriv have "((\<lambda>y. (f y - f c) / (y - c)) \<longlongrightarrow> f') (at c within ?A')"
     unfolding has_field_derivative_iff using interior_subset[of A] by (blast intro: tendsto_mono at_le)
   moreover from eventually_at_right_real[OF xc]
     have "eventually (\<lambda>y. (f y - f c) / (y - c) \<le> (f x - f c) / (x - c)) (at_right c)"
   proof eventually_elim
     fix y assume y: "y \<in> {c<..<x}"
     with convex connected x c have "f y \<le> (f x - f c) / (x - c) * (y - c) + f c"
       using interior_subset[of A]
       by (intro convex_onD_Icc' convex_on_subset[OF convex] connected_contains_Icc) auto
     hence "f y - f c \<le> (f x - f c) / (x - c) * (y - c)" by simp
     thus "(f y - f c) / (y - c) \<le> (f x - f c) / (x - c)" using y xc by (simp add: field_split_simps)
   qed
   hence "eventually (\<lambda>y. (f y - f c) / (y - c) \<le> (f x - f c) / (x - c)) (at c within ?A')"
     by (blast intro: filter_leD at_le)
   ultimately have "f' \<le> (f x - f c) / (x - c)" by (simp add: tendsto_upperbound)
   thus ?thesis using xc by (simp add: field_simps)
 next
   assume xc: "x < c"
   let ?A' = "interior A \<inter> {..<c}"
   from c have "c \<in> interior A \<inter> closure {..<c}" by auto
   also have "\<dots> \<subseteq> closure (interior A \<inter> {..<c})" by (intro open_Int_closure_subset) auto
   finally have "at c within ?A' \<noteq> bot" by (subst at_within_eq_bot_iff) auto
   moreover from deriv have "((\<lambda>y. (f y - f c) / (y - c)) \<longlongrightarrow> f') (at c within ?A')"
     unfolding has_field_derivative_iff using interior_subset[of A] by (blast intro: tendsto_mono at_le)
   moreover from eventually_at_left_real[OF xc]
     have "eventually (\<lambda>y. (f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)) (at_left c)"
   proof eventually_elim
     fix y assume y: "y \<in> {x<..<c}"
     with convex connected x c have "f y \<le> (f x - f c) / (c - x) * (c - y) + f c"
       using interior_subset[of A]
       by (intro convex_onD_Icc'' convex_on_subset[OF convex] connected_contains_Icc) auto
     hence "f y - f c \<le> (f x - f c) * ((c - y) / (c - x))" by simp
     also have "(c - y) / (c - x) = (y - c) / (x - c)" using y xc by (simp add: field_simps)
     finally show "(f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)" using y xc
       by (simp add: field_split_simps)
   qed
   hence "eventually (\<lambda>y. (f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)) (at c within ?A')"
     by (blast intro: filter_leD at_le)
   ultimately have "f' \<ge> (f x - f c) / (x - c)" by (simp add: tendsto_lowerbound)
   thus ?thesis using xc by (simp add: field_simps)
 qed simp_all
 
 
 subsection \<open>Partial derivatives\<close>
 
 lemma eventually_at_Pair_within_TimesI1:
   fixes x::"'a::metric_space"
   assumes "\<forall>\<^sub>F x' in at x within X. P x'"
   assumes "P x"
   shows "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P x'"
 proof -
   from assms[unfolded eventually_at_topological]
   obtain S where S: "open S" "x \<in> S" "\<And>x'. x' \<in> X \<Longrightarrow> x' \<in> S \<Longrightarrow> P x'"
     by metis
   show "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P x'"
     unfolding eventually_at_topological
     by (auto intro!: exI[where x="S \<times> UNIV"] S open_Times)
 qed
 
 lemma eventually_at_Pair_within_TimesI2:
   fixes x::"'a::metric_space"
   assumes "\<forall>\<^sub>F y' in at y within Y. P y'" "P y"
   shows "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P y'"
 proof -
   from assms[unfolded eventually_at_topological]
   obtain S where S: "open S" "y \<in> S" "\<And>y'. y' \<in> Y \<Longrightarrow> y' \<in> S \<Longrightarrow> P y'"
     by metis
   show "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P y'"
     unfolding eventually_at_topological
     by (auto intro!: exI[where x="UNIV \<times> S"] S open_Times)
 qed
 
 proposition has_derivative_partialsI:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
   assumes fx: "((\<lambda>x. f x y) has_derivative fx) (at x within X)"
   assumes fy: "\<And>x y. x \<in> X \<Longrightarrow> y \<in> Y \<Longrightarrow> ((\<lambda>y. f x y) has_derivative blinfun_apply (fy x y)) (at y within Y)"
   assumes fy_cont[unfolded continuous_within]: "continuous (at (x, y) within X \<times> Y) (\<lambda>(x, y). fy x y)"
   assumes "y \<in> Y" "convex Y"
   shows "((\<lambda>(x, y). f x y) has_derivative (\<lambda>(tx, ty). fx tx + fy x y ty)) (at (x, y) within X \<times> Y)"
 proof (safe intro!: has_derivativeI tendstoI, goal_cases)
   case (2 e')
   interpret fx: bounded_linear "fx" using fx by (rule has_derivative_bounded_linear)
   define e where "e = e' / 9"
   have "e > 0" using \<open>e' > 0\<close> by (simp add: e_def)
 
   from fy_cont[THEN tendstoD, OF \<open>e > 0\<close>]
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. dist (fy x' y') (fy x y) < e"
     by (auto simp: split_beta')
   from this[unfolded eventually_at] obtain d' where
     "d' > 0"
     "\<And>x' y'. x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> (x', y') \<noteq> (x, y) \<Longrightarrow> dist (x', y') (x, y) < d' \<Longrightarrow>
       dist (fy x' y') (fy x y) < e"
     by auto
   then
   have d': "x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> dist (x', y') (x, y) < d' \<Longrightarrow> dist (fy x' y') (fy x y) < e"
     for x' y'
     using \<open>0 < e\<close>
     by (cases "(x', y') = (x, y)") auto
   define d where "d = d' / sqrt 2"
   have "d > 0" using \<open>0 < d'\<close> by (simp add: d_def)
   have d: "x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> dist x' x < d \<Longrightarrow> dist y' y < d \<Longrightarrow> dist (fy x' y') (fy x y) < e"
     for x' y'
     by (auto simp: dist_prod_def d_def intro!: d' real_sqrt_sum_squares_less)
 
   let ?S = "ball y d \<inter> Y"
   have "convex ?S"
     by (auto intro!: convex_Int \<open>convex Y\<close>)
   {
     fix x'::'a and y'::'b
     assume x': "x' \<in> X" and y': "y' \<in> Y"
     assume dx': "dist x' x < d" and dy': "dist y' y < d"
     have "norm (fy x' y' - fy x' y) \<le> dist (fy x' y') (fy x y) + dist (fy x' y) (fy x y)"
       by norm
     also have "dist (fy x' y') (fy x y) < e"
       by (rule d; fact)
     also have "dist (fy x' y) (fy x y) < e"
       by (auto intro!: d simp: dist_prod_def x' \<open>d > 0\<close> \<open>y \<in> Y\<close> dx')
     finally
     have "norm (fy x' y' - fy x' y) < e + e"
       by arith
     then have "onorm (blinfun_apply (fy x' y') - blinfun_apply (fy x' y)) < e + e"
       by (auto simp: norm_blinfun.rep_eq blinfun.diff_left[abs_def] fun_diff_def)
   } note onorm = this
 
   have ev_mem: "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. (x', y') \<in> X \<times> Y"
     using \<open>y \<in> Y\<close>
     by (auto simp: eventually_at intro!: zero_less_one)
   moreover
   have ev_dist: "\<forall>\<^sub>F xy in at (x, y) within X \<times> Y. dist xy (x, y) < d" if "d > 0" for d
     using eventually_at_ball[OF that]
     by (rule eventually_elim2) (auto simp: dist_commute intro!: eventually_True)
   note ev_dist[OF \<open>0 < d\<close>]
   ultimately
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y.
     norm (f x' y' - f x' y - (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
   proof (eventually_elim, safe)
     fix x' y'
     assume "x' \<in> X" and y': "y' \<in> Y"
     assume dist: "dist (x', y') (x, y) < d"
     then have dx: "dist x' x < d" and dy: "dist y' y < d"
       unfolding dist_prod_def fst_conv snd_conv atomize_conj
       by (metis le_less_trans real_sqrt_sum_squares_ge1 real_sqrt_sum_squares_ge2)
     {
       fix t::real
       assume "t \<in> {0 .. 1}"
       then have "y + t *\<^sub>R (y' - y) \<in> closed_segment y y'"
         by (auto simp: closed_segment_def algebra_simps intro!: exI[where x=t])
       also
       have "\<dots> \<subseteq> ball y d \<inter> Y"
         using \<open>y \<in> Y\<close> \<open>0 < d\<close> dy y'
         by (intro \<open>convex ?S\<close>[unfolded convex_contains_segment, rule_format, of y y'])
           (auto simp: dist_commute)
       finally have "y + t *\<^sub>R (y' - y) \<in> ?S" .
     } note seg = this
 
     have "\<And>x. x \<in> ball y d \<inter> Y \<Longrightarrow> onorm (blinfun_apply (fy x' x) - blinfun_apply (fy x' y)) \<le> e + e"
       by (safe intro!: onorm less_imp_le \<open>x' \<in> X\<close> dx) (auto simp: dist_commute \<open>0 < d\<close> \<open>y \<in> Y\<close>)
     with seg has_derivative_subset[OF assms(2)[OF \<open>x' \<in> X\<close>]]
     show "norm (f x' y' - f x' y - (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
       by (rule differentiable_bound_linearization[where S="?S"])
         (auto intro!: \<open>0 < d\<close> \<open>y \<in> Y\<close>)
   qed
   moreover
   let ?le = "\<lambda>x'. norm (f x' y - f x y - (fx) (x' - x)) \<le> norm (x' - x) * e"
   from fx[unfolded has_derivative_within, THEN conjunct2, THEN tendstoD, OF \<open>0 < e\<close>]
   have "\<forall>\<^sub>F x' in at x within X. ?le x'"
     by eventually_elim (simp, 
       simp add: dist_norm field_split_simps split: if_split_asm)
   then have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. ?le x'"
     by (rule eventually_at_Pair_within_TimesI1)
        (simp add: blinfun.bilinear_simps)
   moreover have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. norm ((x', y') - (x, y)) \<noteq> 0"
     unfolding norm_eq_zero right_minus_eq
     by (auto simp: eventually_at intro!: zero_less_one)
   moreover
   from fy_cont[THEN tendstoD, OF \<open>0 < e\<close>]
   have "\<forall>\<^sub>F x' in at x within X. norm (fy x' y - fy x y) < e"
     unfolding eventually_at
     using \<open>y \<in> Y\<close>
     by (auto simp: dist_prod_def dist_norm)
   then have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. norm (fy x' y - fy x y) < e"
     by (rule eventually_at_Pair_within_TimesI1)
        (simp add: blinfun.bilinear_simps \<open>0 < e\<close>)
   ultimately
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y.
             norm ((f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) /\<^sub>R
               norm ((x', y') - (x, y)))
             < e'"
     apply eventually_elim
   proof safe
     fix x' y'
     have "norm (f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) \<le>
         norm (f x' y' - f x' y - fy x' y (y' - y)) +
         norm (fy x y (y' - y) - fy x' y (y' - y)) +
         norm (f x' y - f x y - fx (x' - x))"
       by norm
     also
     assume nz: "norm ((x', y') - (x, y)) \<noteq> 0"
       and nfy: "norm (fy x' y - fy x y) < e"
     assume "norm (f x' y' - f x' y - blinfun_apply (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
     also assume "norm (f x' y - f x y - (fx) (x' - x)) \<le> norm (x' - x) * e"
     also
     have "norm ((fy x y) (y' - y) - (fy x' y) (y' - y)) \<le> norm ((fy x y) - (fy x' y)) * norm (y' - y)"
       by (auto simp: blinfun.bilinear_simps[symmetric] intro!: norm_blinfun)
     also have "\<dots> \<le> (e + e) * norm (y' - y)"
       using \<open>e > 0\<close> nfy
       by (auto simp: norm_minus_commute intro!: mult_right_mono)
     also have "norm (x' - x) * e \<le> norm (x' - x) * (e + e)"
       using \<open>0 < e\<close> by simp
     also have "norm (y' - y) * (e + e) + (e + e) * norm (y' - y) + norm (x' - x) * (e + e) \<le>
         (norm (y' - y) + norm (x' - x)) * (4 * e)"
       using \<open>e > 0\<close>
       by (simp add: algebra_simps)
     also have "\<dots> \<le> 2 * norm ((x', y') - (x, y)) * (4 * e)"
       using \<open>0 < e\<close> real_sqrt_sum_squares_ge1[of "norm (x' - x)" "norm (y' - y)"]
         real_sqrt_sum_squares_ge2[of "norm (y' - y)" "norm (x' - x)"]
       by (auto intro!: mult_right_mono simp: norm_prod_def
         simp del: real_sqrt_sum_squares_ge1 real_sqrt_sum_squares_ge2)
     also have "\<dots> \<le> norm ((x', y') - (x, y)) * (8 * e)"
       by simp
     also have "\<dots> < norm ((x', y') - (x, y)) * e'"
       using \<open>0 < e'\<close> nz
       by (auto simp: e_def)
     finally show "norm ((f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) /\<^sub>R norm ((x', y') - (x, y))) < e'"
       by (simp add: dist_norm) (auto simp add: field_split_simps)
   qed
   then show ?case
     by eventually_elim (auto simp: dist_norm field_simps)
 next
   from has_derivative_bounded_linear[OF fx]
   obtain fxb where "fx = blinfun_apply fxb"
     by (metis bounded_linear_Blinfun_apply)
   then show "bounded_linear (\<lambda>(tx, ty). fx tx + blinfun_apply (fy x y) ty)"
     by (auto intro!: bounded_linear_intros simp: split_beta')
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Differentiable case distinction\<close>
 
 lemma has_derivative_within_If_eq:
   "((\<lambda>x. if P x then f x else g x) has_derivative f') (at x within S) =
     (bounded_linear f' \<and>
      ((\<lambda>y.(if P y then (f y - ((if P x then f x else g x) + f' (y - x)))/\<^sub>R norm (y - x)
            else (g y - ((if P x then f x else g x) + f' (y - x)))/\<^sub>R norm (y - x)))
       \<longlongrightarrow> 0) (at x within S))"
   (is "_ = (_ \<and> (?if \<longlongrightarrow> 0) _)")
 proof -
   have "(\<lambda>y. (1 / norm (y - x)) *\<^sub>R
            ((if P y then f y else g y) -
             ((if P x then f x else g x) + f' (y - x)))) = ?if"
     by (auto simp: inverse_eq_divide)
   thus ?thesis by (auto simp: has_derivative_within)
 qed
 
 lemma has_derivative_If_within_closures:
   assumes f': "x \<in> S \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (f has_derivative f' x) (at x within S \<union> (closure S \<inter> closure T))"
   assumes g': "x \<in> T \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (g has_derivative g' x) (at x within T \<union> (closure S \<inter> closure T))"
   assumes connect: "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f x = g x"
   assumes connect': "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f' x = g' x"
   assumes x_in: "x \<in> S \<union> T"
   shows "((\<lambda>x. if x \<in> S then f x else g x) has_derivative
       (if x \<in> S then f' x else g' x)) (at x within (S \<union> T))"
 proof -
   from f' x_in interpret f': bounded_linear "if x \<in> S then f' x else (\<lambda>x. 0)"
     by (auto simp add: has_derivative_within)
   from g' interpret g': bounded_linear "if x \<in> T then g' x else (\<lambda>x. 0)"
     by (auto simp add: has_derivative_within)
   have bl: "bounded_linear (if x \<in> S then f' x else g' x)"
     using f'.scaleR f'.bounded f'.add g'.scaleR g'.bounded g'.add x_in
     by (unfold_locales; force)
   show ?thesis
     using f' g' closure_subset[of T] closure_subset[of S]
     unfolding has_derivative_within_If_eq
     by (intro conjI bl tendsto_If_within_closures x_in)
       (auto simp: has_derivative_within inverse_eq_divide connect connect' subsetD)
 qed
 
 lemma has_vector_derivative_If_within_closures:
   assumes x_in: "x \<in> S \<union> T"
   assumes "u = S \<union> T"
   assumes f': "x \<in> S \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (f has_vector_derivative f' x) (at x within S \<union> (closure S \<inter> closure T))"
   assumes g': "x \<in> T \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (g has_vector_derivative g' x) (at x within T \<union> (closure S \<inter> closure T))"
   assumes connect: "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f x = g x"
   assumes connect': "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f' x = g' x"
   shows "((\<lambda>x. if x \<in> S then f x else g x) has_vector_derivative
     (if x \<in> S then f' x else g' x)) (at x within u)"
   unfolding has_vector_derivative_def assms
   using x_in
   apply (intro has_derivative_If_within_closures[where ?f' = "\<lambda>x a. a *\<^sub>R f' x" and ?g' = "\<lambda>x a. a *\<^sub>R g' x",
         THEN has_derivative_eq_rhs])
   subgoal by (rule f'[unfolded has_vector_derivative_def]; assumption)
   subgoal by (rule g'[unfolded has_vector_derivative_def]; assumption)
   by (auto simp: assms)
 
 subsection\<^marker>\<open>tag important\<close>\<open>The Inverse Function Theorem\<close>
 
 lemma linear_injective_contraction:
   assumes "linear f" "c < 1" and le: "\<And>x. norm (f x - x) \<le> c * norm x"
   shows "inj f"
   unfolding linear_injective_0[OF \<open>linear f\<close>]
 proof safe
   fix x
   assume "f x = 0"
   with le [of x] have "norm x \<le> c * norm x"
     by simp
   then show "x = 0"
     using \<open>c < 1\<close> by (simp add: mult_le_cancel_right1)
 qed
 
 text\<open>From an online proof by J. Michael Boardman, Department of Mathematics, Johns Hopkins University\<close>
 lemma inverse_function_theorem_scaled:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
     and f'::"'a \<Rightarrow> ('a \<Rightarrow>\<^sub>L 'a)"
   assumes "open U"
     and derf: "\<And>x. x \<in> U \<Longrightarrow> (f has_derivative blinfun_apply (f' x)) (at x)"
     and contf: "continuous_on U f'"
     and "0 \<in> U" and [simp]: "f 0 = 0"
     and id: "f' 0 = id_blinfun"
   obtains U' V g g' where "open U'" "U' \<subseteq> U" "0 \<in> U'" "open V" "0 \<in> V" "homeomorphism U' V f g"
                 "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
                 "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (blinfun_apply (f'(g y)))"
                 "\<And>y. y \<in> V \<Longrightarrow> bij (blinfun_apply (f'(g y)))"
 proof -
   obtain d1 where "cball 0 d1 \<subseteq> U" "d1 > 0"
     using \<open>open U\<close> \<open>0 \<in> U\<close> open_contains_cball by blast
   obtain d2 where d2: "\<And>x. \<lbrakk>x \<in> U; dist x 0 \<le> d2\<rbrakk> \<Longrightarrow> dist (f' x) (f' 0) < 1/2" "0 < d2"
     using continuous_onE [OF contf, of 0 "1/2"] by (metis \<open>0 \<in> U\<close> half_gt_zero_iff zero_less_one)
   obtain \<delta> where le: "\<And>x. norm x \<le> \<delta> \<Longrightarrow> dist (f' x) id_blinfun \<le> 1/2" and "0 < \<delta>"
     and subU: "cball 0 \<delta> \<subseteq> U"
   proof
     show "min d1 d2 > 0"
       by (simp add: \<open>0 < d1\<close> \<open>0 < d2\<close>)
     show "cball 0 (min d1 d2) \<subseteq> U"
       using \<open>cball 0 d1 \<subseteq> U\<close> by auto
     show "dist (f' x) id_blinfun \<le> 1/2" if "norm x \<le> min d1 d2" for x
       using \<open>cball 0 d1 \<subseteq> U\<close> d2 that id by fastforce
   qed
   let ?D = "cball 0 \<delta>"
   define V:: "'a set" where "V \<equiv> ball 0 (\<delta>/2)"
   have 4: "norm (f (x + h) - f x - h) \<le> 1/2 * norm h"
     if "x \<in> ?D" "x+h \<in> ?D" for x h
   proof -
     let ?w = "\<lambda>x. f x - x"
     have B: "\<And>x. x \<in> ?D \<Longrightarrow> onorm (blinfun_apply (f' x - id_blinfun)) \<le> 1/2"
       by (metis dist_norm le mem_cball_0 norm_blinfun.rep_eq)
     have "\<And>x. x \<in> ?D \<Longrightarrow> (?w has_derivative (blinfun_apply (f' x - id_blinfun))) (at x)"
       by (rule derivative_eq_intros derf subsetD [OF subU] | force simp: blinfun.diff_left)+
     then have Dw: "\<And>x. x \<in> ?D \<Longrightarrow> (?w has_derivative (blinfun_apply (f' x - id_blinfun))) (at x within ?D)"
       using has_derivative_at_withinI by blast
     have "norm (?w (x+h) - ?w x) \<le> (1/2) * norm h"
       using differentiable_bound [OF convex_cball Dw B] that by fastforce
     then show ?thesis
       by (auto simp: algebra_simps)
   qed
   have for_g: "\<exists>!x. norm x < \<delta> \<and> f x = y" if y: "norm y < \<delta>/2" for y
   proof -
     let ?u = "\<lambda>x. x + (y - f x)"
     have *: "norm (?u x) < \<delta>" if "x \<in> ?D" for x
     proof -
       have fxx: "norm (f x - x) \<le> \<delta>/2"
         using 4 [of 0 x] \<open>0 < \<delta>\<close> \<open>f 0 = 0\<close> that by auto
       have "norm (?u x) \<le> norm y + norm (f x - x)"
         by (metis add.commute add_diff_eq norm_minus_commute norm_triangle_ineq)
       also have "\<dots> < \<delta>/2 + \<delta>/2"
         using fxx y by auto
       finally show ?thesis
         by simp
     qed
     have "\<exists>!x \<in> ?D. ?u x = x"
     proof (rule banach_fix)
       show "cball 0 \<delta> \<noteq> {}"
         using \<open>0 < \<delta>\<close> by auto
       show "(\<lambda>x. x + (y - f x)) ` cball 0 \<delta> \<subseteq> cball 0 \<delta>"
         using * by force
       have "dist (x + (y - f x)) (xh + (y - f xh)) * 2 \<le> dist x xh"
         if "norm x \<le> \<delta>" and "norm xh \<le> \<delta>" for x xh
         using that 4 [of x "xh-x"] by (auto simp: dist_norm norm_minus_commute algebra_simps)
       then show "\<forall>x\<in>cball 0 \<delta>. \<forall>ya\<in>cball 0 \<delta>. dist (x + (y - f x)) (ya + (y - f ya)) \<le> (1/2) * dist x ya"
         by auto
     qed (auto simp: complete_eq_closed)
     then show ?thesis
       by (metis "*" add_cancel_right_right eq_iff_diff_eq_0 le_less mem_cball_0)
   qed
   define g where "g \<equiv> \<lambda>y. THE x. norm x < \<delta> \<and> f x = y"
   have g: "norm (g y) < \<delta> \<and> f (g y) = y" if "norm y < \<delta>/2" for y
     unfolding g_def using that theI' [OF for_g] by meson
   then have fg[simp]: "f (g y) = y" if "y \<in> V" for y
     using that by (auto simp: V_def)
   have 5: "norm (g y' - g y) \<le> 2 * norm (y' - y)" if "y \<in> V" "y' \<in> V" for y y'
   proof -
     have no: "norm (g y) \<le> \<delta>" "norm (g y') \<le> \<delta>" and [simp]: "f (g y) = y"
       using that g unfolding V_def by force+
     have "norm (g y' - g y) \<le> norm (g y' - g y - (y' - y)) + norm (y' - y)"
       by (simp add: add.commute norm_triangle_sub)
     also have "\<dots> \<le> (1/2) * norm (g y' - g y) + norm (y' - y)"
       using 4 [of "g y" "g y' - g y"] that no by (simp add: g norm_minus_commute V_def)
     finally show ?thesis
       by auto
   qed
   have contg: "continuous_on V g"
   proof
     fix y::'a and e::real
     assume "0 < e" and y: "y \<in> V"
     show "\<exists>d>0. \<forall>x'\<in>V. dist x' y < d \<longrightarrow> dist (g x') (g y) \<le> e"
     proof (intro exI conjI ballI impI)
       show "0 < e/2"
         by (simp add: \<open>0 < e\<close>)
     qed (use 5 y in \<open>force simp: dist_norm\<close>)
   qed
   show thesis
   proof
     define U' where "U' \<equiv> (f -` V) \<inter> ball 0 \<delta>"
     have contf: "continuous_on U f"
       using derf has_derivative_at_withinI by (fast intro: has_derivative_continuous_on)
     then have "continuous_on (ball 0 \<delta>) f"
       by (meson ball_subset_cball continuous_on_subset subU)
     then show "open U'"
       by (simp add: U'_def V_def Int_commute continuous_open_preimage)
     show "0 \<in> U'" "U' \<subseteq> U" "open V" "0 \<in> V"
       using \<open>0 < \<delta>\<close> subU by (auto simp: U'_def V_def)
     show hom: "homeomorphism U' V f g"
     proof
       show "continuous_on U' f"
         using \<open>U' \<subseteq> U\<close> contf continuous_on_subset by blast
       show "continuous_on V g"
         using contg by blast
       show "f ` U' \<subseteq> V"
         using U'_def by blast
       show "g ` V \<subseteq> U'"
         by (simp add: U'_def V_def g image_subset_iff)
       show "g (f x) = x" if "x \<in> U'" for x
         by (metis that fg Int_iff U'_def V_def for_g g mem_ball_0 vimage_eq)
       show "f (g y) = y" if "y \<in> V" for y
         using that by (simp add: g V_def)
     qed
     show bij: "bij (blinfun_apply (f'(g y)))" if "y \<in> V" for y
     proof -
       have inj: "inj (blinfun_apply (f' (g y)))"
       proof (rule linear_injective_contraction)
         show "linear (blinfun_apply (f' (g y)))"
           using blinfun.bounded_linear_right bounded_linear_def by blast
       next
         fix x
         have "norm (blinfun_apply (f' (g y)) x - x) = norm (blinfun_apply (f' (g y) - id_blinfun) x)"
           by (simp add: blinfun.diff_left)
         also have "\<dots> \<le> norm (f' (g y) - id_blinfun) * norm x"
           by (rule norm_blinfun)
         also have "\<dots> \<le> (1/2) * norm x"
         proof (rule mult_right_mono)
           show "norm (f' (g y) - id_blinfun) \<le> 1/2"
             using that g [of y] le by (auto simp: V_def dist_norm)
         qed auto
         finally show "norm (blinfun_apply (f' (g y)) x - x) \<le> (1/2) * norm x" .
       qed auto
       moreover
       have "surj (blinfun_apply (f' (g y)))"
         using blinfun.bounded_linear_right bounded_linear_def
         by (blast intro!: linear_inj_imp_surj [OF _ inj])
       ultimately show ?thesis
         using bijI by blast
     qed
     define g' where "g' \<equiv> \<lambda>y. inv (blinfun_apply (f'(g y)))"
     show "(g has_derivative g' y) (at y)" if "y \<in> V" for y
     proof -
       have gy: "g y \<in> U"
         using g subU that unfolding V_def by fastforce
       obtain e where e: "\<And>h. f (g y + h) = y + blinfun_apply (f' (g y)) h + e h"
         and e0: "(\<lambda>h. norm (e h) / norm h) \<midarrow>0\<rightarrow> 0"
         using iffD1 [OF has_derivative_iff_Ex derf [OF gy]] \<open>y \<in> V\<close> by auto
       have [simp]: "e 0 = 0"
         using e [of 0] that by simp
       let ?INV = "inv (blinfun_apply (f' (g y)))"
       have inj: "inj (blinfun_apply (f' (g y)))"
         using bij bij_betw_def that by blast
       have "(g has_derivative g' y) (at y within V)"
         unfolding has_derivative_at_within_iff_Ex [OF \<open>y \<in> V\<close> \<open>open V\<close>]
       proof
         show blinv: "bounded_linear (g' y)"
           unfolding g'_def using derf gy inj inj_linear_imp_inv_bounded_linear by blast
         define eg where "eg \<equiv> \<lambda>k. - ?INV (e (g (y+k) - g y))"
         have "g (y+k) = g y + g' y k + eg k" if "y + k \<in> V" for k
         proof -
           have "?INV k = ?INV (blinfun_apply (f' (g y)) (g (y+k) - g y) + e (g (y+k) - g y))"
             using e [of "g(y+k) - g y"] that by simp
           then have "g (y+k) = g y + ?INV k - ?INV (e (g (y+k) - g y))"
             using inj blinv by (simp add: linear_simps g'_def)
           then show ?thesis
             by (auto simp: eg_def g'_def)
         qed
         moreover have "(\<lambda>k. norm (eg k) / norm k) \<midarrow>0\<rightarrow> 0"
         proof (rule Lim_null_comparison)
           let ?g = "\<lambda>k. 2 * onorm ?INV * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
           show "\<forall>\<^sub>F k in at 0. norm (norm (eg k) / norm k) \<le> ?g k"
             unfolding eventually_at_topological
           proof (intro exI conjI ballI impI)
             show "open ((+)(-y) ` V)"
               using \<open>open V\<close> open_translation by blast
             show "0 \<in> (+)(-y) ` V"
               by (simp add: that)
             show "norm (norm (eg k) / norm k) \<le> 2 * onorm (inv (blinfun_apply (f' (g y)))) * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
               if "k \<in> (+)(-y) ` V" "k \<noteq> 0" for k
             proof -
               have "y+k \<in> V"
                 using that by auto
               have "norm (norm (eg k) / norm k) \<le> onorm ?INV * norm (e (g (y+k) - g y)) / norm k"
                 using blinv g'_def onorm by (force simp: eg_def divide_simps)
               also have "\<dots> = (norm (g (y+k) - g y) / norm k) * (onorm ?INV * (norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)))"
                 by (simp add: divide_simps)
               also have "\<dots> \<le> 2 * (onorm ?INV * (norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)))"
                 apply (rule mult_right_mono)
                 using 5 [of y "y+k"] \<open>y \<in> V\<close> \<open>y + k \<in> V\<close>  onorm_pos_le [OF blinv]
                  apply (auto simp: divide_simps zero_le_mult_iff zero_le_divide_iff g'_def)
                 done
               finally show "norm (norm (eg k) / norm k) \<le> 2 * onorm ?INV * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
                 by simp
             qed
           qed
           have 1: "(\<lambda>h. norm (e h) / norm h) \<midarrow>0\<rightarrow> (norm (e 0) / norm 0)"
             using e0 by auto
           have 2: "(\<lambda>k. g (y+k) - g y) \<midarrow>0\<rightarrow> 0"
             using contg \<open>open V\<close> \<open>y \<in> V\<close> LIM_offset_zero_iff LIM_zero_iff at_within_open continuous_on_def by fastforce
           from tendsto_compose [OF 1 2, simplified]
           have "(\<lambda>k. norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)) \<midarrow>0\<rightarrow> 0" .
           from tendsto_mult_left [OF this] show "?g \<midarrow>0\<rightarrow> 0" by auto
         qed
         ultimately show "\<exists>e. (\<forall>k. y + k \<in> V \<longrightarrow> g (y+k) = g y + g' y k + e k) \<and> (\<lambda>k. norm (e k) / norm k) \<midarrow>0\<rightarrow> 0"
           by blast
       qed
       then show ?thesis
         by (metis \<open>open V\<close> at_within_open that)
     qed
     show "g' y = inv (blinfun_apply (f' (g y)))"
       if "y \<in> V" for y
       by (simp add: g'_def)
   qed
 qed
 
 
 text\<open>We need all this to justify the scaling and translations.\<close>
 theorem inverse_function_theorem:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
     and f'::"'a \<Rightarrow> ('a \<Rightarrow>\<^sub>L 'a)"
   assumes "open U"
     and derf: "\<And>x. x \<in> U \<Longrightarrow> (f has_derivative (blinfun_apply (f' x))) (at x)"
     and contf:  "continuous_on U f'"
     and "x0 \<in> U"
     and invf: "invf o\<^sub>L f' x0 = id_blinfun"
   obtains U' V g g' where "open U'" "U' \<subseteq> U" "x0 \<in> U'" "open V" "f x0 \<in> V" "homeomorphism U' V f g"
     "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
     "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (blinfun_apply (f'(g y)))"
     "\<And>y. y \<in> V \<Longrightarrow> bij (blinfun_apply (f'(g y)))"
 proof -
   have apply1 [simp]: "\<And>i. blinfun_apply invf (blinfun_apply (f' x0) i) = i"
     by (metis blinfun_apply_blinfun_compose blinfun_apply_id_blinfun invf)
   have apply2 [simp]: "\<And>i. blinfun_apply (f' x0) (blinfun_apply invf i) = i"
     by (metis apply1 bij_inv_eq_iff blinfun_bij1 invf)
   have [simp]: "(range (blinfun_apply invf)) = UNIV"
     using apply1 surjI by blast
   let ?f = "invf \<circ> (\<lambda>x. (f \<circ> (+)x0)x - f x0)"
   let ?f' = "\<lambda>x. invf o\<^sub>L (f' (x + x0))"
   obtain U' V g g' where "open U'" and U': "U' \<subseteq> (+)(-x0) ` U" "0 \<in> U'"
     and "open V" "0 \<in> V" and hom: "homeomorphism U' V ?f g"
     and derg: "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
     and g': "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (?f'(g y))"
     and bij: "\<And>y. y \<in> V \<Longrightarrow> bij (?f'(g y))"
   proof (rule inverse_function_theorem_scaled [of "(+)(-x0) ` U" ?f "?f'"])
     show ope: "open ((+) (- x0) ` U)"
       using \<open>open U\<close> open_translation by blast
     show "(?f has_derivative blinfun_apply (?f' x)) (at x)"
       if "x \<in> (+) (- x0) ` U" for x
       using that
       apply clarify
       apply (rule derf derivative_eq_intros | simp add: blinfun_compose.rep_eq)+
       done
     have YY: "(\<lambda>x. f' (x + x0)) \<midarrow>u-x0\<rightarrow> f' u"
       if "f' \<midarrow>u\<rightarrow> f' u" "u \<in> U" for u
       using that LIM_offset [where k = x0] by (auto simp: algebra_simps)
     then have "continuous_on ((+) (- x0) ` U) (\<lambda>x. f' (x + x0))"
       using contf \<open>open U\<close> Lim_at_imp_Lim_at_within
       by (fastforce simp: continuous_on_def at_within_open_NO_MATCH ope)
     then show "continuous_on ((+) (- x0) ` U) ?f'"
       by (intro continuous_intros) simp
   qed (auto simp: invf \<open>x0 \<in> U\<close>)
   show thesis
   proof
     let ?U' = "(+)x0 ` U'"
     let ?V = "((+)(f x0) \<circ> f' x0) ` V"
     let ?g = "(+)x0 \<circ> g \<circ> invf \<circ> (+)(- f x0)"
     let ?g' = "\<lambda>y. inv (blinfun_apply (f' (?g y)))"
     show oU': "open ?U'"
       by (simp add: \<open>open U'\<close> open_translation)
     show subU: "?U' \<subseteq> U"
       using ComplI \<open>U' \<subseteq> (+) (- x0) ` U\<close> by auto
     show "x0 \<in> ?U'"
       by (simp add: \<open>0 \<in> U'\<close>)
     show "open ?V"
       using blinfun_bij2 [OF invf]
       by (metis \<open>open V\<close> bij_is_surj blinfun.bounded_linear_right bounded_linear_def image_comp open_surjective_linear_image open_translation)
     show "f x0 \<in> ?V"
       using \<open>0 \<in> V\<close> image_iff by fastforce
     show "homeomorphism ?U' ?V f ?g"
     proof
       show "continuous_on ?U' f"
         by (meson subU continuous_on_eq_continuous_at derf has_derivative_continuous oU' subsetD)
       have "?f ` U' \<subseteq> V"
         using hom homeomorphism_image1 by blast
       then show "f ` ?U' \<subseteq> ?V"
         unfolding image_subset_iff
         by (clarsimp simp: image_def) (metis apply2 add.commute diff_add_cancel)
       show "?g ` ?V \<subseteq> ?U'"
         using hom invf by (auto simp: image_def homeomorphism_def)
       show "?g (f x) = x"
         if "x \<in> ?U'" for x
         using that hom homeomorphism_apply1 by fastforce
       have "continuous_on V g"
         using hom homeomorphism_def by blast
       then show "continuous_on ?V ?g"
         by (intro continuous_intros) (auto elim!: continuous_on_subset)
       have fg: "?f (g x) = x" if "x \<in> V" for x
         using hom homeomorphism_apply2 that by blast
       show "f (?g y) = y"
         if "y \<in> ?V" for y
         using that fg by (simp add: image_iff) (metis apply2 add.commute diff_add_cancel)
     qed
     show "(?g has_derivative ?g' y) (at y)" "bij (blinfun_apply (f' (?g y)))"
       if "y \<in> ?V" for y
     proof -
       have 1: "bij (blinfun_apply invf)"
         using blinfun_bij1 invf by blast
       then have 2: "bij (blinfun_apply (f' (x0 + g x)))" if "x \<in> V" for x
         by (metis add.commute bij bij_betw_comp_iff2 blinfun_compose.rep_eq that top_greatest)
       then show "bij (blinfun_apply (f' (?g y)))"
         using that by auto
       have "g' x \<circ> blinfun_apply invf = inv (blinfun_apply (f' (x0 + g x)))"
         if "x \<in> V" for x
         using that
         by (simp add: g' o_inv_distrib blinfun_compose.rep_eq 1 2 add.commute bij_is_inj flip: o_assoc)
       then show "(?g has_derivative ?g' y) (at y)"
         using that invf
         by clarsimp (rule derg derivative_eq_intros | simp flip: id_def)+
     qed
   qed auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Piecewise differentiable functions\<close>
 
 definition piecewise_differentiable_on
            (infixr "piecewise'_differentiable'_on" 50)
   where "f piecewise_differentiable_on i  \<equiv>
            continuous_on i f \<and>
            (\<exists>S. finite S \<and> (\<forall>x \<in> i - S. f differentiable (at x within i)))"
 
 lemma piecewise_differentiable_on_imp_continuous_on:
     "f piecewise_differentiable_on S \<Longrightarrow> continuous_on S f"
 by (simp add: piecewise_differentiable_on_def)
 
 lemma piecewise_differentiable_on_subset:
     "f piecewise_differentiable_on S \<Longrightarrow> T \<le> S \<Longrightarrow> f piecewise_differentiable_on T"
   using continuous_on_subset
   unfolding piecewise_differentiable_on_def
   apply safe
   apply (blast elim: continuous_on_subset)
   by (meson Diff_iff differentiable_within_subset subsetCE)
 
 lemma differentiable_on_imp_piecewise_differentiable:
   fixes a:: "'a::{linorder_topology,real_normed_vector}"
   shows "f differentiable_on {a..b} \<Longrightarrow> f piecewise_differentiable_on {a..b}"
   apply (simp add: piecewise_differentiable_on_def differentiable_imp_continuous_on)
   apply (rule_tac x="{a,b}" in exI, simp add: differentiable_on_def)
   done
 
 lemma differentiable_imp_piecewise_differentiable:
     "(\<And>x. x \<in> S \<Longrightarrow> f differentiable (at x within S))
          \<Longrightarrow> f piecewise_differentiable_on S"
 by (auto simp: piecewise_differentiable_on_def differentiable_imp_continuous_on differentiable_on_def
          intro: differentiable_within_subset)
 
 lemma piecewise_differentiable_const [iff]: "(\<lambda>x. z) piecewise_differentiable_on S"
   by (simp add: differentiable_imp_piecewise_differentiable)
 
 lemma piecewise_differentiable_compose:
     "\<lbrakk>f piecewise_differentiable_on S; g piecewise_differentiable_on (f ` S);
       \<And>x. finite (S \<inter> f-`{x})\<rbrakk>
       \<Longrightarrow> (g \<circ> f) piecewise_differentiable_on S"
   apply (simp add: piecewise_differentiable_on_def, safe)
   apply (blast intro: continuous_on_compose2)
   apply (rename_tac A B)
   apply (rule_tac x="A \<union> (\<Union>x\<in>B. S \<inter> f-`{x})" in exI)
   apply (blast intro!: differentiable_chain_within)
   done
 
 lemma piecewise_differentiable_affine:
   fixes m::real
   assumes "f piecewise_differentiable_on ((\<lambda>x. m *\<^sub>R x + c) ` S)"
   shows "(f \<circ> (\<lambda>x. m *\<^sub>R x + c)) piecewise_differentiable_on S"
 proof (cases "m = 0")
   case True
   then show ?thesis
     unfolding o_def
     by (force intro: differentiable_imp_piecewise_differentiable differentiable_const)
 next
   case False
   show ?thesis
     apply (rule piecewise_differentiable_compose [OF differentiable_imp_piecewise_differentiable])
     apply (rule assms derivative_intros | simp add: False vimage_def real_vector_affinity_eq)+
     done
 qed
 
 lemma piecewise_differentiable_cases:
   fixes c::real
   assumes "f piecewise_differentiable_on {a..c}"
           "g piecewise_differentiable_on {c..b}"
            "a \<le> c" "c \<le> b" "f c = g c"
   shows "(\<lambda>x. if x \<le> c then f x else g x) piecewise_differentiable_on {a..b}"
 proof -
   obtain S T where st: "finite S" "finite T"
                and fd: "\<And>x. x \<in> {a..c} - S \<Longrightarrow> f differentiable at x within {a..c}"
                and gd: "\<And>x. x \<in> {c..b} - T \<Longrightarrow> g differentiable at x within {c..b}"
     using assms
     by (auto simp: piecewise_differentiable_on_def)
   have finabc: "finite ({a,b,c} \<union> (S \<union> T))"
     by (metis \<open>finite S\<close> \<open>finite T\<close> finite_Un finite_insert finite.emptyI)
   have "continuous_on {a..c} f" "continuous_on {c..b} g"
     using assms piecewise_differentiable_on_def by auto
   then have "continuous_on {a..b} (\<lambda>x. if x \<le> c then f x else g x)"
     using continuous_on_cases [OF closed_real_atLeastAtMost [of a c],
                                OF closed_real_atLeastAtMost [of c b],
                                of f g "\<lambda>x. x\<le>c"]  assms
     by (force simp: ivl_disj_un_two_touch)
   moreover
   { fix x
     assume x: "x \<in> {a..b} - ({a,b,c} \<union> (S \<union> T))"
     have "(\<lambda>x. if x \<le> c then f x else g x) differentiable at x within {a..b}" (is "?diff_fg")
     proof (cases x c rule: le_cases)
       case le show ?diff_fg
       proof (rule differentiable_transform_within [where d = "dist x c"])
         have "f differentiable at x"
           using x le fd [of x] at_within_interior [of x "{a..c}"] by simp
         then show "f differentiable at x within {a..b}"
           by (simp add: differentiable_at_withinI)
       qed (use x le st dist_real_def in auto)
     next
       case ge show ?diff_fg
       proof (rule differentiable_transform_within [where d = "dist x c"])
         have "g differentiable at x"
           using x ge gd [of x] at_within_interior [of x "{c..b}"] by simp
         then show "g differentiable at x within {a..b}"
           by (simp add: differentiable_at_withinI)
       qed (use x ge st dist_real_def in auto)
     qed
   }
   then have "\<exists>S. finite S \<and>
                  (\<forall>x\<in>{a..b} - S. (\<lambda>x. if x \<le> c then f x else g x) differentiable at x within {a..b})"
     by (meson finabc)
   ultimately show ?thesis
     by (simp add: piecewise_differentiable_on_def)
 qed
 
 lemma piecewise_differentiable_neg:
     "f piecewise_differentiable_on S \<Longrightarrow> (\<lambda>x. -(f x)) piecewise_differentiable_on S"
   by (auto simp: piecewise_differentiable_on_def continuous_on_minus)
 
 lemma piecewise_differentiable_add:
   assumes "f piecewise_differentiable_on i"
           "g piecewise_differentiable_on i"
     shows "(\<lambda>x. f x + g x) piecewise_differentiable_on i"
 proof -
   obtain S T where st: "finite S" "finite T"
                        "\<forall>x\<in>i - S. f differentiable at x within i"
                        "\<forall>x\<in>i - T. g differentiable at x within i"
     using assms by (auto simp: piecewise_differentiable_on_def)
   then have "finite (S \<union> T) \<and> (\<forall>x\<in>i - (S \<union> T). (\<lambda>x. f x + g x) differentiable at x within i)"
     by auto
   moreover have "continuous_on i f" "continuous_on i g"
     using assms piecewise_differentiable_on_def by auto
   ultimately show ?thesis
     by (auto simp: piecewise_differentiable_on_def continuous_on_add)
 qed
 
 lemma piecewise_differentiable_diff:
     "\<lbrakk>f piecewise_differentiable_on S;  g piecewise_differentiable_on S\<rbrakk>
      \<Longrightarrow> (\<lambda>x. f x - g x) piecewise_differentiable_on S"
   unfolding diff_conv_add_uminus
   by (metis piecewise_differentiable_add piecewise_differentiable_neg)
 
 
 subsection\<open>The concept of continuously differentiable\<close>
 
 text \<open>
 John Harrison writes as follows:
 
 ``The usual assumption in complex analysis texts is that a path \<open>\<gamma>\<close> should be piecewise
 continuously differentiable, which ensures that the path integral exists at least for any continuous
 f, since all piecewise continuous functions are integrable. However, our notion of validity is
 weaker, just piecewise differentiability\ldots{} [namely] continuity plus differentiability except on a
 finite set\ldots{} [Our] underlying theory of integration is the Kurzweil-Henstock theory. In contrast to
 the Riemann or Lebesgue theory (but in common with a simple notion based on antiderivatives), this
 can integrate all derivatives.''
 
 "Formalizing basic complex analysis." From Insight to Proof: Festschrift in Honour of Andrzej Trybulec.
 Studies in Logic, Grammar and Rhetoric 10.23 (2007): 151-165.
 
 And indeed he does not assume that his derivatives are continuous, but the penalty is unreasonably
 difficult proofs concerning winding numbers. We need a self-contained and straightforward theorem
 asserting that all derivatives can be integrated before we can adopt Harrison's choice.\<close>
 
 definition\<^marker>\<open>tag important\<close> C1_differentiable_on :: "(real \<Rightarrow> 'a::real_normed_vector) \<Rightarrow> real set \<Rightarrow> bool"
            (infix "C1'_differentiable'_on" 50)
   where
   "f C1_differentiable_on S \<longleftrightarrow>
    (\<exists>D. (\<forall>x \<in> S. (f has_vector_derivative (D x)) (at x)) \<and> continuous_on S D)"
 
 lemma C1_differentiable_on_eq:
     "f C1_differentiable_on S \<longleftrightarrow>
      (\<forall>x \<in> S. f differentiable at x) \<and> continuous_on S (\<lambda>x. vector_derivative f (at x))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding C1_differentiable_on_def
     by (metis (no_types, lifting) continuous_on_eq  differentiableI_vector vector_derivative_at)
 next
   assume ?rhs
   then show ?lhs
     using C1_differentiable_on_def vector_derivative_works by fastforce
 qed
 
 lemma C1_differentiable_on_subset:
   "f C1_differentiable_on T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> f C1_differentiable_on S"
   unfolding C1_differentiable_on_def  continuous_on_eq_continuous_within
   by (blast intro:  continuous_within_subset)
 
 lemma C1_differentiable_compose:
   assumes fg: "f C1_differentiable_on S" "g C1_differentiable_on (f ` S)" and fin: "\<And>x. finite (S \<inter> f-`{x})"
   shows "(g \<circ> f) C1_differentiable_on S"
 proof -
   have "\<And>x. x \<in> S \<Longrightarrow> g \<circ> f differentiable at x"
     by (meson C1_differentiable_on_eq assms differentiable_chain_at imageI)
   moreover have "continuous_on S (\<lambda>x. vector_derivative (g \<circ> f) (at x))"
   proof (rule continuous_on_eq [of _ "\<lambda>x. vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x))"])
     show "continuous_on S (\<lambda>x. vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x)))"
       using fg
       apply (clarsimp simp add: C1_differentiable_on_eq)
       apply (rule Limits.continuous_on_scaleR, assumption)
       by (metis (mono_tags, lifting) continuous_at_imp_continuous_on continuous_on_compose continuous_on_cong differentiable_imp_continuous_within o_def)
     show "\<And>x. x \<in> S \<Longrightarrow> vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x)) = vector_derivative (g \<circ> f) (at x)"
       by (metis (mono_tags, hide_lams) C1_differentiable_on_eq fg imageI vector_derivative_chain_at)
   qed
   ultimately show ?thesis
     by (simp add: C1_differentiable_on_eq)
 qed
 
 lemma C1_diff_imp_diff: "f C1_differentiable_on S \<Longrightarrow> f differentiable_on S"
   by (simp add: C1_differentiable_on_eq differentiable_at_imp_differentiable_on)
 
 lemma C1_differentiable_on_ident [simp, derivative_intros]: "(\<lambda>x. x) C1_differentiable_on S"
   by (auto simp: C1_differentiable_on_eq)
 
 lemma C1_differentiable_on_const [simp, derivative_intros]: "(\<lambda>z. a) C1_differentiable_on S"
   by (auto simp: C1_differentiable_on_eq)
 
 lemma C1_differentiable_on_add [simp, derivative_intros]:
   "f C1_differentiable_on S \<Longrightarrow> g C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x + g x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq  by (auto intro: continuous_intros)
 
 lemma C1_differentiable_on_minus [simp, derivative_intros]:
   "f C1_differentiable_on S \<Longrightarrow> (\<lambda>x. - f x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq  by (auto intro: continuous_intros)
 
 lemma C1_differentiable_on_diff [simp, derivative_intros]:
   "f C1_differentiable_on S \<Longrightarrow> g C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x - g x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq  by (auto intro: continuous_intros)
 
 lemma C1_differentiable_on_mult [simp, derivative_intros]:
   fixes f g :: "real \<Rightarrow> 'a :: real_normed_algebra"
   shows "f C1_differentiable_on S \<Longrightarrow> g C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x * g x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq
   by (auto simp: continuous_on_add continuous_on_mult continuous_at_imp_continuous_on differentiable_imp_continuous_within)
 
 lemma C1_differentiable_on_scaleR [simp, derivative_intros]:
   "f C1_differentiable_on S \<Longrightarrow> g C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x *\<^sub>R g x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq
   by (rule continuous_intros | simp add: continuous_at_imp_continuous_on differentiable_imp_continuous_within)+
 
+lemma C1_differentiable_on_of_real [derivative_intros]: "of_real C1_differentiable_on S"
+  unfolding C1_differentiable_on_def
+  by (smt (verit, del_insts) DERIV_ident UNIV_I continuous_on_const has_vector_derivative_of_real has_vector_derivative_transform)
+
 
 definition\<^marker>\<open>tag important\<close> piecewise_C1_differentiable_on
            (infixr "piecewise'_C1'_differentiable'_on" 50)
   where "f piecewise_C1_differentiable_on i  \<equiv>
            continuous_on i f \<and>
            (\<exists>S. finite S \<and> (f C1_differentiable_on (i - S)))"
 
 lemma C1_differentiable_imp_piecewise:
     "f C1_differentiable_on S \<Longrightarrow> f piecewise_C1_differentiable_on S"
   by (auto simp: piecewise_C1_differentiable_on_def C1_differentiable_on_eq continuous_at_imp_continuous_on differentiable_imp_continuous_within)
 
 lemma piecewise_C1_imp_differentiable:
     "f piecewise_C1_differentiable_on i \<Longrightarrow> f piecewise_differentiable_on i"
   by (auto simp: piecewise_C1_differentiable_on_def piecewise_differentiable_on_def
            C1_differentiable_on_def differentiable_def has_vector_derivative_def
            intro: has_derivative_at_withinI)
 
-lemma piecewise_C1_differentiable_compose:
+lemma piecewise_C1_differentiable_compose [derivative_intros]:
   assumes fg: "f piecewise_C1_differentiable_on S" "g piecewise_C1_differentiable_on (f ` S)" and fin: "\<And>x. finite (S \<inter> f-`{x})"
   shows "(g \<circ> f) piecewise_C1_differentiable_on S"
 proof -
   have "continuous_on S (\<lambda>x. g (f x))"
     by (metis continuous_on_compose2 fg order_refl piecewise_C1_differentiable_on_def)
   moreover have "\<exists>T. finite T \<and> g \<circ> f C1_differentiable_on S - T"
   proof -
     obtain F where "finite F" and F: "f C1_differentiable_on S - F" and f: "f piecewise_C1_differentiable_on S"
       using fg by (auto simp: piecewise_C1_differentiable_on_def)
     obtain G where "finite G" and G: "g C1_differentiable_on f ` S - G" and g: "g piecewise_C1_differentiable_on f ` S"
       using fg by (auto simp: piecewise_C1_differentiable_on_def)
     show ?thesis
     proof (intro exI conjI)
       show "finite (F \<union> (\<Union>x\<in>G. S \<inter> f-`{x}))"
         using fin by (auto simp only: Int_Union \<open>finite F\<close> \<open>finite G\<close> finite_UN finite_imageI)
       show "g \<circ> f C1_differentiable_on S - (F \<union> (\<Union>x\<in>G. S \<inter> f -` {x}))"
         apply (rule C1_differentiable_compose)
           apply (blast intro: C1_differentiable_on_subset [OF F])
           apply (blast intro: C1_differentiable_on_subset [OF G])
         by (simp add:  C1_differentiable_on_subset G Diff_Int_distrib2 fin)
     qed
   qed
   ultimately show ?thesis
     by (simp add: piecewise_C1_differentiable_on_def)
 qed
 
 lemma piecewise_C1_differentiable_on_subset:
     "f piecewise_C1_differentiable_on S \<Longrightarrow> T \<le> S \<Longrightarrow> f piecewise_C1_differentiable_on T"
   by (auto simp: piecewise_C1_differentiable_on_def elim!: continuous_on_subset C1_differentiable_on_subset)
 
 lemma C1_differentiable_imp_continuous_on:
   "f C1_differentiable_on S \<Longrightarrow> continuous_on S f"
   unfolding C1_differentiable_on_eq continuous_on_eq_continuous_within
   using differentiable_at_withinI differentiable_imp_continuous_within by blast
 
-lemma C1_differentiable_on_empty [iff]: "f C1_differentiable_on {}"
+lemma C1_differentiable_on_empty [iff,derivative_intros]: "f C1_differentiable_on {}"
   unfolding C1_differentiable_on_def
   by auto
 
 lemma piecewise_C1_differentiable_affine:
   fixes m::real
   assumes "f piecewise_C1_differentiable_on ((\<lambda>x. m * x + c) ` S)"
   shows "(f \<circ> (\<lambda>x. m *\<^sub>R x + c)) piecewise_C1_differentiable_on S"
 proof (cases "m = 0")
   case True
   then show ?thesis
     unfolding o_def by (auto simp: piecewise_C1_differentiable_on_def)
 next
   case False
   have *: "\<And>x. finite (S \<inter> {y. m * y + c = x})"
     using False not_finite_existsD by fastforce
   show ?thesis
     apply (rule piecewise_C1_differentiable_compose [OF C1_differentiable_imp_piecewise])
     apply (rule * assms derivative_intros | simp add: False vimage_def)+
     done
 qed
 
-lemma piecewise_C1_differentiable_cases:
+lemma piecewise_C1_differentiable_cases [derivative_intros]:
   fixes c::real
   assumes "f piecewise_C1_differentiable_on {a..c}"
           "g piecewise_C1_differentiable_on {c..b}"
            "a \<le> c" "c \<le> b" "f c = g c"
   shows "(\<lambda>x. if x \<le> c then f x else g x) piecewise_C1_differentiable_on {a..b}"
 proof -
   obtain S T where st: "f C1_differentiable_on ({a..c} - S)"
                        "g C1_differentiable_on ({c..b} - T)"
                        "finite S" "finite T"
     using assms
     by (force simp: piecewise_C1_differentiable_on_def)
   then have f_diff: "f differentiable_on {a..<c} - S"
         and g_diff: "g differentiable_on {c<..b} - T"
     by (simp_all add: C1_differentiable_on_eq differentiable_at_withinI differentiable_on_def)
   have "continuous_on {a..c} f" "continuous_on {c..b} g"
     using assms piecewise_C1_differentiable_on_def by auto
   then have cab: "continuous_on {a..b} (\<lambda>x. if x \<le> c then f x else g x)"
     using continuous_on_cases [OF closed_real_atLeastAtMost [of a c],
                                OF closed_real_atLeastAtMost [of c b],
                                of f g "\<lambda>x. x\<le>c"]  assms
     by (force simp: ivl_disj_un_two_touch)
   { fix x
     assume x: "x \<in> {a..b} - insert c (S \<union> T)"
     have "(\<lambda>x. if x \<le> c then f x else g x) differentiable at x" (is "?diff_fg")
     proof (cases x c rule: le_cases)
       case le show ?diff_fg
         apply (rule differentiable_transform_within [where f=f and d = "dist x c"])
         using x dist_real_def le st by (auto simp: C1_differentiable_on_eq)
     next
       case ge show ?diff_fg
         apply (rule differentiable_transform_within [where f=g and d = "dist x c"])
         using dist_nz x dist_real_def ge st x by (auto simp: C1_differentiable_on_eq)
     qed
   }
   then have "(\<forall>x \<in> {a..b} - insert c (S \<union> T). (\<lambda>x. if x \<le> c then f x else g x) differentiable at x)"
     by auto
   moreover
   { assume fcon: "continuous_on ({a<..<c} - S) (\<lambda>x. vector_derivative f (at x))"
        and gcon: "continuous_on ({c<..<b} - T) (\<lambda>x. vector_derivative g (at x))"
     have "open ({a<..<c} - S)"  "open ({c<..<b} - T)"
       using st by (simp_all add: open_Diff finite_imp_closed)
     moreover have "continuous_on ({a<..<c} - S) (\<lambda>x. vector_derivative (\<lambda>x. if x \<le> c then f x else g x) (at x))"
     proof -
       have "((\<lambda>x. if x \<le> c then f x else g x) has_vector_derivative vector_derivative f (at x))            (at x)"
         if "a < x" "x < c" "x \<notin> S" for x
       proof -
         have f: "f differentiable at x"
           by (meson C1_differentiable_on_eq Diff_iff atLeastAtMost_iff less_eq_real_def st(1) that)
         show ?thesis
           using that
           apply (rule_tac f=f and d="dist x c" in has_vector_derivative_transform_within)
              apply (auto simp: dist_norm vector_derivative_works [symmetric] f)
           done
       qed
       then show ?thesis
         by (metis (no_types, lifting) continuous_on_eq [OF fcon] DiffE greaterThanLessThan_iff vector_derivative_at)
     qed
     moreover have "continuous_on ({c<..<b} - T) (\<lambda>x. vector_derivative (\<lambda>x. if x \<le> c then f x else g x) (at x))"
     proof -
       have "((\<lambda>x. if x \<le> c then f x else g x) has_vector_derivative vector_derivative g (at x))            (at x)"
         if "c < x" "x < b" "x \<notin> T" for x
       proof -
         have g: "g differentiable at x"
           by (metis C1_differentiable_on_eq DiffD1 DiffI atLeastAtMost_diff_ends greaterThanLessThan_iff st(2) that)
         show ?thesis
           using that
           apply (rule_tac f=g and d="dist x c" in has_vector_derivative_transform_within)
              apply (auto simp: dist_norm vector_derivative_works [symmetric] g)
           done
       qed
       then show ?thesis
         by (metis (no_types, lifting) continuous_on_eq [OF gcon] DiffE greaterThanLessThan_iff vector_derivative_at)
     qed
     ultimately have "continuous_on ({a<..<b} - insert c (S \<union> T))
         (\<lambda>x. vector_derivative (\<lambda>x. if x \<le> c then f x else g x) (at x))"
       by (rule continuous_on_subset [OF continuous_on_open_Un], auto)
   } note * = this
   have "continuous_on ({a<..<b} - insert c (S \<union> T)) (\<lambda>x. vector_derivative (\<lambda>x. if x \<le> c then f x else g x) (at x))"
     using st
     by (auto simp: C1_differentiable_on_eq elim!: continuous_on_subset intro: *)
   ultimately have "\<exists>S. finite S \<and> ((\<lambda>x. if x \<le> c then f x else g x) C1_differentiable_on {a..b} - S)"
     apply (rule_tac x="{a,b,c} \<union> S \<union> T" in exI)
     using st  by (auto simp: C1_differentiable_on_eq elim!: continuous_on_subset)
   with cab show ?thesis
     by (simp add: piecewise_C1_differentiable_on_def)
 qed
 
-lemma piecewise_C1_differentiable_neg:
+lemma piecewise_C1_differentiable_const [derivative_intros]:
+  "(\<lambda>x. c) piecewise_C1_differentiable_on S"
+  by (simp add: C1_differentiable_imp_piecewise)
+
+lemma piecewise_C1_differentiable_scaleR [derivative_intros]:
+    "\<lbrakk>f piecewise_C1_differentiable_on S\<rbrakk>
+     \<Longrightarrow> (\<lambda>x. c *\<^sub>R f x) piecewise_C1_differentiable_on S"
+  by (force simp add: piecewise_C1_differentiable_on_def continuous_on_scaleR)
+
+lemma piecewise_C1_differentiable_neg [derivative_intros]:
     "f piecewise_C1_differentiable_on S \<Longrightarrow> (\<lambda>x. -(f x)) piecewise_C1_differentiable_on S"
   unfolding piecewise_C1_differentiable_on_def
   by (auto intro!: continuous_on_minus C1_differentiable_on_minus)
 
-lemma piecewise_C1_differentiable_add:
+lemma piecewise_C1_differentiable_add [derivative_intros]:
   assumes "f piecewise_C1_differentiable_on i"
           "g piecewise_C1_differentiable_on i"
     shows "(\<lambda>x. f x + g x) piecewise_C1_differentiable_on i"
 proof -
   obtain S t where st: "finite S" "finite t"
                        "f C1_differentiable_on (i-S)"
                        "g C1_differentiable_on (i-t)"
     using assms by (auto simp: piecewise_C1_differentiable_on_def)
   then have "finite (S \<union> t) \<and> (\<lambda>x. f x + g x) C1_differentiable_on i - (S \<union> t)"
     by (auto intro: C1_differentiable_on_add elim!: C1_differentiable_on_subset)
   moreover have "continuous_on i f" "continuous_on i g"
     using assms piecewise_C1_differentiable_on_def by auto
   ultimately show ?thesis
     by (auto simp: piecewise_C1_differentiable_on_def continuous_on_add)
 qed
 
-lemma piecewise_C1_differentiable_diff:
+lemma piecewise_C1_differentiable_diff [derivative_intros]:
     "\<lbrakk>f piecewise_C1_differentiable_on S;  g piecewise_C1_differentiable_on S\<rbrakk>
      \<Longrightarrow> (\<lambda>x. f x - g x) piecewise_C1_differentiable_on S"
   unfolding diff_conv_add_uminus
   by (metis piecewise_C1_differentiable_add piecewise_C1_differentiable_neg)
 
+lemma piecewise_C1_differentiable_cmult_right [derivative_intros]:
+  fixes c::complex
+  shows "f piecewise_C1_differentiable_on S
+     \<Longrightarrow> (\<lambda>x. f x * c) piecewise_C1_differentiable_on S"
+  by (force simp: piecewise_C1_differentiable_on_def continuous_on_mult_right)
+
+lemma piecewise_C1_differentiable_cmult_left [derivative_intros]:
+  fixes c::complex
+  shows "f piecewise_C1_differentiable_on S
+     \<Longrightarrow> (\<lambda>x. c * f x) piecewise_C1_differentiable_on S"
+  using piecewise_C1_differentiable_cmult_right [of f S c] by (simp add: mult.commute)
+
+lemma piecewise_C1_differentiable_on_of_real [derivative_intros]: 
+  "of_real piecewise_C1_differentiable_on S"
+  by (simp add: C1_differentiable_imp_piecewise C1_differentiable_on_of_real)
+
 end
diff --git a/src/HOL/Analysis/Linear_Algebra.thy b/src/HOL/Analysis/Linear_Algebra.thy
--- a/src/HOL/Analysis/Linear_Algebra.thy
+++ b/src/HOL/Analysis/Linear_Algebra.thy
@@ -1,1878 +1,1881 @@
 (*  Title:      HOL/Analysis/Linear_Algebra.thy
     Author:     Amine Chaieb, University of Cambridge
 *)
 
 section \<open>Elementary Linear Algebra on Euclidean Spaces\<close>
 
 theory Linear_Algebra
 imports
   Euclidean_Space
   "HOL-Library.Infinite_Set"
 begin
 
 lemma linear_simps:
   assumes "bounded_linear f"
   shows
     "f (a + b) = f a + f b"
     "f (a - b) = f a - f b"
     "f 0 = 0"
     "f (- a) = - f a"
     "f (s *\<^sub>R v) = s *\<^sub>R (f v)"
 proof -
   interpret f: bounded_linear f by fact
   show "f (a + b) = f a + f b" by (rule f.add)
   show "f (a - b) = f a - f b" by (rule f.diff)
   show "f 0 = 0" by (rule f.zero)
   show "f (- a) = - f a" by (rule f.neg)
   show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scale)
 qed
 
 lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x \<in> (UNIV::'a::finite set)}"
   using finite finite_image_set by blast
 
 lemma substdbasis_expansion_unique:
   includes inner_syntax
   assumes d: "d \<subseteq> Basis"
   shows "(\<Sum>i\<in>d. f i *\<^sub>R i) = (x::'a::euclidean_space) \<longleftrightarrow>
     (\<forall>i\<in>Basis. (i \<in> d \<longrightarrow> f i = x \<bullet> i) \<and> (i \<notin> d \<longrightarrow> x \<bullet> i = 0))"
 proof -
   have *: "\<And>x a b P. x * (if P then a else b) = (if P then x * a else x * b)"
     by auto
   have **: "finite d"
     by (auto intro: finite_subset[OF assms])
   have ***: "\<And>i. i \<in> Basis \<Longrightarrow> (\<Sum>i\<in>d. f i *\<^sub>R i) \<bullet> i = (\<Sum>x\<in>d. if x = i then f x else 0)"
     using d
     by (auto intro!: sum.cong simp: inner_Basis inner_sum_left)
   show ?thesis
     unfolding euclidean_eq_iff[where 'a='a] by (auto simp: sum.delta[OF **] ***)
 qed
 
 lemma independent_substdbasis: "d \<subseteq> Basis \<Longrightarrow> independent d"
   by (rule independent_mono[OF independent_Basis])
 
 lemma subset_translation_eq [simp]:
     fixes a :: "'a::real_vector" shows "(+) a ` s \<subseteq> (+) a ` t \<longleftrightarrow> s \<subseteq> t"
   by auto
 
 lemma translate_inj_on:
   fixes A :: "'a::ab_group_add set"
   shows "inj_on (\<lambda>x. a + x) A"
   unfolding inj_on_def by auto
 
 lemma translation_assoc:
   fixes a b :: "'a::ab_group_add"
   shows "(\<lambda>x. b + x) ` ((\<lambda>x. a + x) ` S) = (\<lambda>x. (a + b) + x) ` S"
   by auto
 
 lemma translation_invert:
   fixes a :: "'a::ab_group_add"
   assumes "(\<lambda>x. a + x) ` A = (\<lambda>x. a + x) ` B"
   shows "A = B"
 proof -
   have "(\<lambda>x. -a + x) ` ((\<lambda>x. a + x) ` A) = (\<lambda>x. - a + x) ` ((\<lambda>x. a + x) ` B)"
     using assms by auto
   then show ?thesis
     using translation_assoc[of "-a" a A] translation_assoc[of "-a" a B] by auto
 qed
 
 lemma translation_galois:
   fixes a :: "'a::ab_group_add"
   shows "T = ((\<lambda>x. a + x) ` S) \<longleftrightarrow> S = ((\<lambda>x. (- a) + x) ` T)"
   using translation_assoc[of "-a" a S]
   apply auto
   using translation_assoc[of a "-a" T]
   apply auto
   done
 
 lemma translation_inverse_subset:
   assumes "((\<lambda>x. - a + x) ` V) \<le> (S :: 'n::ab_group_add set)"
   shows "V \<le> ((\<lambda>x. a + x) ` S)"
 proof -
   {
     fix x
     assume "x \<in> V"
     then have "x-a \<in> S" using assms by auto
     then have "x \<in> {a + v |v. v \<in> S}"
       apply auto
       apply (rule exI[of _ "x-a"], simp)
       done
     then have "x \<in> ((\<lambda>x. a+x) ` S)" by auto
   }
   then show ?thesis by auto
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More interesting properties of the norm\<close>
 
 unbundle inner_syntax
 
 text\<open>Equality of vectors in terms of \<^term>\<open>(\<bullet>)\<close> products.\<close>
 
 lemma linear_componentwise:
   fixes f:: "'a::euclidean_space \<Rightarrow> 'b::real_inner"
   assumes lf: "linear f"
   shows "(f x) \<bullet> j = (\<Sum>i\<in>Basis. (x\<bullet>i) * (f i\<bullet>j))" (is "?lhs = ?rhs")
 proof -
   interpret linear f by fact
   have "?rhs = (\<Sum>i\<in>Basis. (x\<bullet>i) *\<^sub>R (f i))\<bullet>j"
     by (simp add: inner_sum_left)
   then show ?thesis
     by (simp add: euclidean_representation sum[symmetric] scale[symmetric])
 qed
 
 lemma vector_eq: "x = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y \<and> y \<bullet> y = x \<bullet> x"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then show ?rhs by simp
 next
   assume ?rhs
   then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y \<bullet> y = 0"
     by simp
   then have "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0"
     by (simp add: inner_diff inner_commute)
   then have "(x - y) \<bullet> (x - y) = 0"
     by (simp add: field_simps inner_diff inner_commute)
   then show "x = y" by simp
 qed
 
 lemma norm_triangle_half_r:
   "norm (y - x1) < e / 2 \<Longrightarrow> norm (y - x2) < e / 2 \<Longrightarrow> norm (x1 - x2) < e"
   using dist_triangle_half_r unfolding dist_norm[symmetric] by auto
 
 lemma norm_triangle_half_l:
   assumes "norm (x - y) < e / 2"
     and "norm (x' - y) < e / 2"
   shows "norm (x - x') < e"
   using dist_triangle_half_l[OF assms[unfolded dist_norm[symmetric]]]
   unfolding dist_norm[symmetric] .
 
 lemma abs_triangle_half_r:
   fixes y :: "'a::linordered_field"
   shows "abs (y - x1) < e / 2 \<Longrightarrow> abs (y - x2) < e / 2 \<Longrightarrow> abs (x1 - x2) < e"
   by linarith
 
 lemma abs_triangle_half_l:
   fixes y :: "'a::linordered_field"
   assumes "abs (x - y) < e / 2"
     and "abs (x' - y) < e / 2"
   shows "abs (x - x') < e"
   using assms by linarith
 
 lemma sum_clauses:
   shows "sum f {} = 0"
     and "finite S \<Longrightarrow> sum f (insert x S) = (if x \<in> S then sum f S else f x + sum f S)"
   by (auto simp add: insert_absorb)
 
 lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = z"
 proof
   assume "\<forall>x. x \<bullet> y = x \<bullet> z"
   then have "\<forall>x. x \<bullet> (y - z) = 0"
     by (simp add: inner_diff)
   then have "(y - z) \<bullet> (y - z) = 0" ..
   then show "y = z" by simp
 qed simp
 
 lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = y"
 proof
   assume "\<forall>z. x \<bullet> z = y \<bullet> z"
   then have "\<forall>z. (x - y) \<bullet> z = 0"
     by (simp add: inner_diff)
   then have "(x - y) \<bullet> (x - y) = 0" ..
   then show "x = y" by simp
 qed simp
 
 subsection \<open>Substandard Basis\<close>
 
 lemma ex_card:
   assumes "n \<le> card A"
   shows "\<exists>S\<subseteq>A. card S = n"
 proof (cases "finite A")
   case True
   from ex_bij_betw_nat_finite[OF this] obtain f where f: "bij_betw f {0..<card A} A" ..
   moreover from f \<open>n \<le> card A\<close> have "{..< n} \<subseteq> {..< card A}" "inj_on f {..< n}"
     by (auto simp: bij_betw_def intro: subset_inj_on)
   ultimately have "f ` {..< n} \<subseteq> A" "card (f ` {..< n}) = n"
     by (auto simp: bij_betw_def card_image)
   then show ?thesis by blast
 next
   case False
   with \<open>n \<le> card A\<close> show ?thesis by force
 qed
 
 lemma subspace_substandard: "subspace {x::'a::euclidean_space. (\<forall>i\<in>Basis. P i \<longrightarrow> x\<bullet>i = 0)}"
   by (auto simp: subspace_def inner_add_left)
 
 lemma dim_substandard:
   assumes d: "d \<subseteq> Basis"
   shows "dim {x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0} = card d" (is "dim ?A = _")
 proof (rule dim_unique)
   from d show "d \<subseteq> ?A"
     by (auto simp: inner_Basis)
   from d show "independent d"
     by (rule independent_mono [OF independent_Basis])
   have "x \<in> span d" if "\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0" for x
   proof -
     have "finite d"
       by (rule finite_subset [OF d finite_Basis])
     then have "(\<Sum>i\<in>d. (x \<bullet> i) *\<^sub>R i) \<in> span d"
       by (simp add: span_sum span_clauses)
     also have "(\<Sum>i\<in>d. (x \<bullet> i) *\<^sub>R i) = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i)"
       by (rule sum.mono_neutral_cong_left [OF finite_Basis d]) (auto simp: that)
     finally show "x \<in> span d"
       by (simp only: euclidean_representation)
   qed
   then show "?A \<subseteq> span d" by auto
 qed simp
 
 
 subsection \<open>Orthogonality\<close>
 
 definition\<^marker>\<open>tag important\<close> (in real_inner) "orthogonal x y \<longleftrightarrow> x \<bullet> y = 0"
 
 context real_inner
 begin
 
 lemma orthogonal_self: "orthogonal x x \<longleftrightarrow> x = 0"
   by (simp add: orthogonal_def)
 
 lemma orthogonal_clauses:
   "orthogonal a 0"
   "orthogonal a x \<Longrightarrow> orthogonal a (c *\<^sub>R x)"
   "orthogonal a x \<Longrightarrow> orthogonal a (- x)"
   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x + y)"
   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x - y)"
   "orthogonal 0 a"
   "orthogonal x a \<Longrightarrow> orthogonal (c *\<^sub>R x) a"
   "orthogonal x a \<Longrightarrow> orthogonal (- x) a"
   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x + y) a"
   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x - y) a"
   unfolding orthogonal_def inner_add inner_diff by auto
 
 end
 
 lemma orthogonal_commute: "orthogonal x y \<longleftrightarrow> orthogonal y x"
   by (simp add: orthogonal_def inner_commute)
 
 lemma orthogonal_scaleR [simp]: "c \<noteq> 0 \<Longrightarrow> orthogonal (c *\<^sub>R x) = orthogonal x"
   by (rule ext) (simp add: orthogonal_def)
 
 lemma pairwise_ortho_scaleR:
     "pairwise (\<lambda>i j. orthogonal (f i) (g j)) B
     \<Longrightarrow> pairwise (\<lambda>i j. orthogonal (a i *\<^sub>R f i) (a j *\<^sub>R g j)) B"
   by (auto simp: pairwise_def orthogonal_clauses)
 
 lemma orthogonal_rvsum:
     "\<lbrakk>finite s; \<And>y. y \<in> s \<Longrightarrow> orthogonal x (f y)\<rbrakk> \<Longrightarrow> orthogonal x (sum f s)"
   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
 
 lemma orthogonal_lvsum:
     "\<lbrakk>finite s; \<And>x. x \<in> s \<Longrightarrow> orthogonal (f x) y\<rbrakk> \<Longrightarrow> orthogonal (sum f s) y"
   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
 
 lemma norm_add_Pythagorean:
   assumes "orthogonal a b"
     shows "norm(a + b) ^ 2 = norm a ^ 2 + norm b ^ 2"
 proof -
   from assms have "(a - (0 - b)) \<bullet> (a - (0 - b)) = a \<bullet> a - (0 - b \<bullet> b)"
     by (simp add: algebra_simps orthogonal_def inner_commute)
   then show ?thesis
     by (simp add: power2_norm_eq_inner)
 qed
 
 lemma norm_sum_Pythagorean:
   assumes "finite I" "pairwise (\<lambda>i j. orthogonal (f i) (f j)) I"
     shows "(norm (sum f I))\<^sup>2 = (\<Sum>i\<in>I. (norm (f i))\<^sup>2)"
 using assms
 proof (induction I rule: finite_induct)
   case empty then show ?case by simp
 next
   case (insert x I)
   then have "orthogonal (f x) (sum f I)"
     by (metis pairwise_insert orthogonal_rvsum)
   with insert show ?case
     by (simp add: pairwise_insert norm_add_Pythagorean)
 qed
 
 
 subsection  \<open>Orthogonality of a transformation\<close>
 
 definition\<^marker>\<open>tag important\<close>  "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation:
   "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v. norm (f v) = norm v)"
   unfolding orthogonal_transformation_def
   apply auto
   apply (erule_tac x=v in allE)+
   apply (simp add: norm_eq_sqrt_inner)
   apply (simp add: dot_norm linear_add[symmetric])
   done
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_id [simp]: "orthogonal_transformation (\<lambda>x. x)"
   by (simp add: linear_iff orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_orthogonal_transformation:
     "orthogonal_transformation f \<Longrightarrow> orthogonal (f x) (f y) \<longleftrightarrow> orthogonal x y"
   by (simp add: orthogonal_def orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_compose:
    "\<lbrakk>orthogonal_transformation f; orthogonal_transformation g\<rbrakk> \<Longrightarrow> orthogonal_transformation(f \<circ> g)"
   by (auto simp: orthogonal_transformation_def linear_compose)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_neg:
   "orthogonal_transformation(\<lambda>x. -(f x)) \<longleftrightarrow> orthogonal_transformation f"
   by (auto simp: orthogonal_transformation_def dest: linear_compose_neg)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_scaleR: "orthogonal_transformation f \<Longrightarrow> f (c *\<^sub>R v) = c *\<^sub>R f v"
   by (simp add: linear_iff orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_linear:
    "orthogonal_transformation f \<Longrightarrow> linear f"
   by (simp add: orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_inj:
   "orthogonal_transformation f \<Longrightarrow> inj f"
   unfolding orthogonal_transformation_def inj_on_def
   by (metis vector_eq)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_surj:
   "orthogonal_transformation f \<Longrightarrow> surj f"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (simp add: linear_injective_imp_surjective orthogonal_transformation_inj orthogonal_transformation_linear)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_bij:
   "orthogonal_transformation f \<Longrightarrow> bij f"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (simp add: bij_def orthogonal_transformation_inj orthogonal_transformation_surj)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_inv:
   "orthogonal_transformation f \<Longrightarrow> orthogonal_transformation (inv f)"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (metis (no_types, hide_lams) bijection.inv_right bijection_def inj_linear_imp_inv_linear orthogonal_transformation orthogonal_transformation_bij orthogonal_transformation_inj)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_norm:
   "orthogonal_transformation f \<Longrightarrow> norm (f x) = norm x"
   by (metis orthogonal_transformation)
 
 
 subsection \<open>Bilinear functions\<close>
 
 definition\<^marker>\<open>tag important\<close>
 bilinear :: "('a::real_vector \<Rightarrow> 'b::real_vector \<Rightarrow> 'c::real_vector) \<Rightarrow> bool" where
 "bilinear f \<longleftrightarrow> (\<forall>x. linear (\<lambda>y. f x y)) \<and> (\<forall>y. linear (\<lambda>x. f x y))"
 
 lemma bilinear_ladd: "bilinear h \<Longrightarrow> h (x + y) z = h x z + h y z"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_radd: "bilinear h \<Longrightarrow> h x (y + z) = h x y + h x z"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_times:
   fixes c::"'a::real_algebra" shows "bilinear (\<lambda>x y::'a. x*y)"
   by (auto simp: bilinear_def distrib_left distrib_right intro!: linearI)
 
 lemma bilinear_lmul: "bilinear h \<Longrightarrow> h (c *\<^sub>R x) y = c *\<^sub>R h x y"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_rmul: "bilinear h \<Longrightarrow> h x (c *\<^sub>R y) = c *\<^sub>R h x y"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_lneg: "bilinear h \<Longrightarrow> h (- x) y = - h x y"
   by (drule bilinear_lmul [of _ "- 1"]) simp
 
 lemma bilinear_rneg: "bilinear h \<Longrightarrow> h x (- y) = - h x y"
   by (drule bilinear_rmul [of _ _ "- 1"]) simp
 
 lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
   using add_left_imp_eq[of x y 0] by auto
 
 lemma bilinear_lzero:
   assumes "bilinear h"
   shows "h 0 x = 0"
   using bilinear_ladd [OF assms, of 0 0 x] by (simp add: eq_add_iff field_simps)
 
 lemma bilinear_rzero:
   assumes "bilinear h"
   shows "h x 0 = 0"
   using bilinear_radd [OF assms, of x 0 0 ] by (simp add: eq_add_iff field_simps)
 
 lemma bilinear_lsub: "bilinear h \<Longrightarrow> h (x - y) z = h x z - h y z"
   using bilinear_ladd [of h x "- y"] by (simp add: bilinear_lneg)
 
 lemma bilinear_rsub: "bilinear h \<Longrightarrow> h z (x - y) = h z x - h z y"
   using bilinear_radd [of h _ x "- y"] by (simp add: bilinear_rneg)
 
 lemma bilinear_sum:
   assumes "bilinear h"
   shows "h (sum f S) (sum g T) = sum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
 proof -
   interpret l: linear "\<lambda>x. h x y" for y using assms by (simp add: bilinear_def)
   interpret r: linear "\<lambda>y. h x y" for x using assms by (simp add: bilinear_def)
   have "h (sum f S) (sum g T) = sum (\<lambda>x. h (f x) (sum g T)) S"
     by (simp add: l.sum)
   also have "\<dots> = sum (\<lambda>x. sum (\<lambda>y. h (f x) (g y)) T) S"
     by (rule sum.cong) (simp_all add: r.sum)
   finally show ?thesis
     unfolding sum.cartesian_product .
 qed
 
 
 subsection \<open>Adjoints\<close>
 
 definition\<^marker>\<open>tag important\<close> adjoint :: "(('a::real_inner) \<Rightarrow> ('b::real_inner)) \<Rightarrow> 'b \<Rightarrow> 'a" where
 "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
 
 lemma adjoint_unique:
   assumes "\<forall>x y. inner (f x) y = inner x (g y)"
   shows "adjoint f = g"
   unfolding adjoint_def
 proof (rule some_equality)
   show "\<forall>x y. inner (f x) y = inner x (g y)"
     by (rule assms)
 next
   fix h
   assume "\<forall>x y. inner (f x) y = inner x (h y)"
   then have "\<forall>x y. inner x (g y) = inner x (h y)"
     using assms by simp
   then have "\<forall>x y. inner x (g y - h y) = 0"
     by (simp add: inner_diff_right)
   then have "\<forall>y. inner (g y - h y) (g y - h y) = 0"
     by simp
   then have "\<forall>y. h y = g y"
     by simp
   then show "h = g" by (simp add: ext)
 qed
 
 text \<open>TODO: The following lemmas about adjoints should hold for any
   Hilbert space (i.e. complete inner product space).
   (see \<^url>\<open>https://en.wikipedia.org/wiki/Hermitian_adjoint\<close>)
 \<close>
 
 lemma adjoint_works:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "x \<bullet> adjoint f y = f x \<bullet> y"
 proof -
   interpret linear f by fact
   have "\<forall>y. \<exists>w. \<forall>x. f x \<bullet> y = x \<bullet> w"
   proof (intro allI exI)
     fix y :: "'m" and x
     let ?w = "(\<Sum>i\<in>Basis. (f i \<bullet> y) *\<^sub>R i) :: 'n"
     have "f x \<bullet> y = f (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i) \<bullet> y"
       by (simp add: euclidean_representation)
     also have "\<dots> = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) \<bullet> y"
       by (simp add: sum scale)
     finally show "f x \<bullet> y = x \<bullet> ?w"
       by (simp add: inner_sum_left inner_sum_right mult.commute)
   qed
   then show ?thesis
     unfolding adjoint_def choice_iff
     by (intro someI2_ex[where Q="\<lambda>f'. x \<bullet> f' y = f x \<bullet> y"]) auto
 qed
 
 lemma adjoint_clauses:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "x \<bullet> adjoint f y = f x \<bullet> y"
     and "adjoint f y \<bullet> x = y \<bullet> f x"
   by (simp_all add: adjoint_works[OF lf] inner_commute)
 
 lemma adjoint_linear:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "linear (adjoint f)"
   by (simp add: lf linear_iff euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m]
     adjoint_clauses[OF lf] inner_distrib)
 
 lemma adjoint_adjoint:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "adjoint (adjoint f) = f"
   by (rule adjoint_unique, simp add: adjoint_clauses [OF lf])
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Euclidean Spaces as Typeclass\<close>
 
 lemma independent_Basis: "independent Basis"
   by (rule independent_Basis)
 
 lemma span_Basis [simp]: "span Basis = UNIV"
   by (rule span_Basis)
 
 lemma in_span_Basis: "x \<in> span Basis"
   unfolding span_Basis ..
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Linearity and Bilinearity continued\<close>
 
 lemma linear_bounded:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes lf: "linear f"
   shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
 proof
   interpret linear f by fact
   let ?B = "\<Sum>b\<in>Basis. norm (f b)"
   show "\<forall>x. norm (f x) \<le> ?B * norm x"
   proof
     fix x :: 'a
     let ?g = "\<lambda>b. (x \<bullet> b) *\<^sub>R f b"
     have "norm (f x) = norm (f (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b))"
       unfolding euclidean_representation ..
     also have "\<dots> = norm (sum ?g Basis)"
       by (simp add: sum scale)
     finally have th0: "norm (f x) = norm (sum ?g Basis)" .
     have th: "norm (?g i) \<le> norm (f i) * norm x" if "i \<in> Basis" for i
     proof -
       from Basis_le_norm[OF that, of x]
       show "norm (?g i) \<le> norm (f i) * norm x"
         unfolding norm_scaleR  by (metis mult.commute mult_left_mono norm_ge_zero)
     qed
     from sum_norm_le[of _ ?g, OF th]
     show "norm (f x) \<le> ?B * norm x"
       unfolding th0 sum_distrib_right by metis
   qed
 qed
 
 lemma linear_conv_bounded_linear:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<longleftrightarrow> bounded_linear f"
 proof
   assume "linear f"
   then interpret f: linear f .
   show "bounded_linear f"
   proof
     have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
       using \<open>linear f\<close> by (rule linear_bounded)
     then show "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
       by (simp add: mult.commute)
   qed
 next
   assume "bounded_linear f"
   then interpret f: bounded_linear f .
   show "linear f" ..
 qed
 
 lemmas linear_linear = linear_conv_bounded_linear[symmetric]
 
 lemma inj_linear_imp_inv_bounded_linear:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
   shows "\<lbrakk>bounded_linear f; inj f\<rbrakk> \<Longrightarrow> bounded_linear (inv f)"
   by (simp add: inj_linear_imp_inv_linear linear_linear)
 
 lemma linear_bounded_pos:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes lf: "linear f"
  obtains B where "B > 0" "\<And>x. norm (f x) \<le> B * norm x"
 proof -
   have "\<exists>B > 0. \<forall>x. norm (f x) \<le> norm x * B"
     using lf unfolding linear_conv_bounded_linear
     by (rule bounded_linear.pos_bounded)
   with that show ?thesis
     by (auto simp: mult.commute)
 qed
 
 lemma linear_invertible_bounded_below_pos:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "linear g" "g \<circ> f = id"
   obtains B where "B > 0" "\<And>x. B * norm x \<le> norm(f x)"
 proof -
   obtain B where "B > 0" and B: "\<And>x. norm (g x) \<le> B * norm x"
     using linear_bounded_pos [OF \<open>linear g\<close>] by blast
   show thesis
   proof
     show "0 < 1/B"
       by (simp add: \<open>B > 0\<close>)
     show "1/B * norm x \<le> norm (f x)" for x
     proof -
       have "1/B * norm x = 1/B * norm (g (f x))"
         using assms by (simp add: pointfree_idE)
       also have "\<dots> \<le> norm (f x)"
         using B [of "f x"] by (simp add: \<open>B > 0\<close> mult.commute pos_divide_le_eq)
       finally show ?thesis .
     qed
   qed
 qed
 
 lemma linear_inj_bounded_below_pos:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
   obtains B where "B > 0" "\<And>x. B * norm x \<le> norm(f x)"
   using linear_injective_left_inverse [OF assms]
     linear_invertible_bounded_below_pos assms by blast
 
 lemma bounded_linearI':
   fixes f ::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>x y. f (x + y) = f x + f y"
     and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
   shows "bounded_linear f"
   using assms linearI linear_conv_bounded_linear by blast
 
 lemma bilinear_bounded:
   fixes h :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'k::real_normed_vector"
   assumes bh: "bilinear h"
   shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
 proof (clarify intro!: exI[of _ "\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)"])
   fix x :: 'm
   fix y :: 'n
   have "norm (h x y) = norm (h (sum (\<lambda>i. (x \<bullet> i) *\<^sub>R i) Basis) (sum (\<lambda>i. (y \<bullet> i) *\<^sub>R i) Basis))"
     by (simp add: euclidean_representation)
   also have "\<dots> = norm (sum (\<lambda> (i,j). h ((x \<bullet> i) *\<^sub>R i) ((y \<bullet> j) *\<^sub>R j)) (Basis \<times> Basis))"
     unfolding bilinear_sum[OF bh] ..
   finally have th: "norm (h x y) = \<dots>" .
   have "\<And>i j. \<lbrakk>i \<in> Basis; j \<in> Basis\<rbrakk>
            \<Longrightarrow> \<bar>x \<bullet> i\<bar> * (\<bar>y \<bullet> j\<bar> * norm (h i j)) \<le> norm x * (norm y * norm (h i j))"
     by (auto simp add: zero_le_mult_iff Basis_le_norm mult_mono)
   then show "norm (h x y) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)) * norm x * norm y"
     unfolding sum_distrib_right th sum.cartesian_product
     by (clarsimp simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh]
       field_simps simp del: scaleR_scaleR intro!: sum_norm_le)
 qed
 
 lemma bilinear_conv_bounded_bilinear:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
 proof
   assume "bilinear h"
   show "bounded_bilinear h"
   proof
     fix x y z
     show "h (x + y) z = h x z + h y z"
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
   next
     fix x y z
     show "h x (y + z) = h x y + h x z"
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
   next
     show "h (scaleR r x) y = scaleR r (h x y)" "h x (scaleR r y) = scaleR r (h x y)" for r x y
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
       by simp_all
   next
     have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
       using \<open>bilinear h\<close> by (rule bilinear_bounded)
     then show "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
       by (simp add: ac_simps)
   qed
 next
   assume "bounded_bilinear h"
   then interpret h: bounded_bilinear h .
   show "bilinear h"
     unfolding bilinear_def linear_conv_bounded_linear
     using h.bounded_linear_left h.bounded_linear_right by simp
 qed
 
 lemma bilinear_bounded_pos:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   assumes bh: "bilinear h"
   shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
 proof -
   have "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> norm x * norm y * B"
     using bh [unfolded bilinear_conv_bounded_bilinear]
     by (rule bounded_bilinear.pos_bounded)
   then show ?thesis
     by (simp only: ac_simps)
 qed
 
 lemma bounded_linear_imp_has_derivative: "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
   by (auto simp add: has_derivative_def linear_diff linear_linear linear_def
       dest: bounded_linear.linear)
 
 lemma linear_imp_has_derivative:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> (f has_derivative f) net"
   by (simp add: bounded_linear_imp_has_derivative linear_conv_bounded_linear)
 
 lemma bounded_linear_imp_differentiable: "bounded_linear f \<Longrightarrow> f differentiable net"
   using bounded_linear_imp_has_derivative differentiable_def by blast
 
 lemma linear_imp_differentiable:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> f differentiable net"
   by (metis linear_imp_has_derivative differentiable_def)
 
+lemma of_real_differentiable [simp,derivative_intros]: "of_real differentiable F"
+  by (simp add: bounded_linear_imp_differentiable bounded_linear_of_real)
+
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>We continue\<close>
 
 lemma independent_bound:
   fixes S :: "'a::euclidean_space set"
   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> DIM('a)"
   by (metis dim_subset_UNIV finiteI_independent dim_span_eq_card_independent)
 
 lemmas independent_imp_finite = finiteI_independent
 
 corollary\<^marker>\<open>tag unimportant\<close> independent_card_le:
   fixes S :: "'a::euclidean_space set"
   assumes "independent S"
   shows "card S \<le> DIM('a)"
   using assms independent_bound by auto
 
 lemma dependent_biggerset:
   fixes S :: "'a::euclidean_space set"
   shows "(finite S \<Longrightarrow> card S > DIM('a)) \<Longrightarrow> dependent S"
   by (metis independent_bound not_less)
 
 text \<open>Picking an orthogonal replacement for a spanning set.\<close>
 
 lemma vector_sub_project_orthogonal:
   fixes b x :: "'a::euclidean_space"
   shows "b \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *\<^sub>R b) = 0"
   unfolding inner_simps by auto
 
 lemma pairwise_orthogonal_insert:
   assumes "pairwise orthogonal S"
     and "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
   shows "pairwise orthogonal (insert x S)"
   using assms unfolding pairwise_def
   by (auto simp add: orthogonal_commute)
 
 lemma basis_orthogonal:
   fixes B :: "'a::real_inner set"
   assumes fB: "finite B"
   shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
   (is " \<exists>C. ?P B C")
   using fB
 proof (induct rule: finite_induct)
   case empty
   then show ?case
     apply (rule exI[where x="{}"])
     apply (auto simp add: pairwise_def)
     done
 next
   case (insert a B)
   note fB = \<open>finite B\<close> and aB = \<open>a \<notin> B\<close>
   from \<open>\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C\<close>
   obtain C where C: "finite C" "card C \<le> card B"
     "span C = span B" "pairwise orthogonal C" by blast
   let ?a = "a - sum (\<lambda>x. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x) C"
   let ?C = "insert ?a C"
   from C(1) have fC: "finite ?C"
     by simp
   from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)"
     by (simp add: card_insert_if)
   {
     fix x k
     have th0: "\<And>(a::'a) b c. a - (b - c) = c + (a - b)"
       by (simp add: field_simps)
     have "x - k *\<^sub>R (a - (\<Sum>x\<in>C. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x)) \<in> span C \<longleftrightarrow> x - k *\<^sub>R a \<in> span C"
       apply (simp only: scaleR_right_diff_distrib th0)
       apply (rule span_add_eq)
       apply (rule span_scale)
       apply (rule span_sum)
       apply (rule span_scale)
       apply (rule span_base)
       apply assumption
       done
   }
   then have SC: "span ?C = span (insert a B)"
     unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto
   {
     fix y
     assume yC: "y \<in> C"
     then have Cy: "C = insert y (C - {y})"
       by blast
     have fth: "finite (C - {y})"
       using C by simp
     have "orthogonal ?a y"
       unfolding orthogonal_def
       unfolding inner_diff inner_sum_left right_minus_eq
       unfolding sum.remove [OF \<open>finite C\<close> \<open>y \<in> C\<close>]
       apply (clarsimp simp add: inner_commute[of y a])
       apply (rule sum.neutral)
       apply clarsimp
       apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
       using \<open>y \<in> C\<close> by auto
   }
   with \<open>pairwise orthogonal C\<close> have CPO: "pairwise orthogonal ?C"
     by (rule pairwise_orthogonal_insert)
   from fC cC SC CPO have "?P (insert a B) ?C"
     by blast
   then show ?case by blast
 qed
 
 lemma orthogonal_basis_exists:
   fixes V :: "('a::euclidean_space) set"
   shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and>
   (card B = dim V) \<and> pairwise orthogonal B"
 proof -
   from basis_exists[of V] obtain B where
     B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "card B = dim V"
     by force
   from B have fB: "finite B" "card B = dim V"
     using independent_bound by auto
   from basis_orthogonal[OF fB(1)] obtain C where
     C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C"
     by blast
   from C B have CSV: "C \<subseteq> span V"
     by (metis span_superset span_mono subset_trans)
   from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C"
     by (simp add: span_span)
   from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
   have iC: "independent C"
     by (simp)
   from C fB have "card C \<le> dim V"
     by simp
   moreover have "dim V \<le> card C"
     using span_card_ge_dim[OF CSV SVC C(1)]
     by simp
   ultimately have CdV: "card C = dim V"
     using C(1) by simp
   from C B CSV CdV iC show ?thesis
     by auto
 qed
 
 text \<open>Low-dimensional subset is in a hyperplane (weak orthogonal complement).\<close>
 
 lemma span_not_univ_orthogonal:
   fixes S :: "'a::euclidean_space set"
   assumes sU: "span S \<noteq> UNIV"
   shows "\<exists>a::'a. a \<noteq> 0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
 proof -
   from sU obtain a where a: "a \<notin> span S"
     by blast
   from orthogonal_basis_exists obtain B where
     B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B"
     "card B = dim S" "pairwise orthogonal B"
     by blast
   from B have fB: "finite B" "card B = dim S"
     using independent_bound by auto
   from span_mono[OF B(2)] span_mono[OF B(3)]
   have sSB: "span S = span B"
     by (simp add: span_span)
   let ?a = "a - sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B"
   have "sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B \<in> span S"
     unfolding sSB
     apply (rule span_sum)
     apply (rule span_scale)
     apply (rule span_base)
     apply assumption
     done
   with a have a0:"?a  \<noteq> 0"
     by auto
   have "?a \<bullet> x = 0" if "x\<in>span B" for x
   proof (rule span_induct [OF that])
     show "subspace {x. ?a \<bullet> x = 0}"
       by (auto simp add: subspace_def inner_add)
   next
     {
       fix x
       assume x: "x \<in> B"
       from x have B': "B = insert x (B - {x})"
         by blast
       have fth: "finite (B - {x})"
         using fB by simp
       have "?a \<bullet> x = 0"
         apply (subst B')
         using fB fth
         unfolding sum_clauses(2)[OF fth]
         apply simp unfolding inner_simps
         apply (clarsimp simp add: inner_add inner_sum_left)
         apply (rule sum.neutral, rule ballI)
         apply (simp only: inner_commute)
         apply (auto simp add: x field_simps
           intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])
         done
     }
     then show "?a \<bullet> x = 0" if "x \<in> B" for x
       using that by blast
     qed
   with a0 show ?thesis
     unfolding sSB by (auto intro: exI[where x="?a"])
 qed
 
 lemma span_not_univ_subset_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes SU: "span S \<noteq> UNIV"
   shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
   using span_not_univ_orthogonal[OF SU] by auto
 
 lemma lowdim_subset_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes d: "dim S < DIM('a)"
   shows "\<exists>a::'a. a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
 proof -
   {
     assume "span S = UNIV"
     then have "dim (span S) = dim (UNIV :: ('a) set)"
       by simp
     then have "dim S = DIM('a)"
       by (metis Euclidean_Space.dim_UNIV dim_span)
     with d have False by arith
   }
   then have th: "span S \<noteq> UNIV"
     by blast
   from span_not_univ_subset_hyperplane[OF th] show ?thesis .
 qed
 
 lemma linear_eq_stdbasis:
   fixes f :: "'a::euclidean_space \<Rightarrow> _"
   assumes lf: "linear f"
     and lg: "linear g"
     and fg: "\<And>b. b \<in> Basis \<Longrightarrow> f b = g b"
   shows "f = g"
   using linear_eq_on_span[OF lf lg, of Basis] fg
   by auto
 
 
 text \<open>Similar results for bilinear functions.\<close>
 
 lemma bilinear_eq:
   assumes bf: "bilinear f"
     and bg: "bilinear g"
     and SB: "S \<subseteq> span B"
     and TC: "T \<subseteq> span C"
     and "x\<in>S" "y\<in>T"
     and fg: "\<And>x y. \<lbrakk>x \<in> B; y\<in> C\<rbrakk> \<Longrightarrow> f x y = g x y"
   shows "f x y = g x y"
 proof -
   let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
   from bf bg have sp: "subspace ?P"
     unfolding bilinear_def linear_iff subspace_def bf bg
     by (auto simp add: span_zero bilinear_lzero[OF bf] bilinear_lzero[OF bg]
         span_add Ball_def
       intro: bilinear_ladd[OF bf])
   have sfg: "\<And>x. x \<in> B \<Longrightarrow> subspace {a. f x a = g x a}"
     apply (auto simp add: subspace_def)
     using bf bg unfolding bilinear_def linear_iff
       apply (auto simp add: span_zero bilinear_rzero[OF bf] bilinear_rzero[OF bg]
         span_add Ball_def
       intro: bilinear_ladd[OF bf])
     done
   have "\<forall>y\<in> span C. f x y = g x y" if "x \<in> span B" for x
     apply (rule span_induct [OF that sp])
     using fg sfg span_induct by blast
   then show ?thesis
     using SB TC assms by auto
 qed
 
 lemma bilinear_eq_stdbasis:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> _"
   assumes bf: "bilinear f"
     and bg: "bilinear g"
     and fg: "\<And>i j. i \<in> Basis \<Longrightarrow> j \<in> Basis \<Longrightarrow> f i j = g i j"
   shows "f = g"
   using bilinear_eq[OF bf bg equalityD2[OF span_Basis] equalityD2[OF span_Basis]] fg by blast
 
 
 subsection \<open>Infinity norm\<close>
 
 definition\<^marker>\<open>tag important\<close> "infnorm (x::'a::euclidean_space) = Sup {\<bar>x \<bullet> b\<bar> |b. b \<in> Basis}"
 
 lemma infnorm_set_image:
   fixes x :: "'a::euclidean_space"
   shows "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} = (\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
   by blast
 
 lemma infnorm_Max:
   fixes x :: "'a::euclidean_space"
   shows "infnorm x = Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis)"
   by (simp add: infnorm_def infnorm_set_image cSup_eq_Max)
 
 lemma infnorm_set_lemma:
   fixes x :: "'a::euclidean_space"
   shows "finite {\<bar>x \<bullet> i\<bar> |i. i \<in> Basis}"
     and "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} \<noteq> {}"
   unfolding infnorm_set_image
   by auto
 
 lemma infnorm_pos_le:
   fixes x :: "'a::euclidean_space"
   shows "0 \<le> infnorm x"
   by (simp add: infnorm_Max Max_ge_iff ex_in_conv)
 
 lemma infnorm_triangle:
   fixes x :: "'a::euclidean_space"
   shows "infnorm (x + y) \<le> infnorm x + infnorm y"
 proof -
   have *: "\<And>a b c d :: real. \<bar>a\<bar> \<le> c \<Longrightarrow> \<bar>b\<bar> \<le> d \<Longrightarrow> \<bar>a + b\<bar> \<le> c + d"
     by simp
   show ?thesis
     by (auto simp: infnorm_Max inner_add_left intro!: *)
 qed
 
 lemma infnorm_eq_0:
   fixes x :: "'a::euclidean_space"
   shows "infnorm x = 0 \<longleftrightarrow> x = 0"
 proof -
   have "infnorm x \<le> 0 \<longleftrightarrow> x = 0"
     unfolding infnorm_Max by (simp add: euclidean_all_zero_iff)
   then show ?thesis
     using infnorm_pos_le[of x] by simp
 qed
 
 lemma infnorm_0: "infnorm 0 = 0"
   by (simp add: infnorm_eq_0)
 
 lemma infnorm_neg: "infnorm (- x) = infnorm x"
   unfolding infnorm_def by simp
 
 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
   by (metis infnorm_neg minus_diff_eq)
 
 lemma absdiff_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
 proof -
   have *: "\<And>(nx::real) n ny. nx \<le> n + ny \<Longrightarrow> ny \<le> n + nx \<Longrightarrow> \<bar>nx - ny\<bar> \<le> n"
     by arith
   show ?thesis
   proof (rule *)
     from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
     show "infnorm x \<le> infnorm (x - y) + infnorm y" "infnorm y \<le> infnorm (x - y) + infnorm x"
       by (simp_all add: field_simps infnorm_neg)
   qed
 qed
 
 lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
   using infnorm_pos_le[of x] by arith
 
 lemma Basis_le_infnorm:
   fixes x :: "'a::euclidean_space"
   shows "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> infnorm x"
   by (simp add: infnorm_Max)
 
 lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
   unfolding infnorm_Max
 proof (safe intro!: Max_eqI)
   let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
   { fix b :: 'a
     assume "b \<in> Basis"
     then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
       by (simp add: abs_mult mult_left_mono)
   next
     from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
       by (auto simp del: Max_in)
     then show "\<bar>a\<bar> * Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis) \<in> (\<lambda>i. \<bar>a *\<^sub>R x \<bullet> i\<bar>) ` Basis"
       by (intro image_eqI[where x=b]) (auto simp: abs_mult)
   }
 qed simp
 
 lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \<le> \<bar>a\<bar> * infnorm x"
   unfolding infnorm_mul ..
 
 lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
   using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
 
 text \<open>Prove that it differs only up to a bound from Euclidean norm.\<close>
 
 lemma infnorm_le_norm: "infnorm x \<le> norm x"
   by (simp add: Basis_le_norm infnorm_Max)
 
 lemma norm_le_infnorm:
   fixes x :: "'a::euclidean_space"
   shows "norm x \<le> sqrt DIM('a) * infnorm x"
-  unfolding norm_eq_sqrt_inner id_def 
+  unfolding norm_eq_sqrt_inner id_def
 proof (rule real_le_lsqrt[OF inner_ge_zero])
   show "sqrt DIM('a) * infnorm x \<ge> 0"
     by (simp add: zero_le_mult_iff infnorm_pos_le)
   have "x \<bullet> x \<le> (\<Sum>b\<in>Basis. x \<bullet> b * (x \<bullet> b))"
     by (metis euclidean_inner order_refl)
   also have "... \<le> DIM('a) * \<bar>infnorm x\<bar>\<^sup>2"
     by (rule sum_bounded_above) (metis Basis_le_infnorm abs_le_square_iff power2_eq_square real_abs_infnorm)
   also have "... \<le> (sqrt DIM('a) * infnorm x)\<^sup>2"
     by (simp add: power_mult_distrib)
   finally show "x \<bullet> x \<le> (sqrt DIM('a) * infnorm x)\<^sup>2" .
 qed
 
 lemma tendsto_infnorm [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F"
   shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
 proof (rule tendsto_compose [OF LIM_I assms])
   fix r :: real
   assume "r > 0"
   then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
     by (metis real_norm_def le_less_trans absdiff_infnorm infnorm_le_norm)
 qed
 
 text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
 
 lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "x=0")
   case True
-  then show ?thesis 
+  then show ?thesis
     by auto
 next
   case False
   from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
   have "?rhs \<longleftrightarrow>
       (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
         norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) =  0)"
     using False unfolding inner_simps
     by (auto simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
-  also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" 
+  also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)"
     using False  by (simp add: field_simps inner_commute)
-  also have "\<dots> \<longleftrightarrow> ?lhs" 
+  also have "\<dots> \<longleftrightarrow> ?lhs"
     using False by auto
   finally show ?thesis by metis
 qed
 
 lemma norm_cauchy_schwarz_abs_eq:
   "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
     norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> \<bar>x\<bar> = a \<longleftrightarrow> x = a \<or> x = - a"
     by arith
   have "?rhs \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)"
     by simp
   also have "\<dots> \<longleftrightarrow> (x \<bullet> y = norm x * norm y \<or> (- x) \<bullet> y = norm x * norm y)"
     unfolding norm_cauchy_schwarz_eq[symmetric]
     unfolding norm_minus_cancel norm_scaleR ..
   also have "\<dots> \<longleftrightarrow> ?lhs"
     unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps
     by auto
   finally show ?thesis ..
 qed
 
 lemma norm_triangle_eq:
   fixes x y :: "'a::real_inner"
   shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
 proof (cases "x = 0 \<or> y = 0")
   case True
-  then show ?thesis 
+  then show ?thesis
     by force
 next
   case False
   then have n: "norm x > 0" "norm y > 0"
     by auto
   have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
     by simp
   also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
     unfolding norm_cauchy_schwarz_eq[symmetric]
     unfolding power2_norm_eq_inner inner_simps
     by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
   finally show ?thesis .
 qed
 
 
 subsection \<open>Collinearity\<close>
 
 definition\<^marker>\<open>tag important\<close> collinear :: "'a::real_vector set \<Rightarrow> bool"
   where "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u)"
 
 lemma collinear_alt:
      "collinear S \<longleftrightarrow> (\<exists>u v. \<forall>x \<in> S. \<exists>c. x = u + c *\<^sub>R v)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding collinear_def by (metis Groups.add_ac(2) diff_add_cancel)
 next
   assume ?rhs
   then obtain u v where *: "\<And>x. x \<in> S \<Longrightarrow> \<exists>c. x = u + c *\<^sub>R v"
     by (auto simp: )
   have "\<exists>c. x - y = c *\<^sub>R v" if "x \<in> S" "y \<in> S" for x y
         by (metis *[OF \<open>x \<in> S\<close>] *[OF \<open>y \<in> S\<close>] scaleR_left.diff add_diff_cancel_left)
   then show ?lhs
     using collinear_def by blast
 qed
 
 lemma collinear:
   fixes S :: "'a::{perfect_space,real_vector} set"
   shows "collinear S \<longleftrightarrow> (\<exists>u. u \<noteq> 0 \<and> (\<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u))"
 proof -
   have "\<exists>v. v \<noteq> 0 \<and> (\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R v)"
     if "\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R u" "u=0" for u
   proof -
     have "\<forall>x\<in>S. \<forall>y\<in>S. x = y"
       using that by auto
     moreover
     obtain v::'a where "v \<noteq> 0"
       using UNIV_not_singleton [of 0] by auto
     ultimately have "\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R v"
       by auto
     then show ?thesis
       using \<open>v \<noteq> 0\<close> by blast
   qed
   then show ?thesis
     apply (clarsimp simp: collinear_def)
     by (metis scaleR_zero_right vector_fraction_eq_iff)
 qed
 
 lemma collinear_subset: "\<lbrakk>collinear T; S \<subseteq> T\<rbrakk> \<Longrightarrow> collinear S"
   by (meson collinear_def subsetCE)
 
 lemma collinear_empty [iff]: "collinear {}"
   by (simp add: collinear_def)
 
 lemma collinear_sing [iff]: "collinear {x}"
   by (simp add: collinear_def)
 
 lemma collinear_2 [iff]: "collinear {x, y}"
   apply (simp add: collinear_def)
   apply (rule exI[where x="x - y"])
   by (metis minus_diff_eq scaleR_left.minus scaleR_one)
 
 lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "x = 0 \<or> y = 0")
   case True
   then show ?thesis
     by (auto simp: insert_commute)
 next
   case False
-  show ?thesis 
+  show ?thesis
   proof
     assume h: "?lhs"
     then obtain u where u: "\<forall> x\<in> {0,x,y}. \<forall>y\<in> {0,x,y}. \<exists>c. x - y = c *\<^sub>R u"
       unfolding collinear_def by blast
     from u[rule_format, of x 0] u[rule_format, of y 0]
     obtain cx and cy where
       cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
       by auto
     from cx cy False have cx0: "cx \<noteq> 0" and cy0: "cy \<noteq> 0" by auto
     let ?d = "cy / cx"
     from cx cy cx0 have "y = ?d *\<^sub>R x"
       by simp
     then show ?rhs using False by blast
   next
     assume h: "?rhs"
     then obtain c where c: "y = c *\<^sub>R x"
       using False by blast
     show ?lhs
       unfolding collinear_def c
       apply (rule exI[where x=x])
       apply auto
           apply (rule exI[where x="- 1"], simp)
          apply (rule exI[where x= "-c"], simp)
         apply (rule exI[where x=1], simp)
        apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib)
       apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib)
       done
   qed
 qed
 
 lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
 proof (cases "x=0")
   case True
   then show ?thesis
     by (auto simp: insert_commute)
 next
   case False
   then have nnz: "norm x \<noteq> 0"
     by auto
   show ?thesis
   proof
     assume "\<bar>x \<bullet> y\<bar> = norm x * norm y"
     then show "collinear {0, x, y}"
-      unfolding norm_cauchy_schwarz_abs_eq collinear_lemma 
+      unfolding norm_cauchy_schwarz_abs_eq collinear_lemma
       by (meson eq_vector_fraction_iff nnz)
   next
     assume "collinear {0, x, y}"
     with False show "\<bar>x \<bullet> y\<bar> = norm x * norm y"
       unfolding norm_cauchy_schwarz_abs_eq collinear_lemma  by (auto simp: abs_if)
   qed
 qed
 
 
 subsection\<open>Properties of special hyperplanes\<close>
 
 lemma subspace_hyperplane: "subspace {x. a \<bullet> x = 0}"
   by (simp add: subspace_def inner_right_distrib)
 
 lemma subspace_hyperplane2: "subspace {x. x \<bullet> a = 0}"
   by (simp add: inner_commute inner_right_distrib subspace_def)
 
 lemma special_hyperplane_span:
   fixes S :: "'n::euclidean_space set"
   assumes "k \<in> Basis"
   shows "{x. k \<bullet> x = 0} = span (Basis - {k})"
 proof -
   have *: "x \<in> span (Basis - {k})" if "k \<bullet> x = 0" for x
   proof -
     have "x = (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b)"
       by (simp add: euclidean_representation)
     also have "... = (\<Sum>b \<in> Basis - {k}. (x \<bullet> b) *\<^sub>R b)"
       by (auto simp: sum.remove [of _ k] inner_commute assms that)
     finally have "x = (\<Sum>b\<in>Basis - {k}. (x \<bullet> b) *\<^sub>R b)" .
     then show ?thesis
       by (simp add: span_finite)
   qed
   show ?thesis
     apply (rule span_subspace [symmetric])
     using assms
     apply (auto simp: inner_not_same_Basis intro: * subspace_hyperplane)
     done
 qed
 
 lemma dim_special_hyperplane:
   fixes k :: "'n::euclidean_space"
   shows "k \<in> Basis \<Longrightarrow> dim {x. k \<bullet> x = 0} = DIM('n) - 1"
 apply (simp add: special_hyperplane_span)
 apply (rule dim_unique [OF subset_refl])
 apply (auto simp: independent_substdbasis)
 apply (metis member_remove remove_def span_base)
 done
 
 proposition dim_hyperplane:
   fixes a :: "'a::euclidean_space"
   assumes "a \<noteq> 0"
     shows "dim {x. a \<bullet> x = 0} = DIM('a) - 1"
 proof -
   have span0: "span {x. a \<bullet> x = 0} = {x. a \<bullet> x = 0}"
     by (rule span_unique) (auto simp: subspace_hyperplane)
   then obtain B where "independent B"
               and Bsub: "B \<subseteq> {x. a \<bullet> x = 0}"
               and subspB: "{x. a \<bullet> x = 0} \<subseteq> span B"
               and card0: "(card B = dim {x. a \<bullet> x = 0})"
               and ortho: "pairwise orthogonal B"
     using orthogonal_basis_exists by metis
   with assms have "a \<notin> span B"
     by (metis (mono_tags, lifting) span_eq inner_eq_zero_iff mem_Collect_eq span0)
   then have ind: "independent (insert a B)"
     by (simp add: \<open>independent B\<close> independent_insert)
   have "finite B"
     using \<open>independent B\<close> independent_bound by blast
   have "UNIV \<subseteq> span (insert a B)"
   proof fix y::'a
     obtain r z where z: "y = r *\<^sub>R a + z" "a \<bullet> z = 0"
       apply (rule_tac r="(a \<bullet> y) / (a \<bullet> a)" and z = "y - ((a \<bullet> y) / (a \<bullet> a)) *\<^sub>R a" in that)
       using assms
       by (auto simp: algebra_simps)
     show "y \<in> span (insert a B)"
       by (metis (mono_tags, lifting) z Bsub span_eq_iff
          add_diff_cancel_left' mem_Collect_eq span0 span_breakdown_eq span_subspace subspB)
   qed
   then have dima: "DIM('a) = dim(insert a B)"
     by (metis independent_Basis span_Basis dim_eq_card top.extremum_uniqueI)
   then show ?thesis
     by (metis (mono_tags, lifting) Bsub Diff_insert_absorb \<open>a \<notin> span B\<close> ind card0
         card_Diff_singleton dim_span indep_card_eq_dim_span insertI1 subsetCE
         subspB)
 qed
 
 lemma lowdim_eq_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes "dim S = DIM('a) - 1"
   obtains a where "a \<noteq> 0" and "span S = {x. a \<bullet> x = 0}"
 proof -
   have dimS: "dim S < DIM('a)"
     by (simp add: assms)
   then obtain b where b: "b \<noteq> 0" "span S \<subseteq> {a. b \<bullet> a = 0}"
     using lowdim_subset_hyperplane [of S] by fastforce
   show ?thesis
     apply (rule that[OF b(1)])
     apply (rule subspace_dim_equal)
     by (auto simp: assms b dim_hyperplane subspace_hyperplane)
 qed
 
 lemma dim_eq_hyperplane:
   fixes S :: "'n::euclidean_space set"
   shows "dim S = DIM('n) - 1 \<longleftrightarrow> (\<exists>a. a \<noteq> 0 \<and> span S = {x. a \<bullet> x = 0})"
 by (metis One_nat_def dim_hyperplane dim_span lowdim_eq_hyperplane)
 
 
 subsection\<open> Orthogonal bases and Gram-Schmidt process\<close>
 
 lemma pairwise_orthogonal_independent:
   assumes "pairwise orthogonal S" and "0 \<notin> S"
     shows "independent S"
 proof -
   have 0: "\<And>x y. \<lbrakk>x \<noteq> y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using assms by (simp add: pairwise_def orthogonal_def)
   have "False" if "a \<in> S" and a: "a \<in> span (S - {a})" for a
   proof -
     obtain T U where "T \<subseteq> S - {a}" "a = (\<Sum>v\<in>T. U v *\<^sub>R v)"
       using a by (force simp: span_explicit)
     then have "a \<bullet> a = a \<bullet> (\<Sum>v\<in>T. U v *\<^sub>R v)"
       by simp
     also have "... = 0"
       apply (simp add: inner_sum_right)
       apply (rule comm_monoid_add_class.sum.neutral)
       by (metis "0" DiffE \<open>T \<subseteq> S - {a}\<close> mult_not_zero singletonI subsetCE \<open>a \<in> S\<close>)
     finally show ?thesis
       using \<open>0 \<notin> S\<close> \<open>a \<in> S\<close> by auto
   qed
   then show ?thesis
     by (force simp: dependent_def)
 qed
 
 lemma pairwise_orthogonal_imp_finite:
   fixes S :: "'a::euclidean_space set"
   assumes "pairwise orthogonal S"
     shows "finite S"
 proof -
   have "independent (S - {0})"
     apply (rule pairwise_orthogonal_independent)
      apply (metis Diff_iff assms pairwise_def)
     by blast
   then show ?thesis
     by (meson independent_imp_finite infinite_remove)
 qed
 
 lemma subspace_orthogonal_to_vector: "subspace {y. orthogonal x y}"
   by (simp add: subspace_def orthogonal_clauses)
 
 lemma subspace_orthogonal_to_vectors: "subspace {y. \<forall>x \<in> S. orthogonal x y}"
   by (simp add: subspace_def orthogonal_clauses)
 
 lemma orthogonal_to_span:
   assumes a: "a \<in> span S" and x: "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
     shows "orthogonal x a"
   by (metis a orthogonal_clauses(1,2,4)
       span_induct_alt x)
 
 proposition Gram_Schmidt_step:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S" and x: "x \<in> span S"
     shows "orthogonal x (a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b))"
 proof -
   have "finite S"
     by (simp add: S pairwise_orthogonal_imp_finite)
   have "orthogonal (a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)) x"
        if "x \<in> S" for x
   proof -
     have "a \<bullet> x = (\<Sum>y\<in>S. if y = x then y \<bullet> a else 0)"
       by (simp add: \<open>finite S\<close> inner_commute that)
     also have "... =  (\<Sum>b\<in>S. b \<bullet> a * (b \<bullet> x) / (b \<bullet> b))"
       apply (rule sum.cong [OF refl], simp)
       by (meson S orthogonal_def pairwise_def that)
    finally show ?thesis
      by (simp add: orthogonal_def algebra_simps inner_sum_left)
   qed
   then show ?thesis
     using orthogonal_to_span orthogonal_commute x by blast
 qed
 
 
 lemma orthogonal_extension_aux:
   fixes S :: "'a::euclidean_space set"
   assumes "finite T" "finite S" "pairwise orthogonal S"
     shows "\<exists>U. pairwise orthogonal (S \<union> U) \<and> span (S \<union> U) = span (S \<union> T)"
 using assms
 proof (induction arbitrary: S)
   case empty then show ?case
     by simp (metis sup_bot_right)
 next
   case (insert a T)
   have 0: "\<And>x y. \<lbrakk>x \<noteq> y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using insert by (simp add: pairwise_def orthogonal_def)
   define a' where "a' = a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)"
   obtain U where orthU: "pairwise orthogonal (S \<union> insert a' U)"
              and spanU: "span (insert a' S \<union> U) = span (insert a' S \<union> T)"
     by (rule exE [OF insert.IH [of "insert a' S"]])
       (auto simp: Gram_Schmidt_step a'_def insert.prems orthogonal_commute
         pairwise_orthogonal_insert span_clauses)
   have orthS: "\<And>x. x \<in> S \<Longrightarrow> a' \<bullet> x = 0"
     apply (simp add: a'_def)
     using Gram_Schmidt_step [OF \<open>pairwise orthogonal S\<close>]
     apply (force simp: orthogonal_def inner_commute span_superset [THEN subsetD])
     done
   have "span (S \<union> insert a' U) = span (insert a' (S \<union> T))"
     using spanU by simp
   also have "... = span (insert a (S \<union> T))"
     apply (rule eq_span_insert_eq)
     apply (simp add: a'_def span_neg span_sum span_base span_mul)
     done
   also have "... = span (S \<union> insert a T)"
     by simp
   finally show ?case
     by (rule_tac x="insert a' U" in exI) (use orthU in auto)
 qed
 
 
 proposition orthogonal_extension:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S"
   obtains U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)"
 proof -
   obtain B where "finite B" "span B = span T"
     using basis_subspace_exists [of "span T"] subspace_span by metis
   with orthogonal_extension_aux [of B S]
   obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> B)"
     using assms pairwise_orthogonal_imp_finite by auto
   with \<open>span B = span T\<close> show ?thesis
     by (rule_tac U=U in that) (auto simp: span_Un)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_extension_strong:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S"
   obtains U where "U \<inter> (insert 0 S) = {}" "pairwise orthogonal (S \<union> U)"
                   "span (S \<union> U) = span (S \<union> T)"
 proof -
   obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)"
     using orthogonal_extension assms by blast
   then show ?thesis
     apply (rule_tac U = "U - (insert 0 S)" in that)
       apply blast
      apply (force simp: pairwise_def)
     apply (metis Un_Diff_cancel Un_insert_left span_redundant span_zero)
     done
 qed
 
 subsection\<open>Decomposing a vector into parts in orthogonal subspaces\<close>
 
 text\<open>existence of orthonormal basis for a subspace.\<close>
 
 lemma orthogonal_spanningset_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "B \<subseteq> S" "pairwise orthogonal B" "span B = S"
 proof -
   obtain B where "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
     using basis_exists by blast
   with orthogonal_extension [of "{}" B]
   show ?thesis
     by (metis Un_empty_left assms pairwise_empty span_superset span_subspace that)
 qed
 
 lemma orthogonal_basis_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "0 \<notin> B" "B \<subseteq> S" "pairwise orthogonal B" "independent B"
                   "card B = dim S" "span B = S"
 proof -
   obtain B where "B \<subseteq> S" "pairwise orthogonal B" "span B = S"
     using assms orthogonal_spanningset_subspace by blast
   then show ?thesis
     apply (rule_tac B = "B - {0}" in that)
     apply (auto simp: indep_card_eq_dim_span pairwise_subset pairwise_orthogonal_independent elim: pairwise_subset)
     done
 qed
 
 proposition orthonormal_basis_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "B \<subseteq> S" "pairwise orthogonal B"
               and "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
               and "independent B" "card B = dim S" "span B = S"
 proof -
   obtain B where "0 \<notin> B" "B \<subseteq> S"
              and orth: "pairwise orthogonal B"
              and "independent B" "card B = dim S" "span B = S"
     by (blast intro: orthogonal_basis_subspace [OF assms])
   have 1: "(\<lambda>x. x /\<^sub>R norm x) ` B \<subseteq> S"
     using \<open>span B = S\<close> span_superset span_mul by fastforce
   have 2: "pairwise orthogonal ((\<lambda>x. x /\<^sub>R norm x) ` B)"
     using orth by (force simp: pairwise_def orthogonal_clauses)
   have 3: "\<And>x. x \<in> (\<lambda>x. x /\<^sub>R norm x) ` B \<Longrightarrow> norm x = 1"
     by (metis (no_types, lifting) \<open>0 \<notin> B\<close> image_iff norm_sgn sgn_div_norm)
   have 4: "independent ((\<lambda>x. x /\<^sub>R norm x) ` B)"
     by (metis "2" "3" norm_zero pairwise_orthogonal_independent zero_neq_one)
   have "inj_on (\<lambda>x. x /\<^sub>R norm x) B"
   proof
     fix x y
     assume "x \<in> B" "y \<in> B" "x /\<^sub>R norm x = y /\<^sub>R norm y"
     moreover have "\<And>i. i \<in> B \<Longrightarrow> norm (i /\<^sub>R norm i) = 1"
       using 3 by blast
     ultimately show "x = y"
       by (metis norm_eq_1 orth orthogonal_clauses(7) orthogonal_commute orthogonal_def pairwise_def zero_neq_one)
   qed
   then have 5: "card ((\<lambda>x. x /\<^sub>R norm x) ` B) = dim S"
     by (metis \<open>card B = dim S\<close> card_image)
   have 6: "span ((\<lambda>x. x /\<^sub>R norm x) ` B) = S"
     by (metis "1" "4" "5" assms card_eq_dim independent_imp_finite span_subspace)
   show ?thesis
     by (rule that [OF 1 2 3 4 5 6])
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> orthogonal_to_subspace_exists_gen:
   fixes S :: "'a :: euclidean_space set"
   assumes "span S \<subset> span T"
   obtains x where "x \<noteq> 0" "x \<in> span T" "\<And>y. y \<in> span S \<Longrightarrow> orthogonal x y"
 proof -
   obtain B where "B \<subseteq> span S" and orthB: "pairwise orthogonal B"
              and "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "card B = dim S" "span B = span S"
     by (rule orthonormal_basis_subspace [of "span S", OF subspace_span]) (auto)
   with assms obtain u where spanBT: "span B \<subseteq> span T" and "u \<notin> span B" "u \<in> span T"
     by auto
   obtain C where orthBC: "pairwise orthogonal (B \<union> C)" and spanBC: "span (B \<union> C) = span (B \<union> {u})"
     by (blast intro: orthogonal_extension [OF orthB])
   show thesis
   proof (cases "C \<subseteq> insert 0 B")
     case True
     then have "C \<subseteq> span B"
       using span_eq
       by (metis span_insert_0 subset_trans)
     moreover have "u \<in> span (B \<union> C)"
       using \<open>span (B \<union> C) = span (B \<union> {u})\<close> span_superset by force
     ultimately show ?thesis
       using True \<open>u \<notin> span B\<close>
       by (metis Un_insert_left span_insert_0 sup.orderE)
   next
     case False
     then obtain x where "x \<in> C" "x \<noteq> 0" "x \<notin> B"
       by blast
     then have "x \<in> span T"
       by (metis (no_types, lifting) Un_insert_right Un_upper2 \<open>u \<in> span T\<close> spanBT spanBC
           \<open>u \<in> span T\<close> insert_subset span_superset span_mono
           span_span subsetCE subset_trans sup_bot.comm_neutral)
     moreover have "orthogonal x y" if "y \<in> span B" for y
       using that
     proof (rule span_induct)
       show "subspace {a. orthogonal x a}"
         by (simp add: subspace_orthogonal_to_vector)
       show "\<And>b. b \<in> B \<Longrightarrow> orthogonal x b"
         by (metis Un_iff \<open>x \<in> C\<close> \<open>x \<notin> B\<close> orthBC pairwise_def)
     qed
     ultimately show ?thesis
       using \<open>x \<noteq> 0\<close> that \<open>span B = span S\<close> by auto
   qed
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_to_subspace_exists:
   fixes S :: "'a :: euclidean_space set"
   assumes "dim S < DIM('a)"
   obtains x where "x \<noteq> 0" "\<And>y. y \<in> span S \<Longrightarrow> orthogonal x y"
 proof -
   have "span S \<subset> UNIV"
   by (metis (mono_tags) UNIV_I assms inner_eq_zero_iff less_le lowdim_subset_hyperplane
       mem_Collect_eq top.extremum_strict top.not_eq_extremum)
   with orthogonal_to_subspace_exists_gen [of S UNIV] that show ?thesis
     by (auto)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_to_vector_exists:
   fixes x :: "'a :: euclidean_space"
   assumes "2 \<le> DIM('a)"
   obtains y where "y \<noteq> 0" "orthogonal x y"
 proof -
   have "dim {x} < DIM('a)"
     using assms by auto
   then show thesis
     by (rule orthogonal_to_subspace_exists) (simp add: orthogonal_commute span_base that)
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> orthogonal_subspace_decomp_exists:
   fixes S :: "'a :: euclidean_space set"
   obtains y z
   where "y \<in> span S"
     and "\<And>w. w \<in> span S \<Longrightarrow> orthogonal z w"
     and "x = y + z"
 proof -
   obtain T where "0 \<notin> T" "T \<subseteq> span S" "pairwise orthogonal T" "independent T"
     "card T = dim (span S)" "span T = span S"
     using orthogonal_basis_subspace subspace_span by blast
   let ?a = "\<Sum>b\<in>T. (b \<bullet> x / (b \<bullet> b)) *\<^sub>R b"
   have orth: "orthogonal (x - ?a) w" if "w \<in> span S" for w
     by (simp add: Gram_Schmidt_step \<open>pairwise orthogonal T\<close> \<open>span T = span S\<close>
         orthogonal_commute that)
   show ?thesis
     apply (rule_tac y = "?a" and z = "x - ?a" in that)
       apply (meson \<open>T \<subseteq> span S\<close> span_scale span_sum subsetCE)
      apply (fact orth, simp)
     done
 qed
 
 lemma orthogonal_subspace_decomp_unique:
   fixes S :: "'a :: euclidean_space set"
   assumes "x + y = x' + y'"
       and ST: "x \<in> span S" "x' \<in> span S" "y \<in> span T" "y' \<in> span T"
       and orth: "\<And>a b. \<lbrakk>a \<in> S; b \<in> T\<rbrakk> \<Longrightarrow> orthogonal a b"
   shows "x = x' \<and> y = y'"
 proof -
   have "x + y - y' = x'"
     by (simp add: assms)
   moreover have "\<And>a b. \<lbrakk>a \<in> span S; b \<in> span T\<rbrakk> \<Longrightarrow> orthogonal a b"
     by (meson orth orthogonal_commute orthogonal_to_span)
   ultimately have "0 = x' - x"
     by (metis (full_types) add_diff_cancel_left' ST diff_right_commute orthogonal_clauses(10) orthogonal_clauses(5) orthogonal_self)
   with assms show ?thesis by auto
 qed
 
 lemma vector_in_orthogonal_spanningset:
   fixes a :: "'a::euclidean_space"
   obtains S where "a \<in> S" "pairwise orthogonal S" "span S = UNIV"
   by (metis UNIV_I Un_iff empty_iff insert_subset orthogonal_extension pairwise_def
       pairwise_orthogonal_insert span_UNIV subsetI subset_antisym)
 
 lemma vector_in_orthogonal_basis:
   fixes a :: "'a::euclidean_space"
   assumes "a \<noteq> 0"
   obtains S where "a \<in> S" "0 \<notin> S" "pairwise orthogonal S" "independent S" "finite S"
                   "span S = UNIV" "card S = DIM('a)"
 proof -
   obtain S where S: "a \<in> S" "pairwise orthogonal S" "span S = UNIV"
     using vector_in_orthogonal_spanningset .
   show thesis
   proof
     show "pairwise orthogonal (S - {0})"
       using pairwise_mono S(2) by blast
     show "independent (S - {0})"
       by (simp add: \<open>pairwise orthogonal (S - {0})\<close> pairwise_orthogonal_independent)
     show "finite (S - {0})"
       using \<open>independent (S - {0})\<close> independent_imp_finite by blast
     show "card (S - {0}) = DIM('a)"
       using span_delete_0 [of S] S
       by (simp add: \<open>independent (S - {0})\<close> indep_card_eq_dim_span)
   qed (use S \<open>a \<noteq> 0\<close> in auto)
 qed
 
 lemma vector_in_orthonormal_basis:
   fixes a :: "'a::euclidean_space"
   assumes "norm a = 1"
   obtains S where "a \<in> S" "pairwise orthogonal S" "\<And>x. x \<in> S \<Longrightarrow> norm x = 1"
     "independent S" "card S = DIM('a)" "span S = UNIV"
 proof -
   have "a \<noteq> 0"
     using assms by auto
   then obtain S where "a \<in> S" "0 \<notin> S" "finite S"
           and S: "pairwise orthogonal S" "independent S" "span S = UNIV" "card S = DIM('a)"
     by (metis vector_in_orthogonal_basis)
   let ?S = "(\<lambda>x. x /\<^sub>R norm x) ` S"
   show thesis
   proof
     show "a \<in> ?S"
       using \<open>a \<in> S\<close> assms image_iff by fastforce
   next
     show "pairwise orthogonal ?S"
       using \<open>pairwise orthogonal S\<close> by (auto simp: pairwise_def orthogonal_def)
     show "\<And>x. x \<in> (\<lambda>x. x /\<^sub>R norm x) ` S \<Longrightarrow> norm x = 1"
       using \<open>0 \<notin> S\<close> by (auto simp: field_split_simps)
     then show "independent ?S"
       by (metis \<open>pairwise orthogonal ((\<lambda>x. x /\<^sub>R norm x) ` S)\<close> norm_zero pairwise_orthogonal_independent zero_neq_one)
     have "inj_on (\<lambda>x. x /\<^sub>R norm x) S"
       unfolding inj_on_def
       by (metis (full_types) S(1) \<open>0 \<notin> S\<close> inverse_nonzero_iff_nonzero norm_eq_zero orthogonal_scaleR orthogonal_self pairwise_def)
     then show "card ?S = DIM('a)"
       by (simp add: card_image S)
     show "span ?S = UNIV"
       by (metis (no_types) \<open>0 \<notin> S\<close> \<open>finite S\<close> \<open>span S = UNIV\<close>
           field_class.field_inverse_zero inverse_inverse_eq less_irrefl span_image_scale
           zero_less_norm_iff)
   qed
 qed
 
 proposition dim_orthogonal_sum:
   fixes A :: "'a::euclidean_space set"
   assumes "\<And>x y. \<lbrakk>x \<in> A; y \<in> B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     shows "dim(A \<union> B) = dim A + dim B"
 proof -
   have 1: "\<And>x y. \<lbrakk>x \<in> span A; y \<in> B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     by (erule span_induct [OF _ subspace_hyperplane2]; simp add: assms)
   have "\<And>x y. \<lbrakk>x \<in> span A; y \<in> span B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using 1 by (simp add: span_induct [OF _ subspace_hyperplane])
   then have 0: "\<And>x y. \<lbrakk>x \<in> span A; y \<in> span B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     by simp
   have "dim(A \<union> B) = dim (span (A \<union> B))"
     by (simp)
   also have "span (A \<union> B) = ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
     by (auto simp add: span_Un image_def)
   also have "dim \<dots> = dim {x + y |x y. x \<in> span A \<and> y \<in> span B}"
     by (auto intro!: arg_cong [where f=dim])
   also have "... = dim {x + y |x y. x \<in> span A \<and> y \<in> span B} + dim(span A \<inter> span B)"
     by (auto simp: dest: 0)
   also have "... = dim (span A) + dim (span B)"
     by (rule dim_sums_Int) (auto)
   also have "... = dim A + dim B"
     by (simp)
   finally show ?thesis .
 qed
 
 lemma dim_subspace_orthogonal_to_vectors:
   fixes A :: "'a::euclidean_space set"
   assumes "subspace A" "subspace B" "A \<subseteq> B"
     shows "dim {y \<in> B. \<forall>x \<in> A. orthogonal x y} + dim A = dim B"
 proof -
   have "dim (span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)) = dim (span B)"
   proof (rule arg_cong [where f=dim, OF subset_antisym])
     show "span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A) \<subseteq> span B"
       by (simp add: \<open>A \<subseteq> B\<close> Collect_restrict span_mono)
   next
     have *: "x \<in> span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)"
          if "x \<in> B" for x
     proof -
       obtain y z where "x = y + z" "y \<in> span A" and orth: "\<And>w. w \<in> span A \<Longrightarrow> orthogonal z w"
         using orthogonal_subspace_decomp_exists [of A x] that by auto
       have "y \<in> span B"
         using \<open>y \<in> span A\<close> assms(3) span_mono by blast
       then have "z \<in> {a \<in> B. \<forall>x. x \<in> A \<longrightarrow> orthogonal x a}"
         apply simp
         using \<open>x = y + z\<close> assms(1) assms(2) orth orthogonal_commute span_add_eq
           span_eq_iff that by blast
       then have z: "z \<in> span {y \<in> B. \<forall>x\<in>A. orthogonal x y}"
         by (meson span_superset subset_iff)
       then show ?thesis
         apply (auto simp: span_Un image_def  \<open>x = y + z\<close> \<open>y \<in> span A\<close>)
         using \<open>y \<in> span A\<close> add.commute by blast
     qed
     show "span B \<subseteq> span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)"
       by (rule span_minimal) (auto intro: * span_minimal)
   qed
   then show ?thesis
     by (metis (no_types, lifting) dim_orthogonal_sum dim_span mem_Collect_eq
         orthogonal_commute orthogonal_def)
 qed
 
 subsection\<open>Linear functions are (uniformly) continuous on any set\<close>
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Topological properties of linear functions\<close>
 
 lemma linear_lim_0:
   assumes "bounded_linear f"
   shows "(f \<longlongrightarrow> 0) (at (0))"
 proof -
   interpret f: bounded_linear f by fact
   have "(f \<longlongrightarrow> f 0) (at 0)"
     using tendsto_ident_at by (rule f.tendsto)
   then show ?thesis unfolding f.zero .
 qed
 
 lemma linear_continuous_at:
   assumes "bounded_linear f"
   shows "continuous (at a) f"
   unfolding continuous_at using assms
   apply (rule bounded_linear.tendsto)
   apply (rule tendsto_ident_at)
   done
 
 lemma linear_continuous_within:
   "bounded_linear f \<Longrightarrow> continuous (at x within s) f"
   using continuous_at_imp_continuous_at_within linear_continuous_at by blast
 
 lemma linear_continuous_on:
   "bounded_linear f \<Longrightarrow> continuous_on s f"
   using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
 
 lemma Lim_linear:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and h :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "(f \<longlongrightarrow> l) F" "linear h"
   shows "((\<lambda>x. h(f x)) \<longlongrightarrow> h l) F"
 proof -
   obtain B where B: "B > 0" "\<And>x. norm (h x) \<le> B * norm x"
     using linear_bounded_pos [OF \<open>linear h\<close>] by blast
   show ?thesis
     unfolding tendsto_iff
   proof (intro allI impI)
     show "\<forall>\<^sub>F x in F. dist (h (f x)) (h l) < e" if "e > 0" for e
     proof -
       have "\<forall>\<^sub>F x in F. dist (f x) l < e/B"
         by (simp add: \<open>0 < B\<close> assms(1) tendstoD that)
       then show ?thesis
         unfolding dist_norm
       proof (rule eventually_mono)
         show "norm (h (f x) - h l) < e" if "norm (f x - l) < e / B" for x
           using that B
           apply (simp add: field_split_simps)
           by (metis \<open>linear h\<close> le_less_trans linear_diff)
       qed
     qed
   qed
 qed
 
 lemma linear_continuous_compose:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and g :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous F f" "linear g"
   shows "continuous F (\<lambda>x. g(f x))"
   using assms unfolding continuous_def by (rule Lim_linear)
 
 lemma linear_continuous_on_compose:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and g :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous_on S f" "linear g"
   shows "continuous_on S (\<lambda>x. g(f x))"
   using assms by (simp add: continuous_on_eq_continuous_within linear_continuous_compose)
 
 text\<open>Also bilinear functions, in composition form\<close>
 
 lemma bilinear_continuous_compose:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous F f" "continuous F g" "bilinear h"
   shows "continuous F (\<lambda>x. h (f x) (g x))"
   using assms bilinear_conv_bounded_bilinear bounded_bilinear.continuous by blast
 
 lemma bilinear_continuous_on_compose:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
     and f :: "'d::t2_space \<Rightarrow> 'a"
   assumes "continuous_on S f" "continuous_on S g" "bilinear h"
   shows "continuous_on S (\<lambda>x. h (f x) (g x))"
   using assms by (simp add: continuous_on_eq_continuous_within bilinear_continuous_compose)
 
 end
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,4125 +1,4128 @@
 (*  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 \<longleftrightarrow> continuous_on {0..1} g"
 
 definition\<^marker>\<open>tag important\<close> pathstart :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a"
   where "pathstart g = g 0"
 
 definition\<^marker>\<open>tag important\<close> pathfinish :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a"
   where "pathfinish g = g 1"
 
 definition\<^marker>\<open>tag important\<close> path_image :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a set"
   where "path_image g = g ` {0 .. 1}"
 
 definition\<^marker>\<open>tag important\<close> reversepath :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> real \<Rightarrow> 'a"
   where "reversepath g = (\<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 = (\<lambda>x. if x \<le> 1/2 then g1 (2 * x) else g2 (2 * x - 1))"
 
 definition\<^marker>\<open>tag important\<close> simple_path :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> bool"
   where "simple_path g \<longleftrightarrow>
      path g \<and> (\<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> arc :: "(real \<Rightarrow> 'a :: topological_space) \<Rightarrow> bool"
   where "arc g \<longleftrightarrow> 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 continuous_on_translation_eq:
   fixes g :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_vector"
   shows "continuous_on A ((+) a \<circ> g) = continuous_on A g"
 proof -
   have g: "g = (\<lambda>x. -a + x) \<circ> ((\<lambda>x. a + x) \<circ> g)"
     by (rule ext) simp
   show ?thesis
     by (metis (no_types, hide_lams) g continuous_on_compose homeomorphism_def homeomorphism_translation)
 qed
 
 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
   then have g: "g = h \<circ> (f \<circ> g)"
     by (metis comp_assoc id_comp)
   show ?thesis
     unfolding path_def
     using h assms
     by (metis g continuous_on_compose linear_continuous_on linear_conv_bounded_linear)
 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 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 path_translation_eq)
 
 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 inj_on_eq_iff [of f]
   by (auto simp: path_linear_image_eq simple_path_def path_translation_eq)
 
 lemma arc_translation_eq:
   fixes g :: "real \<Rightarrow> 'a::euclidean_space"
   shows "arc((\<lambda>x. a + x) \<circ> g) = 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 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 arc_imp_simple_path: "arc g \<Longrightarrow> simple_path g"
   by (simp add: arc_def inj_on_def 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 simple_path_cases: "simple_path g \<Longrightarrow> arc g \<or> pathfinish g = pathstart g"
   unfolding simple_path_def arc_def inj_on_def pathfinish_def pathstart_def
   by force
 
 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"
 proof -
   have *: "\<And>g. path_image (reversepath g) \<subseteq> path_image g"
     unfolding path_image_def subset_eq reversepath_def Ball_def image_iff
     by force
   show ?thesis
     using *[of g] *[of "reversepath g"]
     unfolding reversepath_reversepath
     by auto
 qed
 
 lemma path_reversepath [simp]: "path (reversepath g) \<longleftrightarrow> path g"
 proof -
   have *: "\<And>g. path g \<Longrightarrow> path (reversepath g)"
     unfolding path_def reversepath_def
     apply (rule continuous_on_compose[unfolded o_def, of _ "\<lambda>x. 1 - x"])
     apply (auto intro: continuous_intros continuous_on_subset[of "{0..1}"])
     done
   show ?thesis
     using "*" by force
 qed
 
 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 simple_path_reversepath: "simple_path g \<Longrightarrow> simple_path (reversepath g)"
   apply (simp add: simple_path_def)
   apply (force simp: reversepath_def)
   done
 
 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 simple_path_inj_on: "simple_path g \<Longrightarrow> inj_on g {0<..<1}"
   by (auto simp: simple_path_def path_image_def inj_on_def less_eq_real_def Ball_def)
 
 
 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 (auto simp: simple_path_def path_image_def pathstart_def pathfinish_def Ball_def)
     using less_eq_real_def zero_le_one by blast+
 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)
 
 
 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)"
 proof -
   have "{0..1::real} = {0..1/2} \<union> {1/2..1}"
     by auto
   then show ?thesis
     using assms by (metis path_def path_join)
 qed
 
 lemma path_join_imp: "\<lbrakk>path g1; path g2; pathfinish g1 = pathstart g2\<rbrakk> \<Longrightarrow> path(g1 +++ g2)"
   by simp
 
 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}"
     using assms
     by (simp add: arc_def)
   have injg2: "inj_on g2 {0..1}"
     using assms
     by (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
   { fix x and y::real
     assume xy: "g1 (2 * x) = g2 (2 * y - 1)" "y \<le> 1" "0 \<le> x" "\<not> y * 2 \<le> 1" "x * 2 \<le> 1" 
     then have "x = 0 \<and> y = 1"
       using * xy by force
    } note ** = this
   show ?thesis
     using assms
     apply (simp add: arc_def simple_path_def)
     apply (auto simp: joinpaths_def split: if_split_asm 
                 dest!: * ** dest: inj_onD [OF injg1] inj_onD [OF injg2])
     done
 qed
 
 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}"
     using assms
     by (simp add: arc_def)
   have injg2: "inj_on g2 {0..1}"
     using assms
     by (simp add: arc_def)
   have g11: "g1 1 = g2 0"
    and sb:  "g1 ` {0..1} \<inter> g2 ` {0..1} \<subseteq> {g2 0}"
     using assms
     by (simp_all add: 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
   show ?thesis
     using assms
     apply (simp add: arc_def inj_on_def)
     apply (auto simp: joinpaths_def arc_imp_path split: if_split_asm 
                 dest: * *[OF sym] inj_onD [OF injg1] inj_onD [OF injg2])
     done
 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)
   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 have "simple_path(g1 +++ g2)" by (rule arc_imp_simple_path)
   then 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)
   have False if "g1 0 = g2 u" "0 \<le> u" "u \<le> 1" for u
     using * [of 0 "(u + 1) / 2"] that assms arc_distinct_ends [OF \<open>?lhs\<close>]
     by (auto simp: joinpaths_def pathstart_def pathfinish_def split_ifs field_split_simps)
   then have n1: "pathstart g1 \<notin> path_image g2"
     unfolding pathstart_def path_image_def
     using atLeastAtMost_iff by blast
   show ?rhs using \<open>?lhs\<close>
     using \<open>simple_path (g1 +++ g2)\<close> assms n1 simple_path_joinE by auto
 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)
 
 
 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 {0..1} (g \<circ> (\<lambda>x. ((v-u) * x+ u)))"
     using assms
     apply (intro continuous_intros; simp add: image_affinity_atLeastAtMost [where c=u])
     apply (auto simp: path_def continuous_on_subset)
     done
   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 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 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)"
     (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)"
     by (auto simp: arc_def inj_on_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"
       using sim [of "(x-u)/(v-u)" "(y-u)/(v-u)"] p
       by (cases "v = u")
         (simp_all split: if_split_asm add: inj_on_def closed_segment_real_eq image_affinity_atLeastAtMost,
            simp add: field_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
     unfolding inj_on_def
     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"
    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"
    and ne: "u < v \<or> v < u"
    and psp: "path (subpath u v g)"
     by (auto simp: inj_on_def closed_segment_real_eq image_affinity_atLeastAtMost)
   show ?lhs using psp ne
     unfolding arc_def subpath_def inj_on_def
     by (auto simp: algebra_simps affine_ineq mult_left_mono crossproduct_eq dest: d1 d2)
 qed
 
 
 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
   apply (simp add: simple_path_subpath_eq simple_path_imp_path)
   apply (simp add: simple_path_def closed_segment_real_eq image_affinity_atLeastAtMost, fastforce)
   done
 
 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 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"
 proof -
   obtain h where h: "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"
     using exists_path_subpath_to_frontier [OF g _ g1] closure_closed [OF S] g0 by auto
   show ?thesis
   proof
     show "path_image h \<subseteq> path_image g \<inter> S"
       using assms h interior_subset [of S] by (auto simp: frontier_def)
   qed (use h in auto)
 qed
 
 
 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 (auto intro!: pathfinish_shiftpath pathstart_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)"
     using assms(2)[unfolded pathfinish_def pathstart_def]
     by auto
   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 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)"
   unfolding simple_path_def
 proof (intro conjI impI ballI)
   show "path (shiftpath a g)"
     by (simp add: assms path_shiftpath simple_path_imp_path)
   have *: "\<And>x y. \<lbrakk>g x = g y; x \<in> {0..1}; y \<in> {0..1}\<rbrakk> \<Longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
     using assms by (simp add:  simple_path_def)
   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 unfolding shiftpath_def
     by (force split: if_split_asm dest!: *)
 qed
 
 
 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}"
 proof (clarsimp simp: inj_on_def linepath_def)
   fix x y
   assume "(1 - x) *\<^sub>R a + x *\<^sub>R b = (1 - y) *\<^sub>R a + y *\<^sub>R b" "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1"
   then have "x *\<^sub>R (a - b) = y *\<^sub>R (a - b)"
     by (auto simp: algebra_simps)
   then show "x=y"
     using assms by auto
 qed
 
 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: "a \<in> convex hull S"
     and b: "b \<in> convex hull S"
     and x: "0\<le>x" "x\<le>1"
   shows "linepath a b x \<in> convex hull S"
 proof -
   have "linepath a b x \<in> closed_segment a b"
     using x by (auto simp flip: linepath_image_01)
   then show ?thesis
     using a b convex_contains_segment by blast
 qed
 
 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"
 proof -
   have "(1 - inverse(2)) *\<^sub>R x + inverse(2) *\<^sub>R y \<in> convex hull s"
     by (rule convexD_alt) (use assms in auto)
   then show ?thesis
     by (simp add: midpoint_def algebra_simps)
 qed
 
 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 "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
   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
   show ?thesis
   proof (cases "c \<in> open_segment a b \<or> d \<in> open_segment a b")
     case True
     then show ?thesis
       using c d that by blast
   next
     case False
     then have "(c = a \<or> c = b) \<and> (d = a \<or> d = b)"
       by (simp add: \<open>c \<in> closed_segment a b\<close> \<open>d \<in> closed_segment a b\<close> open_segment_def)
     with \<open>a \<noteq> b\<close> \<open>f a = f b\<close> c d show ?thesis
       by (rule_tac z = "midpoint a b" in that) (fastforce+)
   qed
 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) = {}"
 proof -
   obtain e where "ball z e \<inter> path_image g = {}" "e > 0"
     using not_on_path_ball[OF assms] by auto
   moreover have "cball z (e/2) \<subseteq> ball z e"
     using \<open>e > 0\<close> by auto
   ultimately show ?thesis
     by (rule_tac x="e/2" in exI) auto
 qed
 
 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 (rule_tac x="linepath a b" in exI, auto)
 
 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)
 
 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" "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> {}"
     using g(3,4)[unfolded path_defs]
     using obt
     by (simp add: ex_in_conv [symmetric], metis zero_le_one order_refl)
   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
 proof
   fix y
   assume as: "y \<in> path_component_set S x"
   then have "y \<in> S"
     by (simp add: path_component_mem(2))
   then obtain e where e: "e > 0" "ball y e \<subseteq> S"
     using assms openE by blast
 have "\<And>u. dist y u < e \<Longrightarrow> path_component S x u"
       by (metis (full_types) as centre_in_ball convex_ball convex_imp_path_connected e mem_Collect_eq mem_ball path_component_eq path_component_of_subset path_connected_component)
   then show "\<exists>e > 0. ball y e \<subseteq> path_component_set S x"
     using \<open>e>0\<close> by auto
 qed
 
 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
     proof -
       have "y \<in> path_component_set S z"
         by (meson assms convex_ball convex_imp_path_connected e open_contains_ball_eq open_path_component path_component_maximal that(1))
       then have "y \<in> path_component_set S x"
         using path_component_eq that(2) by blast
       then show False
         using y by blast
     qed
   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 assms(1)] open_path_component[OF assms(1)]
       using assms(2)[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 (rule, rule)
   fix x' y'
   assume "x' \<in> f ` S" "y' \<in> f ` S"
   then obtain x y where x: "x \<in> S" and y: "y \<in> S" and x': "x' = f x" and y': "y' = f y"
     by auto
   from x y obtain g where "path g \<and> path_image g \<subseteq> S \<and> pathstart g = x \<and> pathfinish g = y"
     using assms(2)[unfolded path_connected_def] by fast
   then show "\<exists>g. path g \<and> path_image g \<subseteq> f ` S \<and> pathstart g = x' \<and> pathfinish g = y'"
     unfolding x' y' path_defs
     by (fastforce intro: continuous_on_compose continuous_on_subset[OF contf])
 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
   show "path_component (S \<union> T) x y"
     using x y
   proof safe
     assume "x \<in> S" "y \<in> S"
     then show "path_component (S \<union> T) x y"
       by (meson Un_upper1 \<open>path_connected S\<close> path_component_of_subset path_connected_component)
   next
     assume "x \<in> S" "y \<in> T"
     then show "path_component (S \<union> T) x y"
       by (metis z assms(1-2) le_sup_iff order_refl path_component_of_subset path_component_trans path_connected_component)
   next
   assume "x \<in> T" "y \<in> S"
     then show "path_component (S \<union> T) x y"
       by (metis z assms(1-2) le_sup_iff order_refl path_component_of_subset path_component_trans path_connected_component)
   next
     assume "x \<in> T" "y \<in> T"
     then show "path_component (S \<union> T) x y"
       by (metis Un_upper1 assms(2) path_component_of_subset path_connected_component sup_commute)
   qed
 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 (auto elim!: path_component_of_subset [rotated])
   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)"
 proof -
   { fix y z
     assume pa: "path_component s x y" "path_component s x z"
     then have pae: "path_component_set s x = path_component_set s y"
       using path_component_eq by auto
     have yz: "path_component s y z"
       using pa path_component_sym path_component_trans by blast
     then have "\<exists>g. path g \<and> path_image g \<subseteq> path_component_set s x \<and> pathstart g = y \<and> pathfinish g = z"
       apply (simp add: path_component_def)
       by (metis pae path_component_maximal path_connected_path_image pathstart_in_path_image)
   }
   then show ?thesis
     by (simp add: path_connected_def)
 qed
 
 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)"
   apply (intro iffI)
   apply (metis path_connected_path_image path_defs(5) pathfinish_in_path_image pathstart_in_path_image)
   using path_component_of_subset path_connected_component by blast
 
 lemma path_component_path_component [simp]:
    "path_component_set (path_component_set S x) x = path_component_set S x"
 proof (cases "x \<in> S")
   case True show ?thesis
     by (metis True mem_Collect_eq path_component_refl path_connected_component_set path_connected_path_component)
 next
   case False then show ?thesis
     by (metis False empty_iff path_component_eq_empty)
 qed
 
 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"
 apply (rule subset_antisym)
 using path_component_subset apply force
 using path_component_refl by auto
 
 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"
     (is "?lhs = ?rhs")
 proof 
   show "?lhs \<subseteq> ?rhs"
     using assms
     by (metis mem_Collect_eq path_component_refl path_component_subset path_connected_path_component subsetD)
 qed (simp add: assms path_component_maximal)
 
 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 ` {0..1} \<subseteq> T"
   by (simp add: path_def pathin_def)
 
 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)
 
 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
     apply (simp add: fun_eq_iff path_component_in_topspace)
     apply (meson path_component_of_sym path_component_of_trans)
     done
 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 (full_types) path_component_of_aux mem_Collect_eq 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"
   apply (auto simp: path_components_of_def path_component_of_equiv)
   using path_component_of_maximal path_connectedin_def apply fastforce
   by (meson disjnt_subset2 path_component_of_disjoint path_component_of_equiv path_component_of_maximal)
 
 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 Diff_cancel Diff_subset Union_path_components_of cSup_singleton diff_Union_pairwise_disjoint insert_subset pairwise_disjoint_path_components_of)
 
 lemma nonempty_path_components_of:
   assumes "C \<in> path_components_of X" shows "C \<noteq> {}"
 proof -
   have "C \<in> path_component_of_set X ` topspace X"
     using assms path_components_of_def by blast
   then show ?thesis
     using path_component_of_refl by fastforce
 qed
 
 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" "\<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"
     by simp (meson Union_upper \<A> path_component_of 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> topspace X = {}"
   using Union_path_components_of nonempty_path_components_of by fastforce
 
 lemma path_components_of_empty_space:
    "topspace X = {} \<Longrightarrow> path_components_of X = {}"
   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)"
   proof (intro iffI conjI)
     assume L: "path_components_of X = {S}"
     then show "path_connected_space X"
       by (simp add: path_connected_space_iff_components_eq)
     show "topspace X = S"
       by (metis L ccpo_Sup_singleton [of S] Union_path_components_of)
   next
     assume R: "path_connected_space X \<and> topspace X = S"
     then show "path_components_of X = {S}"
       using ccpo_Sup_singleton [of S]
       by (metis False all_not_in_conv insert_iff mk_disjoint_insert path_component_in_path_components_of path_connected_space_iff_components_eq path_connected_space_path_component_set)
   qed
   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"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using ne path_components_of_eq_empty that by fastforce
 next
   case False
   then obtain a where "a \<in> S"
     by blast
   show ?thesis
   proof
     show "Collect (path_component_of X a) \<in> path_components_of X"
       by (meson \<open>a \<in> S\<close> S subsetD path_component_in_path_components_of path_connectedin_subset_topspace)
     show "S \<subseteq> Collect (path_component_of X a)"
       by (simp add: S \<open>a \<in> S\<close> path_component_of_maximal)
   qed
 qed
 
 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 g x unfolding homeomorphic_maps_def
       by (metis f homeomorphic_imp_surjective_map imageI mem_Collect_eq path_component_of_maximal path_component_of_refl 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)"
     (is "?lhs = ?rhs")
   unfolding path_components_of_def homeomorphic_imp_surjective_map [OF assms, symmetric]
   using assms homeomorphic_map_path_component_of by fastforce
 
 
 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 ex_card[OF assms]
     by auto
   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 less
   then show ?thesis
     by (simp)
 next
   case equal
   then show ?thesis
     by (simp)
 next
   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 (sphere (0::'a) r)"
     by auto
   then 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
 
 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 F)
   then have "connected (S-F)" by auto
   moreover have "open (S - F)" using finite_imp_closed[OF \<open>finite F\<close>] \<open>open S\<close> by auto
   ultimately have "connected (S - F - {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, hide_lams) 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"
 proof -
   have "sphere a r = (+) a ` sphere 0 r"
     by (metis add.right_neutral sphere_translation)
   then show ?thesis
     using sphere_1D_doubleton_zero [OF assms]
     by (metis (mono_tags, lifting) dist_add_cancel image_empty image_insert that)
 qed
 
 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 -
   { assume "x \<in> closure (connected_component_set S y)"
     moreover have "x \<in> connected_component_set S x"
       using x by simp
     ultimately have "x \<in> connected_component_set S y"
       using S by (meson Compl_disjoint closure_iff_nhds_not_empty connected_component_disjoint disjoint_eq_subset_Compl open_connected_component)
   }
   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> have "S \<subseteq> T"
     using "3" by auto
   show ?thesis
     using \<open>S \<inter> \<Union>(B - {T}) = {}\<close> \<open>S \<subseteq> T\<close> \<open>T \<in> B\<close> that by auto
 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 (rule subset_antisym; metis 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: "B>0" "-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' where x': "connected_component S x x'" "norm x' > B"
     using bo [unfolded bounded_def dist_norm, simplified, rule_format]
     by (metis diff_zero norm_minus_commute not_less)
   obtain y' where y': "connected_component S y y'" "norm y' > B"
     using bo [unfolded bounded_def dist_norm, simplified, rule_format]
     by (metis diff_zero norm_minus_commute not_less)
   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
   proof (rule connected_component_eq)
     show "x \<in> connected_component_set S y"
       using x' y' x'y'
       by (metis (no_types) connected_component_eq_eq connected_component_in mem_Collect_eq)
   qed
 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"
 proof -
   obtain dx dy where "dx \<ge> 0" "dy \<ge> 0" "x = B + dx" "y = B + dy"
     using assms by auto (metis add.commute diff_add_cancel)
   with \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> show ?thesis
     by (simp add: add_increasing2 mult_left_le field_simps)
 qed
 
 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}"
   apply (auto simp: outside bounded_def dist_norm)
    apply (metis diff_0 norm_minus_cancel not_less)
   by (metis less_diff_eq norm_minus_commute norm_triangle_ineq2 order.trans pinf(6))
 
 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
   { fix y::'a and z::'a
     assume yz: "B < norm z" "B < norm y"
     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 have "connected_component (- S) y z"
       by (metis connected_component_of_subset Bno Compl_anti_mono mem_cball_0 subset_iff)
   } note cyz = this
   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}"
   apply (auto intro: less_imp_le simp: not_outside_connected_component_lt [OF assms])
   by (meson gt_ex less_le_trans)
 
 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"
   apply (auto simp: inside_def)
   by (metis bounded_subset [of "connected_component_set (- S) _"] connected_component_maximal
       Compl_iff Un_iff assms 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 1: "closed_segment x y \<inter> T \<noteq> {}" 
       using \<open>y \<in> T\<close> by blast
     have 2: "closed_segment x y - T \<noteq> {}"
       using False by blast
     obtain c where "c \<in> closed_segment x y" "c \<in> frontier T"
        using False connected_Int_frontier [OF connected_segment 1 2] by auto
     then show ?thesis
     proof -
       have "norm (y - x) < e"
         by (metis dist_norm \<open>dist y x < e\<close>)
       moreover have "norm (c - x) \<le> norm (y - x)"
         by (simp add: \<open>c \<in> closed_segment x y\<close> segment_bound(1))
       ultimately have "norm (c - x) < e"
         by linarith
       then show ?thesis
         by (metis (no_types) \<open>c \<in> frontier T\<close> dist_norm that(1))
     qed
   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 (rule order_trans [OF frontier_Union_subset_closure])
    (auto simp: closure_subset_eq)
 
 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 (no_types, lifting) C Compl_subset_Compl_iff \<open>frontier C \<subset> S\<close> compl_sup frontier_closures in_components_subset psubsetE sup.absorb_iff2 sup.boundedE sup_bot.right_neutral sup_inf_absorb)
   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
     apply (auto simp: inside_def frontier_def)
     apply (rule classical)
     apply (rule bounded_subset [OF assms], blast)
     done
 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"
   unfolding outside_inside Lattices.boolean_algebra_class.compl_le_compl_iff
 proof -
   { assume "interior S \<subseteq> inside (frontier S)"
     hence "interior S \<union> inside (frontier S) = inside (frontier S)"
       by (simp add: subset_Un_eq)
     then have "closure S \<subseteq> frontier S \<union> inside (frontier S)"
       using frontier_def by auto
   }
   then show "closure S \<subseteq> frontier S \<union> inside (frontier S)"
     using interior_inside_frontier [OF assms] by blast
 qed
 
 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"
   apply (simp add: inside_outside outside_frontier_eq_complement_closure)
   using closure_subset interior_subset
   apply (auto simp: frontier_def)
   done
 
 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"
 proof -
   have "closure (inside S) \<inter> - inside S = closure (inside S) - interior (inside S)"
     by (metis (no_types) Diff_Compl assms closure_closed interior_closure open_closed open_inside)
   moreover have "- inside S \<inter> - outside S = S"
     by (metis (no_types) compl_sup double_compl inside_Un_outside)
   moreover have "closure (inside S) \<subseteq> - outside S"
     by (metis (no_types) assms closure_inside_subset union_with_inside)
   ultimately have "closure (inside S) - interior (inside S) \<subseteq> S"
     by blast
   then show ?thesis
     by (simp add: frontier_def open_inside interior_open)
 qed
 
 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 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 (no_types, hide_lams) Compl_anti_mono connected_component_eq connected_component_maximal contra_subsetD double_compl)
 
 lemma outside_bounded_nonempty:
   fixes S :: "'a :: {real_normed_vector, perfect_space} set"
     assumes "bounded S" shows "outside S \<noteq> {}"
   by (metis (no_types, lifting) Collect_empty_eq Collect_mem_eq Compl_eq_Diff_UNIV Diff_cancel
                    Diff_disjoint UNIV_I assms ball_eq_empty bounded_diff cobounded_outside convex_ball
                    double_complement order_refl outside_convex outside_def)
 
 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> {}"
     proof -
       have "- ball 0 r \<subseteq> outside S"
         by (meson convex_ball le_supE outside_subset_convex r)
       moreover have "- ball 0 r \<subseteq> outside T"
         by (meson convex_ball le_supE outside_subset_convex r)
       ultimately show ?thesis
         by (metis Compl_subset_Compl_iff Int_subset_iff bounded_ball inf.orderE outside_bounded_nonempty outside_no_overlap)
     qed
     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
       by (rule_tac x=a in exI, rule_tac x="{a}" in exI, simp)
   next
     assume a: "a \<in> inside S"
     then have ain: "a \<in> closure (inside S)"
       by (simp add: closure_def)
     show ?thesis
       apply (rule exists_path_subpath_to_frontier [OF path_linepath [of a b], of "inside S"])
         apply (simp_all add: ain b)
       subgoal for h
         apply (rule_tac x="pathfinish h" in exI)
         apply (simp add: subsetD [OF frontier_inside_subset[OF S]])
         apply (rule_tac x="path_image h" in exI)
         apply (simp add: pathfinish_in_path_image connected_path_image, auto)
         by (metis Diff_single_insert S frontier_inside_subset insert_iff interior_subset subsetD)
       done
   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)
     show ?thesis
       apply (rule exists_path_subpath_to_frontier [OF path_linepath [of a b], of "outside S"])
         apply (simp_all add: ain b)
       subgoal for h
       apply (rule_tac x="pathfinish h" in exI)
         apply (simp add: subsetD [OF frontier_outside_subset[OF S]])
       apply (rule_tac x="path_image h" in exI)
       apply (simp add: pathfinish_in_path_image connected_path_image, auto)
         by (metis (no_types, lifting) frontier_outside_subset insertE insert_Diff interior_eq open_outside pathfinish_in_path_image S subsetCE)
       done
   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) = {}"
   by (metis (no_types) unbounded_outside connected_with_outside [OF assms] bounded_Un
            inside_complement_unbounded_connected_empty unbounded_outside union_with_outside)
 
 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 rle: "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
     have **: "(b \<inter> (- S) \<noteq> {} \<and> b - (- S) \<noteq> {} \<Longrightarrow> b \<inter> f \<noteq> {})
               \<Longrightarrow> (b \<inter> S \<noteq> {}) \<Longrightarrow> b \<inter> f = {} \<Longrightarrow> b \<subseteq> S" 
              for b f and S :: "'b set"
       by blast
     have \<section>: "\<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 rle wy)
     show ?thesis
       apply (rule ** [OF connected_Int_frontier [where t = "f`S", OF connected_ball]])
         (*such a horrible mess*)
       using \<open>a \<in> S\<close> \<open>0 < r\<close> by (auto simp: disjoint_iff_not_equal dist_norm dest: \<section>)
 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: continuous_map_def gf)
     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
       by (simp add: embedding_map_def) (metis all_closedin_homeomorphic_image f 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/Complex_Analysis/Complex_Singularities.thy b/src/HOL/Complex_Analysis/Complex_Singularities.thy
--- a/src/HOL/Complex_Analysis/Complex_Singularities.thy
+++ b/src/HOL/Complex_Analysis/Complex_Singularities.thy
@@ -1,1533 +1,1538 @@
 theory Complex_Singularities
   imports Conformal_Mappings
 begin
 
 subsection \<open>Non-essential singular points\<close>
 
 definition\<^marker>\<open>tag important\<close> is_pole ::
   "('a::topological_space \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> bool" where
   "is_pole f a =  (LIM x (at a). f x :> at_infinity)"
 
 lemma is_pole_cong:
   assumes "eventually (\<lambda>x. f x = g x) (at a)" "a=b"
   shows "is_pole f a \<longleftrightarrow> is_pole g b"
   unfolding is_pole_def using assms by (intro filterlim_cong,auto)
 
 lemma is_pole_transform:
   assumes "is_pole f a" "eventually (\<lambda>x. f x = g x) (at a)" "a=b"
   shows "is_pole g b"
   using is_pole_cong assms by auto
 
+lemma is_pole_shift_iff:
+  fixes f :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector)"
+  shows "is_pole (f \<circ> (+) d) a = is_pole f (a + d)"
+  by (metis add_diff_cancel_right' filterlim_shift_iff is_pole_def)
+
 lemma is_pole_tendsto:
   fixes f::"('a::topological_space \<Rightarrow> 'b::real_normed_div_algebra)"
   shows "is_pole f x \<Longrightarrow> ((inverse o f) \<longlongrightarrow> 0) (at x)"
 unfolding is_pole_def
 by (auto simp add:filterlim_inverse_at_iff[symmetric] comp_def filterlim_at)
 
 lemma is_pole_inverse_holomorphic:
   assumes "open s"
     and f_holo:"f holomorphic_on (s-{z})"
     and pole:"is_pole f z"
     and non_z:"\<forall>x\<in>s-{z}. f x\<noteq>0"
   shows "(\<lambda>x. if x=z then 0 else inverse (f x)) holomorphic_on s"
 proof -
   define g where "g \<equiv> \<lambda>x. if x=z then 0 else inverse (f x)"
   have "isCont g z" unfolding isCont_def  using is_pole_tendsto[OF pole]
     by (simp add: g_def cong: LIM_cong)
   moreover have "continuous_on (s-{z}) f" using f_holo holomorphic_on_imp_continuous_on by auto
   hence "continuous_on (s-{z}) (inverse o f)" unfolding comp_def
     by (auto elim!:continuous_on_inverse simp add:non_z)
   hence "continuous_on (s-{z}) g" unfolding g_def
     apply (subst continuous_on_cong[where t="s-{z}" and g="inverse o f"])
     by auto
   ultimately have "continuous_on s g" using open_delete[OF \<open>open s\<close>] \<open>open s\<close>
     by (auto simp add:continuous_on_eq_continuous_at)
   moreover have "(inverse o f) holomorphic_on (s-{z})"
     unfolding comp_def using f_holo
     by (auto elim!:holomorphic_on_inverse simp add:non_z)
   hence "g holomorphic_on (s-{z})"
     apply (subst holomorphic_cong[where t="s-{z}" and g="inverse o f"])
     by (auto simp add:g_def)
   ultimately show ?thesis unfolding g_def using \<open>open s\<close>
     by (auto elim!: no_isolated_singularity)
 qed
 
 lemma not_is_pole_holomorphic:
   assumes "open A" "x \<in> A" "f holomorphic_on A"
   shows   "\<not>is_pole f x"
 proof -
   have "continuous_on A f" by (intro holomorphic_on_imp_continuous_on) fact
   with assms have "isCont f x" by (simp add: continuous_on_eq_continuous_at)
   hence "f \<midarrow>x\<rightarrow> f x" by (simp add: isCont_def)
   thus "\<not>is_pole f x" unfolding is_pole_def
     using not_tendsto_and_filterlim_at_infinity[of "at x" f "f x"] by auto
 qed
 
 lemma is_pole_inverse_power: "n > 0 \<Longrightarrow> is_pole (\<lambda>z::complex. 1 / (z - a) ^ n) a"
   unfolding is_pole_def inverse_eq_divide [symmetric]
   by (intro filterlim_compose[OF filterlim_inverse_at_infinity] tendsto_intros)
      (auto simp: filterlim_at eventually_at intro!: exI[of _ 1] tendsto_eq_intros)
 
 lemma is_pole_inverse: "is_pole (\<lambda>z::complex. 1 / (z - a)) a"
   using is_pole_inverse_power[of 1 a] by simp
 
 lemma is_pole_divide:
   fixes f :: "'a :: t2_space \<Rightarrow> 'b :: real_normed_field"
   assumes "isCont f z" "filterlim g (at 0) (at z)" "f z \<noteq> 0"
   shows   "is_pole (\<lambda>z. f z / g z) z"
 proof -
   have "filterlim (\<lambda>z. f z * inverse (g z)) at_infinity (at z)"
     by (intro tendsto_mult_filterlim_at_infinity[of _ "f z"]
                  filterlim_compose[OF filterlim_inverse_at_infinity])+
        (insert assms, auto simp: isCont_def)
   thus ?thesis by (simp add: field_split_simps is_pole_def)
 qed
 
 lemma is_pole_basic:
   assumes "f holomorphic_on A" "open A" "z \<in> A" "f z \<noteq> 0" "n > 0"
   shows   "is_pole (\<lambda>w. f w / (w - z) ^ n) z"
 proof (rule is_pole_divide)
   have "continuous_on A f" by (rule holomorphic_on_imp_continuous_on) fact
   with assms show "isCont f z" by (auto simp: continuous_on_eq_continuous_at)
   have "filterlim (\<lambda>w. (w - z) ^ n) (nhds 0) (at z)"
     using assms by (auto intro!: tendsto_eq_intros)
   thus "filterlim (\<lambda>w. (w - z) ^ n) (at 0) (at z)"
     by (intro filterlim_atI tendsto_eq_intros)
        (insert assms, auto simp: eventually_at_filter)
 qed fact+
 
 lemma is_pole_basic':
   assumes "f holomorphic_on A" "open A" "0 \<in> A" "f 0 \<noteq> 0" "n > 0"
   shows   "is_pole (\<lambda>w. f w / w ^ n) 0"
   using is_pole_basic[of f A 0] assms by simp
 
 text \<open>The proposition
               \<^term>\<open>\<exists>x. ((f::complex\<Rightarrow>complex) \<longlongrightarrow> x) (at z) \<or> is_pole f z\<close>
 can be interpreted as the complex function \<^term>\<open>f\<close> has a non-essential singularity at \<^term>\<open>z\<close>
 (i.e. the singularity is either removable or a pole).\<close>
 definition not_essential::"[complex \<Rightarrow> complex, complex] \<Rightarrow> bool" where
   "not_essential f z = (\<exists>x. f\<midarrow>z\<rightarrow>x \<or> is_pole f z)"
 
 definition isolated_singularity_at::"[complex \<Rightarrow> complex, complex] \<Rightarrow> bool" where
   "isolated_singularity_at f z = (\<exists>r>0. f analytic_on ball z r-{z})"
 
 named_theorems singularity_intros "introduction rules for singularities"
 
 lemma holomorphic_factor_unique:
   fixes f::"complex \<Rightarrow> complex" and z::complex and r::real and m n::int
   assumes "r>0" "g z\<noteq>0" "h z\<noteq>0"
     and asm:"\<forall>w\<in>ball z r-{z}. f w = g w * (w-z) powr n \<and> g w\<noteq>0 \<and> f w =  h w * (w - z) powr m \<and> h w\<noteq>0"
     and g_holo:"g holomorphic_on ball z r" and h_holo:"h holomorphic_on ball z r"
   shows "n=m"
 proof -
   have [simp]:"at z within ball z r \<noteq> bot" using \<open>r>0\<close>
       by (auto simp add:at_within_ball_bot_iff)
   have False when "n>m"
   proof -
     have "(h \<longlongrightarrow> 0) (at z within ball z r)"
     proof (rule Lim_transform_within[OF _ \<open>r>0\<close>, where f="\<lambda>w. (w - z) powr (n - m) * g w"])
       have "\<forall>w\<in>ball z r-{z}. h w = (w-z)powr(n-m) * g w"
         using \<open>n>m\<close> asm \<open>r>0\<close>
         apply (auto simp add:field_simps powr_diff)
         by force
       then show "\<lbrakk>x' \<in> ball z r; 0 < dist x' z;dist x' z < r\<rbrakk>
             \<Longrightarrow> (x' - z) powr (n - m) * g x' = h x'" for x' by auto
     next
       define F where "F \<equiv> at z within ball z r"
       define f' where "f' \<equiv> \<lambda>x. (x - z) powr (n-m)"
       have "f' z=0" using \<open>n>m\<close> unfolding f'_def by auto
       moreover have "continuous F f'" unfolding f'_def F_def continuous_def
         apply (subst Lim_ident_at)
         using \<open>n>m\<close> by (auto intro!:tendsto_powr_complex_0 tendsto_eq_intros)
       ultimately have "(f' \<longlongrightarrow> 0) F" unfolding F_def
         by (simp add: continuous_within)
       moreover have "(g \<longlongrightarrow> g z) F"
         using holomorphic_on_imp_continuous_on[OF g_holo,unfolded continuous_on_def] \<open>r>0\<close>
         unfolding F_def by auto
       ultimately show " ((\<lambda>w. f' w * g w) \<longlongrightarrow> 0) F" using tendsto_mult by fastforce
     qed
     moreover have "(h \<longlongrightarrow> h z) (at z within ball z r)"
       using holomorphic_on_imp_continuous_on[OF h_holo]
       by (auto simp add:continuous_on_def \<open>r>0\<close>)
     ultimately have "h z=0" by (auto intro!: tendsto_unique)
     thus False using \<open>h z\<noteq>0\<close> by auto
   qed
   moreover have False when "m>n"
   proof -
     have "(g \<longlongrightarrow> 0) (at z within ball z r)"
     proof (rule Lim_transform_within[OF _ \<open>r>0\<close>, where f="\<lambda>w. (w - z) powr (m - n) * h w"])
       have "\<forall>w\<in>ball z r -{z}. g w = (w-z) powr (m-n) * h w" using \<open>m>n\<close> asm
         apply (auto simp add:field_simps powr_diff)
         by force
       then show "\<lbrakk>x' \<in> ball z r; 0 < dist x' z;dist x' z < r\<rbrakk>
             \<Longrightarrow> (x' - z) powr (m - n) * h x' = g x'" for x' by auto
     next
       define F where "F \<equiv> at z within ball z r"
       define f' where "f' \<equiv>\<lambda>x. (x - z) powr (m-n)"
       have "f' z=0" using \<open>m>n\<close> unfolding f'_def by auto
       moreover have "continuous F f'" unfolding f'_def F_def continuous_def
         apply (subst Lim_ident_at)
         using \<open>m>n\<close> by (auto intro!:tendsto_powr_complex_0 tendsto_eq_intros)
       ultimately have "(f' \<longlongrightarrow> 0) F" unfolding F_def
         by (simp add: continuous_within)
       moreover have "(h \<longlongrightarrow> h z) F"
         using holomorphic_on_imp_continuous_on[OF h_holo,unfolded continuous_on_def] \<open>r>0\<close>
         unfolding F_def by auto
       ultimately show " ((\<lambda>w. f' w * h w) \<longlongrightarrow> 0) F" using tendsto_mult by fastforce
     qed
     moreover have "(g \<longlongrightarrow> g z) (at z within ball z r)"
       using holomorphic_on_imp_continuous_on[OF g_holo]
       by (auto simp add:continuous_on_def \<open>r>0\<close>)
     ultimately have "g z=0" by (auto intro!: tendsto_unique)
     thus False using \<open>g z\<noteq>0\<close> by auto
   qed
   ultimately show "n=m" by fastforce
 qed
 
 lemma holomorphic_factor_puncture:
   assumes f_iso:"isolated_singularity_at f z"
       and "not_essential f z" \<comment> \<open>\<^term>\<open>f\<close> has either a removable singularity or a pole at \<^term>\<open>z\<close>\<close>
       and non_zero:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0" \<comment> \<open>\<^term>\<open>f\<close> will not be constantly zero in a neighbour of \<^term>\<open>z\<close>\<close>
   shows "\<exists>!n::int. \<exists>g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z\<noteq>0
           \<and> (\<forall>w\<in>cball z r-{z}. f w = g w * (w-z) powr n \<and> g w\<noteq>0)"
 proof -
   define P where "P = (\<lambda>f n g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z\<noteq>0
           \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w-z) powr (of_int n)  \<and> g w\<noteq>0))"
   have imp_unique:"\<exists>!n::int. \<exists>g r. P f n g r" when "\<exists>n g r. P f n g r"
   proof (rule ex_ex1I[OF that])
     fix n1 n2 :: int
     assume g1_asm:"\<exists>g1 r1. P f n1 g1 r1" and g2_asm:"\<exists>g2 r2. P f n2 g2 r2"
     define fac where "fac \<equiv> \<lambda>n g r. \<forall>w\<in>cball z r-{z}. f w = g w * (w - z) powr (of_int n) \<and> g w \<noteq> 0"
     obtain g1 r1 where "0 < r1" and g1_holo: "g1 holomorphic_on cball z r1" and "g1 z\<noteq>0"
         and "fac n1 g1 r1" using g1_asm unfolding P_def fac_def by auto
     obtain g2 r2 where "0 < r2" and g2_holo: "g2 holomorphic_on cball z r2" and "g2 z\<noteq>0"
         and "fac n2 g2 r2" using g2_asm unfolding P_def fac_def by auto
     define r where "r \<equiv> min r1 r2"
     have "r>0" using \<open>r1>0\<close> \<open>r2>0\<close> unfolding r_def by auto
     moreover have "\<forall>w\<in>ball z r-{z}. f w = g1 w * (w-z) powr n1 \<and> g1 w\<noteq>0
         \<and> f w = g2 w * (w - z) powr n2  \<and> g2 w\<noteq>0"
       using \<open>fac n1 g1 r1\<close> \<open>fac n2 g2 r2\<close>   unfolding fac_def r_def
       by fastforce
     ultimately show "n1=n2" using g1_holo g2_holo \<open>g1 z\<noteq>0\<close> \<open>g2 z\<noteq>0\<close>
       apply (elim holomorphic_factor_unique)
       by (auto simp add:r_def)
   qed
 
   have P_exist:"\<exists> n g r. P h n g r" when
       "\<exists>z'. (h \<longlongrightarrow> z') (at z)" "isolated_singularity_at h z"  "\<exists>\<^sub>Fw in (at z). h w\<noteq>0"
     for h
   proof -
     from that(2) obtain r where "r>0" "h analytic_on ball z r - {z}"
       unfolding isolated_singularity_at_def by auto
     obtain z' where "(h \<longlongrightarrow> z') (at z)" using \<open>\<exists>z'. (h \<longlongrightarrow> z') (at z)\<close> by auto
     define h' where "h'=(\<lambda>x. if x=z then z' else h x)"
     have "h' holomorphic_on ball z r"
       apply (rule no_isolated_singularity'[of "{z}"])
       subgoal by (metis LIM_equal Lim_at_imp_Lim_at_within \<open>h \<midarrow>z\<rightarrow> z'\<close> empty_iff h'_def insert_iff)
       subgoal using \<open>h analytic_on ball z r - {z}\<close> analytic_imp_holomorphic h'_def holomorphic_transform
         by fastforce
       by auto
     have ?thesis when "z'=0"
     proof -
       have "h' z=0" using that unfolding h'_def by auto
       moreover have "\<not> h' constant_on ball z r"
         using \<open>\<exists>\<^sub>Fw in (at z). h w\<noteq>0\<close> unfolding constant_on_def frequently_def eventually_at h'_def
         apply simp
         by (metis \<open>0 < r\<close> centre_in_ball dist_commute mem_ball that)
       moreover note \<open>h' holomorphic_on ball z r\<close>
       ultimately obtain g r1 n where "0 < n" "0 < r1" "ball z r1 \<subseteq> ball z r" and
           g:"g holomorphic_on ball z r1"
           "\<And>w. w \<in> ball z r1 \<Longrightarrow> h' w = (w - z) ^ n * g w"
           "\<And>w. w \<in> ball z r1 \<Longrightarrow> g w \<noteq> 0"
         using holomorphic_factor_zero_nonconstant[of _ "ball z r" z thesis,simplified,
                 OF \<open>h' holomorphic_on ball z r\<close> \<open>r>0\<close> \<open>h' z=0\<close> \<open>\<not> h' constant_on ball z r\<close>]
         by (auto simp add:dist_commute)
       define rr where "rr=r1/2"
       have "P h' n g rr"
         unfolding P_def rr_def
         using \<open>n>0\<close> \<open>r1>0\<close> g by (auto simp add:powr_nat)
       then have "P h n g rr"
         unfolding h'_def P_def by auto
       then show ?thesis unfolding P_def by blast
     qed
     moreover have ?thesis when "z'\<noteq>0"
     proof -
       have "h' z\<noteq>0" using that unfolding h'_def by auto
       obtain r1 where "r1>0" "cball z r1 \<subseteq> ball z r" "\<forall>x\<in>cball z r1. h' x\<noteq>0"
       proof -
         have "isCont h' z" "h' z\<noteq>0"
           by (auto simp add: Lim_cong_within \<open>h \<midarrow>z\<rightarrow> z'\<close> \<open>z'\<noteq>0\<close> continuous_at h'_def)
         then obtain r2 where r2:"r2>0" "\<forall>x\<in>ball z r2. h' x\<noteq>0"
           using continuous_at_avoid[of z h' 0 ] unfolding ball_def by auto
         define r1 where "r1=min r2 r / 2"
         have "0 < r1" "cball z r1 \<subseteq> ball z r"
           using \<open>r2>0\<close> \<open>r>0\<close> unfolding r1_def by auto
         moreover have "\<forall>x\<in>cball z r1. h' x \<noteq> 0"
           using r2 unfolding r1_def by simp
         ultimately show ?thesis using that by auto
       qed
       then have "P h' 0 h' r1" using \<open>h' holomorphic_on ball z r\<close> unfolding P_def by auto
       then have "P h 0 h' r1" unfolding P_def h'_def by auto
       then show ?thesis unfolding P_def by blast
     qed
     ultimately show ?thesis by auto
   qed
 
   have ?thesis when "\<exists>x. (f \<longlongrightarrow> x) (at z)"
     apply (rule_tac imp_unique[unfolded P_def])
     using P_exist[OF that(1) f_iso non_zero] unfolding P_def .
   moreover have ?thesis when "is_pole f z"
   proof (rule imp_unique[unfolded P_def])
     obtain e where [simp]:"e>0" and e_holo:"f holomorphic_on ball z e - {z}" and e_nz: "\<forall>x\<in>ball z e-{z}. f x\<noteq>0"
     proof -
       have "\<forall>\<^sub>F z in at z. f z \<noteq> 0"
         using \<open>is_pole f z\<close> filterlim_at_infinity_imp_eventually_ne unfolding is_pole_def
         by auto
       then obtain e1 where e1:"e1>0" "\<forall>x\<in>ball z e1-{z}. f x\<noteq>0"
         using that eventually_at[of "\<lambda>x. f x\<noteq>0" z UNIV,simplified] by (auto simp add:dist_commute)
       obtain e2 where e2:"e2>0" "f holomorphic_on ball z e2 - {z}"
         using f_iso analytic_imp_holomorphic unfolding isolated_singularity_at_def by auto
       define e where "e=min e1 e2"
       show ?thesis
         apply (rule that[of e])
         using  e1 e2 unfolding e_def by auto
     qed
 
     define h where "h \<equiv> \<lambda>x. inverse (f x)"
 
     have "\<exists>n g r. P h n g r"
     proof -
       have "h \<midarrow>z\<rightarrow> 0"
         using Lim_transform_within_open assms(2) h_def is_pole_tendsto that by fastforce
       moreover have "\<exists>\<^sub>Fw in (at z). h w\<noteq>0"
         using non_zero
         apply (elim frequently_rev_mp)
         unfolding h_def eventually_at by (auto intro:exI[where x=1])
       moreover have "isolated_singularity_at h z"
         unfolding isolated_singularity_at_def h_def
         apply (rule exI[where x=e])
         using e_holo e_nz \<open>e>0\<close> by (metis open_ball analytic_on_open
             holomorphic_on_inverse open_delete)
       ultimately show ?thesis
         using P_exist[of h] by auto
     qed
     then obtain n g r
       where "0 < r" and
             g_holo:"g holomorphic_on cball z r" and "g z\<noteq>0" and
             g_fac:"(\<forall>w\<in>cball z r-{z}. h w = g w * (w - z) powr of_int n  \<and> g w \<noteq> 0)"
       unfolding P_def by auto
     have "P f (-n) (inverse o g) r"
     proof -
       have "f w = inverse (g w) * (w - z) powr of_int (- n)" when "w\<in>cball z r - {z}" for w
         using g_fac[rule_format,of w] that unfolding h_def
         apply (auto simp add:powr_minus )
         by (metis inverse_inverse_eq inverse_mult_distrib)
       then show ?thesis
         unfolding P_def comp_def
         using \<open>r>0\<close> g_holo g_fac \<open>g z\<noteq>0\<close> by (auto intro:holomorphic_intros)
     qed
     then show "\<exists>x g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z \<noteq> 0
                   \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int x  \<and> g w \<noteq> 0)"
       unfolding P_def by blast
   qed
   ultimately show ?thesis using \<open>not_essential f z\<close> unfolding not_essential_def  by presburger
 qed
 
 lemma not_essential_transform:
   assumes "not_essential g z"
   assumes "\<forall>\<^sub>F w in (at z). g w = f w"
   shows "not_essential f z"
   using assms unfolding not_essential_def
   by (simp add: filterlim_cong is_pole_cong)
 
 lemma isolated_singularity_at_transform:
   assumes "isolated_singularity_at g z"
   assumes "\<forall>\<^sub>F w in (at z). g w = f w"
   shows "isolated_singularity_at f z"
 proof -
   obtain r1 where "r1>0" and r1:"g analytic_on ball z r1 - {z}"
     using assms(1) unfolding isolated_singularity_at_def by auto
   obtain r2 where "r2>0" and r2:" \<forall>x. x \<noteq> z \<and> dist x z < r2 \<longrightarrow> g x = f x"
     using assms(2) unfolding eventually_at by auto
   define r3 where "r3=min r1 r2"
   have "r3>0" unfolding r3_def using \<open>r1>0\<close> \<open>r2>0\<close> by auto
   moreover have "f analytic_on ball z r3 - {z}"
   proof -
     have "g holomorphic_on ball z r3 - {z}"
       using r1 unfolding r3_def by (subst (asm) analytic_on_open,auto)
     then have "f holomorphic_on ball z r3 - {z}"
       using r2 unfolding r3_def
       by (auto simp add:dist_commute elim!:holomorphic_transform)
     then show ?thesis by (subst analytic_on_open,auto)
   qed
   ultimately show ?thesis unfolding isolated_singularity_at_def by auto
 qed
 
 lemma not_essential_powr[singularity_intros]:
   assumes "LIM w (at z). f w :> (at x)"
   shows "not_essential (\<lambda>w. (f w) powr (of_int n)) z"
 proof -
   define fp where "fp=(\<lambda>w. (f w) powr (of_int n))"
   have ?thesis when "n>0"
   proof -
     have "(\<lambda>w.  (f w) ^ (nat n)) \<midarrow>z\<rightarrow> x ^ nat n"
       using that assms unfolding filterlim_at by (auto intro!:tendsto_eq_intros)
     then have "fp \<midarrow>z\<rightarrow> x ^ nat n" unfolding fp_def
       apply (elim Lim_transform_within[where d=1],simp)
       by (metis less_le powr_0 powr_of_int that zero_less_nat_eq zero_power)
     then show ?thesis unfolding not_essential_def fp_def by auto
   qed
   moreover have ?thesis when "n=0"
   proof -
     have "fp \<midarrow>z\<rightarrow> 1 "
       apply (subst tendsto_cong[where g="\<lambda>_.1"])
       using that filterlim_at_within_not_equal[OF assms,of 0] unfolding fp_def by auto
     then show ?thesis unfolding fp_def not_essential_def by auto
   qed
   moreover have ?thesis when "n<0"
   proof (cases "x=0")
     case True
     have "LIM w (at z). inverse ((f w) ^ (nat (-n))) :> at_infinity"
       apply (subst filterlim_inverse_at_iff[symmetric],simp)
       apply (rule filterlim_atI)
       subgoal using assms True that unfolding filterlim_at by (auto intro!:tendsto_eq_intros)
       subgoal using filterlim_at_within_not_equal[OF assms,of 0]
         by (eventually_elim,insert that,auto)
       done
     then have "LIM w (at z). fp w :> at_infinity"
     proof (elim filterlim_mono_eventually)
       show "\<forall>\<^sub>F x in at z. inverse (f x ^ nat (- n)) = fp x"
         using filterlim_at_within_not_equal[OF assms,of 0] unfolding fp_def
         apply eventually_elim
         using powr_of_int that by auto
     qed auto
     then show ?thesis unfolding fp_def not_essential_def is_pole_def by auto
   next
     case False
     let ?xx= "inverse (x ^ (nat (-n)))"
     have "(\<lambda>w. inverse ((f w) ^ (nat (-n)))) \<midarrow>z\<rightarrow>?xx"
       using assms False unfolding filterlim_at by (auto intro!:tendsto_eq_intros)
     then have "fp \<midarrow>z\<rightarrow>?xx"
       apply (elim Lim_transform_within[where d=1],simp)
       unfolding fp_def by (metis inverse_zero nat_mono_iff nat_zero_as_int neg_0_less_iff_less
           not_le power_eq_0_iff powr_0 powr_of_int that)
     then show ?thesis unfolding fp_def not_essential_def by auto
   qed
   ultimately show ?thesis by linarith
 qed
 
 lemma isolated_singularity_at_powr[singularity_intros]:
   assumes "isolated_singularity_at f z" "\<forall>\<^sub>F w in (at z). f w\<noteq>0"
   shows "isolated_singularity_at (\<lambda>w. (f w) powr (of_int n)) z"
 proof -
   obtain r1 where "r1>0" "f analytic_on ball z r1 - {z}"
     using assms(1) unfolding isolated_singularity_at_def by auto
   then have r1:"f holomorphic_on ball z r1 - {z}"
     using analytic_on_open[of "ball z r1-{z}" f] by blast
   obtain r2 where "r2>0" and r2:"\<forall>w. w \<noteq> z \<and> dist w z < r2 \<longrightarrow> f w \<noteq> 0"
     using assms(2) unfolding eventually_at by auto
   define r3 where "r3=min r1 r2"
   have "(\<lambda>w. (f w) powr of_int n) holomorphic_on ball z r3 - {z}"
     apply (rule holomorphic_on_powr_of_int)
     subgoal unfolding r3_def using r1 by auto
     subgoal unfolding r3_def using r2 by (auto simp add:dist_commute)
     done
   moreover have "r3>0" unfolding r3_def using \<open>0 < r1\<close> \<open>0 < r2\<close> by linarith
   ultimately show ?thesis unfolding isolated_singularity_at_def
     apply (subst (asm) analytic_on_open[symmetric])
     by auto
 qed
 
 lemma non_zero_neighbour:
   assumes f_iso:"isolated_singularity_at f z"
       and f_ness:"not_essential f z"
       and f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
     shows "\<forall>\<^sub>F w in (at z). f w\<noteq>0"
 proof -
   obtain fn fp fr where [simp]:"fp z \<noteq> 0" and "fr > 0"
           and fr: "fp holomorphic_on cball z fr"
                   "\<forall>w\<in>cball z fr - {z}. f w = fp w * (w - z) powr of_int fn \<and> fp w \<noteq> 0"
     using holomorphic_factor_puncture[OF f_iso f_ness f_nconst,THEN ex1_implies_ex] by auto
   have "f w \<noteq> 0" when " w \<noteq> z" "dist w z < fr" for w
   proof -
     have "f w = fp w * (w - z) powr of_int fn" "fp w \<noteq> 0"
       using fr(2)[rule_format, of w] using that by (auto simp add:dist_commute)
     moreover have "(w - z) powr of_int fn \<noteq>0"
       unfolding powr_eq_0_iff using \<open>w\<noteq>z\<close> by auto
     ultimately show ?thesis by auto
   qed
   then show ?thesis using \<open>fr>0\<close> unfolding eventually_at by auto
 qed
 
 lemma non_zero_neighbour_pole:
   assumes "is_pole f z"
   shows "\<forall>\<^sub>F w in (at z). f w\<noteq>0"
   using assms filterlim_at_infinity_imp_eventually_ne[of f "at z" 0]
   unfolding is_pole_def by auto
 
 lemma non_zero_neighbour_alt:
   assumes holo: "f holomorphic_on S"
       and "open S" "connected S" "z \<in> S"  "\<beta> \<in> S" "f \<beta> \<noteq> 0"
     shows "\<forall>\<^sub>F w in (at z). f w\<noteq>0 \<and> w\<in>S"
 proof (cases "f z = 0")
   case True
   from isolated_zeros[OF holo \<open>open S\<close> \<open>connected S\<close> \<open>z \<in> S\<close> True \<open>\<beta> \<in> S\<close> \<open>f \<beta> \<noteq> 0\<close>]
   obtain r where "0 < r" "ball z r \<subseteq> S" "\<forall>w \<in> ball z r - {z}.f w \<noteq> 0" by metis
   then show ?thesis unfolding eventually_at
     apply (rule_tac x=r in exI)
     by (auto simp add:dist_commute)
 next
   case False
   obtain r1 where r1:"r1>0" "\<forall>y. dist z y < r1 \<longrightarrow> f y \<noteq> 0"
     using continuous_at_avoid[of z f, OF _ False] assms(2,4) continuous_on_eq_continuous_at
       holo holomorphic_on_imp_continuous_on by blast
   obtain r2 where r2:"r2>0" "ball z r2 \<subseteq> S"
     using assms(2) assms(4) openE by blast
   show ?thesis unfolding eventually_at
     apply (rule_tac x="min r1 r2" in exI)
     using r1 r2 by (auto simp add:dist_commute)
 qed
 
 lemma not_essential_times[singularity_intros]:
   assumes f_ness:"not_essential f z" and g_ness:"not_essential g z"
   assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z"
   shows "not_essential (\<lambda>w. f w * g w) z"
 proof -
   define fg where "fg = (\<lambda>w. f w * g w)"
   have ?thesis when "\<not> ((\<exists>\<^sub>Fw in (at z). f w\<noteq>0) \<and> (\<exists>\<^sub>Fw in (at z). g w\<noteq>0))"
   proof -
     have "\<forall>\<^sub>Fw in (at z). fg w=0"
       using that[unfolded frequently_def, simplified] unfolding fg_def
       by (auto elim: eventually_rev_mp)
     from tendsto_cong[OF this] have "fg \<midarrow>z\<rightarrow>0" by auto
     then show ?thesis unfolding not_essential_def fg_def by auto
   qed
   moreover have ?thesis when f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0" and g_nconst:"\<exists>\<^sub>Fw in (at z). g w\<noteq>0"
   proof -
     obtain fn fp fr where [simp]:"fp z \<noteq> 0" and "fr > 0"
           and fr: "fp holomorphic_on cball z fr"
                   "\<forall>w\<in>cball z fr - {z}. f w = fp w * (w - z) powr of_int fn \<and> fp w \<noteq> 0"
       using holomorphic_factor_puncture[OF f_iso f_ness f_nconst,THEN ex1_implies_ex] by auto
     obtain gn gp gr where [simp]:"gp z \<noteq> 0" and "gr > 0"
           and gr: "gp holomorphic_on cball z gr"
                   "\<forall>w\<in>cball z gr - {z}. g w = gp w * (w - z) powr of_int gn \<and> gp w \<noteq> 0"
       using holomorphic_factor_puncture[OF g_iso g_ness g_nconst,THEN ex1_implies_ex] by auto
 
     define r1 where "r1=(min fr gr)"
     have "r1>0" unfolding r1_def using  \<open>fr>0\<close> \<open>gr>0\<close> by auto
     have fg_times:"fg w = (fp w * gp w) * (w - z) powr (of_int (fn+gn))" and fgp_nz:"fp w*gp w\<noteq>0"
       when "w\<in>ball z r1 - {z}" for w
     proof -
       have "f w = fp w * (w - z) powr of_int fn" "fp w\<noteq>0"
         using fr(2)[rule_format,of w] that unfolding r1_def by auto
       moreover have "g w = gp w * (w - z) powr of_int gn" "gp w \<noteq> 0"
         using gr(2)[rule_format, of w] that unfolding r1_def by auto
       ultimately show "fg w = (fp w * gp w) * (w - z) powr (of_int (fn+gn))" "fp w*gp w\<noteq>0"
         unfolding fg_def by (auto simp add:powr_add)
     qed
 
     have [intro]: "fp \<midarrow>z\<rightarrow>fp z" "gp \<midarrow>z\<rightarrow>gp z"
         using fr(1) \<open>fr>0\<close> gr(1) \<open>gr>0\<close>
         by (meson open_ball ball_subset_cball centre_in_ball
             continuous_on_eq_continuous_at continuous_within holomorphic_on_imp_continuous_on
             holomorphic_on_subset)+
     have ?thesis when "fn+gn>0"
     proof -
       have "(\<lambda>w. (fp w * gp w) * (w - z) ^ (nat (fn+gn))) \<midarrow>z\<rightarrow>0"
         using that by (auto intro!:tendsto_eq_intros)
       then have "fg \<midarrow>z\<rightarrow> 0"
         apply (elim Lim_transform_within[OF _ \<open>r1>0\<close>])
         by (metis (no_types, hide_lams) Diff_iff cball_trivial dist_commute dist_self
               eq_iff_diff_eq_0 fg_times less_le linorder_not_le mem_ball mem_cball powr_of_int
               that)
       then show ?thesis unfolding not_essential_def fg_def by auto
     qed
     moreover have ?thesis when "fn+gn=0"
     proof -
       have "(\<lambda>w. fp w * gp w) \<midarrow>z\<rightarrow>fp z*gp z"
         using that by (auto intro!:tendsto_eq_intros)
       then have "fg \<midarrow>z\<rightarrow> fp z*gp z"
         apply (elim Lim_transform_within[OF _ \<open>r1>0\<close>])
         apply (subst fg_times)
         by (auto simp add:dist_commute that)
       then show ?thesis unfolding not_essential_def fg_def by auto
     qed
     moreover have ?thesis when "fn+gn<0"
     proof -
       have "LIM w (at z). fp w * gp w / (w-z)^nat (-(fn+gn)) :> at_infinity"
         apply (rule filterlim_divide_at_infinity)
         apply (insert that, auto intro!:tendsto_eq_intros filterlim_atI)
         using eventually_at_topological by blast
       then have "is_pole fg z" unfolding is_pole_def
         apply (elim filterlim_transform_within[OF _ _ \<open>r1>0\<close>],simp)
         apply (subst fg_times,simp add:dist_commute)
         apply (subst powr_of_int)
         using that by (auto simp add:field_split_simps)
       then show ?thesis unfolding not_essential_def fg_def by auto
     qed
     ultimately show ?thesis unfolding not_essential_def fg_def by fastforce
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma not_essential_inverse[singularity_intros]:
   assumes f_ness:"not_essential f z"
   assumes f_iso:"isolated_singularity_at f z"
   shows "not_essential (\<lambda>w. inverse (f w)) z"
 proof -
   define vf where "vf = (\<lambda>w. inverse (f w))"
   have ?thesis when "\<not>(\<exists>\<^sub>Fw in (at z). f w\<noteq>0)"
   proof -
     have "\<forall>\<^sub>Fw in (at z). f w=0"
       using that[unfolded frequently_def, simplified] by (auto elim: eventually_rev_mp)
     then have "\<forall>\<^sub>Fw in (at z). vf w=0"
       unfolding vf_def by auto
     from tendsto_cong[OF this] have "vf \<midarrow>z\<rightarrow>0" unfolding vf_def by auto
     then show ?thesis unfolding not_essential_def vf_def by auto
   qed
   moreover have ?thesis when "is_pole f z"
   proof -
     have "vf \<midarrow>z\<rightarrow>0"
       using that filterlim_at filterlim_inverse_at_iff unfolding is_pole_def vf_def by blast
     then show ?thesis unfolding not_essential_def vf_def by auto
   qed
   moreover have ?thesis when "\<exists>x. f\<midarrow>z\<rightarrow>x " and f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
   proof -
     from that obtain fz where fz:"f\<midarrow>z\<rightarrow>fz" by auto
     have ?thesis when "fz=0"
     proof -
       have "(\<lambda>w. inverse (vf w)) \<midarrow>z\<rightarrow>0"
         using fz that unfolding vf_def by auto
       moreover have "\<forall>\<^sub>F w in at z. inverse (vf w) \<noteq> 0"
         using non_zero_neighbour[OF f_iso f_ness f_nconst]
         unfolding vf_def by auto
       ultimately have "is_pole vf z"
         using filterlim_inverse_at_iff[of vf "at z"] unfolding filterlim_at is_pole_def by auto
       then show ?thesis unfolding not_essential_def vf_def by auto
     qed
     moreover have ?thesis when "fz\<noteq>0"
     proof -
       have "vf \<midarrow>z\<rightarrow>inverse fz"
         using fz that unfolding vf_def by (auto intro:tendsto_eq_intros)
       then show ?thesis unfolding not_essential_def vf_def by auto
     qed
     ultimately show ?thesis by auto
   qed
   ultimately show ?thesis using f_ness unfolding not_essential_def by auto
 qed
 
 lemma isolated_singularity_at_inverse[singularity_intros]:
   assumes f_iso:"isolated_singularity_at f z"
       and f_ness:"not_essential f z"
   shows "isolated_singularity_at (\<lambda>w. inverse (f w)) z"
 proof -
   define vf where "vf = (\<lambda>w. inverse (f w))"
   have ?thesis when "\<not>(\<exists>\<^sub>Fw in (at z). f w\<noteq>0)"
   proof -
     have "\<forall>\<^sub>Fw in (at z). f w=0"
       using that[unfolded frequently_def, simplified] by (auto elim: eventually_rev_mp)
     then have "\<forall>\<^sub>Fw in (at z). vf w=0"
       unfolding vf_def by auto
     then obtain d1 where "d1>0" and d1:"\<forall>x. x \<noteq> z \<and> dist x z < d1 \<longrightarrow> vf x = 0"
       unfolding eventually_at by auto
     then have "vf holomorphic_on ball z d1-{z}"
       apply (rule_tac holomorphic_transform[of "\<lambda>_. 0"])
       by (auto simp add:dist_commute)
     then have "vf analytic_on ball z d1 - {z}"
       by (simp add: analytic_on_open open_delete)
     then show ?thesis using \<open>d1>0\<close> unfolding isolated_singularity_at_def vf_def by auto
   qed
   moreover have ?thesis when f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
   proof -
     have "\<forall>\<^sub>F w in at z. f w \<noteq> 0" using non_zero_neighbour[OF f_iso f_ness f_nconst] .
     then obtain d1 where d1:"d1>0" "\<forall>x. x \<noteq> z \<and> dist x z < d1 \<longrightarrow> f x \<noteq> 0"
       unfolding eventually_at by auto
     obtain d2 where "d2>0" and d2:"f analytic_on ball z d2 - {z}"
       using f_iso unfolding isolated_singularity_at_def by auto
     define d3 where "d3=min d1 d2"
     have "d3>0" unfolding d3_def using \<open>d1>0\<close> \<open>d2>0\<close> by auto
     moreover have "vf analytic_on ball z d3 - {z}"
       unfolding vf_def
       apply (rule analytic_on_inverse)
       subgoal using d2 unfolding d3_def by (elim analytic_on_subset) auto
       subgoal for w using d1 unfolding d3_def by (auto simp add:dist_commute)
       done
     ultimately show ?thesis unfolding isolated_singularity_at_def vf_def by auto
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma not_essential_divide[singularity_intros]:
   assumes f_ness:"not_essential f z" and g_ness:"not_essential g z"
   assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z"
   shows "not_essential (\<lambda>w. f w / g w) z"
 proof -
   have "not_essential (\<lambda>w. f w * inverse (g w)) z"
     apply (rule not_essential_times[where g="\<lambda>w. inverse (g w)"])
     using assms by (auto intro: isolated_singularity_at_inverse not_essential_inverse)
   then show ?thesis by (simp add:field_simps)
 qed
 
 lemma
   assumes f_iso:"isolated_singularity_at f z"
       and g_iso:"isolated_singularity_at g z"
     shows isolated_singularity_at_times[singularity_intros]:
               "isolated_singularity_at (\<lambda>w. f w * g w) z" and
           isolated_singularity_at_add[singularity_intros]:
               "isolated_singularity_at (\<lambda>w. f w + g w) z"
 proof -
   obtain d1 d2 where "d1>0" "d2>0"
       and d1:"f analytic_on ball z d1 - {z}" and d2:"g analytic_on ball z d2 - {z}"
     using f_iso g_iso unfolding isolated_singularity_at_def by auto
   define d3 where "d3=min d1 d2"
   have "d3>0" unfolding d3_def using \<open>d1>0\<close> \<open>d2>0\<close> by auto
 
   have "(\<lambda>w. f w * g w) analytic_on ball z d3 - {z}"
     apply (rule analytic_on_mult)
     using d1 d2 unfolding d3_def by (auto elim:analytic_on_subset)
   then show "isolated_singularity_at (\<lambda>w. f w * g w) z"
     using \<open>d3>0\<close> unfolding isolated_singularity_at_def by auto
   have "(\<lambda>w. f w + g w) analytic_on ball z d3 - {z}"
     apply (rule analytic_on_add)
     using d1 d2 unfolding d3_def by (auto elim:analytic_on_subset)
   then show "isolated_singularity_at (\<lambda>w. f w + g w) z"
     using \<open>d3>0\<close> unfolding isolated_singularity_at_def by auto
 qed
 
 lemma isolated_singularity_at_uminus[singularity_intros]:
   assumes f_iso:"isolated_singularity_at f z"
   shows "isolated_singularity_at (\<lambda>w. - f w) z"
   using assms unfolding isolated_singularity_at_def using analytic_on_neg by blast
 
 lemma isolated_singularity_at_id[singularity_intros]:
      "isolated_singularity_at (\<lambda>w. w) z"
   unfolding isolated_singularity_at_def by (simp add: gt_ex)
 
 lemma isolated_singularity_at_minus[singularity_intros]:
   assumes f_iso:"isolated_singularity_at f z"
       and g_iso:"isolated_singularity_at g z"
     shows "isolated_singularity_at (\<lambda>w. f w - g w) z"
   using isolated_singularity_at_uminus[THEN isolated_singularity_at_add[OF f_iso,of "\<lambda>w. - g w"]
         ,OF g_iso] by simp
 
 lemma isolated_singularity_at_divide[singularity_intros]:
   assumes f_iso:"isolated_singularity_at f z"
       and g_iso:"isolated_singularity_at g z"
       and g_ness:"not_essential g z"
     shows "isolated_singularity_at (\<lambda>w. f w / g w) z"
   using isolated_singularity_at_inverse[THEN isolated_singularity_at_times[OF f_iso,
           of "\<lambda>w. inverse (g w)"],OF g_iso g_ness] by (simp add:field_simps)
 
 lemma isolated_singularity_at_const[singularity_intros]:
     "isolated_singularity_at (\<lambda>w. c) z"
   unfolding isolated_singularity_at_def by (simp add: gt_ex)
 
 lemma isolated_singularity_at_holomorphic:
   assumes "f holomorphic_on s-{z}" "open s" "z\<in>s"
   shows "isolated_singularity_at f z"
   using assms unfolding isolated_singularity_at_def
   by (metis analytic_on_holomorphic centre_in_ball insert_Diff openE open_delete subset_insert_iff)
 
 subsubsection \<open>The order of non-essential singularities (i.e. removable singularities or poles)\<close>
 
 
 definition\<^marker>\<open>tag important\<close> zorder :: "(complex \<Rightarrow> complex) \<Rightarrow> complex \<Rightarrow> int" where
   "zorder f z = (THE n. (\<exists>h r. r>0 \<and> h holomorphic_on cball z r \<and> h z\<noteq>0
                    \<and> (\<forall>w\<in>cball z r - {z}. f w =  h w * (w-z) powr (of_int n)
                    \<and> h w \<noteq>0)))"
 
 definition\<^marker>\<open>tag important\<close> zor_poly
     ::"[complex \<Rightarrow> complex, complex] \<Rightarrow> complex \<Rightarrow> complex" where
   "zor_poly f z = (SOME h. \<exists>r. r > 0 \<and> h holomorphic_on cball z r \<and> h z \<noteq> 0
                    \<and> (\<forall>w\<in>cball z r - {z}. f w =  h w * (w - z) powr (zorder f z)
                    \<and> h w \<noteq>0))"
 
 lemma zorder_exist:
   fixes f::"complex \<Rightarrow> complex" and z::complex
   defines "n\<equiv>zorder f z" and "g\<equiv>zor_poly f z"
   assumes f_iso:"isolated_singularity_at f z"
       and f_ness:"not_essential f z"
       and f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
   shows "g z\<noteq>0 \<and> (\<exists>r. r>0 \<and> g holomorphic_on cball z r
     \<and> (\<forall>w\<in>cball z r - {z}. f w  = g w * (w-z) powr n  \<and> g w \<noteq>0))"
 proof -
   define P where "P = (\<lambda>n g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z\<noteq>0
           \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w-z) powr (of_int n) \<and> g w\<noteq>0))"
   have "\<exists>!n. \<exists>g r. P n g r"
     using holomorphic_factor_puncture[OF assms(3-)] unfolding P_def by auto
   then have "\<exists>g r. P n g r"
     unfolding n_def P_def zorder_def
     by (drule_tac theI',argo)
   then have "\<exists>r. P n g r"
     unfolding P_def zor_poly_def g_def n_def
     by (drule_tac someI_ex,argo)
   then obtain r1 where "P n g r1" by auto
   then show ?thesis unfolding P_def by auto
 qed
 
 lemma
   fixes f::"complex \<Rightarrow> complex" and z::complex
   assumes f_iso:"isolated_singularity_at f z"
       and f_ness:"not_essential f z"
       and f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
     shows zorder_inverse: "zorder (\<lambda>w. inverse (f w)) z = - zorder f z"
       and zor_poly_inverse: "\<forall>\<^sub>Fw in (at z). zor_poly (\<lambda>w. inverse (f w)) z w
                                                 = inverse (zor_poly f z w)"
 proof -
   define vf where "vf = (\<lambda>w. inverse (f w))"
   define fn vfn where
     "fn = zorder f z"  and "vfn = zorder vf z"
   define fp vfp where
     "fp = zor_poly f z" and "vfp = zor_poly vf z"
 
   obtain fr where [simp]:"fp z \<noteq> 0" and "fr > 0"
           and fr: "fp holomorphic_on cball z fr"
                   "\<forall>w\<in>cball z fr - {z}. f w = fp w * (w - z) powr of_int fn \<and> fp w \<noteq> 0"
     using zorder_exist[OF f_iso f_ness f_nconst,folded fn_def fp_def]
     by auto
   have fr_inverse: "vf w = (inverse (fp w)) * (w - z) powr (of_int (-fn))"
         and fr_nz: "inverse (fp w)\<noteq>0"
     when "w\<in>ball z fr - {z}" for w
   proof -
     have "f w = fp w * (w - z) powr of_int fn" "fp w\<noteq>0"
       using fr(2)[rule_format,of w] that by auto
     then show "vf w = (inverse (fp w)) * (w - z) powr (of_int (-fn))" "inverse (fp w)\<noteq>0"
       unfolding vf_def by (auto simp add:powr_minus)
   qed
   obtain vfr where [simp]:"vfp z \<noteq> 0" and "vfr>0" and vfr:"vfp holomorphic_on cball z vfr"
       "(\<forall>w\<in>cball z vfr - {z}. vf w = vfp w * (w - z) powr of_int vfn \<and> vfp w \<noteq> 0)"
   proof -
     have "isolated_singularity_at vf z"
       using isolated_singularity_at_inverse[OF f_iso f_ness] unfolding vf_def .
     moreover have "not_essential vf z"
       using not_essential_inverse[OF f_ness f_iso] unfolding vf_def .
     moreover have "\<exists>\<^sub>F w in at z. vf w \<noteq> 0"
       using f_nconst unfolding vf_def by (auto elim:frequently_elim1)
     ultimately show ?thesis using zorder_exist[of vf z, folded vfn_def vfp_def] that by auto
   qed
 
 
   define r1 where "r1 = min fr vfr"
   have "r1>0" using \<open>fr>0\<close> \<open>vfr>0\<close> unfolding r1_def by simp
   show "vfn = - fn"
     apply (rule holomorphic_factor_unique[of r1 vfp z "\<lambda>w. inverse (fp w)" vf])
     subgoal using \<open>r1>0\<close> by simp
     subgoal by simp
     subgoal by simp
     subgoal
     proof (rule ballI)
       fix w assume "w \<in> ball z r1 - {z}"
       then have "w \<in> ball z fr - {z}" "w \<in> cball z vfr - {z}"  unfolding r1_def by auto
       from fr_inverse[OF this(1)] fr_nz[OF this(1)] vfr(2)[rule_format,OF this(2)]
       show "vf w = vfp w * (w - z) powr of_int vfn \<and> vfp w \<noteq> 0
               \<and> vf w = inverse (fp w) * (w - z) powr of_int (- fn) \<and> inverse (fp w) \<noteq> 0" by auto
     qed
     subgoal using vfr(1) unfolding r1_def by (auto intro!:holomorphic_intros)
     subgoal using fr unfolding r1_def by (auto intro!:holomorphic_intros)
     done
 
   have "vfp w = inverse (fp w)" when "w\<in>ball z r1-{z}" for w
   proof -
     have "w \<in> ball z fr - {z}" "w \<in> cball z vfr - {z}"  "w\<noteq>z" using that unfolding r1_def by auto
     from fr_inverse[OF this(1)] fr_nz[OF this(1)] vfr(2)[rule_format,OF this(2)] \<open>vfn = - fn\<close> \<open>w\<noteq>z\<close>
     show ?thesis by auto
   qed
   then show "\<forall>\<^sub>Fw in (at z). vfp w = inverse (fp w)"
     unfolding eventually_at using \<open>r1>0\<close>
     apply (rule_tac x=r1 in exI)
     by (auto simp add:dist_commute)
 qed
 
 lemma
   fixes f g::"complex \<Rightarrow> complex" and z::complex
   assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z"
       and f_ness:"not_essential f z" and g_ness:"not_essential g z"
       and fg_nconst: "\<exists>\<^sub>Fw in (at z). f w * g w\<noteq> 0"
   shows zorder_times:"zorder (\<lambda>w. f w * g w) z = zorder f z + zorder g z" and
         zor_poly_times:"\<forall>\<^sub>Fw in (at z). zor_poly (\<lambda>w. f w * g w) z w
                                                   = zor_poly f z w *zor_poly g z w"
 proof -
   define fg where "fg = (\<lambda>w. f w * g w)"
   define fn gn fgn where
     "fn = zorder f z" and "gn = zorder g z" and "fgn = zorder fg z"
   define fp gp fgp where
     "fp = zor_poly f z" and "gp = zor_poly g z" and "fgp = zor_poly fg z"
   have f_nconst:"\<exists>\<^sub>Fw in (at z). f w \<noteq> 0" and g_nconst:"\<exists>\<^sub>Fw in (at z).g w\<noteq> 0"
     using fg_nconst by (auto elim!:frequently_elim1)
   obtain fr where [simp]:"fp z \<noteq> 0" and "fr > 0"
           and fr: "fp holomorphic_on cball z fr"
                   "\<forall>w\<in>cball z fr - {z}. f w = fp w * (w - z) powr of_int fn \<and> fp w \<noteq> 0"
     using zorder_exist[OF f_iso f_ness f_nconst,folded fp_def fn_def] by auto
   obtain gr where [simp]:"gp z \<noteq> 0" and "gr > 0"
           and gr: "gp holomorphic_on cball z gr"
                   "\<forall>w\<in>cball z gr - {z}. g w = gp w * (w - z) powr of_int gn \<and> gp w \<noteq> 0"
     using zorder_exist[OF g_iso g_ness g_nconst,folded gn_def gp_def] by auto
   define r1 where "r1=min fr gr"
   have "r1>0" unfolding r1_def using \<open>fr>0\<close> \<open>gr>0\<close> by auto
   have fg_times:"fg w = (fp w * gp w) * (w - z) powr (of_int (fn+gn))" and fgp_nz:"fp w*gp w\<noteq>0"
     when "w\<in>ball z r1 - {z}" for w
   proof -
     have "f w = fp w * (w - z) powr of_int fn" "fp w\<noteq>0"
       using fr(2)[rule_format,of w] that unfolding r1_def by auto
     moreover have "g w = gp w * (w - z) powr of_int gn" "gp w \<noteq> 0"
       using gr(2)[rule_format, of w] that unfolding r1_def by auto
     ultimately show "fg w = (fp w * gp w) * (w - z) powr (of_int (fn+gn))" "fp w*gp w\<noteq>0"
       unfolding fg_def by (auto simp add:powr_add)
   qed
 
   obtain fgr where [simp]:"fgp z \<noteq> 0" and "fgr > 0"
           and fgr: "fgp holomorphic_on cball z fgr"
                   "\<forall>w\<in>cball z fgr - {z}. fg w = fgp w * (w - z) powr of_int fgn \<and> fgp w \<noteq> 0"
   proof -
     have "fgp z \<noteq> 0 \<and> (\<exists>r>0. fgp holomorphic_on cball z r
             \<and> (\<forall>w\<in>cball z r - {z}. fg w = fgp w * (w - z) powr of_int fgn \<and> fgp w \<noteq> 0))"
       apply (rule zorder_exist[of fg z, folded fgn_def fgp_def])
       subgoal unfolding fg_def using isolated_singularity_at_times[OF f_iso g_iso] .
       subgoal unfolding fg_def using not_essential_times[OF f_ness g_ness f_iso g_iso] .
       subgoal unfolding fg_def using fg_nconst .
       done
     then show ?thesis using that by blast
   qed
   define r2 where "r2 = min fgr r1"
   have "r2>0" using \<open>r1>0\<close> \<open>fgr>0\<close> unfolding r2_def by simp
   show "fgn = fn + gn "
     apply (rule holomorphic_factor_unique[of r2 fgp z "\<lambda>w. fp w * gp w" fg])
     subgoal using \<open>r2>0\<close> by simp
     subgoal by simp
     subgoal by simp
     subgoal
     proof (rule ballI)
       fix w assume "w \<in> ball z r2 - {z}"
       then have "w \<in> ball z r1 - {z}" "w \<in> cball z fgr - {z}"  unfolding r2_def by auto
       from fg_times[OF this(1)] fgp_nz[OF this(1)] fgr(2)[rule_format,OF this(2)]
       show "fg w = fgp w * (w - z) powr of_int fgn \<and> fgp w \<noteq> 0
               \<and> fg w = fp w * gp w * (w - z) powr of_int (fn + gn) \<and> fp w * gp w \<noteq> 0" by auto
     qed
     subgoal using fgr(1) unfolding r2_def r1_def by (auto intro!:holomorphic_intros)
     subgoal using fr(1) gr(1) unfolding r2_def r1_def by (auto intro!:holomorphic_intros)
     done
 
   have "fgp w = fp w *gp w" when "w\<in>ball z r2-{z}" for w
   proof -
     have "w \<in> ball z r1 - {z}" "w \<in> cball z fgr - {z}" "w\<noteq>z" using that  unfolding r2_def by auto
     from fg_times[OF this(1)] fgp_nz[OF this(1)] fgr(2)[rule_format,OF this(2)] \<open>fgn = fn + gn\<close> \<open>w\<noteq>z\<close>
     show ?thesis by auto
   qed
   then show "\<forall>\<^sub>Fw in (at z). fgp w = fp w * gp w"
     using \<open>r2>0\<close> unfolding eventually_at by (auto simp add:dist_commute)
 qed
 
 lemma
   fixes f g::"complex \<Rightarrow> complex" and z::complex
   assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z"
       and f_ness:"not_essential f z" and g_ness:"not_essential g z"
       and fg_nconst: "\<exists>\<^sub>Fw in (at z). f w * g w\<noteq> 0"
   shows zorder_divide:"zorder (\<lambda>w. f w / g w) z = zorder f z - zorder g z" and
         zor_poly_divide:"\<forall>\<^sub>Fw in (at z). zor_poly (\<lambda>w. f w / g w) z w
                                                   = zor_poly f z w  / zor_poly g z w"
 proof -
   have f_nconst:"\<exists>\<^sub>Fw in (at z). f w \<noteq> 0" and g_nconst:"\<exists>\<^sub>Fw in (at z).g w\<noteq> 0"
     using fg_nconst by (auto elim!:frequently_elim1)
   define vg where "vg=(\<lambda>w. inverse (g w))"
   have "zorder (\<lambda>w. f w * vg w) z = zorder f z + zorder vg z"
     apply (rule zorder_times[OF f_iso _ f_ness,of vg])
     subgoal unfolding vg_def using isolated_singularity_at_inverse[OF g_iso g_ness] .
     subgoal unfolding vg_def using not_essential_inverse[OF g_ness g_iso] .
     subgoal unfolding vg_def using fg_nconst by (auto elim!:frequently_elim1)
     done
   then show "zorder (\<lambda>w. f w / g w) z = zorder f z - zorder g z"
     using zorder_inverse[OF g_iso g_ness g_nconst,folded vg_def] unfolding vg_def
     by (auto simp add:field_simps)
 
   have "\<forall>\<^sub>F w in at z. zor_poly (\<lambda>w. f w * vg w) z w = zor_poly f z w * zor_poly vg z w"
     apply (rule zor_poly_times[OF f_iso _ f_ness,of vg])
     subgoal unfolding vg_def using isolated_singularity_at_inverse[OF g_iso g_ness] .
     subgoal unfolding vg_def using not_essential_inverse[OF g_ness g_iso] .
     subgoal unfolding vg_def using fg_nconst by (auto elim!:frequently_elim1)
     done
   then show "\<forall>\<^sub>Fw in (at z). zor_poly (\<lambda>w. f w / g w) z w = zor_poly f z w  / zor_poly g z w"
     using zor_poly_inverse[OF g_iso g_ness g_nconst,folded vg_def] unfolding vg_def
     apply eventually_elim
     by (auto simp add:field_simps)
 qed
 
 lemma zorder_exist_zero:
   fixes f::"complex \<Rightarrow> complex" and z::complex
   defines "n\<equiv>zorder f z" and "g\<equiv>zor_poly f z"
   assumes  holo: "f holomorphic_on s" and
           "open s" "connected s" "z\<in>s"
       and non_const: "\<exists>w\<in>s. f w \<noteq> 0"
   shows "(if f z=0 then n > 0 else n=0) \<and> (\<exists>r. r>0 \<and> cball z r \<subseteq> s \<and> g holomorphic_on cball z r
     \<and> (\<forall>w\<in>cball z r. f w  = g w * (w-z) ^ nat n  \<and> g w \<noteq>0))"
 proof -
   obtain r where "g z \<noteq> 0" and r: "r>0" "cball z r \<subseteq> s" "g holomorphic_on cball z r"
             "(\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
   proof -
     have "g z \<noteq> 0 \<and> (\<exists>r>0. g holomorphic_on cball z r
             \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0))"
     proof (rule zorder_exist[of f z,folded g_def n_def])
       show "isolated_singularity_at f z" unfolding isolated_singularity_at_def
         using holo assms(4,6)
         by (meson Diff_subset open_ball analytic_on_holomorphic holomorphic_on_subset openE)
       show "not_essential f z" unfolding not_essential_def
         using assms(4,6) at_within_open continuous_on holo holomorphic_on_imp_continuous_on
         by fastforce
       have "\<forall>\<^sub>F w in at z. f w \<noteq> 0 \<and> w\<in>s"
       proof -
         obtain w where "w\<in>s" "f w\<noteq>0" using non_const by auto
         then show ?thesis
           by (rule non_zero_neighbour_alt[OF holo \<open>open s\<close> \<open>connected s\<close> \<open>z\<in>s\<close>])
       qed
       then show "\<exists>\<^sub>F w in at z. f w \<noteq> 0"
         apply (elim eventually_frequentlyE)
         by auto
     qed
     then obtain r1 where "g z \<noteq> 0" "r1>0" and r1:"g holomorphic_on cball z r1"
             "(\<forall>w\<in>cball z r1 - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
       by auto
     obtain r2 where r2: "r2>0" "cball z r2 \<subseteq> s"
       using assms(4,6) open_contains_cball_eq by blast
     define r3 where "r3=min r1 r2"
     have "r3>0" "cball z r3 \<subseteq> s" using \<open>r1>0\<close> r2 unfolding r3_def by auto
     moreover have "g holomorphic_on cball z r3"
       using r1(1) unfolding r3_def by auto
     moreover have "(\<forall>w\<in>cball z r3 - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
       using r1(2) unfolding r3_def by auto
     ultimately show ?thesis using that[of r3] \<open>g z\<noteq>0\<close> by auto
   qed
 
   have if_0:"if f z=0 then n > 0 else n=0"
   proof -
     have "f\<midarrow> z \<rightarrow> f z"
       by (metis assms(4,6,7) at_within_open continuous_on holo holomorphic_on_imp_continuous_on)
     then have "(\<lambda>w. g w * (w - z) powr of_int n) \<midarrow>z\<rightarrow> f z"
       apply (elim Lim_transform_within_open[where s="ball z r"])
       using r by auto
     moreover have "g \<midarrow>z\<rightarrow>g z"
       by (metis (mono_tags, lifting) open_ball at_within_open_subset
           ball_subset_cball centre_in_ball continuous_on holomorphic_on_imp_continuous_on r(1,3) subsetCE)
     ultimately have "(\<lambda>w. (g w * (w - z) powr of_int n) / g w) \<midarrow>z\<rightarrow> f z/g z"
       apply (rule_tac tendsto_divide)
       using \<open>g z\<noteq>0\<close> by auto
     then have powr_tendsto:"(\<lambda>w. (w - z) powr of_int n) \<midarrow>z\<rightarrow> f z/g z"
       apply (elim Lim_transform_within_open[where s="ball z r"])
       using r by auto
 
     have ?thesis when "n\<ge>0" "f z=0"
     proof -
       have "(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> f z/g z"
         using powr_tendsto
         apply (elim Lim_transform_within[where d=r])
         by (auto simp add: powr_of_int \<open>n\<ge>0\<close> \<open>r>0\<close>)
       then have *:"(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> 0" using \<open>f z=0\<close> by simp
       moreover have False when "n=0"
       proof -
         have "(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> 1"
           using \<open>n=0\<close> by auto
         then show False using * using LIM_unique zero_neq_one by blast
       qed
       ultimately show ?thesis using that by fastforce
     qed
     moreover have ?thesis when "n\<ge>0" "f z\<noteq>0"
     proof -
       have False when "n>0"
       proof -
         have "(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> f z/g z"
           using powr_tendsto
           apply (elim Lim_transform_within[where d=r])
           by (auto simp add: powr_of_int \<open>n\<ge>0\<close> \<open>r>0\<close>)
         moreover have "(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> 0"
           using \<open>n>0\<close> by (auto intro!:tendsto_eq_intros)
         ultimately show False using \<open>f z\<noteq>0\<close> \<open>g z\<noteq>0\<close> using LIM_unique divide_eq_0_iff by blast
       qed
       then show ?thesis using that by force
     qed
     moreover have False when "n<0"
     proof -
       have "(\<lambda>w. inverse ((w - z) ^ nat (- n))) \<midarrow>z\<rightarrow> f z/g z"
            "(\<lambda>w.((w - z) ^ nat (- n))) \<midarrow>z\<rightarrow> 0"
         subgoal  using powr_tendsto powr_of_int that
           by (elim Lim_transform_within_open[where s=UNIV],auto)
         subgoal using that by (auto intro!:tendsto_eq_intros)
         done
       from tendsto_mult[OF this,simplified]
       have "(\<lambda>x. inverse ((x - z) ^ nat (- n)) * (x - z) ^ nat (- n)) \<midarrow>z\<rightarrow> 0" .
       then have "(\<lambda>x. 1::complex) \<midarrow>z\<rightarrow> 0"
         by (elim Lim_transform_within_open[where s=UNIV],auto)
       then show False using LIM_const_eq by fastforce
     qed
     ultimately show ?thesis by fastforce
   qed
   moreover have "f w  = g w * (w-z) ^ nat n  \<and> g w \<noteq>0" when "w\<in>cball z r" for w
   proof (cases "w=z")
     case True
     then have "f \<midarrow>z\<rightarrow>f w"
       using assms(4,6) at_within_open continuous_on holo holomorphic_on_imp_continuous_on by fastforce
     then have "(\<lambda>w. g w * (w-z) ^ nat n) \<midarrow>z\<rightarrow>f w"
     proof (elim Lim_transform_within[OF _ \<open>r>0\<close>])
       fix x assume "0 < dist x z" "dist x z < r"
       then have "x \<in> cball z r - {z}" "x\<noteq>z"
         unfolding cball_def by (auto simp add: dist_commute)
       then have "f x = g x * (x - z) powr of_int n"
         using r(4)[rule_format,of x] by simp
       also have "... = g x * (x - z) ^ nat n"
         apply (subst powr_of_int)
         using if_0 \<open>x\<noteq>z\<close> by (auto split:if_splits)
       finally show "f x = g x * (x - z) ^ nat n" .
     qed
     moreover have "(\<lambda>w. g w * (w-z) ^ nat n) \<midarrow>z\<rightarrow> g w * (w-z) ^ nat n"
       using True apply (auto intro!:tendsto_eq_intros)
       by (metis open_ball at_within_open_subset ball_subset_cball centre_in_ball
           continuous_on holomorphic_on_imp_continuous_on r(1) r(3) that)
     ultimately have "f w = g w * (w-z) ^ nat n" using LIM_unique by blast
     then show ?thesis using \<open>g z\<noteq>0\<close> True by auto
   next
     case False
     then have "f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0"
       using r(4) that by auto
     then show ?thesis using False if_0 powr_of_int by (auto split:if_splits)
   qed
   ultimately show ?thesis using r by auto
 qed
 
 lemma zorder_exist_pole:
   fixes f::"complex \<Rightarrow> complex" and z::complex
   defines "n\<equiv>zorder f z" and "g\<equiv>zor_poly f z"
   assumes  holo: "f holomorphic_on s-{z}" and
           "open s" "z\<in>s"
       and "is_pole f z"
   shows "n < 0 \<and> g z\<noteq>0 \<and> (\<exists>r. r>0 \<and> cball z r \<subseteq> s \<and> g holomorphic_on cball z r
     \<and> (\<forall>w\<in>cball z r - {z}. f w  = g w / (w-z) ^ nat (- n) \<and> g w \<noteq>0))"
 proof -
   obtain r where "g z \<noteq> 0" and r: "r>0" "cball z r \<subseteq> s" "g holomorphic_on cball z r"
             "(\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
   proof -
     have "g z \<noteq> 0 \<and> (\<exists>r>0. g holomorphic_on cball z r
             \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0))"
     proof (rule zorder_exist[of f z,folded g_def n_def])
       show "isolated_singularity_at f z" unfolding isolated_singularity_at_def
         using holo assms(4,5)
         by (metis analytic_on_holomorphic centre_in_ball insert_Diff openE open_delete subset_insert_iff)
       show "not_essential f z" unfolding not_essential_def
         using assms(4,6) at_within_open continuous_on holo holomorphic_on_imp_continuous_on
         by fastforce
       from non_zero_neighbour_pole[OF \<open>is_pole f z\<close>] show "\<exists>\<^sub>F w in at z. f w \<noteq> 0"
         apply (elim eventually_frequentlyE)
         by auto
     qed
     then obtain r1 where "g z \<noteq> 0" "r1>0" and r1:"g holomorphic_on cball z r1"
             "(\<forall>w\<in>cball z r1 - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
       by auto
     obtain r2 where r2: "r2>0" "cball z r2 \<subseteq> s"
       using assms(4,5) open_contains_cball_eq by metis
     define r3 where "r3=min r1 r2"
     have "r3>0" "cball z r3 \<subseteq> s" using \<open>r1>0\<close> r2 unfolding r3_def by auto
     moreover have "g holomorphic_on cball z r3"
       using r1(1) unfolding r3_def by auto
     moreover have "(\<forall>w\<in>cball z r3 - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
       using r1(2) unfolding r3_def by auto
     ultimately show ?thesis using that[of r3] \<open>g z\<noteq>0\<close> by auto
   qed
 
   have "n<0"
   proof (rule ccontr)
     assume " \<not> n < 0"
     define c where "c=(if n=0 then g z else 0)"
     have [simp]:"g \<midarrow>z\<rightarrow> g z"
       by (metis open_ball at_within_open ball_subset_cball centre_in_ball
             continuous_on holomorphic_on_imp_continuous_on holomorphic_on_subset r(1) r(3) )
     have "\<forall>\<^sub>F x in at z. f x = g x * (x - z) ^ nat n"
       unfolding eventually_at_topological
       apply (rule_tac exI[where x="ball z r"])
       using r powr_of_int \<open>\<not> n < 0\<close> by auto
     moreover have "(\<lambda>x. g x * (x - z) ^ nat n) \<midarrow>z\<rightarrow>c"
     proof (cases "n=0")
       case True
       then show ?thesis unfolding c_def by simp
     next
       case False
       then have "(\<lambda>x. (x - z) ^ nat n) \<midarrow>z\<rightarrow> 0" using \<open>\<not> n < 0\<close>
         by (auto intro!:tendsto_eq_intros)
       from tendsto_mult[OF _ this,of g "g z",simplified]
       show ?thesis unfolding c_def using False by simp
     qed
     ultimately have "f \<midarrow>z\<rightarrow>c" using tendsto_cong by fast
     then show False using \<open>is_pole f z\<close> at_neq_bot not_tendsto_and_filterlim_at_infinity
       unfolding is_pole_def by blast
   qed
   moreover have "\<forall>w\<in>cball z r - {z}. f w  = g w / (w-z) ^ nat (- n) \<and> g w \<noteq>0"
     using r(4) \<open>n<0\<close> powr_of_int
     by (metis Diff_iff divide_inverse eq_iff_diff_eq_0 insert_iff linorder_not_le)
   ultimately show ?thesis using r(1-3) \<open>g z\<noteq>0\<close> by auto
 qed
 
 lemma zorder_eqI:
   assumes "open s" "z \<in> s" "g holomorphic_on s" "g z \<noteq> 0"
   assumes fg_eq:"\<And>w. \<lbrakk>w \<in> s;w\<noteq>z\<rbrakk> \<Longrightarrow> f w = g w * (w - z) powr n"
   shows   "zorder f z = n"
 proof -
   have "continuous_on s g" by (rule holomorphic_on_imp_continuous_on) fact
   moreover have "open (-{0::complex})" by auto
   ultimately have "open ((g -` (-{0})) \<inter> s)"
     unfolding continuous_on_open_vimage[OF \<open>open s\<close>] by blast
   moreover from assms have "z \<in> (g -` (-{0})) \<inter> s" by auto
   ultimately obtain r where r: "r > 0" "cball z r \<subseteq>  s \<inter> (g -` (-{0}))"
     unfolding open_contains_cball by blast
 
   let ?gg= "(\<lambda>w. g w * (w - z) powr n)"
   define P where "P = (\<lambda>n g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z\<noteq>0
           \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w-z) powr (of_int n) \<and> g w\<noteq>0))"
   have "P n g r"
     unfolding P_def using r assms(3,4,5) by auto
   then have "\<exists>g r. P n g r" by auto
   moreover have unique: "\<exists>!n. \<exists>g r. P n g r" unfolding P_def
   proof (rule holomorphic_factor_puncture)
     have "ball z r-{z} \<subseteq> s" using r using ball_subset_cball by blast
     then have "?gg holomorphic_on ball z r-{z}"
       using \<open>g holomorphic_on s\<close> r by (auto intro!: holomorphic_intros)
     then have "f holomorphic_on ball z r - {z}"
       apply (elim holomorphic_transform)
       using fg_eq \<open>ball z r-{z} \<subseteq> s\<close> by auto
     then show "isolated_singularity_at f z" unfolding isolated_singularity_at_def
       using analytic_on_open open_delete r(1) by blast
   next
     have "not_essential ?gg z"
     proof (intro singularity_intros)
       show "not_essential g z"
         by (meson \<open>continuous_on s g\<close> assms(1) assms(2) continuous_on_eq_continuous_at
             isCont_def not_essential_def)
       show " \<forall>\<^sub>F w in at z. w - z \<noteq> 0" by (simp add: eventually_at_filter)
       then show "LIM w at z. w - z :> at 0"
         unfolding filterlim_at by (auto intro:tendsto_eq_intros)
       show "isolated_singularity_at g z"
         by (meson Diff_subset open_ball analytic_on_holomorphic
             assms(1,2,3) holomorphic_on_subset isolated_singularity_at_def openE)
     qed
     then show "not_essential f z"
       apply (elim not_essential_transform)
       unfolding eventually_at using assms(1,2) assms(5)[symmetric]
       by (metis dist_commute mem_ball openE subsetCE)
     show "\<exists>\<^sub>F w in at z. f w \<noteq> 0" unfolding frequently_at
     proof (rule,rule)
       fix d::real assume "0 < d"
       define z' where "z'=z+min d r / 2"
       have "z' \<noteq> z" " dist z' z < d "
         unfolding z'_def using \<open>d>0\<close> \<open>r>0\<close>
         by (auto simp add:dist_norm)
       moreover have "f z' \<noteq> 0"
       proof (subst fg_eq[OF _ \<open>z'\<noteq>z\<close>])
         have "z' \<in> cball z r" unfolding z'_def using \<open>r>0\<close> \<open>d>0\<close> by (auto simp add:dist_norm)
         then show " z' \<in> s" using r(2) by blast
         show "g z' * (z' - z) powr of_int n \<noteq> 0"
           using P_def \<open>P n g r\<close> \<open>z' \<in> cball z r\<close> calculation(1) by auto
       qed
       ultimately show "\<exists>x\<in>UNIV. x \<noteq> z \<and> dist x z < d \<and> f x \<noteq> 0" by auto
     qed
   qed
   ultimately have "(THE n. \<exists>g r. P n g r) = n"
     by (rule_tac the1_equality)
   then show ?thesis unfolding zorder_def P_def by blast
 qed
 
 lemma simple_zeroI:
   assumes "open s" "z \<in> s" "g holomorphic_on s" "g z \<noteq> 0"
   assumes "\<And>w. w \<in> s \<Longrightarrow> f w = g w * (w - z)"
   shows   "zorder f z = 1"
   using assms(1-4) by (rule zorder_eqI) (use assms(5) in auto)
 
 lemma higher_deriv_power:
   shows   "(deriv ^^ j) (\<lambda>w. (w - z) ^ n) w =
              pochhammer (of_nat (Suc n - j)) j * (w - z) ^ (n - j)"
 proof (induction j arbitrary: w)
   case 0
   thus ?case by auto
 next
   case (Suc j w)
   have "(deriv ^^ Suc j) (\<lambda>w. (w - z) ^ n) w = deriv ((deriv ^^ j) (\<lambda>w. (w - z) ^ n)) w"
     by simp
   also have "(deriv ^^ j) (\<lambda>w. (w - z) ^ n) =
                (\<lambda>w. pochhammer (of_nat (Suc n - j)) j * (w - z) ^ (n - j))"
     using Suc by (intro Suc.IH ext)
   also {
     have "(\<dots> has_field_derivative of_nat (n - j) *
                pochhammer (of_nat (Suc n - j)) j * (w - z) ^ (n - Suc j)) (at w)"
       using Suc.prems by (auto intro!: derivative_eq_intros)
     also have "of_nat (n - j) * pochhammer (of_nat (Suc n - j)) j =
                  pochhammer (of_nat (Suc n - Suc j)) (Suc j)"
       by (cases "Suc j \<le> n", subst pochhammer_rec)
          (insert Suc.prems, simp_all add: algebra_simps Suc_diff_le pochhammer_0_left)
     finally have "deriv (\<lambda>w. pochhammer (of_nat (Suc n - j)) j * (w - z) ^ (n - j)) w =
                     \<dots> * (w - z) ^ (n - Suc j)"
       by (rule DERIV_imp_deriv)
   }
   finally show ?case .
 qed
 
 lemma zorder_zero_eqI:
   assumes  f_holo:"f holomorphic_on s" and "open s" "z \<in> s"
   assumes zero: "\<And>i. i < nat n \<Longrightarrow> (deriv ^^ i) f z = 0"
   assumes nz: "(deriv ^^ nat n) f z \<noteq> 0" and "n\<ge>0"
   shows   "zorder f z = n"
 proof -
   obtain r where [simp]:"r>0" and "ball z r \<subseteq> s"
     using \<open>open s\<close> \<open>z\<in>s\<close> openE by blast
   have nz':"\<exists>w\<in>ball z r. f w \<noteq> 0"
   proof (rule ccontr)
     assume "\<not> (\<exists>w\<in>ball z r. f w \<noteq> 0)"
     then have "eventually (\<lambda>u. f u = 0) (nhds z)"
       using \<open>r>0\<close> unfolding eventually_nhds
       apply (rule_tac x="ball z r" in exI)
       by auto
     then have "(deriv ^^ nat n) f z = (deriv ^^ nat n) (\<lambda>_. 0) z"
       by (intro higher_deriv_cong_ev) auto
     also have "(deriv ^^ nat n) (\<lambda>_. 0) z = 0"
       by (induction n) simp_all
     finally show False using nz by contradiction
   qed
 
   define zn g where "zn = zorder f z" and "g = zor_poly f z"
   obtain e where e_if:"if f z = 0 then 0 < zn else zn = 0" and
             [simp]:"e>0" and "cball z e \<subseteq> ball z r" and
             g_holo:"g holomorphic_on cball z e" and
             e_fac:"(\<forall>w\<in>cball z e. f w = g w * (w - z) ^ nat zn \<and> g w \<noteq> 0)"
   proof -
     have "f holomorphic_on ball z r"
       using f_holo \<open>ball z r \<subseteq> s\<close> by auto
     from that zorder_exist_zero[of f "ball z r" z,simplified,OF this nz',folded zn_def g_def]
     show ?thesis by blast
   qed
   from this(1,2,5) have "zn\<ge>0" "g z\<noteq>0"
     subgoal by (auto split:if_splits)
     subgoal using \<open>0 < e\<close> ball_subset_cball centre_in_ball e_fac by blast
     done
 
   define A where "A = (\<lambda>i. of_nat (i choose (nat zn)) * fact (nat zn) * (deriv ^^ (i - nat zn)) g z)"
   have deriv_A:"(deriv ^^ i) f z = (if zn \<le> int i then A i else 0)" for i
   proof -
     have "eventually (\<lambda>w. w \<in> ball z e) (nhds z)"
       using \<open>cball z e \<subseteq> ball z r\<close> \<open>e>0\<close> by (intro eventually_nhds_in_open) auto
     hence "eventually (\<lambda>w. f w = (w - z) ^ (nat zn) * g w) (nhds z)"
       apply eventually_elim
       by (use e_fac in auto)
     hence "(deriv ^^ i) f z = (deriv ^^ i) (\<lambda>w. (w - z) ^ nat zn * g w) z"
       by (intro higher_deriv_cong_ev) auto
     also have "\<dots> = (\<Sum>j=0..i. of_nat (i choose j) *
                        (deriv ^^ j) (\<lambda>w. (w - z) ^ nat zn) z * (deriv ^^ (i - j)) g z)"
       using g_holo \<open>e>0\<close>
       by (intro higher_deriv_mult[of _ "ball z e"]) (auto intro!: holomorphic_intros)
     also have "\<dots> = (\<Sum>j=0..i. if j = nat zn then
                     of_nat (i choose nat zn) * fact (nat zn) * (deriv ^^ (i - nat zn)) g z else 0)"
     proof (intro sum.cong refl, goal_cases)
       case (1 j)
       have "(deriv ^^ j) (\<lambda>w. (w - z) ^ nat zn) z =
               pochhammer (of_nat (Suc (nat zn) - j)) j * 0 ^ (nat zn - j)"
         by (subst higher_deriv_power) auto
       also have "\<dots> = (if j = nat zn then fact j else 0)"
         by (auto simp: not_less pochhammer_0_left pochhammer_fact)
       also have "of_nat (i choose j) * \<dots> * (deriv ^^ (i - j)) g z =
                    (if j = nat zn then of_nat (i choose (nat zn)) * fact (nat zn)
                         * (deriv ^^ (i - nat zn)) g z else 0)"
         by simp
       finally show ?case .
     qed
     also have "\<dots> = (if i \<ge> zn then A i else 0)"
       by (auto simp: A_def)
     finally show "(deriv ^^ i) f z = \<dots>" .
   qed
 
   have False when "n<zn"
   proof -
     have "(deriv ^^ nat n) f z = 0"
       using deriv_A[of "nat n"] that \<open>n\<ge>0\<close> by auto
     with nz show False by auto
   qed
   moreover have "n\<le>zn"
   proof -
     have "g z \<noteq> 0" using e_fac[rule_format,of z] \<open>e>0\<close> by simp
     then have "(deriv ^^ nat zn) f z \<noteq> 0"
       using deriv_A[of "nat zn"] by(auto simp add:A_def)
     then have "nat zn \<ge> nat n" using zero[of "nat zn"] by linarith
     moreover have "zn\<ge>0" using e_if by (auto split:if_splits)
     ultimately show ?thesis using nat_le_eq_zle by blast
   qed
   ultimately show ?thesis unfolding zn_def by fastforce
 qed
 
 lemma
   assumes "eventually (\<lambda>z. f z = g z) (at z)" "z = z'"
   shows zorder_cong:"zorder f z = zorder g z'" and zor_poly_cong:"zor_poly f z = zor_poly g z'"
 proof -
   define P where "P = (\<lambda>ff n h r. 0 < r \<and> h holomorphic_on cball z r \<and> h z\<noteq>0
                     \<and> (\<forall>w\<in>cball z r - {z}. ff w = h w * (w-z) powr (of_int n) \<and> h w\<noteq>0))"
   have "(\<exists>r. P f n h r) = (\<exists>r. P g n h r)" for n h
   proof -
     have *: "\<exists>r. P g n h r" if "\<exists>r. P f n h r" and "eventually (\<lambda>x. f x = g x) (at z)" for f g
     proof -
       from that(1) obtain r1 where r1_P:"P f n h r1" by auto
       from that(2) obtain r2 where "r2>0" and r2_dist:"\<forall>x. x \<noteq> z \<and> dist x z \<le> r2 \<longrightarrow> f x = g x"
         unfolding eventually_at_le by auto
       define r where "r=min r1 r2"
       have "r>0" "h z\<noteq>0" using r1_P \<open>r2>0\<close> unfolding r_def P_def by auto
       moreover have "h holomorphic_on cball z r"
         using r1_P unfolding P_def r_def by auto
       moreover have "g w = h w * (w - z) powr of_int n \<and> h w \<noteq> 0" when "w\<in>cball z r - {z}" for w
       proof -
         have "f w = h w * (w - z) powr of_int n \<and> h w \<noteq> 0"
           using r1_P that unfolding P_def r_def by auto
         moreover have "f w=g w" using r2_dist[rule_format,of w] that unfolding r_def
           by (simp add: dist_commute)
         ultimately show ?thesis by simp
       qed
       ultimately show ?thesis unfolding P_def by auto
     qed
     from assms have eq': "eventually (\<lambda>z. g z = f z) (at z)"
       by (simp add: eq_commute)
     show ?thesis
       by (rule iffI[OF *[OF _ assms(1)] *[OF _ eq']])
   qed
   then show "zorder f z = zorder g z'" "zor_poly f z = zor_poly g z'"
       using \<open>z=z'\<close> unfolding P_def zorder_def zor_poly_def by auto
 qed
 
 lemma zorder_nonzero_div_power:
   assumes "open s" "z \<in> s" "f holomorphic_on s" "f z \<noteq> 0" "n > 0"
   shows  "zorder (\<lambda>w. f w / (w - z) ^ n) z = - n"
   apply (rule zorder_eqI[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>f holomorphic_on s\<close> \<open>f z\<noteq>0\<close>])
   apply (subst powr_of_int)
   using \<open>n>0\<close> by (auto simp add:field_simps)
 
 lemma zor_poly_eq:
   assumes "isolated_singularity_at f z" "not_essential f z" "\<exists>\<^sub>F w in at z. f w \<noteq> 0"
   shows "eventually (\<lambda>w. zor_poly f z w = f w * (w - z) powr - zorder f z) (at z)"
 proof -
   obtain r where r:"r>0"
        "(\<forall>w\<in>cball z r - {z}. f w = zor_poly f z w * (w - z) powr of_int (zorder f z))"
     using zorder_exist[OF assms] by blast
   then have *: "\<forall>w\<in>ball z r - {z}. zor_poly f z w = f w * (w - z) powr - zorder f z"
     by (auto simp: field_simps powr_minus)
   have "eventually (\<lambda>w. w \<in> ball z r - {z}) (at z)"
     using r eventually_at_ball'[of r z UNIV] by auto
   thus ?thesis by eventually_elim (insert *, auto)
 qed
 
 lemma zor_poly_zero_eq:
   assumes "f holomorphic_on s" "open s" "connected s" "z \<in> s" "\<exists>w\<in>s. f w \<noteq> 0"
   shows "eventually (\<lambda>w. zor_poly f z w = f w / (w - z) ^ nat (zorder f z)) (at z)"
 proof -
   obtain r where r:"r>0"
        "(\<forall>w\<in>cball z r - {z}. f w = zor_poly f z w * (w - z) ^ nat (zorder f z))"
     using zorder_exist_zero[OF assms] by auto
   then have *: "\<forall>w\<in>ball z r - {z}. zor_poly f z w = f w / (w - z) ^ nat (zorder f z)"
     by (auto simp: field_simps powr_minus)
   have "eventually (\<lambda>w. w \<in> ball z r - {z}) (at z)"
     using r eventually_at_ball'[of r z UNIV] by auto
   thus ?thesis by eventually_elim (insert *, auto)
 qed
 
 lemma zor_poly_pole_eq:
   assumes f_iso:"isolated_singularity_at f z" "is_pole f z"
   shows "eventually (\<lambda>w. zor_poly f z w = f w * (w - z) ^ nat (- zorder f z)) (at z)"
 proof -
   obtain e where [simp]:"e>0" and f_holo:"f holomorphic_on ball z e - {z}"
     using f_iso analytic_imp_holomorphic unfolding isolated_singularity_at_def by blast
   obtain r where r:"r>0"
        "(\<forall>w\<in>cball z r - {z}. f w = zor_poly f z w / (w - z) ^ nat (- zorder f z))"
     using zorder_exist_pole[OF f_holo,simplified,OF \<open>is_pole f z\<close>] by auto
   then have *: "\<forall>w\<in>ball z r - {z}. zor_poly f z w = f w * (w - z) ^ nat (- zorder f z)"
     by (auto simp: field_simps)
   have "eventually (\<lambda>w. w \<in> ball z r - {z}) (at z)"
     using r eventually_at_ball'[of r z UNIV] by auto
   thus ?thesis by eventually_elim (insert *, auto)
 qed
 
 lemma zor_poly_eqI:
   fixes f :: "complex \<Rightarrow> complex" and z0 :: complex
   defines "n \<equiv> zorder f z0"
   assumes "isolated_singularity_at f z0" "not_essential f z0" "\<exists>\<^sub>F w in at z0. f w \<noteq> 0"
   assumes lim: "((\<lambda>x. f (g x) * (g x - z0) powr - n) \<longlongrightarrow> c) F"
   assumes g: "filterlim g (at z0) F" and "F \<noteq> bot"
   shows   "zor_poly f z0 z0 = c"
 proof -
   from zorder_exist[OF assms(2-4)] obtain r where
     r: "r > 0" "zor_poly f z0 holomorphic_on cball z0 r"
        "\<And>w. w \<in> cball z0 r - {z0} \<Longrightarrow> f w = zor_poly f z0 w * (w - z0) powr n"
     unfolding n_def by blast
   from r(1) have "eventually (\<lambda>w. w \<in> ball z0 r \<and> w \<noteq> z0) (at z0)"
     using eventually_at_ball'[of r z0 UNIV] by auto
   hence "eventually (\<lambda>w. zor_poly f z0 w = f w * (w - z0) powr - n) (at z0)"
     by eventually_elim (insert r, auto simp: field_simps powr_minus)
   moreover have "continuous_on (ball z0 r) (zor_poly f z0)"
     using r by (intro holomorphic_on_imp_continuous_on) auto
   with r(1,2) have "isCont (zor_poly f z0) z0"
     by (auto simp: continuous_on_eq_continuous_at)
   hence "(zor_poly f z0 \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     unfolding isCont_def .
   ultimately have "((\<lambda>w. f w * (w - z0) powr - n) \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     by (blast intro: Lim_transform_eventually)
   hence "((\<lambda>x. f (g x) * (g x - z0) powr - n) \<longlongrightarrow> zor_poly f z0 z0) F"
     by (rule filterlim_compose[OF _ g])
   from tendsto_unique[OF \<open>F \<noteq> bot\<close> this lim] show ?thesis .
 qed
 
 lemma zor_poly_zero_eqI:
   fixes f :: "complex \<Rightarrow> complex" and z0 :: complex
   defines "n \<equiv> zorder f z0"
   assumes "f holomorphic_on A" "open A" "connected A" "z0 \<in> A" "\<exists>z\<in>A. f z \<noteq> 0"
   assumes lim: "((\<lambda>x. f (g x) / (g x - z0) ^ nat n) \<longlongrightarrow> c) F"
   assumes g: "filterlim g (at z0) F" and "F \<noteq> bot"
   shows   "zor_poly f z0 z0 = c"
 proof -
   from zorder_exist_zero[OF assms(2-6)] obtain r where
     r: "r > 0" "cball z0 r \<subseteq> A" "zor_poly f z0 holomorphic_on cball z0 r"
        "\<And>w. w \<in> cball z0 r \<Longrightarrow> f w = zor_poly f z0 w * (w - z0) ^ nat n"
     unfolding n_def by blast
   from r(1) have "eventually (\<lambda>w. w \<in> ball z0 r \<and> w \<noteq> z0) (at z0)"
     using eventually_at_ball'[of r z0 UNIV] by auto
   hence "eventually (\<lambda>w. zor_poly f z0 w = f w / (w - z0) ^ nat n) (at z0)"
     by eventually_elim (insert r, auto simp: field_simps)
   moreover have "continuous_on (ball z0 r) (zor_poly f z0)"
     using r by (intro holomorphic_on_imp_continuous_on) auto
   with r(1,2) have "isCont (zor_poly f z0) z0"
     by (auto simp: continuous_on_eq_continuous_at)
   hence "(zor_poly f z0 \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     unfolding isCont_def .
   ultimately have "((\<lambda>w. f w / (w - z0) ^ nat n) \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     by (blast intro: Lim_transform_eventually)
   hence "((\<lambda>x. f (g x) / (g x - z0) ^ nat n) \<longlongrightarrow> zor_poly f z0 z0) F"
     by (rule filterlim_compose[OF _ g])
   from tendsto_unique[OF \<open>F \<noteq> bot\<close> this lim] show ?thesis .
 qed
 
 lemma zor_poly_pole_eqI:
   fixes f :: "complex \<Rightarrow> complex" and z0 :: complex
   defines "n \<equiv> zorder f z0"
   assumes f_iso:"isolated_singularity_at f z0" and "is_pole f z0"
   assumes lim: "((\<lambda>x. f (g x) * (g x - z0) ^ nat (-n)) \<longlongrightarrow> c) F"
   assumes g: "filterlim g (at z0) F" and "F \<noteq> bot"
   shows   "zor_poly f z0 z0 = c"
 proof -
   obtain r where r: "r > 0"  "zor_poly f z0 holomorphic_on cball z0 r"
   proof -
     have "\<exists>\<^sub>F w in at z0. f w \<noteq> 0"
       using non_zero_neighbour_pole[OF \<open>is_pole f z0\<close>] by (auto elim:eventually_frequentlyE)
     moreover have "not_essential f z0" unfolding not_essential_def using \<open>is_pole f z0\<close> by simp
     ultimately show ?thesis using that zorder_exist[OF f_iso,folded n_def] by auto
   qed
   from r(1) have "eventually (\<lambda>w. w \<in> ball z0 r \<and> w \<noteq> z0) (at z0)"
     using eventually_at_ball'[of r z0 UNIV] by auto
   have "eventually (\<lambda>w. zor_poly f z0 w = f w * (w - z0) ^ nat (-n)) (at z0)"
     using zor_poly_pole_eq[OF f_iso \<open>is_pole f z0\<close>] unfolding n_def .
   moreover have "continuous_on (ball z0 r) (zor_poly f z0)"
     using r by (intro holomorphic_on_imp_continuous_on) auto
   with r(1,2) have "isCont (zor_poly f z0) z0"
     by (auto simp: continuous_on_eq_continuous_at)
   hence "(zor_poly f z0 \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     unfolding isCont_def .
   ultimately have "((\<lambda>w. f w * (w - z0) ^ nat (-n)) \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     by (blast intro: Lim_transform_eventually)
   hence "((\<lambda>x. f (g x) * (g x - z0) ^ nat (-n)) \<longlongrightarrow> zor_poly f z0 z0) F"
     by (rule filterlim_compose[OF _ g])
   from tendsto_unique[OF \<open>F \<noteq> bot\<close> this lim] show ?thesis .
 qed
 
 end
\ No newline at end of file
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,1704 +1,1704 @@
 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"
   apply (simp add: 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 g (at x within {a..b})) has_integral i) {a..b} \<longleftrightarrow>
-     ((\<lambda>x. f (g x) * vector_derivative g (at x)) has_integral i) {a..b}"
+    "((\<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 g (at x within {a..b})) integrable_on {a..b} \<longleftrightarrow>
-     (\<lambda>x. f (g x) * vector_derivative g (at x)) integrable_on {a..b}"
+    "(\<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)
 
 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))"
     apply (rule has_integral_unique)
     apply (subst add.commute)
     apply (subst Henstock_Kurzweil_Integration.integral_combine)
     using assms * integral_unique by auto
 
   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)"
 proof (cases u v rule: linorder_class.le_cases)
   case le
   then show ?thesis
     by (metis contour_integrable_on_def has_contour_integral_subpath [OF assms])
 next
   case ge
   with assms show ?thesis
     by (metis (no_types, lifting) contour_integrable_on_def contour_integrable_reversepath_eq has_contour_integral_subpath reversepath_subpath valid_path_subpath)
 qed
 
 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}"
   using assms
 proof -
   have "(\<lambda>r. f (g r) * vector_derivative g (at r)) integrable_on {u..v}"
     by (metis (full_types) assms(1) assms(3) assms(4) atLeastAtMost_iff atLeastatMost_subset_iff contour_integrable_on integrable_on_subinterval)
   then have "((\<lambda>r. f (g r) * vector_derivative g (at r)) has_integral integral {u..v} (\<lambda>r. f (g r) * vector_derivative g (at r))) {u..v}"
     by blast
   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)
 
 
 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)
   } note * = this
   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)
 
 text\<open>Existence of path integral for continuous function\<close>
 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:
     "f contour_integrable_on g \<Longrightarrow> contour_integral g (\<lambda>x. -(f x)) = -(contour_integral g f)"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_neg)
 
 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)"
   using has_contour_integral_bound_linepath [of f]
   by (auto simp: 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)
 
 
 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)"
   by (metis contour_integrable_continuous_linepath contour_integral_unique has_contour_integral_integral has_contour_integral_reverse_linepath)
 
 
 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
   } note fj = this
   show ?thesis
     using f k unfolding has_contour_integral_linepath
     by (simp add: linepath_def has_integral_combine [OF _ _ fi fj])
 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 (cbox (0, 0) (1, 1)) ((\<lambda>(y1, y2). f y1 y2) \<circ> (\<lambda>w. ((g \<circ> fst) w, (h \<circ> snd) w)))"
     apply (intro gcon hcon continuous_intros | simp)+
     apply (auto simp: path_image_def intro: continuous_on_subset [OF fcon])
     done
   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"
 proof -
   have "w \<in> {c. dist z c = r}"
     by (metis (no_types) path_image_part_circlepath_subset sphere_def subset_eq assms)
   thus ?thesis
     by (simp add: dist_norm norm_minus_commute)
 qed
 
 lemma path_image_part_circlepath_subset':
   assumes "r \<ge> 0"
   shows   "path_image (part_circlepath z r s t) \<subseteq> sphere z r"
 proof (cases "s \<le> t")
   case True
   thus ?thesis using path_image_part_circlepath_subset[of s t r z] assms by simp
 next
   case False
   thus ?thesis using path_image_part_circlepath_subset[of t s r z] assms
     by (subst reversepath_part_circlepath [symmetric], subst path_image_reversepath) simp_all
 qed
 
 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_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 (subst reversepath_part_circlepath [symmetric], subst contour_integral_reversepath) simp_all
 
 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, simplified])
     show ?thesis
       apply (rule has_integral_bound [where 'a=real, simplified, OF _ **, simplified])
       using assms le * "2" \<open>r > 0\<close> by (auto simp add: norm_mult vector_derivative_part_circlepath)
   qed
 qed
 
 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
   apply (rule integrable_continuous_real)
   apply (fast intro: path_part_circlepath [unfolded path_def] continuous_intros continuous_on_compose2 [where g=f, OF _ _ order_refl])
   done
 
 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
     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
   show ?thesis using False
     apply (simp add: simple_path_def)
     apply (simp add: part_circlepath_def linepath_def exp_eq  * ** abs01 del: Set.insert_iff)
     apply (subst abs_away)
     apply (auto simp: 1)
     apply (rule ccontr)
     apply (auto simp: 2 field_split_simps abs_mult dest: of_int_leD)
     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)"
       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]
       by (fastforce simp: contour_integrable_on path_image_def)
     have Ble: "B * e / (\<bar>B\<bar> + 1) \<le> e"
       using \<open>0 \<le> B\<close>  \<open>0 < e\<close> by (simp add: field_split_simps)
     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
         apply (rule order_trans [OF _ Ble])
         using noleB [OF that] fga [OF that] \<open>0 \<le> B\<close> \<open>0 < e\<close>
         apply (fastforce simp: mult_ac dest: mult_mono [OF less_imp_le] simp add: norm_mult left_diff_distrib [symmetric] norm_minus_commute divide_simps)
         done
     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>xa\<in>{0..1}. 2 * cmod (f x (\<gamma> xa) - l (\<gamma> xa)) < 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
\ No newline at end of file
diff --git a/src/HOL/Deriv.thy b/src/HOL/Deriv.thy
--- a/src/HOL/Deriv.thy
+++ b/src/HOL/Deriv.thy
@@ -1,2368 +1,2385 @@
 (*  Title:      HOL/Deriv.thy
     Author:     Jacques D. Fleuriot, University of Cambridge, 1998
     Author:     Brian Huffman
     Author:     Lawrence C Paulson, 2004
     Author:     Benjamin Porter, 2005
 *)
 
 section \<open>Differentiation\<close>
 
 theory Deriv
   imports Limits
 begin
 
 subsection \<open>Frechet derivative\<close>
 
 definition has_derivative :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow>
     ('a \<Rightarrow> 'b) \<Rightarrow> 'a filter \<Rightarrow> bool"  (infix "(has'_derivative)" 50)
   where "(f has_derivative f') F \<longleftrightarrow>
     bounded_linear f' \<and>
     ((\<lambda>y. ((f y - f (Lim F (\<lambda>x. x))) - f' (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x))) \<longlongrightarrow> 0) F"
 
 text \<open>
   Usually the filter \<^term>\<open>F\<close> is \<^term>\<open>at x within s\<close>.  \<^term>\<open>(f has_derivative D)
   (at x within s)\<close> means: \<^term>\<open>D\<close> is the derivative of function \<^term>\<open>f\<close> at point \<^term>\<open>x\<close>
   within the set \<^term>\<open>s\<close>. Where \<^term>\<open>s\<close> is used to express left or right sided derivatives. In
   most cases \<^term>\<open>s\<close> is either a variable or \<^term>\<open>UNIV\<close>.
 \<close>
 
 text \<open>These are the only cases we'll care about, probably.\<close>
 
 lemma has_derivative_within: "(f has_derivative f') (at x within s) \<longleftrightarrow>
     bounded_linear f' \<and> ((\<lambda>y. (1 / norm(y - x)) *\<^sub>R (f y - (f x + f' (y - x)))) \<longlongrightarrow> 0) (at x within s)"
   unfolding has_derivative_def tendsto_iff
   by (subst eventually_Lim_ident_at) (auto simp add: field_simps)
 
 lemma has_derivative_eq_rhs: "(f has_derivative f') F \<Longrightarrow> f' = g' \<Longrightarrow> (f has_derivative g') F"
   by simp
 
 definition has_field_derivative :: "('a::real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a filter \<Rightarrow> bool"
     (infix "(has'_field'_derivative)" 50)
   where "(f has_field_derivative D) F \<longleftrightarrow> (f has_derivative (*) D) F"
 
 lemma DERIV_cong: "(f has_field_derivative X) F \<Longrightarrow> X = Y \<Longrightarrow> (f has_field_derivative Y) F"
   by simp
 
 definition has_vector_derivative :: "(real \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'b \<Rightarrow> real filter \<Rightarrow> bool"
     (infix "has'_vector'_derivative" 50)
   where "(f has_vector_derivative f') net \<longleftrightarrow> (f has_derivative (\<lambda>x. x *\<^sub>R f')) net"
 
 lemma has_vector_derivative_eq_rhs:
   "(f has_vector_derivative X) F \<Longrightarrow> X = Y \<Longrightarrow> (f has_vector_derivative Y) F"
   by simp
 
 named_theorems derivative_intros "structural introduction rules for derivatives"
 setup \<open>
   let
     val eq_thms = @{thms has_derivative_eq_rhs DERIV_cong has_vector_derivative_eq_rhs}
     fun eq_rule thm = get_first (try (fn eq_thm => eq_thm OF [thm])) eq_thms
   in
     Global_Theory.add_thms_dynamic
       (\<^binding>\<open>derivative_eq_intros\<close>,
         fn context =>
           Named_Theorems.get (Context.proof_of context) \<^named_theorems>\<open>derivative_intros\<close>
           |> map_filter eq_rule)
   end
 \<close>
 
 text \<open>
   The following syntax is only used as a legacy syntax.
 \<close>
 abbreviation (input)
   FDERIV :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow>  ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   ("(FDERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
   where "FDERIV f x :> f' \<equiv> (f has_derivative f') (at x)"
 
 lemma has_derivative_bounded_linear: "(f has_derivative f') F \<Longrightarrow> bounded_linear f'"
   by (simp add: has_derivative_def)
 
 lemma has_derivative_linear: "(f has_derivative f') F \<Longrightarrow> linear f'"
   using bounded_linear.linear[OF has_derivative_bounded_linear] .
 
 lemma has_derivative_ident[derivative_intros, simp]: "((\<lambda>x. x) has_derivative (\<lambda>x. x)) F"
   by (simp add: has_derivative_def)
 
 lemma has_derivative_id [derivative_intros, simp]: "(id has_derivative id) (at a)"
   by (metis eq_id_iff has_derivative_ident)
 
 lemma has_derivative_const[derivative_intros, simp]: "((\<lambda>x. c) has_derivative (\<lambda>x. 0)) F"
   by (simp add: has_derivative_def)
 
 lemma (in bounded_linear) bounded_linear: "bounded_linear f" ..
 
 lemma (in bounded_linear) has_derivative:
   "(g has_derivative g') F \<Longrightarrow> ((\<lambda>x. f (g x)) has_derivative (\<lambda>x. f (g' x))) F"
   unfolding has_derivative_def
   by (auto simp add: bounded_linear_compose [OF bounded_linear] scaleR diff dest: tendsto)
 
 lemmas has_derivative_scaleR_right [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_linear_scaleR_right]
 
 lemmas has_derivative_scaleR_left [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_linear_scaleR_left]
 
 lemmas has_derivative_mult_right [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_linear_mult_right]
 
 lemmas has_derivative_mult_left [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_linear_mult_left]
 
 lemmas has_derivative_of_real[derivative_intros, simp] = 
   bounded_linear.has_derivative[OF bounded_linear_of_real] 
 
 lemma has_derivative_add[simp, derivative_intros]:
   assumes f: "(f has_derivative f') F"
     and g: "(g has_derivative g') F"
   shows "((\<lambda>x. f x + g x) has_derivative (\<lambda>x. f' x + g' x)) F"
   unfolding has_derivative_def
 proof safe
   let ?x = "Lim F (\<lambda>x. x)"
   let ?D = "\<lambda>f f' y. ((f y - f ?x) - f' (y - ?x)) /\<^sub>R norm (y - ?x)"
   have "((\<lambda>x. ?D f f' x + ?D g g' x) \<longlongrightarrow> (0 + 0)) F"
     using f g by (intro tendsto_add) (auto simp: has_derivative_def)
   then show "(?D (\<lambda>x. f x + g x) (\<lambda>x. f' x + g' x) \<longlongrightarrow> 0) F"
     by (simp add: field_simps scaleR_add_right scaleR_diff_right)
 qed (blast intro: bounded_linear_add f g has_derivative_bounded_linear)
 
 lemma has_derivative_sum[simp, derivative_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i has_derivative f' i) F) \<Longrightarrow>
     ((\<lambda>x. \<Sum>i\<in>I. f i x) has_derivative (\<lambda>x. \<Sum>i\<in>I. f' i x)) F"
   by (induct I rule: infinite_finite_induct) simp_all
 
 lemma has_derivative_minus[simp, derivative_intros]:
   "(f has_derivative f') F \<Longrightarrow> ((\<lambda>x. - f x) has_derivative (\<lambda>x. - f' x)) F"
   using has_derivative_scaleR_right[of f f' F "-1"] by simp
 
 lemma has_derivative_diff[simp, derivative_intros]:
   "(f has_derivative f') F \<Longrightarrow> (g has_derivative g') F \<Longrightarrow>
     ((\<lambda>x. f x - g x) has_derivative (\<lambda>x. f' x - g' x)) F"
   by (simp only: diff_conv_add_uminus has_derivative_add has_derivative_minus)
 
 lemma has_derivative_at_within:
   "(f has_derivative f') (at x within s) \<longleftrightarrow>
     (bounded_linear f' \<and> ((\<lambda>y. ((f y - f x) - f' (y - x)) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0) (at x within s))"
 proof (cases "at x within s = bot")
   case True
   then show ?thesis
     by (metis (no_types, lifting) has_derivative_within tendsto_bot)
 next
   case False
   then show ?thesis
   by (simp add: Lim_ident_at has_derivative_def)
 qed
 
 lemma has_derivative_iff_norm:
   "(f has_derivative f') (at x within s) \<longleftrightarrow>
     bounded_linear f' \<and> ((\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within s)"
   using tendsto_norm_zero_iff[of _ "at x within s", where 'b="'b", symmetric]
   by (simp add: has_derivative_at_within divide_inverse ac_simps)
 
 lemma has_derivative_at:
   "(f has_derivative D) (at x) \<longleftrightarrow>
     (bounded_linear D \<and> (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) \<midarrow>0\<rightarrow> 0)"
   by (simp add: has_derivative_iff_norm LIM_offset_zero_iff)
 
 lemma field_has_derivative_at:
   fixes x :: "'a::real_normed_field"
   shows "(f has_derivative (*) D) (at x) \<longleftrightarrow> (\<lambda>h. (f (x + h) - f x) / h) \<midarrow>0\<rightarrow> D" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<lambda>h. norm (f (x + h) - f x - D * h) / norm h) \<midarrow>0 \<rightarrow> 0"
     by (simp add: bounded_linear_mult_right has_derivative_at)
   also have "... = (\<lambda>y. norm ((f (x + y) - f x - D * y) / y)) \<midarrow>0\<rightarrow> 0"
     by (simp cong: LIM_cong flip: nonzero_norm_divide)
   also have "... = (\<lambda>y. norm ((f (x + y) - f x) / y - D / y * y)) \<midarrow>0\<rightarrow> 0"
     by (simp only: diff_divide_distrib times_divide_eq_left [symmetric])
   also have "... = ?rhs"
     by (simp add: tendsto_norm_zero_iff LIM_zero_iff cong: LIM_cong)
   finally show ?thesis .
 qed
 
 lemma has_derivative_iff_Ex:
   "(f has_derivative f') (at x) \<longleftrightarrow>
     bounded_linear f' \<and> (\<exists>e. (\<forall>h. f (x+h) = f x + f' h + e h) \<and> ((\<lambda>h. norm (e h) / norm h) \<longlongrightarrow> 0) (at 0))"
   unfolding has_derivative_at by force
 
 lemma has_derivative_at_within_iff_Ex:
   assumes "x \<in> S" "open S"
   shows "(f has_derivative f') (at x within S) \<longleftrightarrow>
          bounded_linear f' \<and> (\<exists>e. (\<forall>h. x+h \<in> S \<longrightarrow> f (x+h) = f x + f' h + e h) \<and> ((\<lambda>h. norm (e h) / norm h) \<longlongrightarrow> 0) (at 0))"
     (is "?lhs = ?rhs")
 proof safe
   show "bounded_linear f'"
     if "(f has_derivative f') (at x within S)"
     using has_derivative_bounded_linear that by blast
   show "\<exists>e. (\<forall>h. x + h \<in> S \<longrightarrow> f (x + h) = f x + f' h + e h) \<and> (\<lambda>h. norm (e h) / norm h) \<midarrow>0\<rightarrow> 0"
     if "(f has_derivative f') (at x within S)"
     by (metis (full_types) assms that has_derivative_iff_Ex at_within_open)
   show "(f has_derivative f') (at x within S)"
     if "bounded_linear f'"
       and eq [rule_format]: "\<forall>h. x + h \<in> S \<longrightarrow> f (x + h) = f x + f' h + e h"
       and 0: "(\<lambda>h. norm (e (h::'a)::'b) / norm h) \<midarrow>0\<rightarrow> 0"
     for e 
   proof -
     have 1: "f y - f x = f' (y-x) + e (y-x)" if "y \<in> S" for y
       using eq [of "y-x"] that by simp
     have 2: "((\<lambda>y. norm (e (y-x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within S)"
       by (simp add: "0" assms tendsto_offset_zero_iff)
     have "((\<lambda>y. norm (f y - f x - f' (y - x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within S)"
       by (simp add: Lim_cong_within 1 2)
     then show ?thesis
       by (simp add: has_derivative_iff_norm \<open>bounded_linear f'\<close>)
   qed
 qed
 
 lemma has_derivativeI:
   "bounded_linear f' \<Longrightarrow>
     ((\<lambda>y. ((f y - f x) - f' (y - x)) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0) (at x within s) \<Longrightarrow>
     (f has_derivative f') (at x within s)"
   by (simp add: has_derivative_at_within)
 
 lemma has_derivativeI_sandwich:
   assumes e: "0 < e"
     and bounded: "bounded_linear f'"
     and sandwich: "(\<And>y. y \<in> s \<Longrightarrow> y \<noteq> x \<Longrightarrow> dist y x < e \<Longrightarrow>
       norm ((f y - f x) - f' (y - x)) / norm (y - x) \<le> H y)"
     and "(H \<longlongrightarrow> 0) (at x within s)"
   shows "(f has_derivative f') (at x within s)"
   unfolding has_derivative_iff_norm
 proof safe
   show "((\<lambda>y. norm (f y - f x - f' (y - x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within s)"
   proof (rule tendsto_sandwich[where f="\<lambda>x. 0"])
     show "(H \<longlongrightarrow> 0) (at x within s)" by fact
     show "eventually (\<lambda>n. norm (f n - f x - f' (n - x)) / norm (n - x) \<le> H n) (at x within s)"
       unfolding eventually_at using e sandwich by auto
   qed (auto simp: le_divide_eq)
 qed fact
 
 lemma has_derivative_subset:
   "(f has_derivative f') (at x within s) \<Longrightarrow> t \<subseteq> s \<Longrightarrow> (f has_derivative f') (at x within t)"
   by (auto simp add: has_derivative_iff_norm intro: tendsto_within_subset)
 
 lemma has_derivative_within_singleton_iff:
   "(f has_derivative g) (at x within {x}) \<longleftrightarrow> bounded_linear g"
   by (auto intro!: has_derivativeI_sandwich[where e=1] has_derivative_bounded_linear)
 
 
 subsubsection \<open>Limit transformation for derivatives\<close>
 
 lemma has_derivative_transform_within:
   assumes "(f has_derivative f') (at x within s)"
     and "0 < d"
     and "x \<in> s"
     and "\<And>x'. \<lbrakk>x' \<in> s; dist x' x < d\<rbrakk> \<Longrightarrow> f x' = g x'"
   shows "(g has_derivative f') (at x within s)"
   using assms
   unfolding has_derivative_within
   by (force simp add: intro: Lim_transform_within)
 
 lemma has_derivative_transform_within_open:
   assumes "(f has_derivative f') (at x within t)"
     and "open s"
     and "x \<in> s"
     and "\<And>x. x\<in>s \<Longrightarrow> f x = g x"
   shows "(g has_derivative f') (at x within t)"
   using assms unfolding has_derivative_within
   by (force simp add: intro: Lim_transform_within_open)
 
 lemma has_derivative_transform:
   assumes "x \<in> s" "\<And>x. x \<in> s \<Longrightarrow> g x = f x"
   assumes "(f has_derivative f') (at x within s)"
   shows "(g has_derivative f') (at x within s)"
   using assms
   by (intro has_derivative_transform_within[OF _ zero_less_one, where g=g]) auto
 
 lemma has_derivative_transform_eventually:
   assumes "(f has_derivative f') (at x within s)"
     "(\<forall>\<^sub>F x' in at x within s. f x' = g x')"
   assumes "f x = g x" "x \<in> s"
   shows "(g has_derivative f') (at x within s)"
   using assms
 proof -
   from assms(2,3) obtain d where "d > 0" "\<And>x'. x' \<in> s \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x'"
     by (force simp: eventually_at)
   from has_derivative_transform_within[OF assms(1) this(1) assms(4) this(2)]
   show ?thesis .
 qed
 
 lemma has_field_derivative_transform_within:
   assumes "(f has_field_derivative f') (at a within S)"
     and "0 < d"
     and "a \<in> S"
     and "\<And>x. \<lbrakk>x \<in> S; dist x a < d\<rbrakk> \<Longrightarrow> f x = g x"
   shows "(g has_field_derivative f') (at a within S)"
   using assms unfolding has_field_derivative_def
   by (metis has_derivative_transform_within)
 
 lemma has_field_derivative_transform_within_open:
   assumes "(f has_field_derivative f') (at a)"
     and "open S" "a \<in> S"
     and "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   shows "(g has_field_derivative f') (at a)"
   using assms unfolding has_field_derivative_def
   by (metis has_derivative_transform_within_open)
 
 
 subsection \<open>Continuity\<close>
 
 lemma has_derivative_continuous:
   assumes f: "(f has_derivative f') (at x within s)"
   shows "continuous (at x within s) f"
 proof -
   from f interpret F: bounded_linear f'
     by (rule has_derivative_bounded_linear)
   note F.tendsto[tendsto_intros]
   let ?L = "\<lambda>f. (f \<longlongrightarrow> 0) (at x within s)"
   have "?L (\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x))"
     using f unfolding has_derivative_iff_norm by blast
   then have "?L (\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x) * norm (y - x))" (is ?m)
     by (rule tendsto_mult_zero) (auto intro!: tendsto_eq_intros)
   also have "?m \<longleftrightarrow> ?L (\<lambda>y. norm ((f y - f x) - f' (y - x)))"
     by (intro filterlim_cong) (simp_all add: eventually_at_filter)
   finally have "?L (\<lambda>y. (f y - f x) - f' (y - x))"
     by (rule tendsto_norm_zero_cancel)
   then have "?L (\<lambda>y. ((f y - f x) - f' (y - x)) + f' (y - x))"
     by (rule tendsto_eq_intros) (auto intro!: tendsto_eq_intros simp: F.zero)
   then have "?L (\<lambda>y. f y - f x)"
     by simp
   from tendsto_add[OF this tendsto_const, of "f x"] show ?thesis
     by (simp add: continuous_within)
 qed
 
 
 subsection \<open>Composition\<close>
 
 lemma tendsto_at_iff_tendsto_nhds_within:
   "f x = y \<Longrightarrow> (f \<longlongrightarrow> y) (at x within s) \<longleftrightarrow> (f \<longlongrightarrow> y) (inf (nhds x) (principal s))"
   unfolding tendsto_def eventually_inf_principal eventually_at_filter
   by (intro ext all_cong imp_cong) (auto elim!: eventually_mono)
 
 lemma has_derivative_in_compose:
   assumes f: "(f has_derivative f') (at x within s)"
     and g: "(g has_derivative g') (at (f x) within (f`s))"
   shows "((\<lambda>x. g (f x)) has_derivative (\<lambda>x. g' (f' x))) (at x within s)"
 proof -
   from f interpret F: bounded_linear f'
     by (rule has_derivative_bounded_linear)
   from g interpret G: bounded_linear g'
     by (rule has_derivative_bounded_linear)
   from F.bounded obtain kF where kF: "\<And>x. norm (f' x) \<le> norm x * kF"
     by fast
   from G.bounded obtain kG where kG: "\<And>x. norm (g' x) \<le> norm x * kG"
     by fast
   note G.tendsto[tendsto_intros]
 
   let ?L = "\<lambda>f. (f \<longlongrightarrow> 0) (at x within s)"
   let ?D = "\<lambda>f f' x y. (f y - f x) - f' (y - x)"
   let ?N = "\<lambda>f f' x y. norm (?D f f' x y) / norm (y - x)"
   let ?gf = "\<lambda>x. g (f x)" and ?gf' = "\<lambda>x. g' (f' x)"
   define Nf where "Nf = ?N f f' x"
   define Ng where [abs_def]: "Ng y = ?N g g' (f x) (f y)" for y
 
   show ?thesis
   proof (rule has_derivativeI_sandwich[of 1])
     show "bounded_linear (\<lambda>x. g' (f' x))"
       using f g by (blast intro: bounded_linear_compose has_derivative_bounded_linear)
   next
     fix y :: 'a
     assume neq: "y \<noteq> x"
     have "?N ?gf ?gf' x y = norm (g' (?D f f' x y) + ?D g g' (f x) (f y)) / norm (y - x)"
       by (simp add: G.diff G.add field_simps)
     also have "\<dots> \<le> norm (g' (?D f f' x y)) / norm (y - x) + Ng y * (norm (f y - f x) / norm (y - x))"
       by (simp add: add_divide_distrib[symmetric] divide_right_mono norm_triangle_ineq G.zero Ng_def)
     also have "\<dots> \<le> Nf y * kG + Ng y * (Nf y + kF)"
     proof (intro add_mono mult_left_mono)
       have "norm (f y - f x) = norm (?D f f' x y + f' (y - x))"
         by simp
       also have "\<dots> \<le> norm (?D f f' x y) + norm (f' (y - x))"
         by (rule norm_triangle_ineq)
       also have "\<dots> \<le> norm (?D f f' x y) + norm (y - x) * kF"
         using kF by (intro add_mono) simp
       finally show "norm (f y - f x) / norm (y - x) \<le> Nf y + kF"
         by (simp add: neq Nf_def field_simps)
     qed (use kG in \<open>simp_all add: Ng_def Nf_def neq zero_le_divide_iff field_simps\<close>)
     finally show "?N ?gf ?gf' x y \<le> Nf y * kG + Ng y * (Nf y + kF)" .
   next
     have [tendsto_intros]: "?L Nf"
       using f unfolding has_derivative_iff_norm Nf_def ..
     from f have "(f \<longlongrightarrow> f x) (at x within s)"
       by (blast intro: has_derivative_continuous continuous_within[THEN iffD1])
     then have f': "LIM x at x within s. f x :> inf (nhds (f x)) (principal (f`s))"
       unfolding filterlim_def
       by (simp add: eventually_filtermap eventually_at_filter le_principal)
 
     have "((?N g  g' (f x)) \<longlongrightarrow> 0) (at (f x) within f`s)"
       using g unfolding has_derivative_iff_norm ..
     then have g': "((?N g  g' (f x)) \<longlongrightarrow> 0) (inf (nhds (f x)) (principal (f`s)))"
       by (rule tendsto_at_iff_tendsto_nhds_within[THEN iffD1, rotated]) simp
 
     have [tendsto_intros]: "?L Ng"
       unfolding Ng_def by (rule filterlim_compose[OF g' f'])
     show "((\<lambda>y. Nf y * kG + Ng y * (Nf y + kF)) \<longlongrightarrow> 0) (at x within s)"
       by (intro tendsto_eq_intros) auto
   qed simp
 qed
 
 lemma has_derivative_compose:
   "(f has_derivative f') (at x within s) \<Longrightarrow> (g has_derivative g') (at (f x)) \<Longrightarrow>
   ((\<lambda>x. g (f x)) has_derivative (\<lambda>x. g' (f' x))) (at x within s)"
   by (blast intro: has_derivative_in_compose has_derivative_subset)
 
 lemma has_derivative_in_compose2:
   assumes "\<And>x. x \<in> t \<Longrightarrow> (g has_derivative g' x) (at x within t)"
   assumes "f ` s \<subseteq> t" "x \<in> s"
   assumes "(f has_derivative f') (at x within s)"
   shows "((\<lambda>x. g (f x)) has_derivative (\<lambda>y. g' (f x) (f' y))) (at x within s)"
   using assms
   by (auto intro: has_derivative_subset intro!: has_derivative_in_compose[of f f' x s g])
 
 lemma (in bounded_bilinear) FDERIV:
   assumes f: "(f has_derivative f') (at x within s)" and g: "(g has_derivative g') (at x within s)"
   shows "((\<lambda>x. f x ** g x) has_derivative (\<lambda>h. f x ** g' h + f' h ** g x)) (at x within s)"
 proof -
   from bounded_linear.bounded [OF has_derivative_bounded_linear [OF f]]
   obtain KF where norm_F: "\<And>x. norm (f' x) \<le> norm x * KF" by fast
 
   from pos_bounded obtain K
     where K: "0 < K" and norm_prod: "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
     by fast
   let ?D = "\<lambda>f f' y. f y - f x - f' (y - x)"
   let ?N = "\<lambda>f f' y. norm (?D f f' y) / norm (y - x)"
   define Ng where "Ng = ?N g g'"
   define Nf where "Nf = ?N f f'"
 
   let ?fun1 = "\<lambda>y. norm (f y ** g y - f x ** g x - (f x ** g' (y - x) + f' (y - x) ** g x)) / norm (y - x)"
   let ?fun2 = "\<lambda>y. norm (f x) * Ng y * K + Nf y * norm (g y) * K + KF * norm (g y - g x) * K"
   let ?F = "at x within s"
 
   show ?thesis
   proof (rule has_derivativeI_sandwich[of 1])
     show "bounded_linear (\<lambda>h. f x ** g' h + f' h ** g x)"
       by (intro bounded_linear_add
         bounded_linear_compose [OF bounded_linear_right] bounded_linear_compose [OF bounded_linear_left]
         has_derivative_bounded_linear [OF g] has_derivative_bounded_linear [OF f])
   next
     from g have "(g \<longlongrightarrow> g x) ?F"
       by (intro continuous_within[THEN iffD1] has_derivative_continuous)
     moreover from f g have "(Nf \<longlongrightarrow> 0) ?F" "(Ng \<longlongrightarrow> 0) ?F"
       by (simp_all add: has_derivative_iff_norm Ng_def Nf_def)
     ultimately have "(?fun2 \<longlongrightarrow> norm (f x) * 0 * K + 0 * norm (g x) * K + KF * norm (0::'b) * K) ?F"
       by (intro tendsto_intros) (simp_all add: LIM_zero_iff)
     then show "(?fun2 \<longlongrightarrow> 0) ?F"
       by simp
   next
     fix y :: 'd
     assume "y \<noteq> x"
     have "?fun1 y =
         norm (f x ** ?D g g' y + ?D f f' y ** g y + f' (y - x) ** (g y - g x)) / norm (y - x)"
       by (simp add: diff_left diff_right add_left add_right field_simps)
     also have "\<dots> \<le> (norm (f x) * norm (?D g g' y) * K + norm (?D f f' y) * norm (g y) * K +
         norm (y - x) * KF * norm (g y - g x) * K) / norm (y - x)"
       by (intro divide_right_mono mult_mono'
                 order_trans [OF norm_triangle_ineq add_mono]
                 order_trans [OF norm_prod mult_right_mono]
                 mult_nonneg_nonneg order_refl norm_ge_zero norm_F
                 K [THEN order_less_imp_le])
     also have "\<dots> = ?fun2 y"
       by (simp add: add_divide_distrib Ng_def Nf_def)
     finally show "?fun1 y \<le> ?fun2 y" .
   qed simp
 qed
 
 lemmas has_derivative_mult[simp, derivative_intros] = bounded_bilinear.FDERIV[OF bounded_bilinear_mult]
 lemmas has_derivative_scaleR[simp, derivative_intros] = bounded_bilinear.FDERIV[OF bounded_bilinear_scaleR]
 
 lemma has_derivative_prod[simp, derivative_intros]:
   fixes f :: "'i \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "(\<And>i. i \<in> I \<Longrightarrow> (f i has_derivative f' i) (at x within S)) \<Longrightarrow>
     ((\<lambda>x. \<Prod>i\<in>I. f i x) has_derivative (\<lambda>y. \<Sum>i\<in>I. f' i y * (\<Prod>j\<in>I - {i}. f j x))) (at x within S)"
 proof (induct I rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case (insert i I)
   let ?P = "\<lambda>y. f i x * (\<Sum>i\<in>I. f' i y * (\<Prod>j\<in>I - {i}. f j x)) + (f' i y) * (\<Prod>i\<in>I. f i x)"
   have "((\<lambda>x. f i x * (\<Prod>i\<in>I. f i x)) has_derivative ?P) (at x within S)"
     using insert by (intro has_derivative_mult) auto
   also have "?P = (\<lambda>y. \<Sum>i'\<in>insert i I. f' i' y * (\<Prod>j\<in>insert i I - {i'}. f j x))"
     using insert(1,2)
     by (auto simp add: sum_distrib_left insert_Diff_if intro!: ext sum.cong)
   finally show ?case
     using insert by simp
 qed
 
 lemma has_derivative_power[simp, derivative_intros]:
   fixes f :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   assumes f: "(f has_derivative f') (at x within S)"
   shows "((\<lambda>x. f x^n) has_derivative (\<lambda>y. of_nat n * f' y * f x^(n - 1))) (at x within S)"
   using has_derivative_prod[OF f, of "{..< n}"] by (simp add: prod_constant ac_simps)
 
 lemma has_derivative_inverse':
   fixes x :: "'a::real_normed_div_algebra"
   assumes x: "x \<noteq> 0"
   shows "(inverse has_derivative (\<lambda>h. - (inverse x * h * inverse x))) (at x within S)"
     (is "(_ has_derivative ?f) _")
 proof (rule has_derivativeI_sandwich)
   show "bounded_linear (\<lambda>h. - (inverse x * h * inverse x))"
     by (simp add: bounded_linear_minus bounded_linear_mult_const bounded_linear_mult_right)
   show "0 < norm x" using x by simp
   have "(inverse \<longlongrightarrow> inverse x) (at x within S)"
     using tendsto_inverse tendsto_ident_at x by auto
   then show "((\<lambda>y. norm (inverse y - inverse x) * norm (inverse x)) \<longlongrightarrow> 0) (at x within S)"
     by (simp add: LIM_zero_iff tendsto_mult_left_zero tendsto_norm_zero)
 next
   fix y :: 'a
   assume h: "y \<noteq> x" "dist y x < norm x"
   then have "y \<noteq> 0" by auto
   have "norm (inverse y - inverse x - ?f (y -x)) / norm (y - x) 
         = norm (- (inverse y * (y - x) * inverse x - inverse x * (y - x) * inverse x)) /
                 norm (y - x)"
     by (simp add: \<open>y \<noteq> 0\<close> inverse_diff_inverse x)
   also have "... = norm ((inverse y - inverse x) * (y - x) * inverse x) / norm (y - x)"
     by (simp add: left_diff_distrib norm_minus_commute)
   also have "\<dots> \<le> norm (inverse y - inverse x) * norm (y - x) * norm (inverse x) / norm (y - x)"
     by (simp add: norm_mult)
   also have "\<dots> = norm (inverse y - inverse x) * norm (inverse x)"
     by simp
   finally show "norm (inverse y - inverse x - ?f (y -x)) / norm (y - x) \<le>
     norm (inverse y - inverse x) * norm (inverse x)" .
 qed
 
 lemma has_derivative_inverse[simp, derivative_intros]:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   assumes x:  "f x \<noteq> 0"
     and f: "(f has_derivative f') (at x within S)"
   shows "((\<lambda>x. inverse (f x)) has_derivative (\<lambda>h. - (inverse (f x) * f' h * inverse (f x))))
     (at x within S)"
   using has_derivative_compose[OF f has_derivative_inverse', OF x] .
 
 lemma has_derivative_divide[simp, derivative_intros]:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   assumes f: "(f has_derivative f') (at x within S)"
     and g: "(g has_derivative g') (at x within S)"
   assumes x: "g x \<noteq> 0"
   shows "((\<lambda>x. f x / g x) has_derivative
                 (\<lambda>h. - f x * (inverse (g x) * g' h * inverse (g x)) + f' h / g x)) (at x within S)"
   using has_derivative_mult[OF f has_derivative_inverse[OF x g]]
   by (simp add: field_simps)
 
 lemma has_derivative_power_int':
   fixes x :: "'a::real_normed_field"
   assumes x: "x \<noteq> 0"
   shows "((\<lambda>x. power_int x n) has_derivative (\<lambda>y. y * (of_int n * power_int x (n - 1)))) (at x within S)"
 proof (cases n rule: int_cases4)
   case (nonneg n)
   thus ?thesis using x
     by (cases "n = 0") (auto intro!: derivative_eq_intros simp: field_simps power_int_diff fun_eq_iff
                              simp flip: power_Suc)
 next
   case (neg n)
   thus ?thesis using x
     by (auto intro!: derivative_eq_intros simp: field_simps power_int_diff power_int_minus
              simp flip: power_Suc power_Suc2 power_add)
 qed
 
 lemma has_derivative_power_int[simp, derivative_intros]:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_field"
   assumes x:  "f x \<noteq> 0"
     and f: "(f has_derivative f') (at x within S)"
   shows "((\<lambda>x. power_int (f x) n) has_derivative (\<lambda>h. f' h * (of_int n * power_int (f x) (n - 1))))
            (at x within S)"
   using has_derivative_compose[OF f has_derivative_power_int', OF x] .
 
 
 text \<open>Conventional form requires mult-AC laws. Types real and complex only.\<close>
 
 lemma has_derivative_divide'[derivative_intros]:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_field"
   assumes f: "(f has_derivative f') (at x within S)"
     and g: "(g has_derivative g') (at x within S)"
     and x: "g x \<noteq> 0"
   shows "((\<lambda>x. f x / g x) has_derivative (\<lambda>h. (f' h * g x - f x * g' h) / (g x * g x))) (at x within S)"
 proof -
   have "f' h / g x - f x * (inverse (g x) * g' h * inverse (g x)) =
       (f' h * g x - f x * g' h) / (g x * g x)" for h
     by (simp add: field_simps x)
   then show ?thesis
     using has_derivative_divide [OF f g] x
     by simp
 qed
 
 
 subsection \<open>Uniqueness\<close>
 
 text \<open>
 This can not generally shown for \<^const>\<open>has_derivative\<close>, as we need to approach the point from
 all directions. There is a proof in \<open>Analysis\<close> for \<open>euclidean_space\<close>.
 \<close>
 
 lemma has_derivative_at2: "(f has_derivative f') (at x) \<longleftrightarrow>
     bounded_linear f' \<and> ((\<lambda>y. (1 / (norm(y - x))) *\<^sub>R (f y - (f x + f' (y - x)))) \<longlongrightarrow> 0) (at x)"
   using has_derivative_within [of f f' x UNIV]
   by simp
 
 lemma has_derivative_zero_unique:
   assumes "((\<lambda>x. 0) has_derivative F) (at x)"
   shows "F = (\<lambda>h. 0)"
 proof -
   interpret F: bounded_linear F
     using assms by (rule has_derivative_bounded_linear)
   let ?r = "\<lambda>h. norm (F h) / norm h"
   have *: "?r \<midarrow>0\<rightarrow> 0"
     using assms unfolding has_derivative_at by simp
   show "F = (\<lambda>h. 0)"
   proof
     show "F h = 0" for h
     proof (rule ccontr)
       assume **: "\<not> ?thesis"
       then have h: "h \<noteq> 0"
         by (auto simp add: F.zero)
       with ** have "0 < ?r h"
         by simp
       from LIM_D [OF * this] obtain S
         where S: "0 < S" and r: "\<And>x. x \<noteq> 0 \<Longrightarrow> norm x < S \<Longrightarrow> ?r x < ?r h"
         by auto
       from dense [OF S] obtain t where t: "0 < t \<and> t < S" ..
       let ?x = "scaleR (t / norm h) h"
       have "?x \<noteq> 0" and "norm ?x < S"
         using t h by simp_all
       then have "?r ?x < ?r h"
         by (rule r)
       then show False
         using t h by (simp add: F.scaleR)
     qed
   qed
 qed
 
 lemma has_derivative_unique:
   assumes "(f has_derivative F) (at x)"
     and "(f has_derivative F') (at x)"
   shows "F = F'"
 proof -
   have "((\<lambda>x. 0) has_derivative (\<lambda>h. F h - F' h)) (at x)"
     using has_derivative_diff [OF assms] by simp
   then have "(\<lambda>h. F h - F' h) = (\<lambda>h. 0)"
     by (rule has_derivative_zero_unique)
   then show "F = F'"
     unfolding fun_eq_iff right_minus_eq .
 qed
 
 lemma has_derivative_Uniq: "\<exists>\<^sub>\<le>\<^sub>1F. (f has_derivative F) (at x)"
   by (simp add: Uniq_def has_derivative_unique)
 
 
 subsection \<open>Differentiability predicate\<close>
 
 definition differentiable :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a filter \<Rightarrow> bool"
     (infix "differentiable" 50)
   where "f differentiable F \<longleftrightarrow> (\<exists>D. (f has_derivative D) F)"
 
 lemma differentiable_subset:
   "f differentiable (at x within s) \<Longrightarrow> t \<subseteq> s \<Longrightarrow> f differentiable (at x within t)"
   unfolding differentiable_def by (blast intro: has_derivative_subset)
 
 lemmas differentiable_within_subset = differentiable_subset
 
 lemma differentiable_ident [simp, derivative_intros]: "(\<lambda>x. x) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_ident)
 
 lemma differentiable_const [simp, derivative_intros]: "(\<lambda>z. a) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_const)
 
 lemma differentiable_in_compose:
   "f differentiable (at (g x) within (g`s)) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     (\<lambda>x. f (g x)) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_in_compose)
 
 lemma differentiable_compose:
   "f differentiable (at (g x)) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     (\<lambda>x. f (g x)) differentiable (at x within s)"
   by (blast intro: differentiable_in_compose differentiable_subset)
 
 lemma differentiable_add [simp, derivative_intros]:
   "f differentiable F \<Longrightarrow> g differentiable F \<Longrightarrow> (\<lambda>x. f x + g x) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_add)
 
 lemma differentiable_sum[simp, derivative_intros]:
   assumes "finite s" "\<forall>a\<in>s. (f a) differentiable net"
   shows "(\<lambda>x. sum (\<lambda>a. f a x) s) differentiable net"
 proof -
   from bchoice[OF assms(2)[unfolded differentiable_def]]
   show ?thesis
     by (auto intro!: has_derivative_sum simp: differentiable_def)
 qed
 
 lemma differentiable_minus [simp, derivative_intros]:
   "f differentiable F \<Longrightarrow> (\<lambda>x. - f x) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_minus)
 
 lemma differentiable_diff [simp, derivative_intros]:
   "f differentiable F \<Longrightarrow> g differentiable F \<Longrightarrow> (\<lambda>x. f x - g x) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_diff)
 
 lemma differentiable_mult [simp, derivative_intros]:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_algebra"
   shows "f differentiable (at x within s) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     (\<lambda>x. f x * g x) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_mult)
 
+lemma differentiable_cmult_left_iff [simp]:
+  fixes c::"'a::real_normed_field" 
+  shows "(\<lambda>t. c * q t) differentiable at t \<longleftrightarrow> c = 0 \<or> (\<lambda>t. q t) differentiable at t" (is "?lhs = ?rhs")
+proof
+  assume L: ?lhs
+  {assume "c \<noteq> 0"
+    then have "q differentiable at t"
+      using differentiable_mult [OF differentiable_const L, of concl: "1/c"] by auto
+  } then show ?rhs
+    by auto
+qed auto
+
+lemma differentiable_cmult_right_iff [simp]:
+  fixes c::"'a::real_normed_field" 
+  shows "(\<lambda>t. q t * c) differentiable at t \<longleftrightarrow> c = 0 \<or> (\<lambda>t. q t) differentiable at t" (is "?lhs = ?rhs")
+  by (simp add: mult.commute flip: differentiable_cmult_left_iff)
+
 lemma differentiable_inverse [simp, derivative_intros]:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "f differentiable (at x within s) \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow>
     (\<lambda>x. inverse (f x)) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_inverse)
 
 lemma differentiable_divide [simp, derivative_intros]:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "f differentiable (at x within s) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     g x \<noteq> 0 \<Longrightarrow> (\<lambda>x. f x / g x) differentiable (at x within s)"
   unfolding divide_inverse by simp
 
 lemma differentiable_power [simp, derivative_intros]:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "f differentiable (at x within s) \<Longrightarrow> (\<lambda>x. f x ^ n) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_power)
 
 lemma differentiable_power_int [simp, derivative_intros]:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "f differentiable (at x within s) \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow>
            (\<lambda>x. power_int (f x) n) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_power_int)
 
 lemma differentiable_scaleR [simp, derivative_intros]:
   "f differentiable (at x within s) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     (\<lambda>x. f x *\<^sub>R g x) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_scaleR)
 
 lemma has_derivative_imp_has_field_derivative:
   "(f has_derivative D) F \<Longrightarrow> (\<And>x. x * D' = D x) \<Longrightarrow> (f has_field_derivative D') F"
   unfolding has_field_derivative_def
   by (rule has_derivative_eq_rhs[of f D]) (simp_all add: fun_eq_iff mult.commute)
 
 lemma has_field_derivative_imp_has_derivative:
   "(f has_field_derivative D) F \<Longrightarrow> (f has_derivative (*) D) F"
   by (simp add: has_field_derivative_def)
 
 lemma DERIV_subset:
   "(f has_field_derivative f') (at x within s) \<Longrightarrow> t \<subseteq> s \<Longrightarrow>
     (f has_field_derivative f') (at x within t)"
   by (simp add: has_field_derivative_def has_derivative_subset)
 
 lemma has_field_derivative_at_within:
   "(f has_field_derivative f') (at x) \<Longrightarrow> (f has_field_derivative f') (at x within s)"
   using DERIV_subset by blast
 
 abbreviation (input)
   DERIV :: "('a::real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
     ("(DERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
   where "DERIV f x :> D \<equiv> (f has_field_derivative D) (at x)"
 
 abbreviation has_real_derivative :: "(real \<Rightarrow> real) \<Rightarrow> real \<Rightarrow> real filter \<Rightarrow> bool"
     (infix "(has'_real'_derivative)" 50)
   where "(f has_real_derivative D) F \<equiv> (f has_field_derivative D) F"
 
 lemma real_differentiable_def:
   "f differentiable at x within s \<longleftrightarrow> (\<exists>D. (f has_real_derivative D) (at x within s))"
 proof safe
   assume "f differentiable at x within s"
   then obtain f' where *: "(f has_derivative f') (at x within s)"
     unfolding differentiable_def by auto
   then obtain c where "f' = ((*) c)"
     by (metis real_bounded_linear has_derivative_bounded_linear mult.commute fun_eq_iff)
   with * show "\<exists>D. (f has_real_derivative D) (at x within s)"
     unfolding has_field_derivative_def by auto
 qed (auto simp: differentiable_def has_field_derivative_def)
 
 lemma real_differentiableE [elim?]:
   assumes f: "f differentiable (at x within s)"
   obtains df where "(f has_real_derivative df) (at x within s)"
   using assms by (auto simp: real_differentiable_def)
 
 lemma has_field_derivative_iff:
   "(f has_field_derivative D) (at x within S) \<longleftrightarrow>
     ((\<lambda>y. (f y - f x) / (y - x)) \<longlongrightarrow> D) (at x within S)"
 proof -
   have "((\<lambda>y. norm (f y - f x - D * (y - x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within S) 
       = ((\<lambda>y. (f y - f x) / (y - x) - D) \<longlongrightarrow> 0) (at x within S)"
     apply (subst tendsto_norm_zero_iff[symmetric], rule filterlim_cong)
       apply (simp_all add: eventually_at_filter field_simps nonzero_norm_divide)
     done
   then show ?thesis
     by (simp add: has_field_derivative_def has_derivative_iff_norm bounded_linear_mult_right LIM_zero_iff)
 qed
 
 lemma DERIV_def: "DERIV f x :> D \<longleftrightarrow> (\<lambda>h. (f (x + h) - f x) / h) \<midarrow>0\<rightarrow> D"
   unfolding field_has_derivative_at has_field_derivative_def has_field_derivative_iff ..
 
 lemma mult_commute_abs: "(\<lambda>x. x * c) = (*) c"
   for c :: "'a::ab_semigroup_mult"
   by (simp add: fun_eq_iff mult.commute)
 
 lemma DERIV_compose_FDERIV:
   fixes f::"real\<Rightarrow>real"
   assumes "DERIV f (g x) :> f'"
   assumes "(g has_derivative g') (at x within s)"
   shows "((\<lambda>x. f (g x)) has_derivative (\<lambda>x. g' x * f')) (at x within s)"
   using assms has_derivative_compose[of g g' x s f "(*) f'"]
   by (auto simp: has_field_derivative_def ac_simps)
 
 
 subsection \<open>Vector derivative\<close>
 
 lemma has_field_derivative_iff_has_vector_derivative:
   "(f has_field_derivative y) F \<longleftrightarrow> (f has_vector_derivative y) F"
   unfolding has_vector_derivative_def has_field_derivative_def real_scaleR_def mult_commute_abs ..
 
 lemma has_field_derivative_subset:
   "(f has_field_derivative y) (at x within s) \<Longrightarrow> t \<subseteq> s \<Longrightarrow>
     (f has_field_derivative y) (at x within t)"
   unfolding has_field_derivative_def by (rule has_derivative_subset)
 
 lemma has_vector_derivative_const[simp, derivative_intros]: "((\<lambda>x. c) has_vector_derivative 0) net"
   by (auto simp: has_vector_derivative_def)
 
 lemma has_vector_derivative_id[simp, derivative_intros]: "((\<lambda>x. x) has_vector_derivative 1) net"
   by (auto simp: has_vector_derivative_def)
 
 lemma has_vector_derivative_minus[derivative_intros]:
   "(f has_vector_derivative f') net \<Longrightarrow> ((\<lambda>x. - f x) has_vector_derivative (- f')) net"
   by (auto simp: has_vector_derivative_def)
 
 lemma has_vector_derivative_add[derivative_intros]:
   "(f has_vector_derivative f') net \<Longrightarrow> (g has_vector_derivative g') net \<Longrightarrow>
     ((\<lambda>x. f x + g x) has_vector_derivative (f' + g')) net"
   by (auto simp: has_vector_derivative_def scaleR_right_distrib)
 
 lemma has_vector_derivative_sum[derivative_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i has_vector_derivative f' i) net) \<Longrightarrow>
     ((\<lambda>x. \<Sum>i\<in>I. f i x) has_vector_derivative (\<Sum>i\<in>I. f' i)) net"
   by (auto simp: has_vector_derivative_def fun_eq_iff scaleR_sum_right intro!: derivative_eq_intros)
 
 lemma has_vector_derivative_diff[derivative_intros]:
   "(f has_vector_derivative f') net \<Longrightarrow> (g has_vector_derivative g') net \<Longrightarrow>
     ((\<lambda>x. f x - g x) has_vector_derivative (f' - g')) net"
   by (auto simp: has_vector_derivative_def scaleR_diff_right)
 
 lemma has_vector_derivative_add_const:
   "((\<lambda>t. g t + z) has_vector_derivative f') net = ((\<lambda>t. g t) has_vector_derivative f') net"
   apply (intro iffI)
    apply (force dest: has_vector_derivative_diff [where g = "\<lambda>t. z", OF _ has_vector_derivative_const])
   apply (force dest: has_vector_derivative_add [OF _ has_vector_derivative_const])
   done
 
 lemma has_vector_derivative_diff_const:
   "((\<lambda>t. g t - z) has_vector_derivative f') net = ((\<lambda>t. g t) has_vector_derivative f') net"
   using has_vector_derivative_add_const [where z = "-z"]
   by simp
 
 lemma (in bounded_linear) has_vector_derivative:
   assumes "(g has_vector_derivative g') F"
   shows "((\<lambda>x. f (g x)) has_vector_derivative f g') F"
   using has_derivative[OF assms[unfolded has_vector_derivative_def]]
   by (simp add: has_vector_derivative_def scaleR)
 
 lemma (in bounded_bilinear) has_vector_derivative:
   assumes "(f has_vector_derivative f') (at x within s)"
     and "(g has_vector_derivative g') (at x within s)"
   shows "((\<lambda>x. f x ** g x) has_vector_derivative (f x ** g' + f' ** g x)) (at x within s)"
   using FDERIV[OF assms(1-2)[unfolded has_vector_derivative_def]]
   by (simp add: has_vector_derivative_def scaleR_right scaleR_left scaleR_right_distrib)
 
 lemma has_vector_derivative_scaleR[derivative_intros]:
   "(f has_field_derivative f') (at x within s) \<Longrightarrow> (g has_vector_derivative g') (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x *\<^sub>R g x) has_vector_derivative (f x *\<^sub>R g' + f' *\<^sub>R g x)) (at x within s)"
   unfolding has_field_derivative_iff_has_vector_derivative
   by (rule bounded_bilinear.has_vector_derivative[OF bounded_bilinear_scaleR])
 
 lemma has_vector_derivative_mult[derivative_intros]:
   "(f has_vector_derivative f') (at x within s) \<Longrightarrow> (g has_vector_derivative g') (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x * g x) has_vector_derivative (f x * g' + f' * g x)) (at x within s)"
   for f g :: "real \<Rightarrow> 'a::real_normed_algebra"
   by (rule bounded_bilinear.has_vector_derivative[OF bounded_bilinear_mult])
 
 lemma has_vector_derivative_of_real[derivative_intros]:
   "(f has_field_derivative D) F \<Longrightarrow> ((\<lambda>x. of_real (f x)) has_vector_derivative (of_real D)) F"
   by (rule bounded_linear.has_vector_derivative[OF bounded_linear_of_real])
     (simp add: has_field_derivative_iff_has_vector_derivative)
 
 lemma has_vector_derivative_real_field:
   "(f has_field_derivative f') (at (of_real a)) \<Longrightarrow> ((\<lambda>x. f (of_real x)) has_vector_derivative f') (at a within s)"
   using has_derivative_compose[of of_real of_real a _ f "(*) f'"] 
   by (simp add: scaleR_conv_of_real ac_simps has_vector_derivative_def has_field_derivative_def)
 
 lemma has_vector_derivative_continuous:
   "(f has_vector_derivative D) (at x within s) \<Longrightarrow> continuous (at x within s) f"
   by (auto intro: has_derivative_continuous simp: has_vector_derivative_def)
 
 lemma continuous_on_vector_derivative:
   "(\<And>x. x \<in> S \<Longrightarrow> (f has_vector_derivative f' x) (at x within S)) \<Longrightarrow> continuous_on S f"
   by (auto simp: continuous_on_eq_continuous_within intro!: has_vector_derivative_continuous)
 
 lemma has_vector_derivative_mult_right[derivative_intros]:
   fixes a :: "'a::real_normed_algebra"
   shows "(f has_vector_derivative x) F \<Longrightarrow> ((\<lambda>x. a * f x) has_vector_derivative (a * x)) F"
   by (rule bounded_linear.has_vector_derivative[OF bounded_linear_mult_right])
 
 lemma has_vector_derivative_mult_left[derivative_intros]:
   fixes a :: "'a::real_normed_algebra"
   shows "(f has_vector_derivative x) F \<Longrightarrow> ((\<lambda>x. f x * a) has_vector_derivative (x * a)) F"
   by (rule bounded_linear.has_vector_derivative[OF bounded_linear_mult_left])
 
 
 subsection \<open>Derivatives\<close>
 
 lemma DERIV_D: "DERIV f x :> D \<Longrightarrow> (\<lambda>h. (f (x + h) - f x) / h) \<midarrow>0\<rightarrow> D"
   by (simp add: DERIV_def)
 
 lemma has_field_derivativeD:
   "(f has_field_derivative D) (at x within S) \<Longrightarrow>
     ((\<lambda>y. (f y - f x) / (y - x)) \<longlongrightarrow> D) (at x within S)"
   by (simp add: has_field_derivative_iff)
 
 lemma DERIV_const [simp, derivative_intros]: "((\<lambda>x. k) has_field_derivative 0) F"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_const]) auto
 
 lemma DERIV_ident [simp, derivative_intros]: "((\<lambda>x. x) has_field_derivative 1) F"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_ident]) auto
 
 lemma field_differentiable_add[derivative_intros]:
   "(f has_field_derivative f') F \<Longrightarrow> (g has_field_derivative g') F \<Longrightarrow>
     ((\<lambda>z. f z + g z) has_field_derivative f' + g') F"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_add])
      (auto simp: has_field_derivative_def field_simps mult_commute_abs)
 
 corollary DERIV_add:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow> (g has_field_derivative E) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x + g x) has_field_derivative D + E) (at x within s)"
   by (rule field_differentiable_add)
 
 lemma field_differentiable_minus[derivative_intros]:
   "(f has_field_derivative f') F \<Longrightarrow> ((\<lambda>z. - (f z)) has_field_derivative -f') F"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_minus])
      (auto simp: has_field_derivative_def field_simps mult_commute_abs)
 
 corollary DERIV_minus:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. - f x) has_field_derivative -D) (at x within s)"
   by (rule field_differentiable_minus)
 
 lemma field_differentiable_diff[derivative_intros]:
   "(f has_field_derivative f') F \<Longrightarrow>
     (g has_field_derivative g') F \<Longrightarrow> ((\<lambda>z. f z - g z) has_field_derivative f' - g') F"
   by (simp only: diff_conv_add_uminus field_differentiable_add field_differentiable_minus)
 
 corollary DERIV_diff:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     (g has_field_derivative E) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x - g x) has_field_derivative D - E) (at x within s)"
   by (rule field_differentiable_diff)
 
 lemma DERIV_continuous: "(f has_field_derivative D) (at x within s) \<Longrightarrow> continuous (at x within s) f"
   by (drule has_derivative_continuous[OF has_field_derivative_imp_has_derivative]) simp
 
 corollary DERIV_isCont: "DERIV f x :> D \<Longrightarrow> isCont f x"
   by (rule DERIV_continuous)
 
 lemma DERIV_atLeastAtMost_imp_continuous_on:
   assumes "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y"
   shows "continuous_on {a..b} f"
   by (meson DERIV_isCont assms atLeastAtMost_iff continuous_at_imp_continuous_at_within continuous_on_eq_continuous_within)
 
 lemma DERIV_continuous_on:
   "(\<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative (D x)) (at x within s)) \<Longrightarrow> continuous_on s f"
   unfolding continuous_on_eq_continuous_within
   by (intro continuous_at_imp_continuous_on ballI DERIV_continuous)
 
 lemma DERIV_mult':
   "(f has_field_derivative D) (at x within s) \<Longrightarrow> (g has_field_derivative E) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x * g x) has_field_derivative f x * E + D * g x) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_mult])
      (auto simp: field_simps mult_commute_abs dest: has_field_derivative_imp_has_derivative)
 
 lemma DERIV_mult[derivative_intros]:
   "(f has_field_derivative Da) (at x within s) \<Longrightarrow> (g has_field_derivative Db) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x * g x) has_field_derivative Da * g x + Db * f x) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_mult])
      (auto simp: field_simps dest: has_field_derivative_imp_has_derivative)
 
 text \<open>Derivative of linear multiplication\<close>
 
 lemma DERIV_cmult:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. c * f x) has_field_derivative c * D) (at x within s)"
   by (drule DERIV_mult' [OF DERIV_const]) simp
 
 lemma DERIV_cmult_right:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x * c) has_field_derivative D * c) (at x within s)"
   using DERIV_cmult by (auto simp add: ac_simps)
 
 lemma DERIV_cmult_Id [simp]: "((*) c has_field_derivative c) (at x within s)"
   using DERIV_ident [THEN DERIV_cmult, where c = c and x = x] by simp
 
 lemma DERIV_cdivide:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x / c) has_field_derivative D / c) (at x within s)"
   using DERIV_cmult_right[of f D x s "1 / c"] by simp
 
 lemma DERIV_unique: "DERIV f x :> D \<Longrightarrow> DERIV f x :> E \<Longrightarrow> D = E"
   unfolding DERIV_def by (rule LIM_unique)
 
 lemma DERIV_Uniq: "\<exists>\<^sub>\<le>\<^sub>1D. DERIV f x :> D"
   by (simp add: DERIV_unique Uniq_def)
 
 lemma DERIV_sum[derivative_intros]:
   "(\<And> n. n \<in> S \<Longrightarrow> ((\<lambda>x. f x n) has_field_derivative (f' x n)) F) \<Longrightarrow>
     ((\<lambda>x. sum (f x) S) has_field_derivative sum (f' x) S) F"
   by (rule has_derivative_imp_has_field_derivative [OF has_derivative_sum])
      (auto simp: sum_distrib_left mult_commute_abs dest: has_field_derivative_imp_has_derivative)
 
 lemma DERIV_inverse'[derivative_intros]:
   assumes "(f has_field_derivative D) (at x within s)"
     and "f x \<noteq> 0"
   shows "((\<lambda>x. inverse (f x)) has_field_derivative - (inverse (f x) * D * inverse (f x)))
     (at x within s)"
 proof -
   have "(f has_derivative (\<lambda>x. x * D)) = (f has_derivative (*) D)"
     by (rule arg_cong [of "\<lambda>x. x * D"]) (simp add: fun_eq_iff)
   with assms have "(f has_derivative (\<lambda>x. x * D)) (at x within s)"
     by (auto dest!: has_field_derivative_imp_has_derivative)
   then show ?thesis using \<open>f x \<noteq> 0\<close>
     by (auto intro: has_derivative_imp_has_field_derivative has_derivative_inverse)
 qed
 
 text \<open>Power of \<open>-1\<close>\<close>
 
 lemma DERIV_inverse:
   "x \<noteq> 0 \<Longrightarrow> ((\<lambda>x. inverse(x)) has_field_derivative - (inverse x ^ Suc (Suc 0))) (at x within s)"
   by (drule DERIV_inverse' [OF DERIV_ident]) simp
 
 text \<open>Derivative of inverse\<close>
 
 lemma DERIV_inverse_fun:
   "(f has_field_derivative d) (at x within s) \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow>
     ((\<lambda>x. inverse (f x)) has_field_derivative (- (d * inverse(f x ^ Suc (Suc 0))))) (at x within s)"
   by (drule (1) DERIV_inverse') (simp add: ac_simps nonzero_inverse_mult_distrib)
 
 text \<open>Derivative of quotient\<close>
 
 lemma DERIV_divide[derivative_intros]:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     (g has_field_derivative E) (at x within s) \<Longrightarrow> g x \<noteq> 0 \<Longrightarrow>
     ((\<lambda>x. f x / g x) has_field_derivative (D * g x - f x * E) / (g x * g x)) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_divide])
      (auto dest: has_field_derivative_imp_has_derivative simp: field_simps)
 
 lemma DERIV_quotient:
   "(f has_field_derivative d) (at x within s) \<Longrightarrow>
     (g has_field_derivative e) (at x within s)\<Longrightarrow> g x \<noteq> 0 \<Longrightarrow>
     ((\<lambda>y. f y / g y) has_field_derivative (d * g x - (e * f x)) / (g x ^ Suc (Suc 0))) (at x within s)"
   by (drule (2) DERIV_divide) (simp add: mult.commute)
 
 lemma DERIV_power_Suc:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x ^ Suc n) has_field_derivative (1 + of_nat n) * (D * f x ^ n)) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_power])
      (auto simp: has_field_derivative_def)
 
 lemma DERIV_power[derivative_intros]:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x ^ n) has_field_derivative of_nat n * (D * f x ^ (n - Suc 0))) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_power])
      (auto simp: has_field_derivative_def)
 
 lemma DERIV_pow: "((\<lambda>x. x ^ n) has_field_derivative real n * (x ^ (n - Suc 0))) (at x within s)"
   using DERIV_power [OF DERIV_ident] by simp
 
 lemma DERIV_power_int [derivative_intros]:
   assumes [derivative_intros]: "(f has_field_derivative d) (at x within s)" and [simp]: "f x \<noteq> 0"
   shows   "((\<lambda>x. power_int (f x) n) has_field_derivative
              (of_int n * power_int (f x) (n - 1) * d)) (at x within s)"
 proof (cases n rule: int_cases4)
   case (nonneg n)
   thus ?thesis 
     by (cases "n = 0")
        (auto intro!: derivative_eq_intros simp: field_simps power_int_diff
              simp flip: power_Suc power_Suc2 power_add)
 next
   case (neg n)
   thus ?thesis
     by (auto intro!: derivative_eq_intros simp: field_simps power_int_diff power_int_minus
              simp flip: power_Suc power_Suc2 power_add)
 qed
 
 lemma DERIV_chain': "(f has_field_derivative D) (at x within s) \<Longrightarrow> DERIV g (f x) :> E \<Longrightarrow>
   ((\<lambda>x. g (f x)) has_field_derivative E * D) (at x within s)"
   using has_derivative_compose[of f "(*) D" x s g "(*) E"]
   by (simp only: has_field_derivative_def mult_commute_abs ac_simps)
 
 corollary DERIV_chain2: "DERIV f (g x) :> Da \<Longrightarrow> (g has_field_derivative Db) (at x within s) \<Longrightarrow>
   ((\<lambda>x. f (g x)) has_field_derivative Da * Db) (at x within s)"
   by (rule DERIV_chain')
 
 text \<open>Standard version\<close>
 
 lemma DERIV_chain:
   "DERIV f (g x) :> Da \<Longrightarrow> (g has_field_derivative Db) (at x within s) \<Longrightarrow>
     (f \<circ> g has_field_derivative Da * Db) (at x within s)"
   by (drule (1) DERIV_chain', simp add: o_def mult.commute)
 
 lemma DERIV_image_chain:
   "(f has_field_derivative Da) (at (g x) within (g ` s)) \<Longrightarrow>
     (g has_field_derivative Db) (at x within s) \<Longrightarrow>
     (f \<circ> g has_field_derivative Da * Db) (at x within s)"
   using has_derivative_in_compose [of g "(*) Db" x s f "(*) Da "]
   by (simp add: has_field_derivative_def o_def mult_commute_abs ac_simps)
 
 (*These two are from HOL Light: HAS_COMPLEX_DERIVATIVE_CHAIN*)
 lemma DERIV_chain_s:
   assumes "(\<And>x. x \<in> s \<Longrightarrow> DERIV g x :> g'(x))"
     and "DERIV f x :> f'"
     and "f x \<in> s"
   shows "DERIV (\<lambda>x. g(f x)) x :> f' * g'(f x)"
   by (metis (full_types) DERIV_chain' mult.commute assms)
 
 lemma DERIV_chain3: (*HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV*)
   assumes "(\<And>x. DERIV g x :> g'(x))"
     and "DERIV f x :> f'"
   shows "DERIV (\<lambda>x. g(f x)) x :> f' * g'(f x)"
   by (metis UNIV_I DERIV_chain_s [of UNIV] assms)
 
 text \<open>Alternative definition for differentiability\<close>
 
 lemma DERIV_LIM_iff:
   fixes f :: "'a::{real_normed_vector,inverse} \<Rightarrow> 'a"
   shows "((\<lambda>h. (f (a + h) - f a) / h) \<midarrow>0\<rightarrow> D) = ((\<lambda>x. (f x - f a) / (x - a)) \<midarrow>a\<rightarrow> D)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "(\<lambda>x. (f (a + (x + - a)) - f a) / (x + - a)) \<midarrow>0 - - a\<rightarrow> D"
     by (rule LIM_offset)
   then show ?rhs
     by simp
 next
   assume ?rhs
   then have "(\<lambda>x. (f (x+a) - f a) / ((x+a) - a)) \<midarrow>a-a\<rightarrow> D"
     by (rule LIM_offset)
   then show ?lhs
     by (simp add: add.commute)
 qed
 
 lemma has_field_derivative_cong_ev:
   assumes "x = y"
     and *: "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x = g x) (nhds x)"
     and "u = v" "S = t" "x \<in> S"
   shows "(f has_field_derivative u) (at x within S) = (g has_field_derivative v) (at y within t)"
   unfolding has_field_derivative_iff
 proof (rule filterlim_cong)
   from assms have "f y = g y"
     by (auto simp: eventually_nhds)
   with * show "\<forall>\<^sub>F z in at x within S. (f z - f x) / (z - x) = (g z - g y) / (z - y)"
     unfolding eventually_at_filter
     by eventually_elim (auto simp: assms \<open>f y = g y\<close>)
 qed (simp_all add: assms)
 
 lemma has_field_derivative_cong_eventually:
   assumes "eventually (\<lambda>x. f x = g x) (at x within S)" "f x = g x"
   shows "(f has_field_derivative u) (at x within S) = (g has_field_derivative u) (at x within S)"
   unfolding has_field_derivative_iff
 proof (rule tendsto_cong)
   show "\<forall>\<^sub>F y in at x within S. (f y - f x) / (y - x) = (g y - g x) / (y - x)"
     using assms by (auto elim: eventually_mono)
 qed
 
 lemma DERIV_cong_ev:
   "x = y \<Longrightarrow> eventually (\<lambda>x. f x = g x) (nhds x) \<Longrightarrow> u = v \<Longrightarrow>
     DERIV f x :> u \<longleftrightarrow> DERIV g y :> v"
   by (rule has_field_derivative_cong_ev) simp_all
 
 lemma DERIV_shift:
   "(f has_field_derivative y) (at (x + z)) = ((\<lambda>x. f (x + z)) has_field_derivative y) (at x)"
   by (simp add: DERIV_def field_simps)
 
 lemma DERIV_mirror: "(DERIV f (- x) :> y) \<longleftrightarrow> (DERIV (\<lambda>x. f (- x)) x :> - y)"
   for f :: "real \<Rightarrow> real" and x y :: real
   by (simp add: DERIV_def filterlim_at_split filterlim_at_left_to_right
       tendsto_minus_cancel_left field_simps conj_commute)
 
 lemma floor_has_real_derivative:
   fixes f :: "real \<Rightarrow> 'a::{floor_ceiling,order_topology}"
   assumes "isCont f x"
     and "f x \<notin> \<int>"
   shows "((\<lambda>x. floor (f x)) has_real_derivative 0) (at x)"
 proof (subst DERIV_cong_ev[OF refl _ refl])
   show "((\<lambda>_. floor (f x)) has_real_derivative 0) (at x)"
     by simp
   have "\<forall>\<^sub>F y in at x. \<lfloor>f y\<rfloor> = \<lfloor>f x\<rfloor>"
     by (rule eventually_floor_eq[OF assms[unfolded continuous_at]])
   then show "\<forall>\<^sub>F y in nhds x. real_of_int \<lfloor>f y\<rfloor> = real_of_int \<lfloor>f x\<rfloor>"
     unfolding eventually_at_filter
     by eventually_elim auto
 qed
 
 lemmas has_derivative_floor[derivative_intros] =
   floor_has_real_derivative[THEN DERIV_compose_FDERIV]
 
 lemma continuous_floor:
   fixes x::real
   shows "x \<notin> \<int> \<Longrightarrow> continuous (at x) (real_of_int \<circ> floor)"
   using floor_has_real_derivative [where f=id]
   by (auto simp: o_def has_field_derivative_def intro: has_derivative_continuous)
 
 lemma continuous_frac:
   fixes x::real
   assumes "x \<notin> \<int>"
   shows "continuous (at x) frac"
 proof -
   have "isCont (\<lambda>x. real_of_int \<lfloor>x\<rfloor>) x"
     using continuous_floor [OF assms] by (simp add: o_def)
   then have *: "continuous (at x) (\<lambda>x. x - real_of_int \<lfloor>x\<rfloor>)"
     by (intro continuous_intros)
   moreover have "\<forall>\<^sub>F x in nhds x. frac x = x - real_of_int \<lfloor>x\<rfloor>"
     by (simp add: frac_def)
   ultimately show ?thesis
     by (simp add: LIM_imp_LIM frac_def isCont_def)
 qed
 
 text \<open>Caratheodory formulation of derivative at a point\<close>
 
 lemma CARAT_DERIV:
   "(DERIV f x :> l) \<longleftrightarrow> (\<exists>g. (\<forall>z. f z - f x = g z * (z - x)) \<and> isCont g x \<and> g x = l)"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   show "\<exists>g. (\<forall>z. f z - f x = g z * (z - x)) \<and> isCont g x \<and> g x = l"
   proof (intro exI conjI)
     let ?g = "(\<lambda>z. if z = x then l else (f z - f x) / (z-x))"
     show "\<forall>z. f z - f x = ?g z * (z - x)"
       by simp
     show "isCont ?g x"
       using \<open>?lhs\<close> by (simp add: isCont_iff DERIV_def cong: LIM_equal [rule_format])
     show "?g x = l"
       by simp
   qed
 next
   assume ?rhs
   then show ?lhs
     by (auto simp add: isCont_iff DERIV_def cong: LIM_cong)
 qed
 
 
 subsection \<open>Local extrema\<close>
 
 text \<open>If \<^term>\<open>0 < f' x\<close> then \<^term>\<open>x\<close> is Locally Strictly Increasing At The Right.\<close>
 
 lemma has_real_derivative_pos_inc_right:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "(f has_real_derivative l) (at x within S)"
     and l: "0 < l"
   shows "\<exists>d > 0. \<forall>h > 0. x + h \<in> S \<longrightarrow> h < d \<longrightarrow> f x < f (x + h)"
   using assms
 proof -
   from der [THEN has_field_derivativeD, THEN tendstoD, OF l, unfolded eventually_at]
   obtain s where s: "0 < s"
     and all: "\<And>xa. xa\<in>S \<Longrightarrow> xa \<noteq> x \<and> dist xa x < s \<longrightarrow> \<bar>(f xa - f x) / (xa - x) - l\<bar> < l"
     by (auto simp: dist_real_def)
   then show ?thesis
   proof (intro exI conjI strip)
     show "0 < s" by (rule s)
   next
     fix h :: real
     assume "0 < h" "h < s" "x + h \<in> S"
     with all [of "x + h"] show "f x < f (x+h)"
     proof (simp add: abs_if dist_real_def pos_less_divide_eq split: if_split_asm)
       assume "\<not> (f (x + h) - f x) / h < l" and h: "0 < h"
       with l have "0 < (f (x + h) - f x) / h"
         by arith
       then show "f x < f (x + h)"
         by (simp add: pos_less_divide_eq h)
     qed
   qed
 qed
 
 lemma DERIV_pos_inc_right:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "DERIV f x :> l"
     and l: "0 < l"
   shows "\<exists>d > 0. \<forall>h > 0. h < d \<longrightarrow> f x < f (x + h)"
   using has_real_derivative_pos_inc_right[OF assms]
   by auto
 
 lemma has_real_derivative_neg_dec_left:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "(f has_real_derivative l) (at x within S)"
     and "l < 0"
   shows "\<exists>d > 0. \<forall>h > 0. x - h \<in> S \<longrightarrow> h < d \<longrightarrow> f x < f (x - h)"
 proof -
   from \<open>l < 0\<close> have l: "- l > 0"
     by simp
   from der [THEN has_field_derivativeD, THEN tendstoD, OF l, unfolded eventually_at]
   obtain s where s: "0 < s"
     and all: "\<And>xa. xa\<in>S \<Longrightarrow> xa \<noteq> x \<and> dist xa x < s \<longrightarrow> \<bar>(f xa - f x) / (xa - x) - l\<bar> < - l"
     by (auto simp: dist_real_def)
   then show ?thesis
   proof (intro exI conjI strip)
     show "0 < s" by (rule s)
   next
     fix h :: real
     assume "0 < h" "h < s" "x - h \<in> S"
     with all [of "x - h"] show "f x < f (x-h)"
     proof (simp add: abs_if pos_less_divide_eq dist_real_def split: if_split_asm)
       assume "- ((f (x-h) - f x) / h) < l" and h: "0 < h"
       with l have "0 < (f (x-h) - f x) / h"
         by arith
       then show "f x < f (x - h)"
         by (simp add: pos_less_divide_eq h)
     qed
   qed
 qed
 
 lemma DERIV_neg_dec_left:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "DERIV f x :> l"
     and l: "l < 0"
   shows "\<exists>d > 0. \<forall>h > 0. h < d \<longrightarrow> f x < f (x - h)"
   using has_real_derivative_neg_dec_left[OF assms]
   by auto
 
 lemma has_real_derivative_pos_inc_left:
   fixes f :: "real \<Rightarrow> real"
   shows "(f has_real_derivative l) (at x within S) \<Longrightarrow> 0 < l \<Longrightarrow>
     \<exists>d>0. \<forall>h>0. x - h \<in> S \<longrightarrow> h < d \<longrightarrow> f (x - h) < f x"
   by (rule has_real_derivative_neg_dec_left [of "\<lambda>x. - f x" "-l" x S, simplified])
       (auto simp add: DERIV_minus)
 
 lemma DERIV_pos_inc_left:
   fixes f :: "real \<Rightarrow> real"
   shows "DERIV f x :> l \<Longrightarrow> 0 < l \<Longrightarrow> \<exists>d > 0. \<forall>h > 0. h < d \<longrightarrow> f (x - h) < f x"
   using has_real_derivative_pos_inc_left
   by blast
 
 lemma has_real_derivative_neg_dec_right:
   fixes f :: "real \<Rightarrow> real"
   shows "(f has_real_derivative l) (at x within S) \<Longrightarrow> l < 0 \<Longrightarrow>
     \<exists>d > 0. \<forall>h > 0. x + h \<in> S \<longrightarrow> h < d \<longrightarrow> f x > f (x + h)"
   by (rule has_real_derivative_pos_inc_right [of "\<lambda>x. - f x" "-l" x S, simplified])
       (auto simp add: DERIV_minus)
 
 lemma DERIV_neg_dec_right:
   fixes f :: "real \<Rightarrow> real"
   shows "DERIV f x :> l \<Longrightarrow> l < 0 \<Longrightarrow> \<exists>d > 0. \<forall>h > 0. h < d \<longrightarrow> f x > f (x + h)"
   using has_real_derivative_neg_dec_right by blast
 
 lemma DERIV_local_max:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "DERIV f x :> l"
     and d: "0 < d"
     and le: "\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> f y \<le> f x"
   shows "l = 0"
 proof (cases rule: linorder_cases [of l 0])
   case equal
   then show ?thesis .
 next
   case less
   from DERIV_neg_dec_left [OF der less]
   obtain d' where d': "0 < d'" and lt: "\<forall>h > 0. h < d' \<longrightarrow> f x < f (x - h)"
     by blast
   obtain e where "0 < e \<and> e < d \<and> e < d'"
     using field_lbound_gt_zero [OF d d']  ..
   with lt le [THEN spec [where x="x - e"]] show ?thesis
     by (auto simp add: abs_if)
 next
   case greater
   from DERIV_pos_inc_right [OF der greater]
   obtain d' where d': "0 < d'" and lt: "\<forall>h > 0. h < d' \<longrightarrow> f x < f (x + h)"
     by blast
   obtain e where "0 < e \<and> e < d \<and> e < d'"
     using field_lbound_gt_zero [OF d d'] ..
   with lt le [THEN spec [where x="x + e"]] show ?thesis
     by (auto simp add: abs_if)
 qed
 
 text \<open>Similar theorem for a local minimum\<close>
 lemma DERIV_local_min:
   fixes f :: "real \<Rightarrow> real"
   shows "DERIV f x :> l \<Longrightarrow> 0 < d \<Longrightarrow> \<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> f x \<le> f y \<Longrightarrow> l = 0"
   by (drule DERIV_minus [THEN DERIV_local_max]) auto
 
 
 text\<open>In particular, if a function is locally flat\<close>
 lemma DERIV_local_const:
   fixes f :: "real \<Rightarrow> real"
   shows "DERIV f x :> l \<Longrightarrow> 0 < d \<Longrightarrow> \<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> f x = f y \<Longrightarrow> l = 0"
   by (auto dest!: DERIV_local_max)
 
 
 subsection \<open>Rolle's Theorem\<close>
 
 text \<open>Lemma about introducing open ball in open interval\<close>
 lemma lemma_interval_lt: 
   fixes a b x :: real
   assumes "a < x" "x < b"
   shows "\<exists>d. 0 < d \<and> (\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> a < y \<and> y < b)"
   using linorder_linear [of "x - a" "b - x"]
 proof 
   assume "x - a \<le> b - x"
   with assms show ?thesis
     by (rule_tac x = "x - a" in exI) auto
 next
   assume "b - x \<le> x - a"
   with assms show ?thesis
     by (rule_tac x = "b - x" in exI) auto
 qed
 
 lemma lemma_interval: "a < x \<Longrightarrow> x < b \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b)"
   for a b x :: real
   by (force dest: lemma_interval_lt)
 
 text \<open>Rolle's Theorem.
    If \<^term>\<open>f\<close> is defined and continuous on the closed interval
    \<open>[a,b]\<close> and differentiable on the open interval \<open>(a,b)\<close>,
    and \<^term>\<open>f a = f b\<close>,
    then there exists \<open>x0 \<in> (a,b)\<close> such that \<^term>\<open>f' x0 = 0\<close>\<close>
 theorem Rolle_deriv:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b"
     and fab: "f a = f b"
     and contf: "continuous_on {a..b} f"
     and derf: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x)"
   shows "\<exists>z. a < z \<and> z < b \<and> f' z = (\<lambda>v. 0)"
 proof -
   have le: "a \<le> b"
     using \<open>a < b\<close> by simp
     have "(a + b) / 2 \<in> {a..b}"
       using assms(1) by auto
     then have *: "{a..b} \<noteq> {}"
       by auto
   obtain x where x_max: "\<forall>z. a \<le> z \<and> z \<le> b \<longrightarrow> f z \<le> f x" and "a \<le> x" "x \<le> b"
     using continuous_attains_sup[OF compact_Icc * contf]
     by (meson atLeastAtMost_iff)
   obtain x' where x'_min: "\<forall>z. a \<le> z \<and> z \<le> b \<longrightarrow> f x' \<le> f z" and "a \<le> x'" "x' \<le> b"
     using continuous_attains_inf[OF compact_Icc * contf] by (meson atLeastAtMost_iff)
   consider "a < x" "x < b" | "x = a \<or> x = b"
     using \<open>a \<le> x\<close> \<open>x \<le> b\<close> by arith
   then show ?thesis
   proof cases
     case 1
     \<comment> \<open>\<^term>\<open>f\<close> attains its maximum within the interval\<close>
     then obtain l where der: "DERIV f x :> l"
       using derf differentiable_def real_differentiable_def by blast
     obtain d where d: "0 < d" and bound: "\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
       using lemma_interval [OF 1] by blast
     then have bound': "\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> f y \<le> f x"
       using x_max by blast
     \<comment> \<open>the derivative at a local maximum is zero\<close>
     have "l = 0"
       by (rule DERIV_local_max [OF der d bound'])
     with 1 der derf [of x] show ?thesis
       by (metis has_derivative_unique has_field_derivative_def mult_zero_left)
   next
     case 2
     then have fx: "f b = f x" by (auto simp add: fab)
     consider "a < x'" "x' < b" | "x' = a \<or> x' = b"
       using \<open>a \<le> x'\<close> \<open>x' \<le> b\<close> by arith
     then show ?thesis
     proof cases
       case 1
         \<comment> \<open>\<^term>\<open>f\<close> attains its minimum within the interval\<close>
       then obtain l where der: "DERIV f x' :> l"
         using derf differentiable_def real_differentiable_def by blast 
       from lemma_interval [OF 1]
       obtain d where d: "0<d" and bound: "\<forall>y. \<bar>x'-y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
         by blast
       then have bound': "\<forall>y. \<bar>x' - y\<bar> < d \<longrightarrow> f x' \<le> f y"
         using x'_min by blast
       have "l = 0" by (rule DERIV_local_min [OF der d bound'])
         \<comment> \<open>the derivative at a local minimum is zero\<close>
       then show ?thesis using 1 der derf [of x'] 
         by (metis has_derivative_unique has_field_derivative_def mult_zero_left)
     next
       case 2
         \<comment> \<open>\<^term>\<open>f\<close> is constant throughout the interval\<close>
       then have fx': "f b = f x'" by (auto simp: fab)
       from dense [OF \<open>a < b\<close>] obtain r where r: "a < r" "r < b" by blast
       obtain d where d: "0 < d" and bound: "\<forall>y. \<bar>r - y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
         using lemma_interval [OF r] by blast
       have eq_fb: "f z = f b" if "a \<le> z" and "z \<le> b" for z
       proof (rule order_antisym)
         show "f z \<le> f b" by (simp add: fx x_max that)
         show "f b \<le> f z" by (simp add: fx' x'_min that)
       qed
       have bound': "\<forall>y. \<bar>r - y\<bar> < d \<longrightarrow> f r = f y"
       proof (intro strip)
         fix y :: real
         assume lt: "\<bar>r - y\<bar> < d"
         then have "f y = f b" by (simp add: eq_fb bound)
         then show "f r = f y" by (simp add: eq_fb r order_less_imp_le)
       qed
       obtain l where der: "DERIV f r :> l"
         using derf differentiable_def r(1) r(2) real_differentiable_def by blast
       have "l = 0"
         by (rule DERIV_local_const [OF der d bound'])
         \<comment> \<open>the derivative of a constant function is zero\<close>
       with r der derf [of r] show ?thesis
         by (metis has_derivative_unique has_field_derivative_def mult_zero_left)
     qed
   qed
 qed
 
 corollary Rolle:
   fixes a b :: real
   assumes ab: "a < b" "f a = f b" "continuous_on {a..b} f"
     and dif [rule_format]: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> f differentiable (at x)"
   shows "\<exists>z. a < z \<and> z < b \<and> DERIV f z :> 0"
 proof -
   obtain f' where f': "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x)"
     using dif unfolding differentiable_def by metis
   then have "\<exists>z. a < z \<and> z < b \<and> f' z = (\<lambda>v. 0)"
     by (metis Rolle_deriv [OF ab])
   then show ?thesis
     using f' has_derivative_imp_has_field_derivative by fastforce
 qed
 
 subsection \<open>Mean Value Theorem\<close>
 
 theorem mvt:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b"
     and contf: "continuous_on {a..b} f"
     and derf: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x)"
   obtains \<xi> where "a < \<xi>" "\<xi> < b" "f b - f a = (f' \<xi>) (b - a)"
 proof -
   have "\<exists>x. a < x \<and> x < b \<and> (\<lambda>y. f' x y - (f b - f a) / (b - a) * y) = (\<lambda>v. 0)"
   proof (intro Rolle_deriv[OF \<open>a < b\<close>])
     fix x
     assume x: "a < x" "x < b"
     show "((\<lambda>x. f x - (f b - f a) / (b - a) * x) 
           has_derivative (\<lambda>y. f' x y - (f b - f a) / (b - a) * y)) (at x)"
       by (intro derivative_intros derf[OF x])
   qed (use assms in \<open>auto intro!: continuous_intros simp: field_simps\<close>)
   then obtain \<xi> where
     "a < \<xi>" "\<xi> < b" "(\<lambda>y. f' \<xi> y - (f b - f a) / (b - a) * y) = (\<lambda>v. 0)" 
     by metis
   then show ?thesis
     by (metis (no_types, hide_lams) that add.right_neutral add_diff_cancel_left' add_diff_eq \<open>a < b\<close>
                  less_irrefl nonzero_eq_divide_eq)
 qed
 
 theorem MVT:
   fixes a b :: real
   assumes lt: "a < b"
     and contf: "continuous_on {a..b} f"
     and dif: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> f differentiable (at x)"
   shows "\<exists>l z. a < z \<and> z < b \<and> DERIV f z :> l \<and> f b - f a = (b - a) * l"
 proof -
   obtain f' :: "real \<Rightarrow> real \<Rightarrow> real"
     where derf: "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (f has_derivative f' x) (at x)"
     using dif unfolding differentiable_def by metis
   then obtain z where "a < z" "z < b" "f b - f a = (f' z) (b - a)"
     using mvt [OF lt contf] by blast
   then show ?thesis
     by (simp add: ac_simps)
       (metis derf dif has_derivative_unique has_field_derivative_imp_has_derivative real_differentiable_def)
 qed
 
 corollary MVT2:
   assumes "a < b" and der: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> DERIV f x :> f' x"
   shows "\<exists>z::real. a < z \<and> z < b \<and> (f b - f a = (b - a) * f' z)"
 proof -
   have "\<exists>l z. a < z \<and>
            z < b \<and>
            (f has_real_derivative l) (at z) \<and>
            f b - f a = (b - a) * l"
   proof (rule MVT [OF \<open>a < b\<close>])
     show "continuous_on {a..b} f"
       by (meson DERIV_continuous atLeastAtMost_iff continuous_at_imp_continuous_on der) 
     show "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> f differentiable (at x)"
       using assms by (force dest: order_less_imp_le simp add: real_differentiable_def)
   qed
   with assms show ?thesis
     by (blast dest: DERIV_unique order_less_imp_le)
 qed
 
 lemma pos_deriv_imp_strict_mono:
   assumes "\<And>x. (f has_real_derivative f' x) (at x)"
   assumes "\<And>x. f' x > 0"
   shows   "strict_mono f"
 proof (rule strict_monoI)
   fix x y :: real assume xy: "x < y"
   from assms and xy have "\<exists>z>x. z < y \<and> f y - f x = (y - x) * f' z"
     by (intro MVT2) (auto dest: connectedD_interval)
   then obtain z where z: "z > x" "z < y" "f y - f x = (y - x) * f' z" by blast
   note \<open>f y - f x = (y - x) * f' z\<close>
   also have "(y - x) * f' z > 0" using xy assms by (intro mult_pos_pos) auto
   finally show "f x < f y" by simp
 qed
 
 proposition  deriv_nonneg_imp_mono:
   assumes deriv: "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_real_derivative g' x) (at x)"
   assumes nonneg: "\<And>x. x \<in> {a..b} \<Longrightarrow> g' x \<ge> 0"
   assumes ab: "a \<le> b"
   shows "g a \<le> g b"
 proof (cases "a < b")
   assume "a < b"
   from deriv have "\<And>x. \<lbrakk>x \<ge> a; x \<le> b\<rbrakk> \<Longrightarrow> (g has_real_derivative g' x) (at x)" by simp
   with MVT2[OF \<open>a < b\<close>] and deriv
     obtain \<xi> where \<xi>_ab: "\<xi> > a" "\<xi> < b" and g_ab: "g b - g a = (b - a) * g' \<xi>" by blast
   from \<xi>_ab ab nonneg have "(b - a) * g' \<xi> \<ge> 0" by simp
   with g_ab show ?thesis by simp
 qed (insert ab, simp)
 
 
 subsubsection \<open>A function is constant if its derivative is 0 over an interval.\<close>
 
 lemma DERIV_isconst_end:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b" and contf: "continuous_on {a..b} f"
     and 0: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> DERIV f x :> 0"
   shows "f b = f a"
   using MVT [OF \<open>a < b\<close>] "0" DERIV_unique contf real_differentiable_def
   by (fastforce simp: algebra_simps)
 
 lemma DERIV_isconst2:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b" and contf: "continuous_on {a..b} f" and derf: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> DERIV f x :> 0"
     and "a \<le> x" "x \<le> b"
 shows "f x = f a"
 proof (cases "a < x")
   case True
   have *: "continuous_on {a..x} f"
     using \<open>x \<le> b\<close> contf continuous_on_subset by fastforce
   show ?thesis
     by (rule DERIV_isconst_end [OF True *]) (use \<open>x \<le> b\<close> derf in auto)
 qed (use \<open>a \<le> x\<close> in auto)
 
 lemma DERIV_isconst3:
   fixes a b x y :: real
   assumes "a < b"
     and "x \<in> {a <..< b}"
     and "y \<in> {a <..< b}"
     and derivable: "\<And>x. x \<in> {a <..< b} \<Longrightarrow> DERIV f x :> 0"
   shows "f x = f y"
 proof (cases "x = y")
   case False
   let ?a = "min x y"
   let ?b = "max x y"
   have *: "DERIV f z :> 0" if "?a \<le> z" "z \<le> ?b" for z
   proof -
     have "a < z" and "z < b"
       using that \<open>x \<in> {a <..< b}\<close> and \<open>y \<in> {a <..< b}\<close> by auto
     then have "z \<in> {a<..<b}" by auto
     then show "DERIV f z :> 0" by (rule derivable)
   qed
   have isCont: "continuous_on {?a..?b} f"
     by (meson * DERIV_continuous_on atLeastAtMost_iff has_field_derivative_at_within)
   have DERIV: "\<And>z. \<lbrakk>?a < z; z < ?b\<rbrakk> \<Longrightarrow> DERIV f z :> 0"
     using * by auto
   have "?a < ?b" using \<open>x \<noteq> y\<close> by auto
   from DERIV_isconst2[OF this isCont DERIV, of x] and DERIV_isconst2[OF this isCont DERIV, of y]
   show ?thesis by auto
 qed auto
 
 lemma DERIV_isconst_all:
   fixes f :: "real \<Rightarrow> real"
   shows "\<forall>x. DERIV f x :> 0 \<Longrightarrow> f x = f y"
   apply (rule linorder_cases [of x y])
   apply (metis DERIV_continuous DERIV_isconst_end continuous_at_imp_continuous_on)+
   done
 
 lemma DERIV_const_ratio_const:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<noteq> b" and df: "\<And>x. DERIV f x :> k"
   shows "f b - f a = (b - a) * k"
 proof (cases a b rule: linorder_cases)
   case less
   show ?thesis
     using MVT [OF less] df
     by (metis DERIV_continuous DERIV_unique continuous_at_imp_continuous_on real_differentiable_def)
 next
   case greater
   have  "f a - f b = (a - b) * k"
     using MVT [OF greater] df
     by (metis DERIV_continuous DERIV_unique continuous_at_imp_continuous_on real_differentiable_def)
   then show ?thesis
     by (simp add: algebra_simps)
 qed auto
 
 lemma DERIV_const_ratio_const2:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<noteq> b" and df: "\<And>x. DERIV f x :> k"
   shows "(f b - f a) / (b - a) = k"
   using DERIV_const_ratio_const [OF assms] \<open>a \<noteq> b\<close> by auto
 
 lemma real_average_minus_first [simp]: "(a + b) / 2 - a = (b - a) / 2"
   for a b :: real
   by simp
 
 lemma real_average_minus_second [simp]: "(b + a) / 2 - a = (b - a) / 2"
   for a b :: real
   by simp
 
 text \<open>Gallileo's "trick": average velocity = av. of end velocities.\<close>
 
 lemma DERIV_const_average:
   fixes v :: "real \<Rightarrow> real"
     and a b :: real
   assumes neq: "a \<noteq> b"
     and der: "\<And>x. DERIV v x :> k"
   shows "v ((a + b) / 2) = (v a + v b) / 2"
 proof (cases rule: linorder_cases [of a b])
   case equal
   with neq show ?thesis by simp
 next
   case less
   have "(v b - v a) / (b - a) = k"
     by (rule DERIV_const_ratio_const2 [OF neq der])
   then have "(b - a) * ((v b - v a) / (b - a)) = (b - a) * k"
     by simp
   moreover have "(v ((a + b) / 2) - v a) / ((a + b) / 2 - a) = k"
     by (rule DERIV_const_ratio_const2 [OF _ der]) (simp add: neq)
   ultimately show ?thesis
     using neq by force
 next
   case greater
   have "(v b - v a) / (b - a) = k"
     by (rule DERIV_const_ratio_const2 [OF neq der])
   then have "(b - a) * ((v b - v a) / (b - a)) = (b - a) * k"
     by simp
   moreover have " (v ((b + a) / 2) - v a) / ((b + a) / 2 - a) = k"
     by (rule DERIV_const_ratio_const2 [OF _ der]) (simp add: neq)
   ultimately show ?thesis
     using neq by (force simp add: add.commute)
 qed
 
 subsubsection\<open>A function with positive derivative is increasing\<close>
 text \<open>A simple proof using the MVT, by Jeremy Avigad. And variants.\<close>
 lemma DERIV_pos_imp_increasing_open:
   fixes a b :: real
     and f :: "real \<Rightarrow> real"
   assumes "a < b"
     and "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (\<exists>y. DERIV f x :> y \<and> y > 0)"
     and con: "continuous_on {a..b} f"
   shows "f a < f b"
 proof (rule ccontr)
   assume f: "\<not> ?thesis"
   have "\<exists>l z. a < z \<and> z < b \<and> DERIV f z :> l \<and> f b - f a = (b - a) * l"
     by (rule MVT) (use assms real_differentiable_def in \<open>force+\<close>)
   then obtain l z where z: "a < z" "z < b" "DERIV f z :> l" and "f b - f a = (b - a) * l"
     by auto
   with assms f have "\<not> l > 0"
     by (metis linorder_not_le mult_le_0_iff diff_le_0_iff_le)
   with assms z show False
     by (metis DERIV_unique)
 qed
 
 lemma DERIV_pos_imp_increasing:
   fixes a b :: real and f :: "real \<Rightarrow> real"
   assumes "a < b"
     and der: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y > 0"
   shows "f a < f b"
   by (metis less_le_not_le DERIV_atLeastAtMost_imp_continuous_on DERIV_pos_imp_increasing_open [OF \<open>a < b\<close>] der)
 
 lemma DERIV_nonneg_imp_nondecreasing:
   fixes a b :: real
     and f :: "real \<Rightarrow> real"
   assumes "a \<le> b"
     and "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y \<ge> 0"
   shows "f a \<le> f b"
 proof (rule ccontr, cases "a = b")
   assume "\<not> ?thesis" and "a = b"
   then show False by auto
 next
   assume *: "\<not> ?thesis"
   assume "a \<noteq> b"
   with \<open>a \<le> b\<close> have "a < b"
     by linarith
   moreover have "continuous_on {a..b} f"
     by (meson DERIV_isCont assms(2) atLeastAtMost_iff continuous_at_imp_continuous_on)
   ultimately have "\<exists>l z. a < z \<and> z < b \<and> DERIV f z :> l \<and> f b - f a = (b - a) * l"
     using assms MVT [OF \<open>a < b\<close>, of f] real_differentiable_def less_eq_real_def by blast
   then obtain l z where lz: "a < z" "z < b" "DERIV f z :> l" and **: "f b - f a = (b - a) * l"
     by auto
   with * have "a < b" "f b < f a" by auto
   with ** have "\<not> l \<ge> 0" by (auto simp add: not_le algebra_simps)
     (metis * add_le_cancel_right assms(1) less_eq_real_def mult_right_mono add_left_mono linear order_refl)
   with assms lz show False
     by (metis DERIV_unique order_less_imp_le)
 qed
 
 lemma DERIV_neg_imp_decreasing_open:
   fixes a b :: real
     and f :: "real \<Rightarrow> real"
   assumes "a < b"
     and "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y < 0"
     and con: "continuous_on {a..b} f"
   shows "f a > f b"
 proof -
   have "(\<lambda>x. -f x) a < (\<lambda>x. -f x) b"
   proof (rule DERIV_pos_imp_increasing_open [of a b])
     show "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> \<exists>y. ((\<lambda>x. - f x) has_real_derivative y) (at x) \<and> 0 < y"
       using assms
       by simp (metis field_differentiable_minus neg_0_less_iff_less)
     show "continuous_on {a..b} (\<lambda>x. - f x)"
       using con continuous_on_minus by blast
   qed (use assms in auto)
   then show ?thesis
     by simp
 qed
 
 lemma DERIV_neg_imp_decreasing:
   fixes a b :: real and f :: "real \<Rightarrow> real"
   assumes "a < b"
     and der: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y < 0"
   shows "f a > f b"
   by (metis less_le_not_le DERIV_atLeastAtMost_imp_continuous_on DERIV_neg_imp_decreasing_open [OF \<open>a < b\<close>] der)
 
 lemma DERIV_nonpos_imp_nonincreasing:
   fixes a b :: real
     and f :: "real \<Rightarrow> real"
   assumes "a \<le> b"
     and "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y \<le> 0"
   shows "f a \<ge> f b"
 proof -
   have "(\<lambda>x. -f x) a \<le> (\<lambda>x. -f x) b"
     using DERIV_nonneg_imp_nondecreasing [of a b "\<lambda>x. -f x"] assms DERIV_minus by fastforce
   then show ?thesis
     by simp
 qed
 
 lemma DERIV_pos_imp_increasing_at_bot:
   fixes f :: "real \<Rightarrow> real"
   assumes "\<And>x. x \<le> b \<Longrightarrow> (\<exists>y. DERIV f x :> y \<and> y > 0)"
     and lim: "(f \<longlongrightarrow> flim) at_bot"
   shows "flim < f b"
 proof -
   have "\<exists>N. \<forall>n\<le>N. f n \<le> f (b - 1)"
     by (rule_tac x="b - 2" in exI) (force intro: order.strict_implies_order DERIV_pos_imp_increasing assms)
   then have "flim \<le> f (b - 1)"
      by (auto simp: eventually_at_bot_linorder tendsto_upperbound [OF lim])
   also have "\<dots> < f b"
     by (force intro: DERIV_pos_imp_increasing [where f=f] assms)
   finally show ?thesis .
 qed
 
 lemma DERIV_neg_imp_decreasing_at_top:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "\<And>x. x \<ge> b \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y < 0"
     and lim: "(f \<longlongrightarrow> flim) at_top"
   shows "flim < f b"
   apply (rule DERIV_pos_imp_increasing_at_bot [where f = "\<lambda>i. f (-i)" and b = "-b", simplified])
    apply (metis DERIV_mirror der le_minus_iff neg_0_less_iff_less)
   apply (metis filterlim_at_top_mirror lim)
   done
 
 text \<open>Derivative of inverse function\<close>
 
 lemma DERIV_inverse_function:
   fixes f g :: "real \<Rightarrow> real"
   assumes der: "DERIV f (g x) :> D"
     and neq: "D \<noteq> 0"
     and x: "a < x" "x < b"
     and inj: "\<And>y. \<lbrakk>a < y; y < b\<rbrakk> \<Longrightarrow> f (g y) = y"
     and cont: "isCont g x"
   shows "DERIV g x :> inverse D"
 unfolding has_field_derivative_iff
 proof (rule LIM_equal2)
   show "0 < min (x - a) (b - x)"
     using x by arith
 next
   fix y
   assume "norm (y - x) < min (x - a) (b - x)"
   then have "a < y" and "y < b"
     by (simp_all add: abs_less_iff)
   then show "(g y - g x) / (y - x) = inverse ((f (g y) - x) / (g y - g x))"
     by (simp add: inj)
 next
   have "(\<lambda>z. (f z - f (g x)) / (z - g x)) \<midarrow>g x\<rightarrow> D"
     by (rule der [unfolded has_field_derivative_iff])
   then have 1: "(\<lambda>z. (f z - x) / (z - g x)) \<midarrow>g x\<rightarrow> D"
     using inj x by simp
   have 2: "\<exists>d>0. \<forall>y. y \<noteq> x \<and> norm (y - x) < d \<longrightarrow> g y \<noteq> g x"
   proof (rule exI, safe)
     show "0 < min (x - a) (b - x)"
       using x by simp
   next
     fix y
     assume "norm (y - x) < min (x - a) (b - x)"
     then have y: "a < y" "y < b"
       by (simp_all add: abs_less_iff)
     assume "g y = g x"
     then have "f (g y) = f (g x)" by simp
     then have "y = x" using inj y x by simp
     also assume "y \<noteq> x"
     finally show False by simp
   qed
   have "(\<lambda>y. (f (g y) - x) / (g y - g x)) \<midarrow>x\<rightarrow> D"
     using cont 1 2 by (rule isCont_LIM_compose2)
   then show "(\<lambda>y. inverse ((f (g y) - x) / (g y - g x))) \<midarrow>x\<rightarrow> inverse D"
     using neq by (rule tendsto_inverse)
 qed
 
 subsection \<open>Generalized Mean Value Theorem\<close>
 
 theorem GMVT:
   fixes a b :: real
   assumes alb: "a < b"
     and fc: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x"
     and fd: "\<forall>x. a < x \<and> x < b \<longrightarrow> f differentiable (at x)"
     and gc: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont g x"
     and gd: "\<forall>x. a < x \<and> x < b \<longrightarrow> g differentiable (at x)"
   shows "\<exists>g'c f'c c.
     DERIV g c :> g'c \<and> DERIV f c :> f'c \<and> a < c \<and> c < b \<and> (f b - f a) * g'c = (g b - g a) * f'c"
 proof -
   let ?h = "\<lambda>x. (f b - f a) * g x - (g b - g a) * f x"
   have "\<exists>l z. a < z \<and> z < b \<and> DERIV ?h z :> l \<and> ?h b - ?h a = (b - a) * l"
   proof (rule MVT)
     from assms show "a < b" by simp
     show "continuous_on {a..b} ?h"
       by (simp add: continuous_at_imp_continuous_on fc gc)
     show "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> ?h differentiable (at x)"
       using fd gd by simp
   qed
   then obtain l where l: "\<exists>z. a < z \<and> z < b \<and> DERIV ?h z :> l \<and> ?h b - ?h a = (b - a) * l" ..
   then obtain c where c: "a < c \<and> c < b \<and> DERIV ?h c :> l \<and> ?h b - ?h a = (b - a) * l" ..
 
   from c have cint: "a < c \<and> c < b" by auto
   then obtain g'c where g'c: "DERIV g c :> g'c"
     using gd real_differentiable_def by blast 
   from c have "a < c \<and> c < b" by auto
   then obtain f'c where f'c: "DERIV f c :> f'c"
     using fd real_differentiable_def by blast 
 
   from c have "DERIV ?h c :> l" by auto
   moreover have "DERIV ?h c :>  g'c * (f b - f a) - f'c * (g b - g a)"
     using g'c f'c by (auto intro!: derivative_eq_intros)
   ultimately have leq: "l =  g'c * (f b - f a) - f'c * (g b - g a)" by (rule DERIV_unique)
 
   have "?h b - ?h a = (b - a) * (g'c * (f b - f a) - f'c * (g b - g a))"
   proof -
     from c have "?h b - ?h a = (b - a) * l" by auto
     also from leq have "\<dots> = (b - a) * (g'c * (f b - f a) - f'c * (g b - g a))" by simp
     finally show ?thesis by simp
   qed
   moreover have "?h b - ?h a = 0"
   proof -
     have "?h b - ?h a =
       ((f b)*(g b) - (f a)*(g b) - (g b)*(f b) + (g a)*(f b)) -
       ((f b)*(g a) - (f a)*(g a) - (g b)*(f a) + (g a)*(f a))"
       by (simp add: algebra_simps)
     then show ?thesis  by auto
   qed
   ultimately have "(b - a) * (g'c * (f b - f a) - f'c * (g b - g a)) = 0" by auto
   with alb have "g'c * (f b - f a) - f'c * (g b - g a) = 0" by simp
   then have "g'c * (f b - f a) = f'c * (g b - g a)" by simp
   then have "(f b - f a) * g'c = (g b - g a) * f'c" by (simp add: ac_simps)
   with g'c f'c cint show ?thesis by auto
 qed
 
 lemma GMVT':
   fixes f g :: "real \<Rightarrow> real"
   assumes "a < b"
     and isCont_f: "\<And>z. a \<le> z \<Longrightarrow> z \<le> b \<Longrightarrow> isCont f z"
     and isCont_g: "\<And>z. a \<le> z \<Longrightarrow> z \<le> b \<Longrightarrow> isCont g z"
     and DERIV_g: "\<And>z. a < z \<Longrightarrow> z < b \<Longrightarrow> DERIV g z :> (g' z)"
     and DERIV_f: "\<And>z. a < z \<Longrightarrow> z < b \<Longrightarrow> DERIV f z :> (f' z)"
   shows "\<exists>c. a < c \<and> c < b \<and> (f b - f a) * g' c = (g b - g a) * f' c"
 proof -
   have "\<exists>g'c f'c c. DERIV g c :> g'c \<and> DERIV f c :> f'c \<and>
       a < c \<and> c < b \<and> (f b - f a) * g'c = (g b - g a) * f'c"
     using assms by (intro GMVT) (force simp: real_differentiable_def)+
   then obtain c where "a < c" "c < b" "(f b - f a) * g' c = (g b - g a) * f' c"
     using DERIV_f DERIV_g by (force dest: DERIV_unique)
   then show ?thesis
     by auto
 qed
 
 
 subsection \<open>L'Hopitals rule\<close>
 
 lemma isCont_If_ge:
   fixes a :: "'a :: linorder_topology"
   assumes "continuous (at_left a) g" and f: "(f \<longlongrightarrow> g a) (at_right a)"
   shows "isCont (\<lambda>x. if x \<le> a then g x else f x) a" (is "isCont ?gf a")
 proof -
   have g: "(g \<longlongrightarrow> g a) (at_left a)"
     using assms continuous_within by blast
   show ?thesis
     unfolding isCont_def continuous_within
   proof (intro filterlim_split_at; simp)
     show "(?gf \<longlongrightarrow> g a) (at_left a)"
       by (subst filterlim_cong[OF refl refl, where g=g]) (simp_all add: eventually_at_filter less_le g)
     show "(?gf \<longlongrightarrow> g a) (at_right a)"
       by (subst filterlim_cong[OF refl refl, where g=f]) (simp_all add: eventually_at_filter less_le f)
   qed
 qed
 
 lemma lhopital_right_0:
   fixes f0 g0 :: "real \<Rightarrow> real"
   assumes f_0: "(f0 \<longlongrightarrow> 0) (at_right 0)"
     and g_0: "(g0 \<longlongrightarrow> 0) (at_right 0)"
     and ev:
       "eventually (\<lambda>x. g0 x \<noteq> 0) (at_right 0)"
       "eventually (\<lambda>x. g' x \<noteq> 0) (at_right 0)"
       "eventually (\<lambda>x. DERIV f0 x :> f' x) (at_right 0)"
       "eventually (\<lambda>x. DERIV g0 x :> g' x) (at_right 0)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) F (at_right 0)"
   shows "filterlim (\<lambda> x. f0 x / g0 x) F (at_right 0)"
 proof -
   define f where [abs_def]: "f x = (if x \<le> 0 then 0 else f0 x)" for x
   then have "f 0 = 0" by simp
 
   define g where [abs_def]: "g x = (if x \<le> 0 then 0 else g0 x)" for x
   then have "g 0 = 0" by simp
 
   have "eventually (\<lambda>x. g0 x \<noteq> 0 \<and> g' x \<noteq> 0 \<and>
       DERIV f0 x :> (f' x) \<and> DERIV g0 x :> (g' x)) (at_right 0)"
     using ev by eventually_elim auto
   then obtain a where [arith]: "0 < a"
     and g0_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g0 x \<noteq> 0"
     and g'_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g' x \<noteq> 0"
     and f0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> DERIV f0 x :> (f' x)"
     and g0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> DERIV g0 x :> (g' x)"
     unfolding eventually_at by (auto simp: dist_real_def)
 
   have g_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g x \<noteq> 0"
     using g0_neq_0 by (simp add: g_def)
 
   have f: "DERIV f x :> (f' x)" if x: "0 < x" "x < a" for x
     using that
     by (intro DERIV_cong_ev[THEN iffD1, OF _ _ _ f0[OF x]])
       (auto simp: f_def eventually_nhds_metric dist_real_def intro!: exI[of _ x])
 
   have g: "DERIV g x :> (g' x)" if x: "0 < x" "x < a" for x
     using that
     by (intro DERIV_cong_ev[THEN iffD1, OF _ _ _ g0[OF x]])
          (auto simp: g_def eventually_nhds_metric dist_real_def intro!: exI[of _ x])
 
   have "isCont f 0"
     unfolding f_def by (intro isCont_If_ge f_0 continuous_const)
 
   have "isCont g 0"
     unfolding g_def by (intro isCont_If_ge g_0 continuous_const)
 
   have "\<exists>\<zeta>. \<forall>x\<in>{0 <..< a}. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)"
   proof (rule bchoice, rule ballI)
     fix x
     assume "x \<in> {0 <..< a}"
     then have x[arith]: "0 < x" "x < a" by auto
     with g'_neq_0 g_neq_0 \<open>g 0 = 0\<close> have g': "\<And>x. 0 < x \<Longrightarrow> x < a  \<Longrightarrow> 0 \<noteq> g' x" "g 0 \<noteq> g x"
       by auto
     have "\<And>x. 0 \<le> x \<Longrightarrow> x < a \<Longrightarrow> isCont f x"
       using \<open>isCont f 0\<close> f by (auto intro: DERIV_isCont simp: le_less)
     moreover have "\<And>x. 0 \<le> x \<Longrightarrow> x < a \<Longrightarrow> isCont g x"
       using \<open>isCont g 0\<close> g by (auto intro: DERIV_isCont simp: le_less)
     ultimately have "\<exists>c. 0 < c \<and> c < x \<and> (f x - f 0) * g' c = (g x - g 0) * f' c"
       using f g \<open>x < a\<close> by (intro GMVT') auto
     then obtain c where *: "0 < c" "c < x" "(f x - f 0) * g' c = (g x - g 0) * f' c"
       by blast
     moreover
     from * g'(1)[of c] g'(2) have "(f x - f 0)  / (g x - g 0) = f' c / g' c"
       by (simp add: field_simps)
     ultimately show "\<exists>y. 0 < y \<and> y < x \<and> f x / g x = f' y / g' y"
       using \<open>f 0 = 0\<close> \<open>g 0 = 0\<close> by (auto intro!: exI[of _ c])
   qed
   then obtain \<zeta> where "\<forall>x\<in>{0 <..< a}. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)" ..
   then have \<zeta>: "eventually (\<lambda>x. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)) (at_right 0)"
     unfolding eventually_at by (intro exI[of _ a]) (auto simp: dist_real_def)
   moreover
   from \<zeta> have "eventually (\<lambda>x. norm (\<zeta> x) \<le> x) (at_right 0)"
     by eventually_elim auto
   then have "((\<lambda>x. norm (\<zeta> x)) \<longlongrightarrow> 0) (at_right 0)"
     by (rule_tac real_tendsto_sandwich[where f="\<lambda>x. 0" and h="\<lambda>x. x"]) auto
   then have "(\<zeta> \<longlongrightarrow> 0) (at_right 0)"
     by (rule tendsto_norm_zero_cancel)
   with \<zeta> have "filterlim \<zeta> (at_right 0) (at_right 0)"
     by (auto elim!: eventually_mono simp: filterlim_at)
   from this lim have "filterlim (\<lambda>t. f' (\<zeta> t) / g' (\<zeta> t)) F (at_right 0)"
     by (rule_tac filterlim_compose[of _ _ _ \<zeta>])
   ultimately have "filterlim (\<lambda>t. f t / g t) F (at_right 0)" (is ?P)
     by (rule_tac filterlim_cong[THEN iffD1, OF refl refl])
        (auto elim: eventually_mono)
   also have "?P \<longleftrightarrow> ?thesis"
     by (rule filterlim_cong) (auto simp: f_def g_def eventually_at_filter)
   finally show ?thesis .
 qed
 
 lemma lhopital_right:
   "(f \<longlongrightarrow> 0) (at_right x) \<Longrightarrow> (g \<longlongrightarrow> 0) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. g x \<noteq> 0) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at_right x) \<Longrightarrow>
     filterlim (\<lambda> x. (f' x / g' x)) F (at_right x) \<Longrightarrow>
   filterlim (\<lambda> x. f x / g x) F (at_right x)"
   for x :: real
   unfolding eventually_at_right_to_0[of _ x] filterlim_at_right_to_0[of _ _ x] DERIV_shift
   by (rule lhopital_right_0)
 
 lemma lhopital_left:
   "(f \<longlongrightarrow> 0) (at_left x) \<Longrightarrow> (g \<longlongrightarrow> 0) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. g x \<noteq> 0) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at_left x) \<Longrightarrow>
     filterlim (\<lambda> x. (f' x / g' x)) F (at_left x) \<Longrightarrow>
   filterlim (\<lambda> x. f x / g x) F (at_left x)"
   for x :: real
   unfolding eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror
   by (rule lhopital_right[where f'="\<lambda>x. - f' (- x)"]) (auto simp: DERIV_mirror)
 
 lemma lhopital:
   "(f \<longlongrightarrow> 0) (at x) \<Longrightarrow> (g \<longlongrightarrow> 0) (at x) \<Longrightarrow>
     eventually (\<lambda>x. g x \<noteq> 0) (at x) \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at x) \<Longrightarrow>
     filterlim (\<lambda> x. (f' x / g' x)) F (at x) \<Longrightarrow>
   filterlim (\<lambda> x. f x / g x) F (at x)"
   for x :: real
   unfolding eventually_at_split filterlim_at_split
   by (auto intro!: lhopital_right[of f x g g' f'] lhopital_left[of f x g g' f'])
 
 
 lemma lhopital_right_0_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes g_0: "LIM x at_right 0. g x :> at_top"
     and ev:
       "eventually (\<lambda>x. g' x \<noteq> 0) (at_right 0)"
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_right 0)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_right 0)"
     and lim: "((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> x) (at_right 0)"
   shows "((\<lambda> x. f x / g x) \<longlongrightarrow> x) (at_right 0)"
   unfolding tendsto_iff
 proof safe
   fix e :: real
   assume "0 < e"
   with lim[unfolded tendsto_iff, rule_format, of "e / 4"]
   have "eventually (\<lambda>t. dist (f' t / g' t) x < e / 4) (at_right 0)"
     by simp
   from eventually_conj[OF eventually_conj[OF ev(1) ev(2)] eventually_conj[OF ev(3) this]]
   obtain a where [arith]: "0 < a"
     and g'_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g' x \<noteq> 0"
     and f0: "\<And>x. 0 < x \<Longrightarrow> x \<le> a \<Longrightarrow> DERIV f x :> (f' x)"
     and g0: "\<And>x. 0 < x \<Longrightarrow> x \<le> a \<Longrightarrow> DERIV g x :> (g' x)"
     and Df: "\<And>t. 0 < t \<Longrightarrow> t < a \<Longrightarrow> dist (f' t / g' t) x < e / 4"
     unfolding eventually_at_le by (auto simp: dist_real_def)
 
   from Df have "eventually (\<lambda>t. t < a) (at_right 0)" "eventually (\<lambda>t::real. 0 < t) (at_right 0)"
     unfolding eventually_at by (auto intro!: exI[of _ a] simp: dist_real_def)
 
   moreover
   have "eventually (\<lambda>t. 0 < g t) (at_right 0)" "eventually (\<lambda>t. g a < g t) (at_right 0)"
     using g_0 by (auto elim: eventually_mono simp: filterlim_at_top_dense)
 
   moreover
   have inv_g: "((\<lambda>x. inverse (g x)) \<longlongrightarrow> 0) (at_right 0)"
     using tendsto_inverse_0 filterlim_mono[OF g_0 at_top_le_at_infinity order_refl]
     by (rule filterlim_compose)
   then have "((\<lambda>x. norm (1 - g a * inverse (g x))) \<longlongrightarrow> norm (1 - g a * 0)) (at_right 0)"
     by (intro tendsto_intros)
   then have "((\<lambda>x. norm (1 - g a / g x)) \<longlongrightarrow> 1) (at_right 0)"
     by (simp add: inverse_eq_divide)
   from this[unfolded tendsto_iff, rule_format, of 1]
   have "eventually (\<lambda>x. norm (1 - g a / g x) < 2) (at_right 0)"
     by (auto elim!: eventually_mono simp: dist_real_def)
 
   moreover
   from inv_g have "((\<lambda>t. norm ((f a - x * g a) * inverse (g t))) \<longlongrightarrow> norm ((f a - x * g a) * 0))
       (at_right 0)"
     by (intro tendsto_intros)
   then have "((\<lambda>t. norm (f a - x * g a) / norm (g t)) \<longlongrightarrow> 0) (at_right 0)"
     by (simp add: inverse_eq_divide)
   from this[unfolded tendsto_iff, rule_format, of "e / 2"] \<open>0 < e\<close>
   have "eventually (\<lambda>t. norm (f a - x * g a) / norm (g t) < e / 2) (at_right 0)"
     by (auto simp: dist_real_def)
 
   ultimately show "eventually (\<lambda>t. dist (f t / g t) x < e) (at_right 0)"
   proof eventually_elim
     fix t assume t[arith]: "0 < t" "t < a" "g a < g t" "0 < g t"
     assume ineq: "norm (1 - g a / g t) < 2" "norm (f a - x * g a) / norm (g t) < e / 2"
 
     have "\<exists>y. t < y \<and> y < a \<and> (g a - g t) * f' y = (f a - f t) * g' y"
       using f0 g0 t(1,2) by (intro GMVT') (force intro!: DERIV_isCont)+
     then obtain y where [arith]: "t < y" "y < a"
       and D_eq0: "(g a - g t) * f' y = (f a - f t) * g' y"
       by blast
     from D_eq0 have D_eq: "(f t - f a) / (g t - g a) = f' y / g' y"
       using \<open>g a < g t\<close> g'_neq_0[of y] by (auto simp add: field_simps)
 
     have *: "f t / g t - x = ((f t - f a) / (g t - g a) - x) * (1 - g a / g t) + (f a - x * g a) / g t"
       by (simp add: field_simps)
     have "norm (f t / g t - x) \<le>
         norm (((f t - f a) / (g t - g a) - x) * (1 - g a / g t)) + norm ((f a - x * g a) / g t)"
       unfolding * by (rule norm_triangle_ineq)
     also have "\<dots> = dist (f' y / g' y) x * norm (1 - g a / g t) + norm (f a - x * g a) / norm (g t)"
       by (simp add: abs_mult D_eq dist_real_def)
     also have "\<dots> < (e / 4) * 2 + e / 2"
       using ineq Df[of y] \<open>0 < e\<close> by (intro add_le_less_mono mult_mono) auto
     finally show "dist (f t / g t) x < e"
       by (simp add: dist_real_def)
   qed
 qed
 
 lemma lhopital_right_at_top:
   "LIM x at_right x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at_right x) \<Longrightarrow>
     ((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> y) (at_right x) \<Longrightarrow>
     ((\<lambda> x. f x / g x) \<longlongrightarrow> y) (at_right x)"
   unfolding eventually_at_right_to_0[of _ x] filterlim_at_right_to_0[of _ _ x] DERIV_shift
   by (rule lhopital_right_0_at_top)
 
 lemma lhopital_left_at_top:
   "LIM x at_left x. g x :> at_top \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at_left x) \<Longrightarrow>
     ((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> y) (at_left x) \<Longrightarrow>
     ((\<lambda> x. f x / g x) \<longlongrightarrow> y) (at_left x)"
   for x :: real
   unfolding eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror
   by (rule lhopital_right_at_top[where f'="\<lambda>x. - f' (- x)"]) (auto simp: DERIV_mirror)
 
 lemma lhopital_at_top:
   "LIM x at x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at x) \<Longrightarrow>
     ((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> y) (at x) \<Longrightarrow>
     ((\<lambda> x. f x / g x) \<longlongrightarrow> y) (at x)"
   unfolding eventually_at_split filterlim_at_split
   by (auto intro!: lhopital_right_at_top[of g x g' f f'] lhopital_left_at_top[of g x g' f f'])
 
 lemma lhospital_at_top_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes g_0: "LIM x at_top. g x :> at_top"
     and g': "eventually (\<lambda>x. g' x \<noteq> 0) at_top"
     and Df: "eventually (\<lambda>x. DERIV f x :> f' x) at_top"
     and Dg: "eventually (\<lambda>x. DERIV g x :> g' x) at_top"
     and lim: "((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> x) at_top"
   shows "((\<lambda> x. f x / g x) \<longlongrightarrow> x) at_top"
   unfolding filterlim_at_top_to_right
 proof (rule lhopital_right_0_at_top)
   let ?F = "\<lambda>x. f (inverse x)"
   let ?G = "\<lambda>x. g (inverse x)"
   let ?R = "at_right (0::real)"
   let ?D = "\<lambda>f' x. f' (inverse x) * - (inverse x ^ Suc (Suc 0))"
   show "LIM x ?R. ?G x :> at_top"
     using g_0 unfolding filterlim_at_top_to_right .
   show "eventually (\<lambda>x. DERIV ?G x  :> ?D g' x) ?R"
     unfolding eventually_at_right_to_top
     using Dg eventually_ge_at_top[where c=1]
     by eventually_elim (rule derivative_eq_intros DERIV_chain'[where f=inverse] | simp)+
   show "eventually (\<lambda>x. DERIV ?F x  :> ?D f' x) ?R"
     unfolding eventually_at_right_to_top
     using Df eventually_ge_at_top[where c=1]
     by eventually_elim (rule derivative_eq_intros DERIV_chain'[where f=inverse] | simp)+
   show "eventually (\<lambda>x. ?D g' x \<noteq> 0) ?R"
     unfolding eventually_at_right_to_top
     using g' eventually_ge_at_top[where c=1]
     by eventually_elim auto
   show "((\<lambda>x. ?D f' x / ?D g' x) \<longlongrightarrow> x) ?R"
     unfolding filterlim_at_right_to_top
     apply (intro filterlim_cong[THEN iffD2, OF refl refl _ lim])
     using eventually_ge_at_top[where c=1]
     by eventually_elim simp
 qed
 
 lemma lhopital_right_at_top_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at_right a. f x :> at_top"
   assumes g_0: "LIM x at_right a. g x :> at_top"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_right a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_right a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_top (at_right a)"
   shows "filterlim (\<lambda> x. f x / g x) at_top (at_right a)"
 proof -
   from lim have pos: "eventually (\<lambda>x. f' x / g' x > 0) (at_right a)"
     unfolding filterlim_at_top_dense by blast
   have "((\<lambda>x. g x / f x) \<longlongrightarrow> 0) (at_right a)"
   proof (rule lhopital_right_at_top)
     from pos show "eventually (\<lambda>x. f' x \<noteq> 0) (at_right a)" by eventually_elim auto
     from tendsto_inverse_0_at_top[OF lim]
       show "((\<lambda>x. g' x / f' x) \<longlongrightarrow> 0) (at_right a)" by simp
   qed fact+
   moreover from f_0 g_0 
     have "eventually (\<lambda>x. f x > 0) (at_right a)" "eventually (\<lambda>x. g x > 0) (at_right a)"
     unfolding filterlim_at_top_dense by blast+
   hence "eventually (\<lambda>x. g x / f x > 0) (at_right a)" by eventually_elim simp
   ultimately have "filterlim (\<lambda>x. inverse (g x / f x)) at_top (at_right a)"
     by (rule filterlim_inverse_at_top)
   thus ?thesis by simp
 qed
 
 lemma lhopital_right_at_top_at_bot:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at_right a. f x :> at_top"
   assumes g_0: "LIM x at_right a. g x :> at_bot"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_right a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_right a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_bot (at_right a)"
   shows "filterlim (\<lambda> x. f x / g x) at_bot (at_right a)"
 proof -
   from ev(2) have ev': "eventually (\<lambda>x. DERIV (\<lambda>x. -g x) x :> -g' x) (at_right a)"
     by eventually_elim (auto intro: derivative_intros)
   have "filterlim (\<lambda>x. f x / (-g x)) at_top (at_right a)"
     by (rule lhopital_right_at_top_at_top[where f' = f' and g' = "\<lambda>x. -g' x"])
        (insert assms ev', auto simp: filterlim_uminus_at_bot)
   hence "filterlim (\<lambda>x. -(f x / g x)) at_top (at_right a)" by simp
   thus ?thesis by (simp add: filterlim_uminus_at_bot)
 qed
 
 lemma lhopital_left_at_top_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at_left a. f x :> at_top"
   assumes g_0: "LIM x at_left a. g x :> at_top"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_left a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_left a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_top (at_left a)"
   shows "filterlim (\<lambda> x. f x / g x) at_top (at_left a)"
   by (insert assms, unfold eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror,
       rule lhopital_right_at_top_at_top[where f'="\<lambda>x. - f' (- x)"]) 
      (insert assms, auto simp: DERIV_mirror)
 
 lemma lhopital_left_at_top_at_bot:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at_left a. f x :> at_top"
   assumes g_0: "LIM x at_left a. g x :> at_bot"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_left a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_left a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_bot (at_left a)"
   shows "filterlim (\<lambda> x. f x / g x) at_bot (at_left a)"
   by (insert assms, unfold eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror,
       rule lhopital_right_at_top_at_bot[where f'="\<lambda>x. - f' (- x)"]) 
      (insert assms, auto simp: DERIV_mirror)
 
 lemma lhopital_at_top_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at a. f x :> at_top"
   assumes g_0: "LIM x at a. g x :> at_top"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_top (at a)"
   shows "filterlim (\<lambda> x. f x / g x) at_top (at a)"
   using assms unfolding eventually_at_split filterlim_at_split
   by (auto intro!: lhopital_right_at_top_at_top[of f a g f' g'] 
                    lhopital_left_at_top_at_top[of f a g f' g'])
 
 lemma lhopital_at_top_at_bot:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at a. f x :> at_top"
   assumes g_0: "LIM x at a. g x :> at_bot"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_bot (at a)"
   shows "filterlim (\<lambda> x. f x / g x) at_bot (at a)"
   using assms unfolding eventually_at_split filterlim_at_split
   by (auto intro!: lhopital_right_at_top_at_bot[of f a g f' g'] 
                    lhopital_left_at_top_at_bot[of f a g f' g'])
 
 end
diff --git a/src/HOL/Limits.thy b/src/HOL/Limits.thy
--- a/src/HOL/Limits.thy
+++ b/src/HOL/Limits.thy
@@ -1,3035 +1,3071 @@
 (*  Title:      HOL/Limits.thy
     Author:     Brian Huffman
     Author:     Jacques D. Fleuriot, University of Cambridge
     Author:     Lawrence C Paulson
     Author:     Jeremy Avigad
 *)
 
 section \<open>Limits on Real Vector Spaces\<close>
 
 theory Limits
   imports Real_Vector_Spaces
 begin
 
+text \<open>Lemmas related to shifting/scaling\<close>
+lemma range_add [simp]:
+  fixes a::"'a::group_add" shows "range ((+) a) = UNIV"
+  by (metis add_minus_cancel surjI)
+
+lemma range_diff [simp]:
+  fixes a::"'a::group_add" shows "range ((-) a) = UNIV"
+  by (metis (full_types) add_minus_cancel diff_minus_eq_add surj_def)
+
+lemma range_mult [simp]:
+  fixes a::"real" shows "range ((*) a) = (if a=0 then {0} else UNIV)"
+  by (simp add: surj_def) (meson dvdE dvd_field_iff)
+
+
 subsection \<open>Filter going to infinity norm\<close>
 
 definition at_infinity :: "'a::real_normed_vector filter"
   where "at_infinity = (INF r. principal {x. r \<le> norm x})"
 
 lemma eventually_at_infinity: "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. b \<le> norm x \<longrightarrow> P x)"
   unfolding at_infinity_def
   by (subst eventually_INF_base)
      (auto simp: subset_eq eventually_principal intro!: exI[of _ "max a b" for a b])
 
 corollary eventually_at_infinity_pos:
   "eventually p at_infinity \<longleftrightarrow> (\<exists>b. 0 < b \<and> (\<forall>x. norm x \<ge> b \<longrightarrow> p x))"
   unfolding eventually_at_infinity
   by (meson le_less_trans norm_ge_zero not_le zero_less_one)
 
 lemma at_infinity_eq_at_top_bot: "(at_infinity :: real filter) = sup at_top at_bot"
 proof -
   have 1: "\<lbrakk>\<forall>n\<ge>u. A n; \<forall>n\<le>v. A n\<rbrakk>
        \<Longrightarrow> \<exists>b. \<forall>x. b \<le> \<bar>x\<bar> \<longrightarrow> A x" for A and u v::real
     by (rule_tac x="max (- v) u" in exI) (auto simp: abs_real_def)
   have 2: "\<forall>x. u \<le> \<bar>x\<bar> \<longrightarrow> A x \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. A n" for A and u::real
     by (meson abs_less_iff le_cases less_le_not_le)
   have 3: "\<forall>x. u \<le> \<bar>x\<bar> \<longrightarrow> A x \<Longrightarrow> \<exists>N. \<forall>n\<le>N. A n" for A and u::real
     by (metis (full_types) abs_ge_self abs_minus_cancel le_minus_iff order_trans)
   show ?thesis
     by (auto simp: filter_eq_iff eventually_sup eventually_at_infinity
       eventually_at_top_linorder eventually_at_bot_linorder intro: 1 2 3)
 qed
 
 lemma at_top_le_at_infinity: "at_top \<le> (at_infinity :: real filter)"
   unfolding at_infinity_eq_at_top_bot by simp
 
 lemma at_bot_le_at_infinity: "at_bot \<le> (at_infinity :: real filter)"
   unfolding at_infinity_eq_at_top_bot by simp
 
 lemma filterlim_at_top_imp_at_infinity: "filterlim f at_top F \<Longrightarrow> filterlim f at_infinity F"
   for f :: "_ \<Rightarrow> real"
   by (rule filterlim_mono[OF _ at_top_le_at_infinity order_refl])
 
 lemma filterlim_real_at_infinity_sequentially: "filterlim real at_infinity sequentially"
   by (simp add: filterlim_at_top_imp_at_infinity filterlim_real_sequentially)
 
 lemma lim_infinity_imp_sequentially: "(f \<longlongrightarrow> l) at_infinity \<Longrightarrow> ((\<lambda>n. f(n)) \<longlongrightarrow> l) sequentially"
   by (simp add: filterlim_at_top_imp_at_infinity filterlim_compose filterlim_real_sequentially)
 
 
 subsubsection \<open>Boundedness\<close>
 
 definition Bfun :: "('a \<Rightarrow> 'b::metric_space) \<Rightarrow> 'a filter \<Rightarrow> bool"
   where Bfun_metric_def: "Bfun f F = (\<exists>y. \<exists>K>0. eventually (\<lambda>x. dist (f x) y \<le> K) F)"
 
 abbreviation Bseq :: "(nat \<Rightarrow> 'a::metric_space) \<Rightarrow> bool"
   where "Bseq X \<equiv> Bfun X sequentially"
 
 lemma Bseq_conv_Bfun: "Bseq X \<longleftrightarrow> Bfun X sequentially" ..
 
 lemma Bseq_ignore_initial_segment: "Bseq X \<Longrightarrow> Bseq (\<lambda>n. X (n + k))"
   unfolding Bfun_metric_def by (subst eventually_sequentially_seg)
 
 lemma Bseq_offset: "Bseq (\<lambda>n. X (n + k)) \<Longrightarrow> Bseq X"
   unfolding Bfun_metric_def by (subst (asm) eventually_sequentially_seg)
 
 lemma Bfun_def: "Bfun f F \<longleftrightarrow> (\<exists>K>0. eventually (\<lambda>x. norm (f x) \<le> K) F)"
   unfolding Bfun_metric_def norm_conv_dist
 proof safe
   fix y K
   assume K: "0 < K" and *: "eventually (\<lambda>x. dist (f x) y \<le> K) F"
   moreover have "eventually (\<lambda>x. dist (f x) 0 \<le> dist (f x) y + dist 0 y) F"
     by (intro always_eventually) (metis dist_commute dist_triangle)
   with * have "eventually (\<lambda>x. dist (f x) 0 \<le> K + dist 0 y) F"
     by eventually_elim auto
   with \<open>0 < K\<close> show "\<exists>K>0. eventually (\<lambda>x. dist (f x) 0 \<le> K) F"
     by (intro exI[of _ "K + dist 0 y"] add_pos_nonneg conjI zero_le_dist) auto
 qed (force simp del: norm_conv_dist [symmetric])
 
 lemma BfunI:
   assumes K: "eventually (\<lambda>x. norm (f x) \<le> K) F"
   shows "Bfun f F"
   unfolding Bfun_def
 proof (intro exI conjI allI)
   show "0 < max K 1" by simp
   show "eventually (\<lambda>x. norm (f x) \<le> max K 1) F"
     using K by (rule eventually_mono) simp
 qed
 
 lemma BfunE:
   assumes "Bfun f F"
   obtains B where "0 < B" and "eventually (\<lambda>x. norm (f x) \<le> B) F"
   using assms unfolding Bfun_def by blast
 
 lemma Cauchy_Bseq:
   assumes "Cauchy X" shows "Bseq X"
 proof -
   have "\<exists>y K. 0 < K \<and> (\<exists>N. \<forall>n\<ge>N. dist (X n) y \<le> K)"
     if "\<And>m n. \<lbrakk>m \<ge> M; n \<ge> M\<rbrakk> \<Longrightarrow> dist (X m) (X n) < 1" for M
     by (meson order.order_iff_strict that zero_less_one)
   with assms show ?thesis
     by (force simp: Cauchy_def Bfun_metric_def eventually_sequentially)
 qed
 
 subsubsection \<open>Bounded Sequences\<close>
 
 lemma BseqI': "(\<And>n. norm (X n) \<le> K) \<Longrightarrow> Bseq X"
   by (intro BfunI) (auto simp: eventually_sequentially)
 
 lemma Bseq_def: "Bseq X \<longleftrightarrow> (\<exists>K>0. \<forall>n. norm (X n) \<le> K)"
   unfolding Bfun_def eventually_sequentially
 proof safe
   fix N K
   assume "0 < K" "\<forall>n\<ge>N. norm (X n) \<le> K"
   then show "\<exists>K>0. \<forall>n. norm (X n) \<le> K"
     by (intro exI[of _ "max (Max (norm ` X ` {..N})) K"] max.strict_coboundedI2)
        (auto intro!: imageI not_less[where 'a=nat, THEN iffD1] Max_ge simp: le_max_iff_disj)
 qed auto
 
 lemma BseqE: "Bseq X \<Longrightarrow> (\<And>K. 0 < K \<Longrightarrow> \<forall>n. norm (X n) \<le> K \<Longrightarrow> Q) \<Longrightarrow> Q"
   unfolding Bseq_def by auto
 
 lemma BseqD: "Bseq X \<Longrightarrow> \<exists>K. 0 < K \<and> (\<forall>n. norm (X n) \<le> K)"
   by (simp add: Bseq_def)
 
 lemma BseqI: "0 < K \<Longrightarrow> \<forall>n. norm (X n) \<le> K \<Longrightarrow> Bseq X"
   by (auto simp: Bseq_def)
 
 lemma Bseq_bdd_above: "Bseq X \<Longrightarrow> bdd_above (range X)"
   for X :: "nat \<Rightarrow> real"
 proof (elim BseqE, intro bdd_aboveI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "X n \<le> K"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_bdd_above': "Bseq X \<Longrightarrow> bdd_above (range (\<lambda>n. norm (X n)))"
   for X :: "nat \<Rightarrow> 'a :: real_normed_vector"
 proof (elim BseqE, intro bdd_aboveI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "norm (X n) \<le> K"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_bdd_below: "Bseq X \<Longrightarrow> bdd_below (range X)"
   for X :: "nat \<Rightarrow> real"
 proof (elim BseqE, intro bdd_belowI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "- K \<le> X n"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_eventually_mono:
   assumes "eventually (\<lambda>n. norm (f n) \<le> norm (g n)) sequentially" "Bseq g"
   shows "Bseq f"
 proof -
   from assms(2) obtain K where "0 < K" and "eventually (\<lambda>n. norm (g n) \<le> K) sequentially"
     unfolding Bfun_def by fast
   with assms(1) have "eventually (\<lambda>n. norm (f n) \<le> K) sequentially"
     by (fast elim: eventually_elim2 order_trans)
   with \<open>0 < K\<close> show "Bseq f"
     unfolding Bfun_def by fast
 qed
 
 lemma lemma_NBseq_def: "(\<exists>K > 0. \<forall>n. norm (X n) \<le> K) \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) \<le> real(Suc N))"
 proof safe
   fix K :: real
   from reals_Archimedean2 obtain n :: nat where "K < real n" ..
   then have "K \<le> real (Suc n)" by auto
   moreover assume "\<forall>m. norm (X m) \<le> K"
   ultimately have "\<forall>m. norm (X m) \<le> real (Suc n)"
     by (blast intro: order_trans)
   then show "\<exists>N. \<forall>n. norm (X n) \<le> real (Suc N)" ..
 next
   show "\<And>N. \<forall>n. norm (X n) \<le> real (Suc N) \<Longrightarrow> \<exists>K>0. \<forall>n. norm (X n) \<le> K"
     using of_nat_0_less_iff by blast
 qed
 
 text \<open>Alternative definition for \<open>Bseq\<close>.\<close>
 lemma Bseq_iff: "Bseq X \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) \<le> real(Suc N))"
   by (simp add: Bseq_def) (simp add: lemma_NBseq_def)
 
 lemma lemma_NBseq_def2: "(\<exists>K > 0. \<forall>n. norm (X n) \<le> K) = (\<exists>N. \<forall>n. norm (X n) < real(Suc N))"
 proof -
   have *: "\<And>N. \<forall>n. norm (X n) \<le> 1 + real N \<Longrightarrow>
          \<exists>N. \<forall>n. norm (X n) < 1 + real N"
     by (metis add.commute le_less_trans less_add_one of_nat_Suc)
   then show ?thesis
     unfolding lemma_NBseq_def
     by (metis less_le_not_le not_less_iff_gr_or_eq of_nat_Suc)
 qed
 
 text \<open>Yet another definition for Bseq.\<close>
 lemma Bseq_iff1a: "Bseq X \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) < real (Suc N))"
   by (simp add: Bseq_def lemma_NBseq_def2)
 
 subsubsection \<open>A Few More Equivalence Theorems for Boundedness\<close>
 
 text \<open>Alternative formulation for boundedness.\<close>
 lemma Bseq_iff2: "Bseq X \<longleftrightarrow> (\<exists>k > 0. \<exists>x. \<forall>n. norm (X n + - x) \<le> k)"
   by (metis BseqE BseqI' add.commute add_cancel_right_left add_uminus_conv_diff norm_add_leD
             norm_minus_cancel norm_minus_commute)
 
 text \<open>Alternative formulation for boundedness.\<close>
 lemma Bseq_iff3: "Bseq X \<longleftrightarrow> (\<exists>k>0. \<exists>N. \<forall>n. norm (X n + - X N) \<le> k)"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then obtain K where *: "0 < K" and **: "\<And>n. norm (X n) \<le> K"
     by (auto simp: Bseq_def)
   from * have "0 < K + norm (X 0)" by (rule order_less_le_trans) simp
   from ** have "\<forall>n. norm (X n - X 0) \<le> K + norm (X 0)"
     by (auto intro: order_trans norm_triangle_ineq4)
   then have "\<forall>n. norm (X n + - X 0) \<le> K + norm (X 0)"
     by simp
   with \<open>0 < K + norm (X 0)\<close> show ?Q by blast
 next
   assume ?Q
   then show ?P by (auto simp: Bseq_iff2)
 qed
 
 
 subsubsection \<open>Upper Bounds and Lubs of Bounded Sequences\<close>
 
 lemma Bseq_minus_iff: "Bseq (\<lambda>n. - (X n) :: 'a::real_normed_vector) \<longleftrightarrow> Bseq X"
   by (simp add: Bseq_def)
 
 lemma Bseq_add:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
   assumes "Bseq f"
   shows "Bseq (\<lambda>x. f x + c)"
 proof -
   from assms obtain K where K: "\<And>x. norm (f x) \<le> K"
     unfolding Bseq_def by blast
   {
     fix x :: nat
     have "norm (f x + c) \<le> norm (f x) + norm c" by (rule norm_triangle_ineq)
     also have "norm (f x) \<le> K" by (rule K)
     finally have "norm (f x + c) \<le> K + norm c" by simp
   }
   then show ?thesis by (rule BseqI')
 qed
 
 lemma Bseq_add_iff: "Bseq (\<lambda>x. f x + c) \<longleftrightarrow> Bseq f"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   using Bseq_add[of f c] Bseq_add[of "\<lambda>x. f x + c" "-c"] by auto
 
 lemma Bseq_mult:
   fixes f g :: "nat \<Rightarrow> 'a::real_normed_field"
   assumes "Bseq f" and "Bseq g"
   shows "Bseq (\<lambda>x. f x * g x)"
 proof -
   from assms obtain K1 K2 where K: "norm (f x) \<le> K1" "K1 > 0" "norm (g x) \<le> K2" "K2 > 0"
     for x
     unfolding Bseq_def by blast
   then have "norm (f x * g x) \<le> K1 * K2" for x
     by (auto simp: norm_mult intro!: mult_mono)
   then show ?thesis by (rule BseqI')
 qed
 
 lemma Bfun_const [simp]: "Bfun (\<lambda>_. c) F"
   unfolding Bfun_metric_def by (auto intro!: exI[of _ c] exI[of _ "1::real"])
 
 lemma Bseq_cmult_iff:
   fixes c :: "'a::real_normed_field"
   assumes "c \<noteq> 0"
   shows "Bseq (\<lambda>x. c * f x) \<longleftrightarrow> Bseq f"
 proof
   assume "Bseq (\<lambda>x. c * f x)"
   with Bfun_const have "Bseq (\<lambda>x. inverse c * (c * f x))"
     by (rule Bseq_mult)
   with \<open>c \<noteq> 0\<close> show "Bseq f"
     by (simp add: field_split_simps)
 qed (intro Bseq_mult Bfun_const)
 
 lemma Bseq_subseq: "Bseq f \<Longrightarrow> Bseq (\<lambda>x. f (g x))"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   unfolding Bseq_def by auto
 
 lemma Bseq_Suc_iff: "Bseq (\<lambda>n. f (Suc n)) \<longleftrightarrow> Bseq f"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   using Bseq_offset[of f 1] by (auto intro: Bseq_subseq)
 
 lemma increasing_Bseq_subseq_iff:
   assumes "\<And>x y. x \<le> y \<Longrightarrow> norm (f x :: 'a::real_normed_vector) \<le> norm (f y)" "strict_mono g"
   shows "Bseq (\<lambda>x. f (g x)) \<longleftrightarrow> Bseq f"
 proof
   assume "Bseq (\<lambda>x. f (g x))"
   then obtain K where K: "\<And>x. norm (f (g x)) \<le> K"
     unfolding Bseq_def by auto
   {
     fix x :: nat
     from filterlim_subseq[OF assms(2)] obtain y where "g y \<ge> x"
       by (auto simp: filterlim_at_top eventually_at_top_linorder)
     then have "norm (f x) \<le> norm (f (g y))"
       using assms(1) by blast
     also have "norm (f (g y)) \<le> K" by (rule K)
     finally have "norm (f x) \<le> K" .
   }
   then show "Bseq f" by (rule BseqI')
 qed (use Bseq_subseq[of f g] in simp_all)
 
 lemma nonneg_incseq_Bseq_subseq_iff:
   fixes f :: "nat \<Rightarrow> real"
     and g :: "nat \<Rightarrow> nat"
   assumes "\<And>x. f x \<ge> 0" "incseq f" "strict_mono g"
   shows "Bseq (\<lambda>x. f (g x)) \<longleftrightarrow> Bseq f"
   using assms by (intro increasing_Bseq_subseq_iff) (auto simp: incseq_def)
 
 lemma Bseq_eq_bounded: "range f \<subseteq> {a..b} \<Longrightarrow> Bseq f"
   for a b :: real
 proof (rule BseqI'[where K="max (norm a) (norm b)"])
   fix n assume "range f \<subseteq> {a..b}"
   then have "f n \<in> {a..b}"
     by blast
   then show "norm (f n) \<le> max (norm a) (norm b)"
     by auto
 qed
 
 lemma incseq_bounded: "incseq X \<Longrightarrow> \<forall>i. X i \<le> B \<Longrightarrow> Bseq X"
   for B :: real
   by (intro Bseq_eq_bounded[of X "X 0" B]) (auto simp: incseq_def)
 
 lemma decseq_bounded: "decseq X \<Longrightarrow> \<forall>i. B \<le> X i \<Longrightarrow> Bseq X"
   for B :: real
   by (intro Bseq_eq_bounded[of X B "X 0"]) (auto simp: decseq_def)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Polynomal function extremal theorem, from HOL Light\<close>
 
 lemma polyfun_extremal_lemma: 
     fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   assumes "0 < e"
     shows "\<exists>M. \<forall>z. M \<le> norm(z) \<longrightarrow> norm (\<Sum>i\<le>n. c(i) * z^i) \<le> e * norm(z) ^ (Suc n)"
 proof (induct n)
   case 0 with assms
   show ?case
     apply (rule_tac x="norm (c 0) / e" in exI)
     apply (auto simp: field_simps)
     done
 next
   case (Suc n)
   obtain M where M: "\<And>z. M \<le> norm z \<Longrightarrow> norm (\<Sum>i\<le>n. c i * z^i) \<le> e * norm z ^ Suc n"
     using Suc assms by blast
   show ?case
   proof (rule exI [where x= "max M (1 + norm(c(Suc n)) / e)"], clarsimp simp del: power_Suc)
     fix z::'a
     assume z1: "M \<le> norm z" and "1 + norm (c (Suc n)) / e \<le> norm z"
     then have z2: "e + norm (c (Suc n)) \<le> e * norm z"
       using assms by (simp add: field_simps)
     have "norm (\<Sum>i\<le>n. c i * z^i) \<le> e * norm z ^ Suc n"
       using M [OF z1] by simp
     then have "norm (\<Sum>i\<le>n. c i * z^i) + norm (c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc n + norm (c (Suc n) * z ^ Suc n)"
       by simp
     then have "norm ((\<Sum>i\<le>n. c i * z^i) + c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc n + norm (c (Suc n) * z ^ Suc n)"
       by (blast intro: norm_triangle_le elim: )
     also have "... \<le> (e + norm (c (Suc n))) * norm z ^ Suc n"
       by (simp add: norm_power norm_mult algebra_simps)
     also have "... \<le> (e * norm z) * norm z ^ Suc n"
       by (metis z2 mult.commute mult_left_mono norm_ge_zero norm_power)
     finally show "norm ((\<Sum>i\<le>n. c i * z^i) + c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc (Suc n)"
       by simp
   qed
 qed
 
 lemma polyfun_extremal: (*COMPLEX_POLYFUN_EXTREMAL in HOL Light*)
     fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   assumes k: "c k \<noteq> 0" "1\<le>k" and kn: "k\<le>n"
     shows "eventually (\<lambda>z. norm (\<Sum>i\<le>n. c(i) * z^i) \<ge> B) at_infinity"
 using kn
 proof (induction n)
   case 0
   then show ?case
     using k by simp
 next
   case (Suc m)
   show ?case
   proof (cases "c (Suc m) = 0")
     case True
     then show ?thesis using Suc k
       by auto (metis antisym_conv less_eq_Suc_le not_le)
   next
     case False
     then obtain M where M:
           "\<And>z. M \<le> norm z \<Longrightarrow> norm (\<Sum>i\<le>m. c i * z^i) \<le> norm (c (Suc m)) / 2 * norm z ^ Suc m"
       using polyfun_extremal_lemma [of "norm(c (Suc m)) / 2" c m] Suc
       by auto
     have "\<exists>b. \<forall>z. b \<le> norm z \<longrightarrow> B \<le> norm (\<Sum>i\<le>Suc m. c i * z^i)"
     proof (rule exI [where x="max M (max 1 (\<bar>B\<bar> / (norm(c (Suc m)) / 2)))"], clarsimp simp del: power_Suc)
       fix z::'a
       assume z1: "M \<le> norm z" "1 \<le> norm z"
          and "\<bar>B\<bar> * 2 / norm (c (Suc m)) \<le> norm z"
       then have z2: "\<bar>B\<bar> \<le> norm (c (Suc m)) * norm z / 2"
         using False by (simp add: field_simps)
       have nz: "norm z \<le> norm z ^ Suc m"
         by (metis \<open>1 \<le> norm z\<close> One_nat_def less_eq_Suc_le power_increasing power_one_right zero_less_Suc)
       have *: "\<And>y x. norm (c (Suc m)) * norm z / 2 \<le> norm y - norm x \<Longrightarrow> B \<le> norm (x + y)"
         by (metis abs_le_iff add.commute norm_diff_ineq order_trans z2)
       have "norm z * norm (c (Suc m)) + 2 * norm (\<Sum>i\<le>m. c i * z^i)
             \<le> norm (c (Suc m)) * norm z + norm (c (Suc m)) * norm z ^ Suc m"
         using M [of z] Suc z1  by auto
       also have "... \<le> 2 * (norm (c (Suc m)) * norm z ^ Suc m)"
         using nz by (simp add: mult_mono del: power_Suc)
       finally show "B \<le> norm ((\<Sum>i\<le>m. c i * z^i) + c (Suc m) * z ^ Suc m)"
         using Suc.IH
         apply (auto simp: eventually_at_infinity)
         apply (rule *)
         apply (simp add: field_simps norm_mult norm_power)
         done
     qed
     then show ?thesis
       by (simp add: eventually_at_infinity)
   qed
 qed
 
 subsection \<open>Convergence to Zero\<close>
 
 definition Zfun :: "('a \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a filter \<Rightarrow> bool"
   where "Zfun f F = (\<forall>r>0. eventually (\<lambda>x. norm (f x) < r) F)"
 
 lemma ZfunI: "(\<And>r. 0 < r \<Longrightarrow> eventually (\<lambda>x. norm (f x) < r) F) \<Longrightarrow> Zfun f F"
   by (simp add: Zfun_def)
 
 lemma ZfunD: "Zfun f F \<Longrightarrow> 0 < r \<Longrightarrow> eventually (\<lambda>x. norm (f x) < r) F"
   by (simp add: Zfun_def)
 
 lemma Zfun_ssubst: "eventually (\<lambda>x. f x = g x) F \<Longrightarrow> Zfun g F \<Longrightarrow> Zfun f F"
   unfolding Zfun_def by (auto elim!: eventually_rev_mp)
 
 lemma Zfun_zero: "Zfun (\<lambda>x. 0) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_norm_iff: "Zfun (\<lambda>x. norm (f x)) F = Zfun (\<lambda>x. f x) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_imp_Zfun:
   assumes f: "Zfun f F"
     and g: "eventually (\<lambda>x. norm (g x) \<le> norm (f x) * K) F"
   shows "Zfun (\<lambda>x. g x) F"
 proof (cases "0 < K")
   case K: True
   show ?thesis
   proof (rule ZfunI)
     fix r :: real
     assume "0 < r"
     then have "0 < r / K" using K by simp
     then have "eventually (\<lambda>x. norm (f x) < r / K) F"
       using ZfunD [OF f] by blast
     with g show "eventually (\<lambda>x. norm (g x) < r) F"
     proof eventually_elim
       case (elim x)
       then have "norm (f x) * K < r"
         by (simp add: pos_less_divide_eq K)
       then show ?case
         by (simp add: order_le_less_trans [OF elim(1)])
     qed
   qed
 next
   case False
   then have K: "K \<le> 0" by (simp only: not_less)
   show ?thesis
   proof (rule ZfunI)
     fix r :: real
     assume "0 < r"
     from g show "eventually (\<lambda>x. norm (g x) < r) F"
     proof eventually_elim
       case (elim x)
       also have "norm (f x) * K \<le> norm (f x) * 0"
         using K norm_ge_zero by (rule mult_left_mono)
       finally show ?case
         using \<open>0 < r\<close> by simp
     qed
   qed
 qed
 
 lemma Zfun_le: "Zfun g F \<Longrightarrow> \<forall>x. norm (f x) \<le> norm (g x) \<Longrightarrow> Zfun f F"
   by (erule Zfun_imp_Zfun [where K = 1]) simp
 
 lemma Zfun_add:
   assumes f: "Zfun f F"
     and g: "Zfun g F"
   shows "Zfun (\<lambda>x. f x + g x) F"
 proof (rule ZfunI)
   fix r :: real
   assume "0 < r"
   then have r: "0 < r / 2" by simp
   have "eventually (\<lambda>x. norm (f x) < r/2) F"
     using f r by (rule ZfunD)
   moreover
   have "eventually (\<lambda>x. norm (g x) < r/2) F"
     using g r by (rule ZfunD)
   ultimately
   show "eventually (\<lambda>x. norm (f x + g x) < r) F"
   proof eventually_elim
     case (elim x)
     have "norm (f x + g x) \<le> norm (f x) + norm (g x)"
       by (rule norm_triangle_ineq)
     also have "\<dots> < r/2 + r/2"
       using elim by (rule add_strict_mono)
     finally show ?case
       by simp
   qed
 qed
 
 lemma Zfun_minus: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. - f x) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_diff: "Zfun f F \<Longrightarrow> Zfun g F \<Longrightarrow> Zfun (\<lambda>x. f x - g x) F"
   using Zfun_add [of f F "\<lambda>x. - g x"] by (simp add: Zfun_minus)
 
 lemma (in bounded_linear) Zfun:
   assumes g: "Zfun g F"
   shows "Zfun (\<lambda>x. f (g x)) F"
 proof -
   obtain K where "norm (f x) \<le> norm x * K" for x
     using bounded by blast
   then have "eventually (\<lambda>x. norm (f (g x)) \<le> norm (g x) * K) F"
     by simp
   with g show ?thesis
     by (rule Zfun_imp_Zfun)
 qed
 
 lemma (in bounded_bilinear) Zfun:
   assumes f: "Zfun f F"
     and g: "Zfun g F"
   shows "Zfun (\<lambda>x. f x ** g x) F"
 proof (rule ZfunI)
   fix r :: real
   assume r: "0 < r"
   obtain K where K: "0 < K"
     and norm_le: "norm (x ** y) \<le> norm x * norm y * K" for x y
     using pos_bounded by blast
   from K have K': "0 < inverse K"
     by (rule positive_imp_inverse_positive)
   have "eventually (\<lambda>x. norm (f x) < r) F"
     using f r by (rule ZfunD)
   moreover
   have "eventually (\<lambda>x. norm (g x) < inverse K) F"
     using g K' by (rule ZfunD)
   ultimately
   show "eventually (\<lambda>x. norm (f x ** g x) < r) F"
   proof eventually_elim
     case (elim x)
     have "norm (f x ** g x) \<le> norm (f x) * norm (g x) * K"
       by (rule norm_le)
     also have "norm (f x) * norm (g x) * K < r * inverse K * K"
       by (intro mult_strict_right_mono mult_strict_mono' norm_ge_zero elim K)
     also from K have "r * inverse K * K = r"
       by simp
     finally show ?case .
   qed
 qed
 
 lemma (in bounded_bilinear) Zfun_left: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. f x ** a) F"
   by (rule bounded_linear_left [THEN bounded_linear.Zfun])
 
 lemma (in bounded_bilinear) Zfun_right: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. a ** f x) F"
   by (rule bounded_linear_right [THEN bounded_linear.Zfun])
 
 lemmas Zfun_mult = bounded_bilinear.Zfun [OF bounded_bilinear_mult]
 lemmas Zfun_mult_right = bounded_bilinear.Zfun_right [OF bounded_bilinear_mult]
 lemmas Zfun_mult_left = bounded_bilinear.Zfun_left [OF bounded_bilinear_mult]
 
 lemma tendsto_Zfun_iff: "(f \<longlongrightarrow> a) F = Zfun (\<lambda>x. f x - a) F"
   by (simp only: tendsto_iff Zfun_def dist_norm)
 
 lemma tendsto_0_le:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> eventually (\<lambda>x. norm (g x) \<le> norm (f x) * K) F \<Longrightarrow> (g \<longlongrightarrow> 0) F"
   by (simp add: Zfun_imp_Zfun tendsto_Zfun_iff)
 
 
 subsubsection \<open>Distance and norms\<close>
 
 lemma tendsto_dist [tendsto_intros]:
   fixes l m :: "'a::metric_space"
   assumes f: "(f \<longlongrightarrow> l) F"
     and g: "(g \<longlongrightarrow> m) F"
   shows "((\<lambda>x. dist (f x) (g x)) \<longlongrightarrow> dist l m) F"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   then have e2: "0 < e/2" by simp
   from tendstoD [OF f e2] tendstoD [OF g e2]
   show "eventually (\<lambda>x. dist (dist (f x) (g x)) (dist l m) < e) F"
   proof (eventually_elim)
     case (elim x)
     then show "dist (dist (f x) (g x)) (dist l m) < e"
       unfolding dist_real_def
       using dist_triangle2 [of "f x" "g x" "l"]
         and dist_triangle2 [of "g x" "l" "m"]
         and dist_triangle3 [of "l" "m" "f x"]
         and dist_triangle [of "f x" "m" "g x"]
       by arith
   qed
 qed
 
 lemma continuous_dist[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'a :: metric_space"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. dist (f x) (g x))"
   unfolding continuous_def by (rule tendsto_dist)
 
 lemma continuous_on_dist[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'a :: metric_space"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. dist (f x) (g x))"
   unfolding continuous_on_def by (auto intro: tendsto_dist)
 
 lemma continuous_at_dist: "isCont (dist a) b"
   using continuous_on_dist [OF continuous_on_const continuous_on_id] continuous_on_eq_continuous_within by blast
 
 lemma tendsto_norm [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. norm (f x)) \<longlongrightarrow> norm a) F"
   unfolding norm_conv_dist by (intro tendsto_intros)
 
 lemma continuous_norm [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. norm (f x))"
   unfolding continuous_def by (rule tendsto_norm)
 
 lemma continuous_on_norm [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. norm (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_norm)
 
 lemma continuous_on_norm_id [continuous_intros]: "continuous_on S norm"
   by (intro continuous_on_id continuous_on_norm)
 
 lemma tendsto_norm_zero: "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F"
   by (drule tendsto_norm) simp
 
 lemma tendsto_norm_zero_cancel: "((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> 0) F"
   unfolding tendsto_iff dist_norm by simp
 
 lemma tendsto_norm_zero_iff: "((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F \<longleftrightarrow> (f \<longlongrightarrow> 0) F"
   unfolding tendsto_iff dist_norm by simp
 
 lemma tendsto_rabs [tendsto_intros]: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> \<bar>l\<bar>) F"
   for l :: real
   by (fold real_norm_def) (rule tendsto_norm)
 
 lemma continuous_rabs [continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F (\<lambda>x. \<bar>f x :: real\<bar>)"
   unfolding real_norm_def[symmetric] by (rule continuous_norm)
 
 lemma continuous_on_rabs [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. \<bar>f x :: real\<bar>)"
   unfolding real_norm_def[symmetric] by (rule continuous_on_norm)
 
 lemma tendsto_rabs_zero: "(f \<longlongrightarrow> (0::real)) F \<Longrightarrow> ((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero)
 
 lemma tendsto_rabs_zero_cancel: "((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> (0::real)) F \<Longrightarrow> (f \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero_cancel)
 
 lemma tendsto_rabs_zero_iff: "((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> (0::real)) F \<longleftrightarrow> (f \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero_iff)
 
 
 subsection \<open>Topological Monoid\<close>
 
 class topological_monoid_add = topological_space + monoid_add +
   assumes tendsto_add_Pair: "LIM x (nhds a \<times>\<^sub>F nhds b). fst x + snd x :> nhds (a + b)"
 
 class topological_comm_monoid_add = topological_monoid_add + comm_monoid_add
 
 lemma tendsto_add [tendsto_intros]:
   fixes a b :: "'a::topological_monoid_add"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x + g x) \<longlongrightarrow> a + b) F"
   using filterlim_compose[OF tendsto_add_Pair, of "\<lambda>x. (f x, g x)" a b F]
   by (simp add: nhds_prod[symmetric] tendsto_Pair)
 
 lemma continuous_add [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x + g x)"
   unfolding continuous_def by (rule tendsto_add)
 
 lemma continuous_on_add [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
   unfolding continuous_on_def by (auto intro: tendsto_add)
 
 lemma tendsto_add_zero:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "(f \<longlongrightarrow> 0) F \<Longrightarrow> (g \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x + g x) \<longlongrightarrow> 0) F"
   by (drule (1) tendsto_add) simp
 
 lemma tendsto_sum [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> (f i \<longlongrightarrow> a i) F) \<Longrightarrow> ((\<lambda>x. \<Sum>i\<in>I. f i x) \<longlongrightarrow> (\<Sum>i\<in>I. a i)) F"
   by (induct I rule: infinite_finite_induct) (simp_all add: tendsto_add)
 
 lemma tendsto_null_sum:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_add"
   assumes "\<And>i. i \<in> I \<Longrightarrow> ((\<lambda>x. f x i) \<longlongrightarrow> 0) F"
   shows "((\<lambda>i. sum (f i) I) \<longlongrightarrow> 0) F"
   using tendsto_sum [of I "\<lambda>x y. f y x" "\<lambda>x. 0"] assms by simp
 
 lemma continuous_sum [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous F (f i)) \<Longrightarrow> continuous F (\<lambda>x. \<Sum>i\<in>I. f i x)"
   unfolding continuous_def by (rule tendsto_sum)
 
 lemma continuous_on_sum [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::topological_space \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous_on S (f i)) \<Longrightarrow> continuous_on S (\<lambda>x. \<Sum>i\<in>I. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_sum)
 
 instance nat :: topological_comm_monoid_add
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 instance int :: topological_comm_monoid_add
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 
 subsubsection \<open>Topological group\<close>
 
 class topological_group_add = topological_monoid_add + group_add +
   assumes tendsto_uminus_nhds: "(uminus \<longlongrightarrow> - a) (nhds a)"
 begin
 
 lemma tendsto_minus [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. - f x) \<longlongrightarrow> - a) F"
   by (rule filterlim_compose[OF tendsto_uminus_nhds])
 
 end
 
 class topological_ab_group_add = topological_group_add + ab_group_add
 
 instance topological_ab_group_add < topological_comm_monoid_add ..
 
 lemma continuous_minus [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. - f x)"
   for f :: "'a::t2_space \<Rightarrow> 'b::topological_group_add"
   unfolding continuous_def by (rule tendsto_minus)
 
 lemma continuous_on_minus [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
   for f :: "_ \<Rightarrow> 'b::topological_group_add"
   unfolding continuous_on_def by (auto intro: tendsto_minus)
 
 lemma tendsto_minus_cancel: "((\<lambda>x. - f x) \<longlongrightarrow> - a) F \<Longrightarrow> (f \<longlongrightarrow> a) F"
   for a :: "'a::topological_group_add"
   by (drule tendsto_minus) simp
 
 lemma tendsto_minus_cancel_left:
   "(f \<longlongrightarrow> - (y::_::topological_group_add)) F \<longleftrightarrow> ((\<lambda>x. - f x) \<longlongrightarrow> y) F"
   using tendsto_minus_cancel[of f "- y" F]  tendsto_minus[of f "- y" F]
   by auto
 
 lemma tendsto_diff [tendsto_intros]:
   fixes a b :: "'a::topological_group_add"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x - g x) \<longlongrightarrow> a - b) F"
   using tendsto_add [of f a F "\<lambda>x. - g x" "- b"] by (simp add: tendsto_minus)
 
 lemma continuous_diff [continuous_intros]:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::topological_group_add"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x - g x)"
   unfolding continuous_def by (rule tendsto_diff)
 
 lemma continuous_on_diff [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_group_add"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
   unfolding continuous_on_def by (auto intro: tendsto_diff)
 
 lemma continuous_on_op_minus: "continuous_on (s::'a::topological_group_add set) ((-) x)"
   by (rule continuous_intros | simp)+
 
 instance real_normed_vector < topological_ab_group_add
 proof
   fix a b :: 'a
   show "((\<lambda>x. fst x + snd x) \<longlongrightarrow> a + b) (nhds a \<times>\<^sub>F nhds b)"
     unfolding tendsto_Zfun_iff add_diff_add
     using tendsto_fst[OF filterlim_ident, of "(a,b)"] tendsto_snd[OF filterlim_ident, of "(a,b)"]
     by (intro Zfun_add)
        (auto simp: tendsto_Zfun_iff[symmetric] nhds_prod[symmetric] intro!: tendsto_fst)
   show "(uminus \<longlongrightarrow> - a) (nhds a)"
     unfolding tendsto_Zfun_iff minus_diff_minus
     using filterlim_ident[of "nhds a"]
     by (intro Zfun_minus) (simp add: tendsto_Zfun_iff)
 qed
 
 lemmas real_tendsto_sandwich = tendsto_sandwich[where 'a=real]
 
 
 subsubsection \<open>Linear operators and multiplication\<close>
 
 lemma linear_times [simp]: "linear (\<lambda>x. c * x)"
   for c :: "'a::real_algebra"
   by (auto simp: linearI distrib_left)
 
 lemma (in bounded_linear) tendsto: "(g \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f (g x)) \<longlongrightarrow> f a) F"
   by (simp only: tendsto_Zfun_iff diff [symmetric] Zfun)
 
 lemma (in bounded_linear) continuous: "continuous F g \<Longrightarrow> continuous F (\<lambda>x. f (g x))"
   using tendsto[of g _ F] by (auto simp: continuous_def)
 
 lemma (in bounded_linear) continuous_on: "continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f (g x))"
   using tendsto[of g] by (auto simp: continuous_on_def)
 
 lemma (in bounded_linear) tendsto_zero: "(g \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f (g x)) \<longlongrightarrow> 0) F"
   by (drule tendsto) (simp only: zero)
 
 lemma (in bounded_bilinear) tendsto:
   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x ** g x) \<longlongrightarrow> a ** b) F"
   by (simp only: tendsto_Zfun_iff prod_diff_prod Zfun_add Zfun Zfun_left Zfun_right)
 
 lemma (in bounded_bilinear) continuous:
   "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x ** g x)"
   using tendsto[of f _ F g] by (auto simp: continuous_def)
 
 lemma (in bounded_bilinear) continuous_on:
   "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x ** g x)"
   using tendsto[of f _ _ g] by (auto simp: continuous_on_def)
 
 lemma (in bounded_bilinear) tendsto_zero:
   assumes f: "(f \<longlongrightarrow> 0) F"
     and g: "(g \<longlongrightarrow> 0) F"
   shows "((\<lambda>x. f x ** g x) \<longlongrightarrow> 0) F"
   using tendsto [OF f g] by (simp add: zero_left)
 
 lemma (in bounded_bilinear) tendsto_left_zero:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x ** c) \<longlongrightarrow> 0) F"
   by (rule bounded_linear.tendsto_zero [OF bounded_linear_left])
 
 lemma (in bounded_bilinear) tendsto_right_zero:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. c ** f x) \<longlongrightarrow> 0) F"
   by (rule bounded_linear.tendsto_zero [OF bounded_linear_right])
 
 lemmas tendsto_of_real [tendsto_intros] =
   bounded_linear.tendsto [OF bounded_linear_of_real]
 
 lemmas tendsto_scaleR [tendsto_intros] =
   bounded_bilinear.tendsto [OF bounded_bilinear_scaleR]
 
 
 text\<open>Analogous type class for multiplication\<close>
 class topological_semigroup_mult = topological_space + semigroup_mult +
   assumes tendsto_mult_Pair: "LIM x (nhds a \<times>\<^sub>F nhds b). fst x * snd x :> nhds (a * b)"
 
 instance real_normed_algebra < topological_semigroup_mult
 proof
   fix a b :: 'a
   show "((\<lambda>x. fst x * snd x) \<longlongrightarrow> a * b) (nhds a \<times>\<^sub>F nhds b)"
     unfolding nhds_prod[symmetric]
     using tendsto_fst[OF filterlim_ident, of "(a,b)"] tendsto_snd[OF filterlim_ident, of "(a,b)"]
     by (simp add: bounded_bilinear.tendsto [OF bounded_bilinear_mult])
 qed
 
 lemma tendsto_mult [tendsto_intros]:
   fixes a b :: "'a::topological_semigroup_mult"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x * g x) \<longlongrightarrow> a * b) F"
   using filterlim_compose[OF tendsto_mult_Pair, of "\<lambda>x. (f x, g x)" a b F]
   by (simp add: nhds_prod[symmetric] tendsto_Pair)
 
 lemma tendsto_mult_left: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. c * (f x)) \<longlongrightarrow> c * l) F"
   for c :: "'a::topological_semigroup_mult"
   by (rule tendsto_mult [OF tendsto_const])
 
 lemma tendsto_mult_right: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. (f x) * c) \<longlongrightarrow> l * c) F"
   for c :: "'a::topological_semigroup_mult"
   by (rule tendsto_mult [OF _ tendsto_const])
 
 lemma tendsto_mult_left_iff [simp]:
    "c \<noteq> 0 \<Longrightarrow> tendsto(\<lambda>x. c * f x) (c * l) F \<longleftrightarrow> tendsto f l F" for c :: "'a::{topological_semigroup_mult,field}"
   by (auto simp: tendsto_mult_left dest: tendsto_mult_left [where c = "1/c"])
 
 lemma tendsto_mult_right_iff [simp]:
    "c \<noteq> 0 \<Longrightarrow> tendsto(\<lambda>x. f x * c) (l * c) F \<longleftrightarrow> tendsto f l F" for c :: "'a::{topological_semigroup_mult,field}"
   by (auto simp: tendsto_mult_right dest: tendsto_mult_left [where c = "1/c"])
 
 lemma tendsto_zero_mult_left_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. c * a n)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using assms tendsto_mult_left tendsto_mult_left_iff by fastforce
 
 lemma tendsto_zero_mult_right_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. a n * c)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using assms tendsto_mult_right tendsto_mult_right_iff by fastforce
 
 lemma tendsto_zero_divide_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. a n / c)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using tendsto_zero_mult_right_iff [of "1/c" a] assms by (simp add: field_simps)
 
 lemma lim_const_over_n [tendsto_intros]:
   fixes a :: "'a::real_normed_field"
   shows "(\<lambda>n. a / of_nat n) \<longlonglongrightarrow> 0"
   using tendsto_mult [OF tendsto_const [of a] lim_1_over_n] by simp
 
 lemmas continuous_of_real [continuous_intros] =
   bounded_linear.continuous [OF bounded_linear_of_real]
 
 lemmas continuous_scaleR [continuous_intros] =
   bounded_bilinear.continuous [OF bounded_bilinear_scaleR]
 
 lemmas continuous_mult [continuous_intros] =
   bounded_bilinear.continuous [OF bounded_bilinear_mult]
 
 lemmas continuous_on_of_real [continuous_intros] =
   bounded_linear.continuous_on [OF bounded_linear_of_real]
 
 lemmas continuous_on_scaleR [continuous_intros] =
   bounded_bilinear.continuous_on [OF bounded_bilinear_scaleR]
 
 lemmas continuous_on_mult [continuous_intros] =
   bounded_bilinear.continuous_on [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_zero =
   bounded_bilinear.tendsto_zero [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_left_zero =
   bounded_bilinear.tendsto_left_zero [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_right_zero =
   bounded_bilinear.tendsto_right_zero [OF bounded_bilinear_mult]
 
 
 lemma continuous_mult_left:
   fixes c::"'a::real_normed_algebra"
   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. c * f x)"
 by (rule continuous_mult [OF continuous_const])
 
 lemma continuous_mult_right:
   fixes c::"'a::real_normed_algebra"
   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. f x * c)"
 by (rule continuous_mult [OF _ continuous_const])
 
 lemma continuous_on_mult_left:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. c * f x)"
 by (rule continuous_on_mult [OF continuous_on_const])
 
 lemma continuous_on_mult_right:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. f x * c)"
 by (rule continuous_on_mult [OF _ continuous_on_const])
 
 lemma continuous_on_mult_const [simp]:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s ((*) c)"
   by (intro continuous_on_mult_left continuous_on_id)
 
 lemma tendsto_divide_zero:
   fixes c :: "'a::real_normed_field"
   shows "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x / c) \<longlongrightarrow> 0) F"
   by (cases "c=0") (simp_all add: divide_inverse tendsto_mult_left_zero)
 
 lemma tendsto_power [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f x ^ n) \<longlongrightarrow> a ^ n) F"
   for f :: "'a \<Rightarrow> 'b::{power,real_normed_algebra}"
   by (induct n) (simp_all add: tendsto_mult)
 
 lemma tendsto_null_power: "\<lbrakk>(f \<longlongrightarrow> 0) F; 0 < n\<rbrakk> \<Longrightarrow> ((\<lambda>x. f x ^ n) \<longlongrightarrow> 0) F"
     for f :: "'a \<Rightarrow> 'b::{power,real_normed_algebra_1}"
   using tendsto_power [of f 0 F n] by (simp add: power_0_left)
 
 lemma continuous_power [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. (f x)^n)"
   for f :: "'a::t2_space \<Rightarrow> 'b::{power,real_normed_algebra}"
   unfolding continuous_def by (rule tendsto_power)
 
 lemma continuous_on_power [continuous_intros]:
   fixes f :: "_ \<Rightarrow> 'b::{power,real_normed_algebra}"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. (f x)^n)"
   unfolding continuous_on_def by (auto intro: tendsto_power)
 
 lemma tendsto_prod [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> (f i \<longlongrightarrow> L i) F) \<Longrightarrow> ((\<lambda>x. \<Prod>i\<in>S. f i x) \<longlongrightarrow> (\<Prod>i\<in>S. L i)) F"
   by (induct S rule: infinite_finite_induct) (simp_all add: tendsto_mult)
 
 lemma continuous_prod [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> continuous F (f i)) \<Longrightarrow> continuous F (\<lambda>x. \<Prod>i\<in>S. f i x)"
   unfolding continuous_def by (rule tendsto_prod)
 
 lemma continuous_on_prod [continuous_intros]:
   fixes f :: "'a \<Rightarrow> _ \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> continuous_on s (f i)) \<Longrightarrow> continuous_on s (\<lambda>x. \<Prod>i\<in>S. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_prod)
 
 lemma tendsto_of_real_iff:
   "((\<lambda>x. of_real (f x) :: 'a::real_normed_div_algebra) \<longlongrightarrow> of_real c) F \<longleftrightarrow> (f \<longlongrightarrow> c) F"
   unfolding tendsto_iff by simp
 
 lemma tendsto_add_const_iff:
   "((\<lambda>x. c + f x :: 'a::real_normed_vector) \<longlongrightarrow> c + d) F \<longleftrightarrow> (f \<longlongrightarrow> d) F"
   using tendsto_add[OF tendsto_const[of c], of f d]
     and tendsto_add[OF tendsto_const[of "-c"], of "\<lambda>x. c + f x" "c + d"] by auto
 
 
 class topological_monoid_mult = topological_semigroup_mult + monoid_mult
 class topological_comm_monoid_mult = topological_monoid_mult + comm_monoid_mult
 
 lemma tendsto_power_strong [tendsto_intros]:
   fixes f :: "_ \<Rightarrow> 'b :: topological_monoid_mult"
   assumes "(f \<longlongrightarrow> a) F" "(g \<longlongrightarrow> b) F"
   shows   "((\<lambda>x. f x ^ g x) \<longlongrightarrow> a ^ b) F"
 proof -
   have "((\<lambda>x. f x ^ b) \<longlongrightarrow> a ^ b) F"
     by (induction b) (auto intro: tendsto_intros assms)
   also from assms(2) have "eventually (\<lambda>x. g x = b) F"
     by (simp add: nhds_discrete filterlim_principal)
   hence "eventually (\<lambda>x. f x ^ b = f x ^ g x) F"
     by eventually_elim simp
   hence "((\<lambda>x. f x ^ b) \<longlongrightarrow> a ^ b) F \<longleftrightarrow> ((\<lambda>x. f x ^ g x) \<longlongrightarrow> a ^ b) F"
     by (intro filterlim_cong refl)
   finally show ?thesis .
 qed
 
 lemma continuous_mult' [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_semigroup_mult"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x * g x)"
   unfolding continuous_def by (rule tendsto_mult)
 
 lemma continuous_power' [continuous_intros]:
   fixes f :: "_ \<Rightarrow> 'b::topological_monoid_mult"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x ^ g x)"
   unfolding continuous_def by (rule tendsto_power_strong) auto
 
 lemma continuous_on_mult' [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_semigroup_mult"
   shows "continuous_on A f \<Longrightarrow> continuous_on A g \<Longrightarrow> continuous_on A (\<lambda>x. f x * g x)"
   unfolding continuous_on_def by (auto intro: tendsto_mult)
 
 lemma continuous_on_power' [continuous_intros]:
   fixes f :: "_ \<Rightarrow> 'b::topological_monoid_mult"
   shows "continuous_on A f \<Longrightarrow> continuous_on A g \<Longrightarrow> continuous_on A (\<lambda>x. f x ^ g x)"
   unfolding continuous_on_def by (auto intro: tendsto_power_strong)
 
 lemma tendsto_mult_one:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_mult"
   shows "(f \<longlongrightarrow> 1) F \<Longrightarrow> (g \<longlongrightarrow> 1) F \<Longrightarrow> ((\<lambda>x. f x * g x) \<longlongrightarrow> 1) F"
   by (drule (1) tendsto_mult) simp
 
 lemma tendsto_prod' [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_mult"
   shows "(\<And>i. i \<in> I \<Longrightarrow> (f i \<longlongrightarrow> a i) F) \<Longrightarrow> ((\<lambda>x. \<Prod>i\<in>I. f i x) \<longlongrightarrow> (\<Prod>i\<in>I. a i)) F"
   by (induct I rule: infinite_finite_induct) (simp_all add: tendsto_mult)
 
 lemma tendsto_one_prod':
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_mult"
   assumes "\<And>i. i \<in> I \<Longrightarrow> ((\<lambda>x. f x i) \<longlongrightarrow> 1) F"
   shows "((\<lambda>i. prod (f i) I) \<longlongrightarrow> 1) F"
   using tendsto_prod' [of I "\<lambda>x y. f y x" "\<lambda>x. 1"] assms by simp
 
 lemma continuous_prod' [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::topological_comm_monoid_mult"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous F (f i)) \<Longrightarrow> continuous F (\<lambda>x. \<Prod>i\<in>I. f i x)"
   unfolding continuous_def by (rule tendsto_prod')
 
 lemma continuous_on_prod' [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::topological_space \<Rightarrow> 'c::topological_comm_monoid_mult"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous_on S (f i)) \<Longrightarrow> continuous_on S (\<lambda>x. \<Prod>i\<in>I. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_prod')
 
 instance nat :: topological_comm_monoid_mult
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 instance int :: topological_comm_monoid_mult
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 class comm_real_normed_algebra_1 = real_normed_algebra_1 + comm_monoid_mult
 
 context real_normed_field
 begin
 
 subclass comm_real_normed_algebra_1
 proof
   from norm_mult[of "1 :: 'a" 1] show "norm 1 = 1" by simp 
 qed (simp_all add: norm_mult)
 
 end
 
 subsubsection \<open>Inverse and division\<close>
 
 lemma (in bounded_bilinear) Zfun_prod_Bfun:
   assumes f: "Zfun f F"
     and g: "Bfun g F"
   shows "Zfun (\<lambda>x. f x ** g x) F"
 proof -
   obtain K where K: "0 \<le> K"
     and norm_le: "\<And>x y. norm (x ** y) \<le> norm x * norm y * K"
     using nonneg_bounded by blast
   obtain B where B: "0 < B"
     and norm_g: "eventually (\<lambda>x. norm (g x) \<le> B) F"
     using g by (rule BfunE)
   have "eventually (\<lambda>x. norm (f x ** g x) \<le> norm (f x) * (B * K)) F"
   using norm_g proof eventually_elim
     case (elim x)
     have "norm (f x ** g x) \<le> norm (f x) * norm (g x) * K"
       by (rule norm_le)
     also have "\<dots> \<le> norm (f x) * B * K"
       by (intro mult_mono' order_refl norm_g norm_ge_zero mult_nonneg_nonneg K elim)
     also have "\<dots> = norm (f x) * (B * K)"
       by (rule mult.assoc)
     finally show "norm (f x ** g x) \<le> norm (f x) * (B * K)" .
   qed
   with f show ?thesis
     by (rule Zfun_imp_Zfun)
 qed
 
 lemma (in bounded_bilinear) Bfun_prod_Zfun:
   assumes f: "Bfun f F"
     and g: "Zfun g F"
   shows "Zfun (\<lambda>x. f x ** g x) F"
   using flip g f by (rule bounded_bilinear.Zfun_prod_Bfun)
 
 lemma Bfun_inverse:
   fixes a :: "'a::real_normed_div_algebra"
   assumes f: "(f \<longlongrightarrow> a) F"
   assumes a: "a \<noteq> 0"
   shows "Bfun (\<lambda>x. inverse (f x)) F"
 proof -
   from a have "0 < norm a" by simp
   then have "\<exists>r>0. r < norm a" by (rule dense)
   then obtain r where r1: "0 < r" and r2: "r < norm a"
     by blast
   have "eventually (\<lambda>x. dist (f x) a < r) F"
     using tendstoD [OF f r1] by blast
   then have "eventually (\<lambda>x. norm (inverse (f x)) \<le> inverse (norm a - r)) F"
   proof eventually_elim
     case (elim x)
     then have 1: "norm (f x - a) < r"
       by (simp add: dist_norm)
     then have 2: "f x \<noteq> 0" using r2 by auto
     then have "norm (inverse (f x)) = inverse (norm (f x))"
       by (rule nonzero_norm_inverse)
     also have "\<dots> \<le> inverse (norm a - r)"
     proof (rule le_imp_inverse_le)
       show "0 < norm a - r"
         using r2 by simp
       have "norm a - norm (f x) \<le> norm (a - f x)"
         by (rule norm_triangle_ineq2)
       also have "\<dots> = norm (f x - a)"
         by (rule norm_minus_commute)
       also have "\<dots> < r" using 1 .
       finally show "norm a - r \<le> norm (f x)"
         by simp
     qed
     finally show "norm (inverse (f x)) \<le> inverse (norm a - r)" .
   qed
   then show ?thesis by (rule BfunI)
 qed
 
 lemma tendsto_inverse [tendsto_intros]:
   fixes a :: "'a::real_normed_div_algebra"
   assumes f: "(f \<longlongrightarrow> a) F"
     and a: "a \<noteq> 0"
   shows "((\<lambda>x. inverse (f x)) \<longlongrightarrow> inverse a) F"
 proof -
   from a have "0 < norm a" by simp
   with f have "eventually (\<lambda>x. dist (f x) a < norm a) F"
     by (rule tendstoD)
   then have "eventually (\<lambda>x. f x \<noteq> 0) F"
     unfolding dist_norm by (auto elim!: eventually_mono)
   with a have "eventually (\<lambda>x. inverse (f x) - inverse a =
     - (inverse (f x) * (f x - a) * inverse a)) F"
     by (auto elim!: eventually_mono simp: inverse_diff_inverse)
   moreover have "Zfun (\<lambda>x. - (inverse (f x) * (f x - a) * inverse a)) F"
     by (intro Zfun_minus Zfun_mult_left
       bounded_bilinear.Bfun_prod_Zfun [OF bounded_bilinear_mult]
       Bfun_inverse [OF f a] f [unfolded tendsto_Zfun_iff])
   ultimately show ?thesis
     unfolding tendsto_Zfun_iff by (rule Zfun_ssubst)
 qed
 
 lemma continuous_inverse:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous F f"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. inverse (f x))"
   using assms unfolding continuous_def by (rule tendsto_inverse)
 
 lemma continuous_at_within_inverse[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous (at a within s) f"
     and "f a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. inverse (f x))"
   using assms unfolding continuous_within by (rule tendsto_inverse)
 
 lemma continuous_on_inverse[continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous_on s f"
     and "\<forall>x\<in>s. f x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. inverse (f x))"
   using assms unfolding continuous_on_def by (blast intro: tendsto_inverse)
 
 lemma tendsto_divide [tendsto_intros]:
   fixes a b :: "'a::real_normed_field"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> ((\<lambda>x. f x / g x) \<longlongrightarrow> a / b) F"
   by (simp add: tendsto_mult tendsto_inverse divide_inverse)
 
 lemma continuous_divide:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_field"
   assumes "continuous F f"
     and "continuous F g"
     and "g (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. (f x) / (g x))"
   using assms unfolding continuous_def by (rule tendsto_divide)
 
 lemma continuous_at_within_divide[continuous_intros]:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_field"
   assumes "continuous (at a within s) f" "continuous (at a within s) g"
     and "g a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. (f x) / (g x))"
   using assms unfolding continuous_within by (rule tendsto_divide)
 
 lemma isCont_divide[continuous_intros, simp]:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_field"
   assumes "isCont f a" "isCont g a" "g a \<noteq> 0"
   shows "isCont (\<lambda>x. (f x) / g x) a"
   using assms unfolding continuous_at by (rule tendsto_divide)
 
 lemma continuous_on_divide[continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_field"
   assumes "continuous_on s f" "continuous_on s g"
     and "\<forall>x\<in>s. g x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. (f x) / (g x))"
   using assms unfolding continuous_on_def by (blast intro: tendsto_divide)
 
 lemma tendsto_power_int [tendsto_intros]:
   fixes a :: "'a::real_normed_div_algebra"
   assumes f: "(f \<longlongrightarrow> a) F"
     and a: "a \<noteq> 0"
   shows "((\<lambda>x. power_int (f x) n) \<longlongrightarrow> power_int a n) F"
   using assms by (cases n rule: int_cases4) (auto intro!: tendsto_intros simp: power_int_minus)
 
 lemma continuous_power_int:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous F f"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. power_int (f x) n)"
   using assms unfolding continuous_def by (rule tendsto_power_int)
 
 lemma continuous_at_within_power_int[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous (at a within s) f"
     and "f a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. power_int (f x) n)"
   using assms unfolding continuous_within by (rule tendsto_power_int)
 
 lemma continuous_on_power_int [continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous_on s f" and "\<forall>x\<in>s. f x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. power_int (f x) n)"
   using assms unfolding continuous_on_def by (blast intro: tendsto_power_int)
 
 lemma tendsto_sgn [tendsto_intros]: "(f \<longlongrightarrow> l) F \<Longrightarrow> l \<noteq> 0 \<Longrightarrow> ((\<lambda>x. sgn (f x)) \<longlongrightarrow> sgn l) F"
   for l :: "'a::real_normed_vector"
   unfolding sgn_div_norm by (simp add: tendsto_intros)
 
 lemma continuous_sgn:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous F f"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_def by (rule tendsto_sgn)
 
 lemma continuous_at_within_sgn[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous (at a within s) f"
     and "f a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_within by (rule tendsto_sgn)
 
 lemma isCont_sgn[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "isCont f a"
     and "f a \<noteq> 0"
   shows "isCont (\<lambda>x. sgn (f x)) a"
   using assms unfolding continuous_at by (rule tendsto_sgn)
 
 lemma continuous_on_sgn[continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous_on s f"
     and "\<forall>x\<in>s. f x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_on_def by (blast intro: tendsto_sgn)
 
 lemma filterlim_at_infinity:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_vector"
   assumes "0 \<le> c"
   shows "(LIM x F. f x :> at_infinity) \<longleftrightarrow> (\<forall>r>c. eventually (\<lambda>x. r \<le> norm (f x)) F)"
   unfolding filterlim_iff eventually_at_infinity
 proof safe
   fix P :: "'a \<Rightarrow> bool"
   fix b
   assume *: "\<forall>r>c. eventually (\<lambda>x. r \<le> norm (f x)) F"
   assume P: "\<forall>x. b \<le> norm x \<longrightarrow> P x"
   have "max b (c + 1) > c" by auto
   with * have "eventually (\<lambda>x. max b (c + 1) \<le> norm (f x)) F"
     by auto
   then show "eventually (\<lambda>x. P (f x)) F"
   proof eventually_elim
     case (elim x)
     with P show "P (f x)" by auto
   qed
 qed force
 
 lemma filterlim_at_infinity_imp_norm_at_top:
   fixes F
   assumes "filterlim f at_infinity F"
   shows   "filterlim (\<lambda>x. norm (f x)) at_top F"
 proof -
   {
     fix r :: real
     have "\<forall>\<^sub>F x in F. r \<le> norm (f x)" using filterlim_at_infinity[of 0 f F] assms
       by (cases "r > 0")
          (auto simp: not_less intro: always_eventually order.trans[OF _ norm_ge_zero])
   }
   thus ?thesis by (auto simp: filterlim_at_top)
 qed
 
 lemma filterlim_norm_at_top_imp_at_infinity:
   fixes F
   assumes "filterlim (\<lambda>x. norm (f x)) at_top F"
   shows   "filterlim f at_infinity F"
   using filterlim_at_infinity[of 0 f F] assms by (auto simp: filterlim_at_top)
 
 lemma filterlim_norm_at_top: "filterlim norm at_top at_infinity"
   by (rule filterlim_at_infinity_imp_norm_at_top) (rule filterlim_ident)
 
 lemma filterlim_at_infinity_conv_norm_at_top:
   "filterlim f at_infinity G \<longleftrightarrow> filterlim (\<lambda>x. norm (f x)) at_top G"
   by (auto simp: filterlim_at_infinity[OF order.refl] filterlim_at_top_gt[of _ _ 0])
 
 lemma eventually_not_equal_at_infinity:
   "eventually (\<lambda>x. x \<noteq> (a :: 'a :: {real_normed_vector})) at_infinity"
 proof -
   from filterlim_norm_at_top[where 'a = 'a]
     have "\<forall>\<^sub>F x in at_infinity. norm a < norm (x::'a)" by (auto simp: filterlim_at_top_dense)
   thus ?thesis by eventually_elim auto
 qed
 
 lemma filterlim_int_of_nat_at_topD:
   fixes F
   assumes "filterlim (\<lambda>x. f (int x)) F at_top"
   shows   "filterlim f F at_top"
 proof -
   have "filterlim (\<lambda>x. f (int (nat x))) F at_top"
     by (rule filterlim_compose[OF assms filterlim_nat_sequentially])
   also have "?this \<longleftrightarrow> filterlim f F at_top"
     by (intro filterlim_cong refl eventually_mono [OF eventually_ge_at_top[of "0::int"]]) auto
   finally show ?thesis .
 qed
 
 lemma filterlim_int_sequentially [tendsto_intros]:
   "filterlim int at_top sequentially"
   unfolding filterlim_at_top
 proof
   fix C :: int
   show "eventually (\<lambda>n. int n \<ge> C) at_top"
     using eventually_ge_at_top[of "nat \<lceil>C\<rceil>"] by eventually_elim linarith
 qed
 
 lemma filterlim_real_of_int_at_top [tendsto_intros]:
   "filterlim real_of_int at_top at_top"
   unfolding filterlim_at_top
 proof
   fix C :: real
   show "eventually (\<lambda>n. real_of_int n \<ge> C) at_top"
     using eventually_ge_at_top[of "\<lceil>C\<rceil>"] by eventually_elim linarith
 qed
 
 lemma filterlim_abs_real: "filterlim (abs::real \<Rightarrow> real) at_top at_top"
 proof (subst filterlim_cong[OF refl refl])
   from eventually_ge_at_top[of "0::real"] show "eventually (\<lambda>x::real. \<bar>x\<bar> = x) at_top"
     by eventually_elim simp
 qed (simp_all add: filterlim_ident)
 
 lemma filterlim_of_real_at_infinity [tendsto_intros]:
   "filterlim (of_real :: real \<Rightarrow> 'a :: real_normed_algebra_1) at_infinity at_top"
   by (intro filterlim_norm_at_top_imp_at_infinity) (auto simp: filterlim_abs_real)
 
 lemma not_tendsto_and_filterlim_at_infinity:
   fixes c :: "'a::real_normed_vector"
   assumes "F \<noteq> bot"
     and "(f \<longlongrightarrow> c) F"
     and "filterlim f at_infinity F"
   shows False
 proof -
   from tendstoD[OF assms(2), of "1/2"]
   have "eventually (\<lambda>x. dist (f x) c < 1/2) F"
     by simp
   moreover
   from filterlim_at_infinity[of "norm c" f F] assms(3)
   have "eventually (\<lambda>x. norm (f x) \<ge> norm c + 1) F" by simp
   ultimately have "eventually (\<lambda>x. False) F"
   proof eventually_elim
     fix x
     assume A: "dist (f x) c < 1/2"
     assume "norm (f x) \<ge> norm c + 1"
     also have "norm (f x) = dist (f x) 0" by simp
     also have "\<dots> \<le> dist (f x) c + dist c 0" by (rule dist_triangle)
     finally show False using A by simp
   qed
   with assms show False by simp
 qed
 
 lemma filterlim_at_infinity_imp_not_convergent:
   assumes "filterlim f at_infinity sequentially"
   shows "\<not> convergent f"
   by (rule notI, rule not_tendsto_and_filterlim_at_infinity[OF _ _ assms])
      (simp_all add: convergent_LIMSEQ_iff)
 
 lemma filterlim_at_infinity_imp_eventually_ne:
   assumes "filterlim f at_infinity F"
   shows "eventually (\<lambda>z. f z \<noteq> c) F"
 proof -
   have "norm c + 1 > 0"
     by (intro add_nonneg_pos) simp_all
   with filterlim_at_infinity[OF order.refl, of f F] assms
   have "eventually (\<lambda>z. norm (f z) \<ge> norm c + 1) F"
     by blast
   then show ?thesis
     by eventually_elim auto
 qed
 
 lemma tendsto_of_nat [tendsto_intros]:
   "filterlim (of_nat :: nat \<Rightarrow> 'a::real_normed_algebra_1) at_infinity sequentially"
 proof (subst filterlim_at_infinity[OF order.refl], intro allI impI)
   fix r :: real
   assume r: "r > 0"
   define n where "n = nat \<lceil>r\<rceil>"
   from r have n: "\<forall>m\<ge>n. of_nat m \<ge> r"
     unfolding n_def by linarith
   from eventually_ge_at_top[of n] show "eventually (\<lambda>m. norm (of_nat m :: 'a) \<ge> r) sequentially"
     by eventually_elim (use n in simp_all)
 qed
 
 
 subsection \<open>Relate \<^const>\<open>at\<close>, \<^const>\<open>at_left\<close> and \<^const>\<open>at_right\<close>\<close>
 
 text \<open>
   This lemmas are useful for conversion between \<^term>\<open>at x\<close> to \<^term>\<open>at_left x\<close> and
   \<^term>\<open>at_right x\<close> and also \<^term>\<open>at_right 0\<close>.
 \<close>
 
 lemmas filterlim_split_at_real = filterlim_split_at[where 'a=real]
 
 lemma filtermap_nhds_shift: "filtermap (\<lambda>x. x - d) (nhds a) = nhds (a - d)"
   for a d :: "'a::real_normed_vector"
   by (rule filtermap_fun_inverse[where g="\<lambda>x. x + d"])
     (auto intro!: tendsto_eq_intros filterlim_ident)
 
 lemma filtermap_nhds_minus: "filtermap (\<lambda>x. - x) (nhds a) = nhds (- a)"
   for a :: "'a::real_normed_vector"
   by (rule filtermap_fun_inverse[where g=uminus])
     (auto intro!: tendsto_eq_intros filterlim_ident)
 
 lemma filtermap_at_shift: "filtermap (\<lambda>x. x - d) (at a) = at (a - d)"
   for a d :: "'a::real_normed_vector"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_shift[symmetric])
 
 lemma filtermap_at_right_shift: "filtermap (\<lambda>x. x - d) (at_right a) = at_right (a - d)"
   for a d :: "real"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_shift[symmetric])
 
+lemma filterlim_shift:
+  fixes d :: "'a::real_normed_vector"
+  assumes "filterlim f F (at a)"
+  shows "filterlim (f \<circ> (+) d) F (at (a - d))"
+  unfolding filterlim_iff
+proof (intro strip)
+  fix P
+  assume "eventually P F"
+  then have "\<forall>\<^sub>F x in filtermap (\<lambda>y. y - d) (at a). P (f (d + x))"
+    using assms by (force simp add: filterlim_iff eventually_filtermap)
+  then show "(\<forall>\<^sub>F x in at (a - d). P ((f \<circ> (+) d) x))"
+    by (force simp add: filtermap_at_shift)
+qed
+
+lemma filterlim_shift_iff:
+  fixes d :: "'a::real_normed_vector"
+  shows "filterlim (f \<circ> (+) d) F (at (a - d)) = filterlim f F (at a)"   (is "?lhs = ?rhs")
+proof
+  assume L: ?lhs show ?rhs
+    using filterlim_shift [OF L, of "-d"] by (simp add: filterlim_iff)
+qed (metis filterlim_shift)
+
 lemma at_right_to_0: "at_right a = filtermap (\<lambda>x. x + a) (at_right 0)"
   for a :: real
   using filtermap_at_right_shift[of "-a" 0] by simp
 
 lemma filterlim_at_right_to_0:
   "filterlim f F (at_right a) \<longleftrightarrow> filterlim (\<lambda>x. f (x + a)) F (at_right 0)"
   for a :: real
   unfolding filterlim_def filtermap_filtermap at_right_to_0[of a] ..
 
 lemma eventually_at_right_to_0:
   "eventually P (at_right a) \<longleftrightarrow> eventually (\<lambda>x. P (x + a)) (at_right 0)"
   for a :: real
   unfolding at_right_to_0[of a] by (simp add: eventually_filtermap)
 
 lemma at_to_0: "at a = filtermap (\<lambda>x. x + a) (at 0)"
   for a :: "'a::real_normed_vector"
   using filtermap_at_shift[of "-a" 0] by simp
 
 lemma filterlim_at_to_0:
   "filterlim f F (at a) \<longleftrightarrow> filterlim (\<lambda>x. f (x + a)) F (at 0)"
   for a :: "'a::real_normed_vector"
   unfolding filterlim_def filtermap_filtermap at_to_0[of a] ..
 
 lemma eventually_at_to_0:
   "eventually P (at a) \<longleftrightarrow> eventually (\<lambda>x. P (x + a)) (at 0)"
   for a ::  "'a::real_normed_vector"
   unfolding at_to_0[of a] by (simp add: eventually_filtermap)
 
 lemma filtermap_at_minus: "filtermap (\<lambda>x. - x) (at a) = at (- a)"
   for a :: "'a::real_normed_vector"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 lemma at_left_minus: "at_left a = filtermap (\<lambda>x. - x) (at_right (- a))"
   for a :: real
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 lemma at_right_minus: "at_right a = filtermap (\<lambda>x. - x) (at_left (- a))"
   for a :: real
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 
 lemma filterlim_at_left_to_right:
   "filterlim f F (at_left a) \<longleftrightarrow> filterlim (\<lambda>x. f (- x)) F (at_right (-a))"
   for a :: real
   unfolding filterlim_def filtermap_filtermap at_left_minus[of a] ..
 
 lemma eventually_at_left_to_right:
   "eventually P (at_left a) \<longleftrightarrow> eventually (\<lambda>x. P (- x)) (at_right (-a))"
   for a :: real
   unfolding at_left_minus[of a] by (simp add: eventually_filtermap)
 
 lemma filterlim_uminus_at_top_at_bot: "LIM x at_bot. - x :: real :> at_top"
   unfolding filterlim_at_top eventually_at_bot_dense
   by (metis leI minus_less_iff order_less_asym)
 
 lemma filterlim_uminus_at_bot_at_top: "LIM x at_top. - x :: real :> at_bot"
   unfolding filterlim_at_bot eventually_at_top_dense
   by (metis leI less_minus_iff order_less_asym)
 
 lemma at_bot_mirror :
   shows "(at_bot::('a::{ordered_ab_group_add,linorder} filter)) = filtermap uminus at_top"
 proof (rule filtermap_fun_inverse[symmetric])
   show "filterlim uminus at_top (at_bot::'a filter)"
     using eventually_at_bot_linorder filterlim_at_top le_minus_iff by force
   show "filterlim uminus (at_bot::'a filter) at_top"
     by (simp add: filterlim_at_bot minus_le_iff)
 qed auto
 
 lemma at_top_mirror :
   shows "(at_top::('a::{ordered_ab_group_add,linorder} filter)) = filtermap uminus at_bot"
   apply (subst at_bot_mirror)
   by (auto simp: filtermap_filtermap)
 
 lemma filterlim_at_top_mirror: "(LIM x at_top. f x :> F) \<longleftrightarrow> (LIM x at_bot. f (-x::real) :> F)"
   unfolding filterlim_def at_top_mirror filtermap_filtermap ..
 
 lemma filterlim_at_bot_mirror: "(LIM x at_bot. f x :> F) \<longleftrightarrow> (LIM x at_top. f (-x::real) :> F)"
   unfolding filterlim_def at_bot_mirror filtermap_filtermap ..
 
 lemma filterlim_uminus_at_top: "(LIM x F. f x :> at_top) \<longleftrightarrow> (LIM x F. - (f x) :: real :> at_bot)"
   using filterlim_compose[OF filterlim_uminus_at_bot_at_top, of f F]
     and filterlim_compose[OF filterlim_uminus_at_top_at_bot, of "\<lambda>x. - f x" F]
   by auto
 
 lemma tendsto_at_botI_sequentially:
   fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
   assumes *: "\<And>X. filterlim X at_bot sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
   shows "(f \<longlongrightarrow> y) at_bot"
   unfolding filterlim_at_bot_mirror
 proof (rule tendsto_at_topI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume "filterlim X at_top sequentially"
   thus "(\<lambda>n. f (-X n)) \<longlonglongrightarrow> y" by (intro *) (auto simp: filterlim_uminus_at_top)
 qed
 
 lemma filterlim_at_infinity_imp_filterlim_at_top:
   assumes "filterlim (f :: 'a \<Rightarrow> real) at_infinity F"
   assumes "eventually (\<lambda>x. f x > 0) F"
   shows   "filterlim f at_top F"
 proof -
   from assms(2) have *: "eventually (\<lambda>x. norm (f x) = f x) F" by eventually_elim simp
   from assms(1) show ?thesis unfolding filterlim_at_infinity_conv_norm_at_top
     by (subst (asm) filterlim_cong[OF refl refl *])
 qed
 
 lemma filterlim_at_infinity_imp_filterlim_at_bot:
   assumes "filterlim (f :: 'a \<Rightarrow> real) at_infinity F"
   assumes "eventually (\<lambda>x. f x < 0) F"
   shows   "filterlim f at_bot F"
 proof -
   from assms(2) have *: "eventually (\<lambda>x. norm (f x) = -f x) F" by eventually_elim simp
   from assms(1) have "filterlim (\<lambda>x. - f x) at_top F"
     unfolding filterlim_at_infinity_conv_norm_at_top
     by (subst (asm) filterlim_cong[OF refl refl *])
   thus ?thesis by (simp add: filterlim_uminus_at_top)
 qed
 
 lemma filterlim_uminus_at_bot: "(LIM x F. f x :> at_bot) \<longleftrightarrow> (LIM x F. - (f x) :: real :> at_top)"
   unfolding filterlim_uminus_at_top by simp
 
 lemma filterlim_inverse_at_top_right: "LIM x at_right (0::real). inverse x :> at_top"
   unfolding filterlim_at_top_gt[where c=0] eventually_at_filter
 proof safe
   fix Z :: real
   assume [arith]: "0 < Z"
   then have "eventually (\<lambda>x. x < inverse Z) (nhds 0)"
     by (auto simp: eventually_nhds_metric dist_real_def intro!: exI[of _ "\<bar>inverse Z\<bar>"])
   then show "eventually (\<lambda>x. x \<noteq> 0 \<longrightarrow> x \<in> {0<..} \<longrightarrow> Z \<le> inverse x) (nhds 0)"
     by (auto elim!: eventually_mono simp: inverse_eq_divide field_simps)
 qed
 
 lemma tendsto_inverse_0:
   fixes x :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   shows "(inverse \<longlongrightarrow> (0::'a)) at_infinity"
   unfolding tendsto_Zfun_iff diff_0_right Zfun_def eventually_at_infinity
 proof safe
   fix r :: real
   assume "0 < r"
   show "\<exists>b. \<forall>x. b \<le> norm x \<longrightarrow> norm (inverse x :: 'a) < r"
   proof (intro exI[of _ "inverse (r / 2)"] allI impI)
     fix x :: 'a
     from \<open>0 < r\<close> have "0 < inverse (r / 2)" by simp
     also assume *: "inverse (r / 2) \<le> norm x"
     finally show "norm (inverse x) < r"
       using * \<open>0 < r\<close>
       by (subst nonzero_norm_inverse) (simp_all add: inverse_eq_divide field_simps)
   qed
 qed
 
 lemma tendsto_add_filterlim_at_infinity:
   fixes c :: "'b::real_normed_vector"
     and F :: "'a filter"
   assumes "(f \<longlongrightarrow> c) F"
     and "filterlim g at_infinity F"
   shows "filterlim (\<lambda>x. f x + g x) at_infinity F"
 proof (subst filterlim_at_infinity[OF order_refl], safe)
   fix r :: real
   assume r: "r > 0"
   from assms(1) have "((\<lambda>x. norm (f x)) \<longlongrightarrow> norm c) F"
     by (rule tendsto_norm)
   then have "eventually (\<lambda>x. norm (f x) < norm c + 1) F"
     by (rule order_tendstoD) simp_all
   moreover from r have "r + norm c + 1 > 0"
     by (intro add_pos_nonneg) simp_all
   with assms(2) have "eventually (\<lambda>x. norm (g x) \<ge> r + norm c + 1) F"
     unfolding filterlim_at_infinity[OF order_refl]
     by (elim allE[of _ "r + norm c + 1"]) simp_all
   ultimately show "eventually (\<lambda>x. norm (f x + g x) \<ge> r) F"
   proof eventually_elim
     fix x :: 'a
     assume A: "norm (f x) < norm c + 1" and B: "r + norm c + 1 \<le> norm (g x)"
     from A B have "r \<le> norm (g x) - norm (f x)"
       by simp
     also have "norm (g x) - norm (f x) \<le> norm (g x + f x)"
       by (rule norm_diff_ineq)
     finally show "r \<le> norm (f x + g x)"
       by (simp add: add_ac)
   qed
 qed
 
 lemma tendsto_add_filterlim_at_infinity':
   fixes c :: "'b::real_normed_vector"
     and F :: "'a filter"
   assumes "filterlim f at_infinity F"
     and "(g \<longlongrightarrow> c) F"
   shows "filterlim (\<lambda>x. f x + g x) at_infinity F"
   by (subst add.commute) (rule tendsto_add_filterlim_at_infinity assms)+
 
 lemma filterlim_inverse_at_right_top: "LIM x at_top. inverse x :> at_right (0::real)"
   unfolding filterlim_at
   by (auto simp: eventually_at_top_dense)
      (metis tendsto_inverse_0 filterlim_mono at_top_le_at_infinity order_refl)
 
 lemma filterlim_inverse_at_top:
   "(f \<longlongrightarrow> (0 :: real)) F \<Longrightarrow> eventually (\<lambda>x. 0 < f x) F \<Longrightarrow> LIM x F. inverse (f x) :> at_top"
   by (intro filterlim_compose[OF filterlim_inverse_at_top_right])
      (simp add: filterlim_def eventually_filtermap eventually_mono at_within_def le_principal)
 
 lemma filterlim_inverse_at_bot_neg:
   "LIM x (at_left (0::real)). inverse x :> at_bot"
   by (simp add: filterlim_inverse_at_top_right filterlim_uminus_at_bot filterlim_at_left_to_right)
 
 lemma filterlim_inverse_at_bot:
   "(f \<longlongrightarrow> (0 :: real)) F \<Longrightarrow> eventually (\<lambda>x. f x < 0) F \<Longrightarrow> LIM x F. inverse (f x) :> at_bot"
   unfolding filterlim_uminus_at_bot inverse_minus_eq[symmetric]
   by (rule filterlim_inverse_at_top) (simp_all add: tendsto_minus_cancel_left[symmetric])
 
 lemma at_right_to_top: "(at_right (0::real)) = filtermap inverse at_top"
   by (intro filtermap_fun_inverse[symmetric, where g=inverse])
      (auto intro: filterlim_inverse_at_top_right filterlim_inverse_at_right_top)
 
 lemma eventually_at_right_to_top:
   "eventually P (at_right (0::real)) \<longleftrightarrow> eventually (\<lambda>x. P (inverse x)) at_top"
   unfolding at_right_to_top eventually_filtermap ..
 
 lemma filterlim_at_right_to_top:
   "filterlim f F (at_right (0::real)) \<longleftrightarrow> (LIM x at_top. f (inverse x) :> F)"
   unfolding filterlim_def at_right_to_top filtermap_filtermap ..
 
 lemma at_top_to_right: "at_top = filtermap inverse (at_right (0::real))"
   unfolding at_right_to_top filtermap_filtermap inverse_inverse_eq filtermap_ident ..
 
 lemma eventually_at_top_to_right:
   "eventually P at_top \<longleftrightarrow> eventually (\<lambda>x. P (inverse x)) (at_right (0::real))"
   unfolding at_top_to_right eventually_filtermap ..
 
 lemma filterlim_at_top_to_right:
   "filterlim f F at_top \<longleftrightarrow> (LIM x (at_right (0::real)). f (inverse x) :> F)"
   unfolding filterlim_def at_top_to_right filtermap_filtermap ..
 
 lemma filterlim_inverse_at_infinity:
   fixes x :: "_ \<Rightarrow> 'a::{real_normed_div_algebra, division_ring}"
   shows "filterlim inverse at_infinity (at (0::'a))"
   unfolding filterlim_at_infinity[OF order_refl]
 proof safe
   fix r :: real
   assume "0 < r"
   then show "eventually (\<lambda>x::'a. r \<le> norm (inverse x)) (at 0)"
     unfolding eventually_at norm_inverse
     by (intro exI[of _ "inverse r"])
        (auto simp: norm_conv_dist[symmetric] field_simps inverse_eq_divide)
 qed
 
 lemma filterlim_inverse_at_iff:
   fixes g :: "'a \<Rightarrow> 'b::{real_normed_div_algebra, division_ring}"
   shows "(LIM x F. inverse (g x) :> at 0) \<longleftrightarrow> (LIM x F. g x :> at_infinity)"
   unfolding filterlim_def filtermap_filtermap[symmetric]
 proof
   assume "filtermap g F \<le> at_infinity"
   then have "filtermap inverse (filtermap g F) \<le> filtermap inverse at_infinity"
     by (rule filtermap_mono)
   also have "\<dots> \<le> at 0"
     using tendsto_inverse_0[where 'a='b]
     by (auto intro!: exI[of _ 1]
         simp: le_principal eventually_filtermap filterlim_def at_within_def eventually_at_infinity)
   finally show "filtermap inverse (filtermap g F) \<le> at 0" .
 next
   assume "filtermap inverse (filtermap g F) \<le> at 0"
   then have "filtermap inverse (filtermap inverse (filtermap g F)) \<le> filtermap inverse (at 0)"
     by (rule filtermap_mono)
   with filterlim_inverse_at_infinity show "filtermap g F \<le> at_infinity"
     by (auto intro: order_trans simp: filterlim_def filtermap_filtermap)
 qed
 
 lemma tendsto_mult_filterlim_at_infinity:
   fixes c :: "'a::real_normed_field"
   assumes  "(f \<longlongrightarrow> c) F" "c \<noteq> 0"
   assumes "filterlim g at_infinity F"
   shows "filterlim (\<lambda>x. f x * g x) at_infinity F"
 proof -
   have "((\<lambda>x. inverse (f x) * inverse (g x)) \<longlongrightarrow> inverse c * 0) F"
     by (intro tendsto_mult tendsto_inverse assms filterlim_compose[OF tendsto_inverse_0])
   then have "filterlim (\<lambda>x. inverse (f x) * inverse (g x)) (at (inverse c * 0)) F"
     unfolding filterlim_at
     using assms
     by (auto intro: filterlim_at_infinity_imp_eventually_ne tendsto_imp_eventually_ne eventually_conj)
   then show ?thesis
     by (subst filterlim_inverse_at_iff[symmetric]) simp_all
 qed
 
 lemma tendsto_inverse_0_at_top: "LIM x F. f x :> at_top \<Longrightarrow> ((\<lambda>x. inverse (f x) :: real) \<longlongrightarrow> 0) F"
  by (metis filterlim_at filterlim_mono[OF _ at_top_le_at_infinity order_refl] filterlim_inverse_at_iff)
 
 lemma real_tendsto_divide_at_top:
   fixes c::"real"
   assumes "(f \<longlongrightarrow> c) F"
   assumes "filterlim g at_top F"
   shows "((\<lambda>x. f x / g x) \<longlongrightarrow> 0) F"
   by (auto simp: divide_inverse_commute
       intro!: tendsto_mult[THEN tendsto_eq_rhs] tendsto_inverse_0_at_top assms)
 
 lemma mult_nat_left_at_top: "c > 0 \<Longrightarrow> filterlim (\<lambda>x. c * x) at_top sequentially"
   for c :: nat
   by (rule filterlim_subseq) (auto simp: strict_mono_def)
 
 lemma mult_nat_right_at_top: "c > 0 \<Longrightarrow> filterlim (\<lambda>x. x * c) at_top sequentially"
   for c :: nat
   by (rule filterlim_subseq) (auto simp: strict_mono_def)
 
 lemma filterlim_times_pos:
   "LIM x F1. c * f x :> at_right l"
   if "filterlim f (at_right p) F1" "0 < c" "l = c * p"
   for c::"'a::{linordered_field, linorder_topology}"
   unfolding filterlim_iff
 proof safe
   fix P
   assume "\<forall>\<^sub>F x in at_right l. P x"
   then obtain d where "c * p < d" "\<And>y. y > c * p \<Longrightarrow> y < d \<Longrightarrow> P y"
     unfolding \<open>l = _ \<close> eventually_at_right_field
     by auto
   then have "\<forall>\<^sub>F a in at_right p. P (c * a)"
     by (auto simp: eventually_at_right_field \<open>0 < c\<close> field_simps intro!: exI[where x="d/c"])
   from that(1)[unfolded filterlim_iff, rule_format, OF this]
   show "\<forall>\<^sub>F x in F1. P (c * f x)" .
 qed
 
 lemma filtermap_nhds_times: "c \<noteq> 0 \<Longrightarrow> filtermap (times c) (nhds a) = nhds (c * a)"
   for a c :: "'a::real_normed_field"
   by (rule filtermap_fun_inverse[where g="\<lambda>x. inverse c * x"])
     (auto intro!: tendsto_eq_intros filterlim_ident)
 
 lemma filtermap_times_pos_at_right:
   fixes c::"'a::{linordered_field, linorder_topology}"
   assumes "c > 0"
   shows "filtermap (times c) (at_right p) = at_right (c * p)"
   using assms
   by (intro filtermap_fun_inverse[where g="\<lambda>x. inverse c * x"])
     (auto intro!: filterlim_ident filterlim_times_pos)
 
 lemma at_to_infinity: "(at (0::'a::{real_normed_field,field})) = filtermap inverse at_infinity"
 proof (rule antisym)
   have "(inverse \<longlongrightarrow> (0::'a)) at_infinity"
     by (fact tendsto_inverse_0)
   then show "filtermap inverse at_infinity \<le> at (0::'a)"
     using filterlim_def filterlim_ident filterlim_inverse_at_iff by fastforce
 next
   have "filtermap inverse (filtermap inverse (at (0::'a))) \<le> filtermap inverse at_infinity"
     using filterlim_inverse_at_infinity unfolding filterlim_def
     by (rule filtermap_mono)
   then show "at (0::'a) \<le> filtermap inverse at_infinity"
     by (simp add: filtermap_ident filtermap_filtermap)
 qed
 
 lemma lim_at_infinity_0:
   fixes l :: "'a::{real_normed_field,field}"
   shows "(f \<longlongrightarrow> l) at_infinity \<longleftrightarrow> ((f \<circ> inverse) \<longlongrightarrow> l) (at (0::'a))"
   by (simp add: tendsto_compose_filtermap at_to_infinity filtermap_filtermap)
 
 lemma lim_zero_infinity:
   fixes l :: "'a::{real_normed_field,field}"
   shows "((\<lambda>x. f(1 / x)) \<longlongrightarrow> l) (at (0::'a)) \<Longrightarrow> (f \<longlongrightarrow> l) at_infinity"
   by (simp add: inverse_eq_divide lim_at_infinity_0 comp_def)
 
 
 text \<open>
   We only show rules for multiplication and addition when the functions are either against a real
   value or against infinity. Further rules are easy to derive by using @{thm
   filterlim_uminus_at_top}.
 \<close>
 
 lemma filterlim_tendsto_pos_mult_at_top:
   assumes f: "(f \<longlongrightarrow> c) F"
     and c: "0 < c"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (f x * g x :: real) :> at_top"
   unfolding filterlim_at_top_gt[where c=0]
 proof safe
   fix Z :: real
   assume "0 < Z"
   from f \<open>0 < c\<close> have "eventually (\<lambda>x. c / 2 < f x) F"
     by (auto dest!: tendstoD[where e="c / 2"] elim!: eventually_mono
         simp: dist_real_def abs_real_def split: if_split_asm)
   moreover from g have "eventually (\<lambda>x. (Z / c * 2) \<le> g x) F"
     unfolding filterlim_at_top by auto
   ultimately show "eventually (\<lambda>x. Z \<le> f x * g x) F"
   proof eventually_elim
     case (elim x)
     with \<open>0 < Z\<close> \<open>0 < c\<close> have "c / 2 * (Z / c * 2) \<le> f x * g x"
       by (intro mult_mono) (auto simp: zero_le_divide_iff)
     with \<open>0 < c\<close> show "Z \<le> f x * g x"
        by simp
   qed
 qed
 
 lemma filterlim_at_top_mult_at_top:
   assumes f: "LIM x F. f x :> at_top"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (f x * g x :: real) :> at_top"
   unfolding filterlim_at_top_gt[where c=0]
 proof safe
   fix Z :: real
   assume "0 < Z"
   from f have "eventually (\<lambda>x. 1 \<le> f x) F"
     unfolding filterlim_at_top by auto
   moreover from g have "eventually (\<lambda>x. Z \<le> g x) F"
     unfolding filterlim_at_top by auto
   ultimately show "eventually (\<lambda>x. Z \<le> f x * g x) F"
   proof eventually_elim
     case (elim x)
     with \<open>0 < Z\<close> have "1 * Z \<le> f x * g x"
       by (intro mult_mono) (auto simp: zero_le_divide_iff)
     then show "Z \<le> f x * g x"
        by simp
   qed
 qed
 
 lemma filterlim_at_top_mult_tendsto_pos:
   assumes f: "(f \<longlongrightarrow> c) F"
     and c: "0 < c"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (g x * f x:: real) :> at_top"
   by (auto simp: mult.commute intro!: filterlim_tendsto_pos_mult_at_top f c g)
 
 lemma filterlim_tendsto_pos_mult_at_bot:
   fixes c :: real
   assumes "(f \<longlongrightarrow> c) F" "0 < c" "filterlim g at_bot F"
   shows "LIM x F. f x * g x :> at_bot"
   using filterlim_tendsto_pos_mult_at_top[OF assms(1,2), of "\<lambda>x. - g x"] assms(3)
   unfolding filterlim_uminus_at_bot by simp
 
 lemma filterlim_tendsto_neg_mult_at_bot:
   fixes c :: real
   assumes c: "(f \<longlongrightarrow> c) F" "c < 0" and g: "filterlim g at_top F"
   shows "LIM x F. f x * g x :> at_bot"
   using c filterlim_tendsto_pos_mult_at_top[of "\<lambda>x. - f x" "- c" F, OF _ _ g]
   unfolding filterlim_uminus_at_bot tendsto_minus_cancel_left by simp
 
 lemma filterlim_pow_at_top:
   fixes f :: "'a \<Rightarrow> real"
   assumes "0 < n"
     and f: "LIM x F. f x :> at_top"
   shows "LIM x F. (f x)^n :: real :> at_top"
   using \<open>0 < n\<close>
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n) with f show ?case
     by (cases "n = 0") (auto intro!: filterlim_at_top_mult_at_top)
 qed
 
 lemma filterlim_pow_at_bot_even:
   fixes f :: "real \<Rightarrow> real"
   shows "0 < n \<Longrightarrow> LIM x F. f x :> at_bot \<Longrightarrow> even n \<Longrightarrow> LIM x F. (f x)^n :> at_top"
   using filterlim_pow_at_top[of n "\<lambda>x. - f x" F] by (simp add: filterlim_uminus_at_top)
 
 lemma filterlim_pow_at_bot_odd:
   fixes f :: "real \<Rightarrow> real"
   shows "0 < n \<Longrightarrow> LIM x F. f x :> at_bot \<Longrightarrow> odd n \<Longrightarrow> LIM x F. (f x)^n :> at_bot"
   using filterlim_pow_at_top[of n "\<lambda>x. - f x" F] by (simp add: filterlim_uminus_at_bot)
 
 lemma filterlim_power_at_infinity [tendsto_intros]:
   fixes F and f :: "'a \<Rightarrow> 'b :: real_normed_div_algebra"
   assumes "filterlim f at_infinity F" "n > 0"
   shows   "filterlim (\<lambda>x. f x ^ n) at_infinity F"
   by (rule filterlim_norm_at_top_imp_at_infinity)
      (auto simp: norm_power intro!: filterlim_pow_at_top assms
            intro: filterlim_at_infinity_imp_norm_at_top)
 
 lemma filterlim_tendsto_add_at_top:
   assumes f: "(f \<longlongrightarrow> c) F"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (f x + g x :: real) :> at_top"
   unfolding filterlim_at_top_gt[where c=0]
 proof safe
   fix Z :: real
   assume "0 < Z"
   from f have "eventually (\<lambda>x. c - 1 < f x) F"
     by (auto dest!: tendstoD[where e=1] elim!: eventually_mono simp: dist_real_def)
   moreover from g have "eventually (\<lambda>x. Z - (c - 1) \<le> g x) F"
     unfolding filterlim_at_top by auto
   ultimately show "eventually (\<lambda>x. Z \<le> f x + g x) F"
     by eventually_elim simp
 qed
 
 lemma LIM_at_top_divide:
   fixes f g :: "'a \<Rightarrow> real"
   assumes f: "(f \<longlongrightarrow> a) F" "0 < a"
     and g: "(g \<longlongrightarrow> 0) F" "eventually (\<lambda>x. 0 < g x) F"
   shows "LIM x F. f x / g x :> at_top"
   unfolding divide_inverse
   by (rule filterlim_tendsto_pos_mult_at_top[OF f]) (rule filterlim_inverse_at_top[OF g])
 
 lemma filterlim_at_top_add_at_top:
   assumes f: "LIM x F. f x :> at_top"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (f x + g x :: real) :> at_top"
   unfolding filterlim_at_top_gt[where c=0]
 proof safe
   fix Z :: real
   assume "0 < Z"
   from f have "eventually (\<lambda>x. 0 \<le> f x) F"
     unfolding filterlim_at_top by auto
   moreover from g have "eventually (\<lambda>x. Z \<le> g x) F"
     unfolding filterlim_at_top by auto
   ultimately show "eventually (\<lambda>x. Z \<le> f x + g x) F"
     by eventually_elim simp
 qed
 
 lemma tendsto_divide_0:
   fixes f :: "_ \<Rightarrow> 'a::{real_normed_div_algebra, division_ring}"
   assumes f: "(f \<longlongrightarrow> c) F"
     and g: "LIM x F. g x :> at_infinity"
   shows "((\<lambda>x. f x / g x) \<longlongrightarrow> 0) F"
   using tendsto_mult[OF f filterlim_compose[OF tendsto_inverse_0 g]]
   by (simp add: divide_inverse)
 
 lemma linear_plus_1_le_power:
   fixes x :: real
   assumes x: "0 \<le> x"
   shows "real n * x + 1 \<le> (x + 1) ^ n"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   from x have "real (Suc n) * x + 1 \<le> (x + 1) * (real n * x + 1)"
     by (simp add: field_simps)
   also have "\<dots> \<le> (x + 1)^Suc n"
     using Suc x by (simp add: mult_left_mono)
   finally show ?case .
 qed
 
 lemma filterlim_realpow_sequentially_gt1:
   fixes x :: "'a :: real_normed_div_algebra"
   assumes x[arith]: "1 < norm x"
   shows "LIM n sequentially. x ^ n :> at_infinity"
 proof (intro filterlim_at_infinity[THEN iffD2] allI impI)
   fix y :: real
   assume "0 < y"
   obtain N :: nat where "y < real N * (norm x - 1)"
     by (meson diff_gt_0_iff_gt reals_Archimedean3 x)
   also have "\<dots> \<le> real N * (norm x - 1) + 1"
     by simp
   also have "\<dots> \<le> (norm x - 1 + 1) ^ N"
     by (rule linear_plus_1_le_power) simp
   also have "\<dots> = norm x ^ N"
     by simp
   finally have "\<forall>n\<ge>N. y \<le> norm x ^ n"
     by (metis order_less_le_trans power_increasing order_less_imp_le x)
   then show "eventually (\<lambda>n. y \<le> norm (x ^ n)) sequentially"
     unfolding eventually_sequentially
     by (auto simp: norm_power)
 qed simp
 
 
 lemma filterlim_divide_at_infinity:
   fixes f g :: "'a \<Rightarrow> 'a :: real_normed_field"
   assumes "filterlim f (nhds c) F" "filterlim g (at 0) F" "c \<noteq> 0"
   shows   "filterlim (\<lambda>x. f x / g x) at_infinity F"
 proof -
   have "filterlim (\<lambda>x. f x * inverse (g x)) at_infinity F"
     by (intro tendsto_mult_filterlim_at_infinity[OF assms(1,3)]
           filterlim_compose [OF filterlim_inverse_at_infinity assms(2)])
   thus ?thesis by (simp add: field_simps)
 qed
 
 subsection \<open>Floor and Ceiling\<close>
 
 lemma eventually_floor_less:
   fixes f :: "'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes f: "(f \<longlongrightarrow> l) F"
     and l: "l \<notin> \<int>"
   shows "\<forall>\<^sub>F x in F. of_int (floor l) < f x"
   by (intro order_tendstoD[OF f]) (metis Ints_of_int antisym_conv2 floor_correct l)
 
 lemma eventually_less_ceiling:
   fixes f :: "'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes f: "(f \<longlongrightarrow> l) F"
     and l: "l \<notin> \<int>"
   shows "\<forall>\<^sub>F x in F. f x < of_int (ceiling l)"
   by (intro order_tendstoD[OF f]) (metis Ints_of_int l le_of_int_ceiling less_le)
 
 lemma eventually_floor_eq:
   fixes f::"'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes f: "(f \<longlongrightarrow> l) F"
     and l: "l \<notin> \<int>"
   shows "\<forall>\<^sub>F x in F. floor (f x) = floor l"
   using eventually_floor_less[OF assms] eventually_less_ceiling[OF assms]
   by eventually_elim (meson floor_less_iff less_ceiling_iff not_less_iff_gr_or_eq)
 
 lemma eventually_ceiling_eq:
   fixes f::"'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes f: "(f \<longlongrightarrow> l) F"
     and l: "l \<notin> \<int>"
   shows "\<forall>\<^sub>F x in F. ceiling (f x) = ceiling l"
   using eventually_floor_less[OF assms] eventually_less_ceiling[OF assms]
   by eventually_elim (meson floor_less_iff less_ceiling_iff not_less_iff_gr_or_eq)
 
 lemma tendsto_of_int_floor:
   fixes f::"'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes "(f \<longlongrightarrow> l) F"
     and "l \<notin> \<int>"
   shows "((\<lambda>x. of_int (floor (f x)) :: 'c::{ring_1,topological_space}) \<longlongrightarrow> of_int (floor l)) F"
   using eventually_floor_eq[OF assms]
   by (simp add: eventually_mono topological_tendstoI)
 
 lemma tendsto_of_int_ceiling:
   fixes f::"'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes "(f \<longlongrightarrow> l) F"
     and "l \<notin> \<int>"
   shows "((\<lambda>x. of_int (ceiling (f x)):: 'c::{ring_1,topological_space}) \<longlongrightarrow> of_int (ceiling l)) F"
   using eventually_ceiling_eq[OF assms]
   by (simp add: eventually_mono topological_tendstoI)
 
 lemma continuous_on_of_int_floor:
   "continuous_on (UNIV - \<int>::'a::{order_topology, floor_ceiling} set)
     (\<lambda>x. of_int (floor x)::'b::{ring_1, topological_space})"
   unfolding continuous_on_def
   by (auto intro!: tendsto_of_int_floor)
 
 lemma continuous_on_of_int_ceiling:
   "continuous_on (UNIV - \<int>::'a::{order_topology, floor_ceiling} set)
     (\<lambda>x. of_int (ceiling x)::'b::{ring_1, topological_space})"
   unfolding continuous_on_def
   by (auto intro!: tendsto_of_int_ceiling)
 
 
 subsection \<open>Limits of Sequences\<close>
 
 lemma [trans]: "X = Y \<Longrightarrow> Y \<longlonglongrightarrow> z \<Longrightarrow> X \<longlonglongrightarrow> z"
   by simp
 
 lemma LIMSEQ_iff:
   fixes L :: "'a::real_normed_vector"
   shows "(X \<longlonglongrightarrow> L) = (\<forall>r>0. \<exists>no. \<forall>n \<ge> no. norm (X n - L) < r)"
 unfolding lim_sequentially dist_norm ..
 
 lemma LIMSEQ_I: "(\<And>r. 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. norm (X n - L) < r) \<Longrightarrow> X \<longlonglongrightarrow> L"
   for L :: "'a::real_normed_vector"
   by (simp add: LIMSEQ_iff)
 
 lemma LIMSEQ_D: "X \<longlonglongrightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. norm (X n - L) < r"
   for L :: "'a::real_normed_vector"
   by (simp add: LIMSEQ_iff)
 
 lemma LIMSEQ_linear: "X \<longlonglongrightarrow> x \<Longrightarrow> l > 0 \<Longrightarrow> (\<lambda> n. X (n * l)) \<longlonglongrightarrow> x"
   unfolding tendsto_def eventually_sequentially
   by (metis div_le_dividend div_mult_self1_is_m le_trans mult.commute)
 
 
 text \<open>Transformation of limit.\<close>
 
 lemma Lim_transform: "(g \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f x - g x) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> a) F"
   for a b :: "'a::real_normed_vector"
   using tendsto_add [of g a F "\<lambda>x. f x - g x" 0] by simp
 
 lemma Lim_transform2: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f x - g x) \<longlongrightarrow> 0) F \<Longrightarrow> (g \<longlongrightarrow> a) F"
   for a b :: "'a::real_normed_vector"
   by (erule Lim_transform) (simp add: tendsto_minus_cancel)
 
 proposition Lim_transform_eq: "((\<lambda>x. f x - g x) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> a) F \<longleftrightarrow> (g \<longlongrightarrow> a) F"
   for a :: "'a::real_normed_vector"
   using Lim_transform Lim_transform2 by blast
 
 lemma Lim_transform_eventually:
   "\<lbrakk>(f \<longlongrightarrow> l) F; eventually (\<lambda>x. f x = g x) F\<rbrakk> \<Longrightarrow> (g \<longlongrightarrow> l) F"
   using eventually_elim2 by (fastforce simp add: tendsto_def)
 
 lemma Lim_transform_within:
   assumes "(f \<longlongrightarrow> l) (at x within S)"
     and "0 < d"
     and "\<And>x'. x'\<in>S \<Longrightarrow> 0 < dist x' x \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x'"
   shows "(g \<longlongrightarrow> l) (at x within S)"
 proof (rule Lim_transform_eventually)
   show "eventually (\<lambda>x. f x = g x) (at x within S)"
     using assms by (auto simp: eventually_at)
   show "(f \<longlongrightarrow> l) (at x within S)"
     by fact
 qed
 
 lemma filterlim_transform_within:
   assumes "filterlim g G (at x within S)"
   assumes "G \<le> F" "0<d" "(\<And>x'. x' \<in> S \<Longrightarrow> 0 < dist x' x \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x') "
   shows "filterlim f F (at x within S)"
   using assms
   apply (elim filterlim_mono_eventually)
   unfolding eventually_at by auto
 
 text \<open>Common case assuming being away from some crucial point like 0.\<close>
 lemma Lim_transform_away_within:
   fixes a b :: "'a::t1_space"
   assumes "a \<noteq> b"
     and "\<forall>x\<in>S. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
     and "(f \<longlongrightarrow> l) (at a within S)"
   shows "(g \<longlongrightarrow> l) (at a within S)"
 proof (rule Lim_transform_eventually)
   show "(f \<longlongrightarrow> l) (at a within S)"
     by fact
   show "eventually (\<lambda>x. f x = g x) (at a within S)"
     unfolding eventually_at_topological
     by (rule exI [where x="- {b}"]) (simp add: open_Compl assms)
 qed
 
 lemma Lim_transform_away_at:
   fixes a b :: "'a::t1_space"
   assumes ab: "a \<noteq> b"
     and fg: "\<forall>x. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
     and fl: "(f \<longlongrightarrow> l) (at a)"
   shows "(g \<longlongrightarrow> l) (at a)"
   using Lim_transform_away_within[OF ab, of UNIV f g l] fg fl by simp
 
 text \<open>Alternatively, within an open set.\<close>
 lemma Lim_transform_within_open:
   assumes "(f \<longlongrightarrow> l) (at a within T)"
     and "open s" and "a \<in> s"
     and "\<And>x. x\<in>s \<Longrightarrow> x \<noteq> a \<Longrightarrow> f x = g x"
   shows "(g \<longlongrightarrow> l) (at a within T)"
 proof (rule Lim_transform_eventually)
   show "eventually (\<lambda>x. f x = g x) (at a within T)"
     unfolding eventually_at_topological
     using assms by auto
   show "(f \<longlongrightarrow> l) (at a within T)" by fact
 qed
 
 
 text \<open>A congruence rule allowing us to transform limits assuming not at point.\<close>
 
 lemma Lim_cong_within:
   assumes "a = b"
     and "x = y"
     and "S = T"
     and "\<And>x. x \<noteq> b \<Longrightarrow> x \<in> T \<Longrightarrow> f x = g x"
   shows "(f \<longlongrightarrow> x) (at a within S) \<longleftrightarrow> (g \<longlongrightarrow> y) (at b within T)"
   unfolding tendsto_def eventually_at_topological
   using assms by simp
 
 text \<open>An unbounded sequence's inverse tends to 0.\<close>
 lemma LIMSEQ_inverse_zero:
   assumes "\<And>r::real. \<exists>N. \<forall>n\<ge>N. r < X n"
   shows "(\<lambda>n. inverse (X n)) \<longlonglongrightarrow> 0"
   apply (rule filterlim_compose[OF tendsto_inverse_0])
   by (metis assms eventually_at_top_linorderI filterlim_at_top_dense filterlim_at_top_imp_at_infinity)
 
 text \<open>The sequence \<^term>\<open>1/n\<close> tends to 0 as \<^term>\<open>n\<close> tends to infinity.\<close>
 lemma LIMSEQ_inverse_real_of_nat: "(\<lambda>n. inverse (real (Suc n))) \<longlonglongrightarrow> 0"
   by (metis filterlim_compose tendsto_inverse_0 filterlim_mono order_refl filterlim_Suc
       filterlim_compose[OF filterlim_real_sequentially] at_top_le_at_infinity)
 
 text \<open>
   The sequence \<^term>\<open>r + 1/n\<close> tends to \<^term>\<open>r\<close> as \<^term>\<open>n\<close> tends to
   infinity is now easily proved.
 \<close>
 
 lemma LIMSEQ_inverse_real_of_nat_add: "(\<lambda>n. r + inverse (real (Suc n))) \<longlonglongrightarrow> r"
   using tendsto_add [OF tendsto_const LIMSEQ_inverse_real_of_nat] by auto
 
 lemma LIMSEQ_inverse_real_of_nat_add_minus: "(\<lambda>n. r + -inverse (real (Suc n))) \<longlonglongrightarrow> r"
   using tendsto_add [OF tendsto_const tendsto_minus [OF LIMSEQ_inverse_real_of_nat]]
   by auto
 
 lemma LIMSEQ_inverse_real_of_nat_add_minus_mult: "(\<lambda>n. r * (1 + - inverse (real (Suc n)))) \<longlonglongrightarrow> r"
   using tendsto_mult [OF tendsto_const LIMSEQ_inverse_real_of_nat_add_minus [of 1]]
   by auto
 
 lemma lim_inverse_n: "((\<lambda>n. inverse(of_nat n)) \<longlongrightarrow> (0::'a::real_normed_field)) sequentially"
   using lim_1_over_n by (simp add: inverse_eq_divide)
 
 lemma lim_inverse_n': "((\<lambda>n. 1 / n) \<longlongrightarrow> 0) sequentially"
   using lim_inverse_n
   by (simp add: inverse_eq_divide)
 
 lemma LIMSEQ_Suc_n_over_n: "(\<lambda>n. of_nat (Suc n) / of_nat n :: 'a :: real_normed_field) \<longlonglongrightarrow> 1"
 proof (rule Lim_transform_eventually)
   show "eventually (\<lambda>n. 1 + inverse (of_nat n :: 'a) = of_nat (Suc n) / of_nat n) sequentially"
     using eventually_gt_at_top[of "0::nat"]
     by eventually_elim (simp add: field_simps)
   have "(\<lambda>n. 1 + inverse (of_nat n) :: 'a) \<longlonglongrightarrow> 1 + 0"
     by (intro tendsto_add tendsto_const lim_inverse_n)
   then show "(\<lambda>n. 1 + inverse (of_nat n) :: 'a) \<longlonglongrightarrow> 1"
     by simp
 qed
 
 lemma LIMSEQ_n_over_Suc_n: "(\<lambda>n. of_nat n / of_nat (Suc n) :: 'a :: real_normed_field) \<longlonglongrightarrow> 1"
 proof (rule Lim_transform_eventually)
   show "eventually (\<lambda>n. inverse (of_nat (Suc n) / of_nat n :: 'a) =
       of_nat n / of_nat (Suc n)) sequentially"
     using eventually_gt_at_top[of "0::nat"]
     by eventually_elim (simp add: field_simps del: of_nat_Suc)
   have "(\<lambda>n. inverse (of_nat (Suc n) / of_nat n :: 'a)) \<longlonglongrightarrow> inverse 1"
     by (intro tendsto_inverse LIMSEQ_Suc_n_over_n) simp_all
   then show "(\<lambda>n. inverse (of_nat (Suc n) / of_nat n :: 'a)) \<longlonglongrightarrow> 1"
     by simp
 qed
 
 
 subsection \<open>Convergence on sequences\<close>
 
 lemma convergent_cong:
   assumes "eventually (\<lambda>x. f x = g x) sequentially"
   shows "convergent f \<longleftrightarrow> convergent g"
   unfolding convergent_def
   by (subst filterlim_cong[OF refl refl assms]) (rule refl)
 
 lemma convergent_Suc_iff: "convergent (\<lambda>n. f (Suc n)) \<longleftrightarrow> convergent f"
   by (auto simp: convergent_def filterlim_sequentially_Suc)
 
 lemma convergent_ignore_initial_segment: "convergent (\<lambda>n. f (n + m)) = convergent f"
 proof (induct m arbitrary: f)
   case 0
   then show ?case by simp
 next
   case (Suc m)
   have "convergent (\<lambda>n. f (n + Suc m)) \<longleftrightarrow> convergent (\<lambda>n. f (Suc n + m))"
     by simp
   also have "\<dots> \<longleftrightarrow> convergent (\<lambda>n. f (n + m))"
     by (rule convergent_Suc_iff)
   also have "\<dots> \<longleftrightarrow> convergent f"
     by (rule Suc)
   finally show ?case .
 qed
 
 lemma convergent_add:
   fixes X Y :: "nat \<Rightarrow> 'a::topological_monoid_add"
   assumes "convergent (\<lambda>n. X n)"
     and "convergent (\<lambda>n. Y n)"
   shows "convergent (\<lambda>n. X n + Y n)"
   using assms unfolding convergent_def by (blast intro: tendsto_add)
 
 lemma convergent_sum:
   fixes X :: "'a \<Rightarrow> nat \<Rightarrow> 'b::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> A \<Longrightarrow> convergent (\<lambda>n. X i n)) \<Longrightarrow> convergent (\<lambda>n. \<Sum>i\<in>A. X i n)"
   by (induct A rule: infinite_finite_induct) (simp_all add: convergent_const convergent_add)
 
 lemma (in bounded_linear) convergent:
   assumes "convergent (\<lambda>n. X n)"
   shows "convergent (\<lambda>n. f (X n))"
   using assms unfolding convergent_def by (blast intro: tendsto)
 
 lemma (in bounded_bilinear) convergent:
   assumes "convergent (\<lambda>n. X n)"
     and "convergent (\<lambda>n. Y n)"
   shows "convergent (\<lambda>n. X n ** Y n)"
   using assms unfolding convergent_def by (blast intro: tendsto)
 
 lemma convergent_minus_iff:
   fixes X :: "nat \<Rightarrow> 'a::topological_group_add"
   shows "convergent X \<longleftrightarrow> convergent (\<lambda>n. - X n)"
   unfolding convergent_def by (force dest: tendsto_minus)
 
 lemma convergent_diff:
   fixes X Y :: "nat \<Rightarrow> 'a::topological_group_add"
   assumes "convergent (\<lambda>n. X n)"
   assumes "convergent (\<lambda>n. Y n)"
   shows "convergent (\<lambda>n. X n - Y n)"
   using assms unfolding convergent_def by (blast intro: tendsto_diff)
 
 lemma convergent_norm:
   assumes "convergent f"
   shows "convergent (\<lambda>n. norm (f n))"
 proof -
   from assms have "f \<longlonglongrightarrow> lim f"
     by (simp add: convergent_LIMSEQ_iff)
   then have "(\<lambda>n. norm (f n)) \<longlonglongrightarrow> norm (lim f)"
     by (rule tendsto_norm)
   then show ?thesis
     by (auto simp: convergent_def)
 qed
 
 lemma convergent_of_real:
   "convergent f \<Longrightarrow> convergent (\<lambda>n. of_real (f n) :: 'a::real_normed_algebra_1)"
   unfolding convergent_def by (blast intro!: tendsto_of_real)
 
 lemma convergent_add_const_iff:
   "convergent (\<lambda>n. c + f n :: 'a::topological_ab_group_add) \<longleftrightarrow> convergent f"
 proof
   assume "convergent (\<lambda>n. c + f n)"
   from convergent_diff[OF this convergent_const[of c]] show "convergent f"
     by simp
 next
   assume "convergent f"
   from convergent_add[OF convergent_const[of c] this] show "convergent (\<lambda>n. c + f n)"
     by simp
 qed
 
 lemma convergent_add_const_right_iff:
   "convergent (\<lambda>n. f n + c :: 'a::topological_ab_group_add) \<longleftrightarrow> convergent f"
   using convergent_add_const_iff[of c f] by (simp add: add_ac)
 
 lemma convergent_diff_const_right_iff:
   "convergent (\<lambda>n. f n - c :: 'a::topological_ab_group_add) \<longleftrightarrow> convergent f"
   using convergent_add_const_right_iff[of f "-c"] by (simp add: add_ac)
 
 lemma convergent_mult:
   fixes X Y :: "nat \<Rightarrow> 'a::topological_semigroup_mult"
   assumes "convergent (\<lambda>n. X n)"
     and "convergent (\<lambda>n. Y n)"
   shows "convergent (\<lambda>n. X n * Y n)"
   using assms unfolding convergent_def by (blast intro: tendsto_mult)
 
 lemma convergent_mult_const_iff:
   assumes "c \<noteq> 0"
   shows "convergent (\<lambda>n. c * f n :: 'a::{field,topological_semigroup_mult}) \<longleftrightarrow> convergent f"
 proof
   assume "convergent (\<lambda>n. c * f n)"
   from assms convergent_mult[OF this convergent_const[of "inverse c"]]
     show "convergent f" by (simp add: field_simps)
 next
   assume "convergent f"
   from convergent_mult[OF convergent_const[of c] this] show "convergent (\<lambda>n. c * f n)"
     by simp
 qed
 
 lemma convergent_mult_const_right_iff:
   fixes c :: "'a::{field,topological_semigroup_mult}"
   assumes "c \<noteq> 0"
   shows "convergent (\<lambda>n. f n * c) \<longleftrightarrow> convergent f"
   using convergent_mult_const_iff[OF assms, of f] by (simp add: mult_ac)
 
 lemma convergent_imp_Bseq: "convergent f \<Longrightarrow> Bseq f"
   by (simp add: Cauchy_Bseq convergent_Cauchy)
 
 
 text \<open>A monotone sequence converges to its least upper bound.\<close>
 
 lemma LIMSEQ_incseq_SUP:
   fixes X :: "nat \<Rightarrow> 'a::{conditionally_complete_linorder,linorder_topology}"
   assumes u: "bdd_above (range X)"
     and X: "incseq X"
   shows "X \<longlonglongrightarrow> (SUP i. X i)"
   by (rule order_tendstoI)
     (auto simp: eventually_sequentially u less_cSUP_iff
       intro: X[THEN incseqD] less_le_trans cSUP_lessD[OF u])
 
 lemma LIMSEQ_decseq_INF:
   fixes X :: "nat \<Rightarrow> 'a::{conditionally_complete_linorder, linorder_topology}"
   assumes u: "bdd_below (range X)"
     and X: "decseq X"
   shows "X \<longlonglongrightarrow> (INF i. X i)"
   by (rule order_tendstoI)
      (auto simp: eventually_sequentially u cINF_less_iff
        intro: X[THEN decseqD] le_less_trans less_cINF_D[OF u])
 
 text \<open>Main monotonicity theorem.\<close>
 
 lemma Bseq_monoseq_convergent: "Bseq X \<Longrightarrow> monoseq X \<Longrightarrow> convergent X"
   for X :: "nat \<Rightarrow> real"
   by (auto simp: monoseq_iff convergent_def intro: LIMSEQ_decseq_INF LIMSEQ_incseq_SUP
       dest: Bseq_bdd_above Bseq_bdd_below)
 
 lemma Bseq_mono_convergent: "Bseq X \<Longrightarrow> (\<forall>m n. m \<le> n \<longrightarrow> X m \<le> X n) \<Longrightarrow> convergent X"
   for X :: "nat \<Rightarrow> real"
   by (auto intro!: Bseq_monoseq_convergent incseq_imp_monoseq simp: incseq_def)
 
 lemma monoseq_imp_convergent_iff_Bseq: "monoseq f \<Longrightarrow> convergent f \<longleftrightarrow> Bseq f"
   for f :: "nat \<Rightarrow> real"
   using Bseq_monoseq_convergent[of f] convergent_imp_Bseq[of f] by blast
 
 lemma Bseq_monoseq_convergent'_inc:
   fixes f :: "nat \<Rightarrow> real"
   shows "Bseq (\<lambda>n. f (n + M)) \<Longrightarrow> (\<And>m n. M \<le> m \<Longrightarrow> m \<le> n \<Longrightarrow> f m \<le> f n) \<Longrightarrow> convergent f"
   by (subst convergent_ignore_initial_segment [symmetric, of _ M])
      (auto intro!: Bseq_monoseq_convergent simp: monoseq_def)
 
 lemma Bseq_monoseq_convergent'_dec:
   fixes f :: "nat \<Rightarrow> real"
   shows "Bseq (\<lambda>n. f (n + M)) \<Longrightarrow> (\<And>m n. M \<le> m \<Longrightarrow> m \<le> n \<Longrightarrow> f m \<ge> f n) \<Longrightarrow> convergent f"
   by (subst convergent_ignore_initial_segment [symmetric, of _ M])
     (auto intro!: Bseq_monoseq_convergent simp: monoseq_def)
 
 lemma Cauchy_iff: "Cauchy X \<longleftrightarrow> (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (X m - X n) < e)"
   for X :: "nat \<Rightarrow> 'a::real_normed_vector"
   unfolding Cauchy_def dist_norm ..
 
 lemma CauchyI: "(\<And>e. 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (X m - X n) < e) \<Longrightarrow> Cauchy X"
   for X :: "nat \<Rightarrow> 'a::real_normed_vector"
   by (simp add: Cauchy_iff)
 
 lemma CauchyD: "Cauchy X \<Longrightarrow> 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (X m - X n) < e"
   for X :: "nat \<Rightarrow> 'a::real_normed_vector"
   by (simp add: Cauchy_iff)
 
 lemma incseq_convergent:
   fixes X :: "nat \<Rightarrow> real"
   assumes "incseq X"
     and "\<forall>i. X i \<le> B"
   obtains L where "X \<longlonglongrightarrow> L" "\<forall>i. X i \<le> L"
 proof atomize_elim
   from incseq_bounded[OF assms] \<open>incseq X\<close> Bseq_monoseq_convergent[of X]
   obtain L where "X \<longlonglongrightarrow> L"
     by (auto simp: convergent_def monoseq_def incseq_def)
   with \<open>incseq X\<close> show "\<exists>L. X \<longlonglongrightarrow> L \<and> (\<forall>i. X i \<le> L)"
     by (auto intro!: exI[of _ L] incseq_le)
 qed
 
 lemma decseq_convergent:
   fixes X :: "nat \<Rightarrow> real"
   assumes "decseq X"
     and "\<forall>i. B \<le> X i"
   obtains L where "X \<longlonglongrightarrow> L" "\<forall>i. L \<le> X i"
 proof atomize_elim
   from decseq_bounded[OF assms] \<open>decseq X\<close> Bseq_monoseq_convergent[of X]
   obtain L where "X \<longlonglongrightarrow> L"
     by (auto simp: convergent_def monoseq_def decseq_def)
   with \<open>decseq X\<close> show "\<exists>L. X \<longlonglongrightarrow> L \<and> (\<forall>i. L \<le> X i)"
     by (auto intro!: exI[of _ L] decseq_ge)
 qed
 
 lemma monoseq_convergent:
   fixes X :: "nat \<Rightarrow> real"
   assumes X: "monoseq X" and B: "\<And>i. \<bar>X i\<bar> \<le> B"
   obtains L where "X \<longlonglongrightarrow> L"
   using X unfolding monoseq_iff
 proof
   assume "incseq X"
   show thesis
     using abs_le_D1 [OF B] incseq_convergent [OF \<open>incseq X\<close>] that by meson
 next
   assume "decseq X"
   show thesis
     using decseq_convergent [OF \<open>decseq X\<close>] that
     by (metis B abs_le_iff add.inverse_inverse neg_le_iff_le)
 qed
 
 subsection \<open>Power Sequences\<close>
 
 lemma Bseq_realpow: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> Bseq (\<lambda>n. x ^ n)"
   for x :: real
   by (metis decseq_bounded decseq_def power_decreasing zero_le_power)
 
 lemma monoseq_realpow: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> monoseq (\<lambda>n. x ^ n)"
   for x :: real
   using monoseq_def power_decreasing by blast
 
 lemma convergent_realpow: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> convergent (\<lambda>n. x ^ n)"
   for x :: real
   by (blast intro!: Bseq_monoseq_convergent Bseq_realpow monoseq_realpow)
 
 lemma LIMSEQ_inverse_realpow_zero: "1 < x \<Longrightarrow> (\<lambda>n. inverse (x ^ n)) \<longlonglongrightarrow> 0"
   for x :: real
   by (rule filterlim_compose[OF tendsto_inverse_0 filterlim_realpow_sequentially_gt1]) simp
 
 lemma LIMSEQ_realpow_zero:
   fixes x :: real
   assumes "0 \<le> x" "x < 1"
   shows "(\<lambda>n. x ^ n) \<longlonglongrightarrow> 0"
 proof (cases "x = 0")
   case False
   with \<open>0 \<le> x\<close> have x0: "0 < x" by simp
   then have "1 < inverse x"
     using \<open>x < 1\<close> by (rule one_less_inverse)
   then have "(\<lambda>n. inverse (inverse x ^ n)) \<longlonglongrightarrow> 0"
     by (rule LIMSEQ_inverse_realpow_zero)
   then show ?thesis by (simp add: power_inverse)
 next
   case True
   show ?thesis
     by (rule LIMSEQ_imp_Suc) (simp add: True)
 qed
 
 lemma LIMSEQ_power_zero [tendsto_intros]: "norm x < 1 \<Longrightarrow> (\<lambda>n. x ^ n) \<longlonglongrightarrow> 0"
   for x :: "'a::real_normed_algebra_1"
   apply (drule LIMSEQ_realpow_zero [OF norm_ge_zero])
   by (simp add: Zfun_le norm_power_ineq tendsto_Zfun_iff)
 
 lemma LIMSEQ_divide_realpow_zero: "1 < x \<Longrightarrow> (\<lambda>n. a / (x ^ n) :: real) \<longlonglongrightarrow> 0"
   by (rule tendsto_divide_0 [OF tendsto_const filterlim_realpow_sequentially_gt1]) simp
 
 lemma
   tendsto_power_zero:
   fixes x::"'a::real_normed_algebra_1"
   assumes "filterlim f at_top F"
   assumes "norm x < 1"
   shows "((\<lambda>y. x ^ (f y)) \<longlongrightarrow> 0) F"
 proof (rule tendstoI)
   fix e::real assume "0 < e"
   from tendstoD[OF LIMSEQ_power_zero[OF \<open>norm x < 1\<close>] \<open>0 < e\<close>]
   have "\<forall>\<^sub>F xa in sequentially. norm (x ^ xa) < e"
     by simp
   then obtain N where N: "norm (x ^ n) < e" if "n \<ge> N" for n
     by (auto simp: eventually_sequentially)
   have "\<forall>\<^sub>F i in F. f i \<ge> N"
     using \<open>filterlim f sequentially F\<close>
     by (simp add: filterlim_at_top)
   then show "\<forall>\<^sub>F i in F. dist (x ^ f i) 0 < e"
     by eventually_elim (auto simp: N)
 qed
 
 text \<open>Limit of \<^term>\<open>c^n\<close> for \<^term>\<open>\<bar>c\<bar> < 1\<close>.\<close>
 
 lemma LIMSEQ_abs_realpow_zero: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. \<bar>c\<bar> ^ n :: real) \<longlonglongrightarrow> 0"
   by (rule LIMSEQ_realpow_zero [OF abs_ge_zero])
 
 lemma LIMSEQ_abs_realpow_zero2: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. c ^ n :: real) \<longlonglongrightarrow> 0"
   by (rule LIMSEQ_power_zero) simp
 
 
 subsection \<open>Limits of Functions\<close>
 
 lemma LIM_eq: "f \<midarrow>a\<rightarrow> L = (\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r)"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_def dist_norm)
 
 lemma LIM_I:
   "(\<And>r. 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r) \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_eq)
 
 lemma LIM_D: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>s>0.\<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_eq)
 
 lemma LIM_offset: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. f (x + k)) \<midarrow>(a - k)\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (simp add: filtermap_at_shift[symmetric, of a k] filterlim_def filtermap_filtermap)
 
 lemma LIM_offset_zero: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (drule LIM_offset [where k = a]) (simp add: add.commute)
 
 lemma LIM_offset_zero_cancel: "(\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (drule LIM_offset [where k = "- a"]) simp
 
 lemma LIM_offset_zero_iff: "NO_MATCH 0 a \<Longrightarrow> f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L"
   for f :: "'a :: real_normed_vector \<Rightarrow> _"
   using LIM_offset_zero_cancel[of f a L] LIM_offset_zero[of f L a] by auto
 
 lemma tendsto_offset_zero_iff:
   fixes f :: "'a :: real_normed_vector \<Rightarrow> _"
   assumes " NO_MATCH 0 a" "a \<in> S" "open S"
   shows "(f \<longlongrightarrow> L) (at a within S) \<longleftrightarrow> ((\<lambda>h. f (a + h)) \<longlongrightarrow> L) (at 0)"
   using assms by (simp add: tendsto_within_open_NO_MATCH LIM_offset_zero_iff)
 
 lemma LIM_zero: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. f x - l) \<longlongrightarrow> 0) F"
   for f :: "'a \<Rightarrow> 'b::real_normed_vector"
   unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_zero_cancel:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   shows "((\<lambda>x. f x - l) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> l) F"
 unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_zero_iff: "((\<lambda>x. f x - l) \<longlongrightarrow> 0) F = (f \<longlongrightarrow> l) F"
   for f :: "'a \<Rightarrow> 'b::real_normed_vector"
   unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_imp_LIM:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   fixes g :: "'a::topological_space \<Rightarrow> 'c::real_normed_vector"
   assumes f: "f \<midarrow>a\<rightarrow> l"
     and le: "\<And>x. x \<noteq> a \<Longrightarrow> norm (g x - m) \<le> norm (f x - l)"
   shows "g \<midarrow>a\<rightarrow> m"
   by (rule metric_LIM_imp_LIM [OF f]) (simp add: dist_norm le)
 
 lemma LIM_equal2:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   assumes "0 < R"
     and "\<And>x. x \<noteq> a \<Longrightarrow> norm (x - a) < R \<Longrightarrow> f x = g x"
   shows "g \<midarrow>a\<rightarrow> l \<Longrightarrow> f \<midarrow>a\<rightarrow> l"
   by (rule metric_LIM_equal2 [OF _ assms]) (simp_all add: dist_norm)
 
 lemma LIM_compose2:
   fixes a :: "'a::real_normed_vector"
   assumes f: "f \<midarrow>a\<rightarrow> b"
     and g: "g \<midarrow>b\<rightarrow> c"
     and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> f x \<noteq> b"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> c"
   by (rule metric_LIM_compose2 [OF f g inj [folded dist_norm]])
 
 lemma real_LIM_sandwich_zero:
   fixes f g :: "'a::topological_space \<Rightarrow> real"
   assumes f: "f \<midarrow>a\<rightarrow> 0"
     and 1: "\<And>x. x \<noteq> a \<Longrightarrow> 0 \<le> g x"
     and 2: "\<And>x. x \<noteq> a \<Longrightarrow> g x \<le> f x"
   shows "g \<midarrow>a\<rightarrow> 0"
 proof (rule LIM_imp_LIM [OF f]) (* FIXME: use tendsto_sandwich *)
   fix x
   assume x: "x \<noteq> a"
   with 1 have "norm (g x - 0) = g x" by simp
   also have "g x \<le> f x" by (rule 2 [OF x])
   also have "f x \<le> \<bar>f x\<bar>" by (rule abs_ge_self)
   also have "\<bar>f x\<bar> = norm (f x - 0)" by simp
   finally show "norm (g x - 0) \<le> norm (f x - 0)" .
 qed
 
 
 subsection \<open>Continuity\<close>
 
 lemma LIM_isCont_iff: "(f \<midarrow>a\<rightarrow> f a) = ((\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> f a)"
   for f :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   by (rule iffI [OF LIM_offset_zero LIM_offset_zero_cancel])
 
 lemma isCont_iff: "isCont f x = (\<lambda>h. f (x + h)) \<midarrow>0\<rightarrow> f x"
   for f :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   by (simp add: isCont_def LIM_isCont_iff)
 
 lemma isCont_LIM_compose2:
   fixes a :: "'a::real_normed_vector"
   assumes f [unfolded isCont_def]: "isCont f a"
     and g: "g \<midarrow>f a\<rightarrow> l"
     and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> f x \<noteq> f a"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> l"
   by (rule LIM_compose2 [OF f g inj])
 
 lemma isCont_norm [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. norm (f x)) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_norm)
 
 lemma isCont_rabs [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. \<bar>f x\<bar>) a"
   for f :: "'a::t2_space \<Rightarrow> real"
   by (fact continuous_rabs)
 
 lemma isCont_add [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x + g x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::topological_monoid_add"
   by (fact continuous_add)
 
 lemma isCont_minus [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. - f x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_minus)
 
 lemma isCont_diff [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x - g x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_diff)
 
 lemma isCont_mult [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x * g x) a"
   for f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_algebra"
   by (fact continuous_mult)
 
 lemma (in bounded_linear) isCont: "isCont g a \<Longrightarrow> isCont (\<lambda>x. f (g x)) a"
   by (fact continuous)
 
 lemma (in bounded_bilinear) isCont: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x ** g x) a"
   by (fact continuous)
 
 lemmas isCont_scaleR [simp] =
   bounded_bilinear.isCont [OF bounded_bilinear_scaleR]
 
 lemmas isCont_of_real [simp] =
   bounded_linear.isCont [OF bounded_linear_of_real]
 
 lemma isCont_power [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. f x ^ n) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::{power,real_normed_algebra}"
   by (fact continuous_power)
 
 lemma isCont_sum [simp]: "\<forall>i\<in>A. isCont (f i) a \<Longrightarrow> isCont (\<lambda>x. \<Sum>i\<in>A. f i x) a"
   for f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::topological_comm_monoid_add"
   by (auto intro: continuous_sum)
 
 
 subsection \<open>Uniform Continuity\<close>
 
 lemma uniformly_continuous_on_def:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   shows "uniformly_continuous_on s f \<longleftrightarrow>
     (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e)"
   unfolding uniformly_continuous_on_uniformity
     uniformity_dist filterlim_INF filterlim_principal eventually_inf_principal
   by (force simp: Ball_def uniformity_dist[symmetric] eventually_uniformity_metric)
 
 abbreviation isUCont :: "['a::metric_space \<Rightarrow> 'b::metric_space] \<Rightarrow> bool"
   where "isUCont f \<equiv> uniformly_continuous_on UNIV f"
 
 lemma isUCont_def: "isUCont f \<longleftrightarrow> (\<forall>r>0. \<exists>s>0. \<forall>x y. dist x y < s \<longrightarrow> dist (f x) (f y) < r)"
   by (auto simp: uniformly_continuous_on_def dist_commute)
 
 lemma isUCont_isCont: "isUCont f \<Longrightarrow> isCont f x"
   by (drule uniformly_continuous_imp_continuous) (simp add: continuous_on_eq_continuous_at)
 
 lemma uniformly_continuous_on_Cauchy:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   assumes "uniformly_continuous_on S f" "Cauchy X" "\<And>n. X n \<in> S"
   shows "Cauchy (\<lambda>n. f (X n))"
   using assms
   unfolding uniformly_continuous_on_def  by (meson Cauchy_def)
 
 lemma isUCont_Cauchy: "isUCont f \<Longrightarrow> Cauchy X \<Longrightarrow> Cauchy (\<lambda>n. f (X n))"
   by (rule uniformly_continuous_on_Cauchy[where S=UNIV and f=f]) simp_all
 
 lemma uniformly_continuous_imp_Cauchy_continuous:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   shows "\<lbrakk>uniformly_continuous_on S f; Cauchy \<sigma>; \<And>n. (\<sigma> n) \<in> S\<rbrakk> \<Longrightarrow> Cauchy(f \<circ> \<sigma>)"
   by (simp add: uniformly_continuous_on_def Cauchy_def) meson
 
 lemma (in bounded_linear) isUCont: "isUCont f"
   unfolding isUCont_def dist_norm
 proof (intro allI impI)
   fix r :: real
   assume r: "0 < r"
   obtain K where K: "0 < K" and norm_le: "norm (f x) \<le> norm x * K" for x
     using pos_bounded by blast
   show "\<exists>s>0. \<forall>x y. norm (x - y) < s \<longrightarrow> norm (f x - f y) < r"
   proof (rule exI, safe)
     from r K show "0 < r / K" by simp
   next
     fix x y :: 'a
     assume xy: "norm (x - y) < r / K"
     have "norm (f x - f y) = norm (f (x - y))" by (simp only: diff)
     also have "\<dots> \<le> norm (x - y) * K" by (rule norm_le)
     also from K xy have "\<dots> < r" by (simp only: pos_less_divide_eq)
     finally show "norm (f x - f y) < r" .
   qed
 qed
 
 lemma (in bounded_linear) Cauchy: "Cauchy X \<Longrightarrow> Cauchy (\<lambda>n. f (X n))"
   by (rule isUCont [THEN isUCont_Cauchy])
 
 lemma LIM_less_bound:
   fixes f :: "real \<Rightarrow> real"
   assumes ev: "b < x" "\<forall> x' \<in> { b <..< x}. 0 \<le> f x'" and "isCont f x"
   shows "0 \<le> f x"
 proof (rule tendsto_lowerbound)
   show "(f \<longlongrightarrow> f x) (at_left x)"
     using \<open>isCont f x\<close> by (simp add: filterlim_at_split isCont_def)
   show "eventually (\<lambda>x. 0 \<le> f x) (at_left x)"
     using ev by (auto simp: eventually_at dist_real_def intro!: exI[of _ "x - b"])
 qed simp
 
 
 subsection \<open>Nested Intervals and Bisection -- Needed for Compactness\<close>
 
 lemma nested_sequence_unique:
   assumes "\<forall>n. f n \<le> f (Suc n)" "\<forall>n. g (Suc n) \<le> g n" "\<forall>n. f n \<le> g n" "(\<lambda>n. f n - g n) \<longlonglongrightarrow> 0"
   shows "\<exists>l::real. ((\<forall>n. f n \<le> l) \<and> f \<longlonglongrightarrow> l) \<and> ((\<forall>n. l \<le> g n) \<and> g \<longlonglongrightarrow> l)"
 proof -
   have "incseq f" unfolding incseq_Suc_iff by fact
   have "decseq g" unfolding decseq_Suc_iff by fact
   have "f n \<le> g 0" for n
   proof -
     from \<open>decseq g\<close> have "g n \<le> g 0"
       by (rule decseqD) simp
     with \<open>\<forall>n. f n \<le> g n\<close>[THEN spec, of n] show ?thesis
       by auto
   qed
   then obtain u where "f \<longlonglongrightarrow> u" "\<forall>i. f i \<le> u"
     using incseq_convergent[OF \<open>incseq f\<close>] by auto
   moreover have "f 0 \<le> g n" for n
   proof -
     from \<open>incseq f\<close> have "f 0 \<le> f n" by (rule incseqD) simp
     with \<open>\<forall>n. f n \<le> g n\<close>[THEN spec, of n] show ?thesis
       by simp
   qed
   then obtain l where "g \<longlonglongrightarrow> l" "\<forall>i. l \<le> g i"
     using decseq_convergent[OF \<open>decseq g\<close>] by auto
   moreover note LIMSEQ_unique[OF assms(4) tendsto_diff[OF \<open>f \<longlonglongrightarrow> u\<close> \<open>g \<longlonglongrightarrow> l\<close>]]
   ultimately show ?thesis by auto
 qed
 
 lemma Bolzano[consumes 1, case_names trans local]:
   fixes P :: "real \<Rightarrow> real \<Rightarrow> bool"
   assumes [arith]: "a \<le> b"
     and trans: "\<And>a b c. P a b \<Longrightarrow> P b c \<Longrightarrow> a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> P a c"
     and local: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> \<exists>d>0. \<forall>a b. a \<le> x \<and> x \<le> b \<and> b - a < d \<longrightarrow> P a b"
   shows "P a b"
 proof -
   define bisect where "bisect =
     rec_nat (a, b) (\<lambda>n (x, y). if P x ((x+y) / 2) then ((x+y)/2, y) else (x, (x+y)/2))"
   define l u where "l n = fst (bisect n)" and "u n = snd (bisect n)" for n
   have l[simp]: "l 0 = a" "\<And>n. l (Suc n) = (if P (l n) ((l n + u n) / 2) then (l n + u n) / 2 else l n)"
     and u[simp]: "u 0 = b" "\<And>n. u (Suc n) = (if P (l n) ((l n + u n) / 2) then u n else (l n + u n) / 2)"
     by (simp_all add: l_def u_def bisect_def split: prod.split)
 
   have [simp]: "l n \<le> u n" for n by (induct n) auto
 
   have "\<exists>x. ((\<forall>n. l n \<le> x) \<and> l \<longlonglongrightarrow> x) \<and> ((\<forall>n. x \<le> u n) \<and> u \<longlonglongrightarrow> x)"
   proof (safe intro!: nested_sequence_unique)
     show "l n \<le> l (Suc n)" "u (Suc n) \<le> u n" for n
       by (induct n) auto
   next
     have "l n - u n = (a - b) / 2^n" for n
       by (induct n) (auto simp: field_simps)
     then show "(\<lambda>n. l n - u n) \<longlonglongrightarrow> 0"
       by (simp add: LIMSEQ_divide_realpow_zero)
   qed fact
   then obtain x where x: "\<And>n. l n \<le> x" "\<And>n. x \<le> u n" and "l \<longlonglongrightarrow> x" "u \<longlonglongrightarrow> x"
     by auto
   obtain d where "0 < d" and d: "a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> b - a < d \<Longrightarrow> P a b" for a b
     using \<open>l 0 \<le> x\<close> \<open>x \<le> u 0\<close> local[of x] by auto
 
   show "P a b"
   proof (rule ccontr)
     assume "\<not> P a b"
     have "\<not> P (l n) (u n)" for n
     proof (induct n)
       case 0
       then show ?case
         by (simp add: \<open>\<not> P a b\<close>)
     next
       case (Suc n)
       with trans[of "l n" "(l n + u n) / 2" "u n"] show ?case
         by auto
     qed
     moreover
     {
       have "eventually (\<lambda>n. x - d / 2 < l n) sequentially"
         using \<open>0 < d\<close> \<open>l \<longlonglongrightarrow> x\<close> by (intro order_tendstoD[of _ x]) auto
       moreover have "eventually (\<lambda>n. u n < x + d / 2) sequentially"
         using \<open>0 < d\<close> \<open>u \<longlonglongrightarrow> x\<close> by (intro order_tendstoD[of _ x]) auto
       ultimately have "eventually (\<lambda>n. P (l n) (u n)) sequentially"
       proof eventually_elim
         case (elim n)
         from add_strict_mono[OF this] have "u n - l n < d" by simp
         with x show "P (l n) (u n)" by (rule d)
       qed
     }
     ultimately show False by simp
   qed
 qed
 
 lemma compact_Icc[simp, intro]: "compact {a .. b::real}"
 proof (cases "a \<le> b", rule compactI)
   fix C
   assume C: "a \<le> b" "\<forall>t\<in>C. open t" "{a..b} \<subseteq> \<Union>C"
   define T where "T = {a .. b}"
   from C(1,3) show "\<exists>C'\<subseteq>C. finite C' \<and> {a..b} \<subseteq> \<Union>C'"
   proof (induct rule: Bolzano)
     case (trans a b c)
     then have *: "{a..c} = {a..b} \<union> {b..c}"
       by auto
     with trans obtain C1 C2
       where "C1\<subseteq>C" "finite C1" "{a..b} \<subseteq> \<Union>C1" "C2\<subseteq>C" "finite C2" "{b..c} \<subseteq> \<Union>C2"
       by auto
     with trans show ?case
       unfolding * by (intro exI[of _ "C1 \<union> C2"]) auto
   next
     case (local x)
     with C have "x \<in> \<Union>C" by auto
     with C(2) obtain c where "x \<in> c" "open c" "c \<in> C"
       by auto
     then obtain e where "0 < e" "{x - e <..< x + e} \<subseteq> c"
       by (auto simp: open_dist dist_real_def subset_eq Ball_def abs_less_iff)
     with \<open>c \<in> C\<close> show ?case
       by (safe intro!: exI[of _ "e/2"] exI[of _ "{c}"]) auto
   qed
 qed simp
 
 
 lemma continuous_image_closed_interval:
   fixes a b and f :: "real \<Rightarrow> real"
   defines "S \<equiv> {a..b}"
   assumes "a \<le> b" and f: "continuous_on S f"
   shows "\<exists>c d. f`S = {c..d} \<and> c \<le> d"
 proof -
   have S: "compact S" "S \<noteq> {}"
     using \<open>a \<le> b\<close> by (auto simp: S_def)
   obtain c where "c \<in> S" "\<forall>d\<in>S. f d \<le> f c"
     using continuous_attains_sup[OF S f] by auto
   moreover obtain d where "d \<in> S" "\<forall>c\<in>S. f d \<le> f c"
     using continuous_attains_inf[OF S f] by auto
   moreover have "connected (f`S)"
     using connected_continuous_image[OF f] connected_Icc by (auto simp: S_def)
   ultimately have "f ` S = {f d .. f c} \<and> f d \<le> f c"
     by (auto simp: connected_iff_interval)
   then show ?thesis
     by auto
 qed
 
 lemma open_Collect_positive:
   fixes f :: "'a::topological_space \<Rightarrow> real"
   assumes f: "continuous_on s f"
   shows "\<exists>A. open A \<and> A \<inter> s = {x\<in>s. 0 < f x}"
   using continuous_on_open_invariant[THEN iffD1, OF f, rule_format, of "{0 <..}"]
   by (auto simp: Int_def field_simps)
 
 lemma open_Collect_less_Int:
   fixes f g :: "'a::topological_space \<Rightarrow> real"
   assumes f: "continuous_on s f"
     and g: "continuous_on s g"
   shows "\<exists>A. open A \<and> A \<inter> s = {x\<in>s. f x < g x}"
   using open_Collect_positive[OF continuous_on_diff[OF g f]] by (simp add: field_simps)
 
 
 subsection \<open>Boundedness of continuous functions\<close>
 
 text\<open>By bisection, function continuous on closed interval is bounded above\<close>
 
 lemma isCont_eq_Ub:
   fixes f :: "real \<Rightarrow> 'a::linorder_topology"
   shows "a \<le> b \<Longrightarrow> \<forall>x::real. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x \<Longrightarrow>
     \<exists>M. (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f x \<le> M) \<and> (\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = M)"
   using continuous_attains_sup[of "{a..b}" f]
   by (auto simp: continuous_at_imp_continuous_on Ball_def Bex_def)
 
 lemma isCont_eq_Lb:
   fixes f :: "real \<Rightarrow> 'a::linorder_topology"
   shows "a \<le> b \<Longrightarrow> \<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x \<Longrightarrow>
     \<exists>M. (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> M \<le> f x) \<and> (\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = M)"
   using continuous_attains_inf[of "{a..b}" f]
   by (auto simp: continuous_at_imp_continuous_on Ball_def Bex_def)
 
 lemma isCont_bounded:
   fixes f :: "real \<Rightarrow> 'a::linorder_topology"
   shows "a \<le> b \<Longrightarrow> \<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x \<Longrightarrow> \<exists>M. \<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f x \<le> M"
   using isCont_eq_Ub[of a b f] by auto
 
 lemma isCont_has_Ub:
   fixes f :: "real \<Rightarrow> 'a::linorder_topology"
   shows "a \<le> b \<Longrightarrow> \<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x \<Longrightarrow>
     \<exists>M. (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f x \<le> M) \<and> (\<forall>N. N < M \<longrightarrow> (\<exists>x. a \<le> x \<and> x \<le> b \<and> N < f x))"
   using isCont_eq_Ub[of a b f] by auto
 
 lemma isCont_Lb_Ub:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<le> b" "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x"
   shows "\<exists>L M. (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> L \<le> f x \<and> f x \<le> M) \<and>
     (\<forall>y. L \<le> y \<and> y \<le> M \<longrightarrow> (\<exists>x. a \<le> x \<and> x \<le> b \<and> (f x = y)))"
 proof -
   obtain M where M: "a \<le> M" "M \<le> b" "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f x \<le> f M"
     using isCont_eq_Ub[OF assms] by auto
   obtain L where L: "a \<le> L" "L \<le> b" "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f L \<le> f x"
     using isCont_eq_Lb[OF assms] by auto
   have "(\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f L \<le> f x \<and> f x \<le> f M)"
     using M L by simp
   moreover
   have "(\<forall>y. f L \<le> y \<and> y \<le> f M \<longrightarrow> (\<exists>x\<ge>a. x \<le> b \<and> f x = y))"
   proof (cases "L \<le> M")
     case True then show ?thesis
     using IVT[of f L _ M] M L assms by (metis order.trans)
   next
     case False then show ?thesis
     using IVT2[of f L _ M]
     by (metis L(2) M(1) assms(2) le_cases order.trans)
 qed
   ultimately show ?thesis
     by blast
 qed
 
 
 text \<open>Continuity of inverse function.\<close>
 
 lemma isCont_inverse_function:
   fixes f g :: "real \<Rightarrow> real"
   assumes d: "0 < d"
     and inj: "\<And>z. \<bar>z-x\<bar> \<le> d \<Longrightarrow> g (f z) = z"
     and cont: "\<And>z. \<bar>z-x\<bar> \<le> d \<Longrightarrow> isCont f z"
   shows "isCont g (f x)"
 proof -
   let ?A = "f (x - d)"
   let ?B = "f (x + d)"
   let ?D = "{x - d..x + d}"
 
   have f: "continuous_on ?D f"
     using cont by (intro continuous_at_imp_continuous_on ballI) auto
   then have g: "continuous_on (f`?D) g"
     using inj by (intro continuous_on_inv) auto
 
   from d f have "{min ?A ?B <..< max ?A ?B} \<subseteq> f ` ?D"
     by (intro connected_contains_Ioo connected_continuous_image) (auto split: split_min split_max)
   with g have "continuous_on {min ?A ?B <..< max ?A ?B} g"
     by (rule continuous_on_subset)
   moreover
   have "(?A < f x \<and> f x < ?B) \<or> (?B < f x \<and> f x < ?A)"
     using d inj by (intro continuous_inj_imp_mono[OF _ _ f] inj_on_imageI2[of g, OF inj_onI]) auto
   then have "f x \<in> {min ?A ?B <..< max ?A ?B}"
     by auto
   ultimately show ?thesis
     by (simp add: continuous_on_eq_continuous_at)
 qed
 
 lemma isCont_inverse_function2:
   fixes f g :: "real \<Rightarrow> real"
   shows
     "\<lbrakk>a < x; x < b;
       \<And>z. \<lbrakk>a \<le> z; z \<le> b\<rbrakk> \<Longrightarrow> g (f z) = z;
       \<And>z. \<lbrakk>a \<le> z; z \<le> b\<rbrakk> \<Longrightarrow> isCont f z\<rbrakk> \<Longrightarrow> isCont g (f x)"
   apply (rule isCont_inverse_function [where f=f and d="min (x - a) (b - x)"])
   apply (simp_all add: abs_le_iff)
   done
 
 text \<open>Bartle/Sherbert: Introduction to Real Analysis, Theorem 4.2.9, p. 110.\<close>
 lemma LIM_fun_gt_zero: "f \<midarrow>c\<rightarrow> l \<Longrightarrow> 0 < l \<Longrightarrow> \<exists>r. 0 < r \<and> (\<forall>x. x \<noteq> c \<and> \<bar>c - x\<bar> < r \<longrightarrow> 0 < f x)"
   for f :: "real \<Rightarrow> real"
   by (force simp: dest: LIM_D)
 
 lemma LIM_fun_less_zero: "f \<midarrow>c\<rightarrow> l \<Longrightarrow> l < 0 \<Longrightarrow> \<exists>r. 0 < r \<and> (\<forall>x. x \<noteq> c \<and> \<bar>c - x\<bar> < r \<longrightarrow> f x < 0)"
   for f :: "real \<Rightarrow> real"
   by (drule LIM_D [where r="-l"]) force+
 
 lemma LIM_fun_not_zero: "f \<midarrow>c\<rightarrow> l \<Longrightarrow> l \<noteq> 0 \<Longrightarrow> \<exists>r. 0 < r \<and> (\<forall>x. x \<noteq> c \<and> \<bar>c - x\<bar> < r \<longrightarrow> f x \<noteq> 0)"
   for f :: "real \<Rightarrow> real"
   using LIM_fun_gt_zero[of f l c] LIM_fun_less_zero[of f l c] by (auto simp: neq_iff)
 
 end