diff --git a/src/HOL/Analysis/Further_Topology.thy b/src/HOL/Analysis/Further_Topology.thy
--- a/src/HOL/Analysis/Further_Topology.thy
+++ b/src/HOL/Analysis/Further_Topology.thy
@@ -1,5706 +1,5573 @@
 section \<open>Extending Continous Maps, Invariance of Domain, etc\<close> (*FIX rename? *)
 
 text\<open>Ported from HOL Light (moretop.ml) by L C Paulson\<close>
 
 theory Further_Topology
   imports Weierstrass_Theorems Polytope Complex_Transcendental Equivalence_Lebesgue_Henstock_Integration Retracts
 begin
 
 subsection\<open>A map from a sphere to a higher dimensional sphere is nullhomotopic\<close>
 
 lemma spheremap_lemma1:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes "subspace S" "subspace T" and dimST: "dim S < dim T"
       and "S \<subseteq> T"
       and diff_f: "f differentiable_on sphere 0 1 \<inter> S"
     shows "f ` (sphere 0 1 \<inter> S) \<noteq> sphere 0 1 \<inter> T"
 proof
   assume fim: "f ` (sphere 0 1 \<inter> S) = sphere 0 1 \<inter> T"
   have inS: "\<And>x. \<lbrakk>x \<in> S; x \<noteq> 0\<rbrakk> \<Longrightarrow> (x /\<^sub>R norm x) \<in> S"
     using subspace_mul \<open>subspace S\<close> by blast
   have subS01: "(\<lambda>x. x /\<^sub>R norm x) ` (S - {0}) \<subseteq> sphere 0 1 \<inter> S"
     using \<open>subspace S\<close> subspace_mul by fastforce
   then have diff_f': "f differentiable_on (\<lambda>x. x /\<^sub>R norm x) ` (S - {0})"
     by (rule differentiable_on_subset [OF diff_f])
   define g where "g \<equiv> \<lambda>x. norm x *\<^sub>R f(inverse(norm x) *\<^sub>R x)"
   have gdiff: "g differentiable_on S - {0}"
     unfolding g_def
     by (rule diff_f' derivative_intros differentiable_on_compose [where f=f] | force)+
   have geq: "g ` (S - {0}) = T - {0}"
   proof
     have "\<And>u. \<lbrakk>u \<in> S; norm u *\<^sub>R f (u /\<^sub>R norm u) \<notin> T\<rbrakk> \<Longrightarrow> u = 0"
       by (metis (mono_tags, lifting) DiffI subS01 subspace_mul [OF \<open>subspace T\<close>] fim image_subset_iff inf_le2 singletonD)
     then have "g ` (S - {0}) \<subseteq> T"
       using g_def by blast
     moreover have "g ` (S - {0}) \<subseteq> UNIV - {0}"
     proof (clarsimp simp: g_def)
       fix y
       assume "y \<in> S" and f0: "f (y /\<^sub>R norm y) = 0"
       then have "y \<noteq> 0 \<Longrightarrow> y /\<^sub>R norm y \<in> sphere 0 1 \<inter> S"
         by (auto simp: subspace_mul [OF \<open>subspace S\<close>])
       then show "y = 0"
         by (metis fim f0 Int_iff image_iff mem_sphere_0 norm_eq_zero zero_neq_one)
     qed
     ultimately show "g ` (S - {0}) \<subseteq> T - {0}"
       by auto
   next
     have *: "sphere 0 1 \<inter> T \<subseteq> f ` (sphere 0 1 \<inter> S)"
       using fim by (simp add: image_subset_iff)
     have "x \<in> (\<lambda>x. norm x *\<^sub>R f (x /\<^sub>R norm x)) ` (S - {0})"
           if "x \<in> T" "x \<noteq> 0" for x
     proof -
       have "x /\<^sub>R norm x \<in> T"
         using \<open>subspace T\<close> subspace_mul that by blast
       then obtain u where u: "f u \<in> T" "x /\<^sub>R norm x = f u" "norm u = 1" "u \<in> S"
         using * [THEN subsetD, of "x /\<^sub>R norm x"] \<open>x \<noteq> 0\<close> by auto
       with that have [simp]: "norm x *\<^sub>R f u = x"
         by (metis divideR_right norm_eq_zero)
       moreover have "norm x *\<^sub>R u \<in> S - {0}"
         using \<open>subspace S\<close> subspace_scale that(2) u by auto
       with u show ?thesis
         by (simp add: image_eqI [where x="norm x *\<^sub>R u"])
     qed
     then have "T - {0} \<subseteq> (\<lambda>x. norm x *\<^sub>R f (x /\<^sub>R norm x)) ` (S - {0})"
       by force
     then show "T - {0} \<subseteq> g ` (S - {0})"
       by (simp add: g_def)
   qed
   define T' where "T' \<equiv> {y. \<forall>x \<in> T. orthogonal x y}"
   have "subspace T'"
     by (simp add: subspace_orthogonal_to_vectors T'_def)
   have dim_eq: "dim T' + dim T = DIM('a)"
     using dim_subspace_orthogonal_to_vectors [of T UNIV] \<open>subspace T\<close>
     by (simp add: T'_def)
   have "\<exists>v1 v2. v1 \<in> span T \<and> (\<forall>w \<in> span T. orthogonal v2 w) \<and> x = v1 + v2" for x
     by (force intro: orthogonal_subspace_decomp_exists [of T x])
   then obtain p1 p2 where p1span: "p1 x \<in> span T"
                       and "\<And>w. w \<in> span T \<Longrightarrow> orthogonal (p2 x) w"
                       and eq: "p1 x + p2 x = x" for x
     by metis
   then have p1: "\<And>z. p1 z \<in> T" and ortho: "\<And>w. w \<in> T \<Longrightarrow> orthogonal (p2 x) w" for x
     using span_eq_iff \<open>subspace T\<close> by blast+
   then have p2: "\<And>z. p2 z \<in> T'"
     by (simp add: T'_def orthogonal_commute)
   have p12_eq: "\<And>x y. \<lbrakk>x \<in> T; y \<in> T'\<rbrakk> \<Longrightarrow> p1(x + y) = x \<and> p2(x + y) = y"
   proof (rule orthogonal_subspace_decomp_unique [OF eq p1span, where T=T'])
     show "\<And>x y. \<lbrakk>x \<in> T; y \<in> T'\<rbrakk> \<Longrightarrow> p2 (x + y) \<in> span T'"
       using span_eq_iff p2 \<open>subspace T'\<close> by blast
     show "\<And>a b. \<lbrakk>a \<in> T; b \<in> T'\<rbrakk> \<Longrightarrow> orthogonal a b"
       using T'_def by blast
   qed (auto simp: span_base)
   then have "\<And>c x. p1 (c *\<^sub>R x) = c *\<^sub>R p1 x \<and> p2 (c *\<^sub>R x) = c *\<^sub>R p2 x"
   proof -
     fix c :: real and x :: 'a
     have f1: "c *\<^sub>R x = c *\<^sub>R p1 x + c *\<^sub>R p2 x"
       by (metis eq pth_6)
     have f2: "c *\<^sub>R p2 x \<in> T'"
       by (simp add: \<open>subspace T'\<close> p2 subspace_scale)
     have "c *\<^sub>R p1 x \<in> T"
       by (metis (full_types) assms(2) p1span span_eq_iff subspace_scale)
     then show "p1 (c *\<^sub>R x) = c *\<^sub>R p1 x \<and> p2 (c *\<^sub>R x) = c *\<^sub>R p2 x"
       using f2 f1 p12_eq by presburger
   qed
   moreover have lin_add: "\<And>x y. p1 (x + y) = p1 x + p1 y \<and> p2 (x + y) = p2 x + p2 y"
   proof (rule orthogonal_subspace_decomp_unique [OF _ p1span, where T=T'])
     show "\<And>x y. p1 (x + y) + p2 (x + y) = p1 x + p1 y + (p2 x + p2 y)"
       by (simp add: add.assoc add.left_commute eq)
     show  "\<And>a b. \<lbrakk>a \<in> T; b \<in> T'\<rbrakk> \<Longrightarrow> orthogonal a b"
       using T'_def by blast
   qed (auto simp: p1span p2 span_base span_add)
   ultimately have "linear p1" "linear p2"
     by unfold_locales auto
   have "g differentiable_on p1 ` {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     using p12_eq \<open>S \<subseteq> T\<close>  by (force intro: differentiable_on_subset [OF gdiff])
   then have "(\<lambda>z. g (p1 z)) differentiable_on {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     by (rule differentiable_on_compose [OF linear_imp_differentiable_on [OF \<open>linear p1\<close>]])
   then have diff: "(\<lambda>x. g (p1 x) + p2 x) differentiable_on {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     by (intro derivative_intros linear_imp_differentiable_on [OF \<open>linear p2\<close>])
   have "dim {x + y |x y. x \<in> S - {0} \<and> y \<in> T'} \<le> dim {x + y |x y. x \<in> S  \<and> y \<in> T'}"
     by (blast intro: dim_subset)
   also have "... = dim S + dim T' - dim (S \<inter> T')"
     using dim_sums_Int [OF \<open>subspace S\<close> \<open>subspace T'\<close>]
     by (simp add: algebra_simps)
   also have "... < DIM('a)"
     using dimST dim_eq by auto
   finally have neg: "negligible {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     by (rule negligible_lowdim)
   have "negligible ((\<lambda>x. g (p1 x) + p2 x) ` {x + y |x y. x \<in> S - {0} \<and> y \<in> T'})"
     by (rule negligible_differentiable_image_negligible [OF order_refl neg diff])
   then have "negligible {x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}"
   proof (rule negligible_subset)
     have "\<lbrakk>t' \<in> T'; s \<in> S; s \<noteq> 0\<rbrakk>
           \<Longrightarrow> g s + t' \<in> (\<lambda>x. g (p1 x) + p2 x) `
                          {x + t' |x t'. x \<in> S \<and> x \<noteq> 0 \<and> t' \<in> T'}" for t' s
-      apply (rule_tac x="s + t'" in image_eqI)
-      using \<open>S \<subseteq> T\<close> p12_eq by auto
+      using \<open>S \<subseteq> T\<close> p12_eq  by (rule_tac x="s + t'" in image_eqI) auto
     then show "{x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}
           \<subseteq> (\<lambda>x. g (p1 x) + p2 x) ` {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
       by auto
   qed
   moreover have "- T' \<subseteq> {x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}"
   proof clarsimp
     fix z assume "z \<notin> T'"
     show "\<exists>x y. z = x + y \<and> x \<in> g ` (S - {0}) \<and> y \<in> T'"
       by (metis Diff_iff \<open>z \<notin> T'\<close> add.left_neutral eq geq p1 p2 singletonD)
   qed
   ultimately have "negligible (-T')"
     using negligible_subset by blast
   moreover have "negligible T'"
     using negligible_lowdim
     by (metis add.commute assms(3) diff_add_inverse2 diff_self_eq_0 dim_eq le_add1 le_antisym linordered_semidom_class.add_diff_inverse not_less0)
   ultimately have  "negligible (-T' \<union> T')"
     by (metis negligible_Un_eq)
   then show False
     using negligible_Un_eq non_negligible_UNIV by simp
 qed
 
 
 lemma spheremap_lemma2:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes ST: "subspace S" "subspace T" "dim S < dim T"
       and "S \<subseteq> T"
       and contf: "continuous_on (sphere 0 1 \<inter> S) f"
       and fim: "f ` (sphere 0 1 \<inter> S) \<subseteq> sphere 0 1 \<inter> T"
     shows "\<exists>c. homotopic_with_canon (\<lambda>x. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) f (\<lambda>x. c)"
 proof -
   have [simp]: "\<And>x. \<lbrakk>norm x = 1; x \<in> S\<rbrakk> \<Longrightarrow> norm (f x) = 1"
     using fim by (simp add: image_subset_iff)
   have "compact (sphere 0 1 \<inter> S)"
     by (simp add: \<open>subspace S\<close> closed_subspace compact_Int_closed)
   then obtain g where pfg: "polynomial_function g" and gim: "g ` (sphere 0 1 \<inter> S) \<subseteq> T"
                 and g12: "\<And>x. x \<in> sphere 0 1 \<inter> S \<Longrightarrow> norm(f x - g x) < 1/2"
     apply (rule Stone_Weierstrass_polynomial_function_subspace [OF _ contf _ \<open>subspace T\<close>, of "1/2"])
     using fim by auto
   have gnz: "g x \<noteq> 0" if "x \<in> sphere 0 1 \<inter> S" for x
   proof -
     have "norm (f x) = 1"
       using fim that by (simp add: image_subset_iff)
     then show ?thesis
       using g12 [OF that] by auto
   qed
   have diffg: "g differentiable_on sphere 0 1 \<inter> S"
     by (metis pfg differentiable_on_polynomial_function)
   define h where "h \<equiv> \<lambda>x. inverse(norm(g x)) *\<^sub>R g x"
   have h: "x \<in> sphere 0 1 \<inter> S \<Longrightarrow> h x \<in> sphere 0 1 \<inter> T" for x
     unfolding h_def
     using gnz [of x]
     by (auto simp: subspace_mul [OF \<open>subspace T\<close>] subsetD [OF gim])
   have diffh: "h differentiable_on sphere 0 1 \<inter> S"
     unfolding h_def using gnz
     by (fastforce intro: derivative_intros diffg differentiable_on_compose [OF diffg])
   have homfg: "homotopic_with_canon (\<lambda>z. True) (sphere 0 1 \<inter> S) (T - {0}) f g"
   proof (rule homotopic_with_linear [OF contf])
     show "continuous_on (sphere 0 1 \<inter> S) g"
       using pfg by (simp add: differentiable_imp_continuous_on diffg)
   next
     have non0fg: "0 \<notin> closed_segment (f x) (g x)" if "norm x = 1" "x \<in> S" for x
     proof -
       have "f x \<in> sphere 0 1"
         using fim that by (simp add: image_subset_iff)
       moreover have "norm(f x - g x) < 1/2"
         using g12 that by auto
       ultimately show ?thesis
         by (auto simp: norm_minus_commute dest: segment_bound)
     qed
     show "closed_segment (f x) (g x) \<subseteq> T - {0}" if "x \<in> sphere 0 1 \<inter> S" for x
     proof -
       have "convex T"
         by (simp add: \<open>subspace T\<close> subspace_imp_convex)
       then have "convex hull {f x, g x} \<subseteq> T"
         by (metis IntD2 closed_segment_subset fim gim image_subset_iff segment_convex_hull that)
       then show ?thesis
         using that non0fg segment_convex_hull by fastforce
     qed
   qed
   obtain d where d: "d \<in> (sphere 0 1 \<inter> T) - h ` (sphere 0 1 \<inter> S)"
     using h spheremap_lemma1 [OF ST \<open>S \<subseteq> T\<close> diffh] by force
   then have non0hd: "0 \<notin> closed_segment (h x) (- d)" if "norm x = 1" "x \<in> S" for x
     using midpoint_between [of 0 "h x" "-d"] that h [of x]
     by (auto simp: between_mem_segment midpoint_def)
   have conth: "continuous_on (sphere 0 1 \<inter> S) h"
     using differentiable_imp_continuous_on diffh by blast
   have hom_hd: "homotopic_with_canon (\<lambda>z. True) (sphere 0 1 \<inter> S) (T - {0}) h (\<lambda>x. -d)"
   proof (rule homotopic_with_linear [OF conth continuous_on_const])
     fix x
     assume x: "x \<in> sphere 0 1 \<inter> S"
     have "convex hull {h x, - d} \<subseteq> T"
     proof (rule hull_minimal)
       show "{h x, - d} \<subseteq> T"
         using h d x by (force simp: subspace_neg [OF \<open>subspace T\<close>])
     qed (simp add: subspace_imp_convex [OF \<open>subspace T\<close>])
     with x segment_convex_hull show "closed_segment (h x) (- d) \<subseteq> T - {0}"
       by (auto simp add: subset_Diff_insert non0hd)
   qed
   have conT0: "continuous_on (T - {0}) (\<lambda>y. inverse(norm y) *\<^sub>R y)"
     by (intro continuous_intros) auto
   have sub0T: "(\<lambda>y. y /\<^sub>R norm y) ` (T - {0}) \<subseteq> sphere 0 1 \<inter> T"
     by (fastforce simp: assms(2) subspace_mul)
   obtain c where homhc: "homotopic_with_canon (\<lambda>z. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) h (\<lambda>x. c)"
-    apply (rule_tac c="-d" in that)
-    apply (rule homotopic_with_eq)
-       apply (rule homotopic_with_compose_continuous_left [OF hom_hd conT0 sub0T])
-    using d apply (auto simp: h_def)
-    done
+  proof
+    show "homotopic_with_canon (\<lambda>z. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) h (\<lambda>x. - d)"
+      using d 
+      by (force simp: h_def 
+           intro: homotopic_with_eq homotopic_with_compose_continuous_left [OF hom_hd conT0 sub0T])
+  qed
   have "homotopic_with_canon (\<lambda>x. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) f h"
-    apply (rule homotopic_with_eq [OF homotopic_with_compose_continuous_left [OF homfg conT0 sub0T]])
-    by (auto simp: h_def)
+    by (force simp: h_def 
+           intro:  homotopic_with_eq homotopic_with_compose_continuous_left [OF homfg conT0 sub0T])
   then show ?thesis
     by (metis homotopic_with_trans [OF _ homhc])
 qed
 
 
 lemma spheremap_lemma3:
   assumes "bounded S" "convex S" "subspace U" and affSU: "aff_dim S \<le> dim U"
   obtains T where "subspace T" "T \<subseteq> U" "S \<noteq> {} \<Longrightarrow> aff_dim T = aff_dim S"
                   "(rel_frontier S) homeomorphic (sphere 0 1 \<inter> T)"
 proof (cases "S = {}")
   case True
   with \<open>subspace U\<close> subspace_0 show ?thesis
     by (rule_tac T = "{0}" in that) auto
 next
   case False
   then obtain a where "a \<in> S"
     by auto
   then have affS: "aff_dim S = int (dim ((\<lambda>x. -a+x) ` S))"
     by (metis hull_inc aff_dim_eq_dim)
   with affSU have "dim ((\<lambda>x. -a+x) ` S) \<le> dim U"
     by linarith
   with choose_subspace_of_subspace
   obtain T where "subspace T" "T \<subseteq> span U" and dimT: "dim T = dim ((\<lambda>x. -a+x) ` S)" .
   show ?thesis
   proof (rule that [OF \<open>subspace T\<close>])
     show "T \<subseteq> U"
       using span_eq_iff \<open>subspace U\<close> \<open>T \<subseteq> span U\<close> by blast
     show "aff_dim T = aff_dim S"
       using dimT \<open>subspace T\<close> affS aff_dim_subspace by fastforce
     show "rel_frontier S homeomorphic sphere 0 1 \<inter> T"
     proof -
       have "aff_dim (ball 0 1 \<inter> T) = aff_dim (T)"
         by (metis IntI interior_ball \<open>subspace T\<close> aff_dim_convex_Int_nonempty_interior centre_in_ball empty_iff inf_commute subspace_0 subspace_imp_convex zero_less_one)
       then have affS_eq: "aff_dim S = aff_dim (ball 0 1 \<inter> T)"
         using \<open>aff_dim T = aff_dim S\<close> by simp
       have "rel_frontier S homeomorphic rel_frontier(ball 0 1 \<inter> T)"
       proof (rule homeomorphic_rel_frontiers_convex_bounded_sets [OF \<open>convex S\<close> \<open>bounded S\<close>])
         show "convex (ball 0 1 \<inter> T)"
           by (simp add: \<open>subspace T\<close> convex_Int subspace_imp_convex)
         show "bounded (ball 0 1 \<inter> T)"
           by (simp add: bounded_Int)
         show "aff_dim S = aff_dim (ball 0 1 \<inter> T)"
           by (rule affS_eq)
       qed
       also have "... = frontier (ball 0 1) \<inter> T"
       proof (rule convex_affine_rel_frontier_Int [OF convex_ball])
         show "affine T"
           by (simp add: \<open>subspace T\<close> subspace_imp_affine)
         show "interior (ball 0 1) \<inter> T \<noteq> {}"
           using \<open>subspace T\<close> subspace_0 by force
       qed
       also have "... = sphere 0 1 \<inter> T"
         by auto
       finally show ?thesis .
     qed
   qed
 qed
 
 
 proposition inessential_spheremap_lowdim_gen:
   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes "convex S" "bounded S" "convex T" "bounded T"
       and affST: "aff_dim S < aff_dim T"
       and contf: "continuous_on (rel_frontier S) f"
       and fim: "f ` (rel_frontier S) \<subseteq> rel_frontier T"
   obtains c where "homotopic_with_canon (\<lambda>z. True) (rel_frontier S) (rel_frontier T) f (\<lambda>x. c)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: that)
 next
   case False
   then show ?thesis
   proof (cases "T = {}")
     case True
     then show ?thesis
       using fim that by auto
   next
     case False
     obtain T':: "'a set"
       where "subspace T'" and affT': "aff_dim T' = aff_dim T"
         and homT: "rel_frontier T homeomorphic sphere 0 1 \<inter> T'"
       apply (rule spheremap_lemma3 [OF \<open>bounded T\<close> \<open>convex T\<close> subspace_UNIV, where 'b='a])
-       apply (simp add: aff_dim_le_DIM)
-      using \<open>T \<noteq> {}\<close> by blast
+      using \<open>T \<noteq> {}\<close>  by (auto simp add: aff_dim_le_DIM)
     with homeomorphic_imp_homotopy_eqv
     have relT: "sphere 0 1 \<inter> T'  homotopy_eqv rel_frontier T"
       using homotopy_equivalent_space_sym by blast
     have "aff_dim S \<le> int (dim T')"
       using affT' \<open>subspace T'\<close> affST aff_dim_subspace by force
     with spheremap_lemma3 [OF \<open>bounded S\<close> \<open>convex S\<close> \<open>subspace T'\<close>] \<open>S \<noteq> {}\<close>
     obtain S':: "'a set" where "subspace S'" "S' \<subseteq> T'"
        and affS': "aff_dim S' = aff_dim S"
        and homT: "rel_frontier S homeomorphic sphere 0 1 \<inter> S'"
         by metis
     with homeomorphic_imp_homotopy_eqv
     have relS: "sphere 0 1 \<inter> S'  homotopy_eqv rel_frontier S"
       using homotopy_equivalent_space_sym by blast
     have dimST': "dim S' < dim T'"
       by (metis \<open>S' \<subseteq> T'\<close> \<open>subspace S'\<close> \<open>subspace T'\<close> affS' affST affT' less_irrefl not_le subspace_dim_equal)
     have "\<exists>c. homotopic_with_canon (\<lambda>z. True) (rel_frontier S) (rel_frontier T) f (\<lambda>x. c)"
       apply (rule homotopy_eqv_homotopic_triviality_null_imp [OF relT contf fim])
       apply (rule homotopy_eqv_cohomotopic_triviality_null[OF relS, THEN iffD1, rule_format])
        apply (metis dimST' \<open>subspace S'\<close>  \<open>subspace T'\<close>  \<open>S' \<subseteq> T'\<close> spheremap_lemma2, blast)
       done
     with that show ?thesis by blast
   qed
 qed
 
 lemma inessential_spheremap_lowdim:
   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes
    "DIM('M) < DIM('a)" and f: "continuous_on (sphere a r) f" "f ` (sphere a r) \<subseteq> (sphere b s)"
    obtains c where "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. c)"
 proof (cases "s \<le> 0")
   case True then show ?thesis
     by (meson nullhomotopic_into_contractible f contractible_sphere that)
 next
   case False
   show ?thesis
   proof (cases "r \<le> 0")
     case True then show ?thesis
       by (meson f nullhomotopic_from_contractible contractible_sphere that)
   next
     case False
     with \<open>\<not> s \<le> 0\<close> have "r > 0" "s > 0" by auto
     show thesis
       apply (rule inessential_spheremap_lowdim_gen [of "cball a r" "cball b s" f])
-      using  \<open>0 < r\<close> \<open>0 < s\<close> assms(1) that
-      by (simp_all add: f aff_dim_cball inessential_spheremap_lowdim_gen [of "cball a r" "cball b s" f])
+      using  \<open>0 < r\<close> \<open>0 < s\<close> assms(1) that by (simp_all add: f aff_dim_cball)
   qed
 qed
 
 
 
 subsection\<open> Some technical lemmas about extending maps from cell complexes\<close>
 
 lemma extending_maps_Union_aux:
   assumes fin: "finite \<F>"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
       and "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>; S \<noteq> T\<rbrakk> \<Longrightarrow> S \<inter> T \<subseteq> K"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>g. continuous_on S g \<and> g ` S \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
    shows "\<exists>g. continuous_on (\<Union>\<F>) g \<and> g ` (\<Union>\<F>) \<subseteq> T \<and> (\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x)"
 using assms
 proof (induction \<F>)
   case empty show ?case by simp
 next
   case (insert S \<F>)
   then obtain f where contf: "continuous_on (S) f" and fim: "f ` S \<subseteq> T" and feq: "\<forall>x \<in> S \<inter> K. f x = h x"
     by (meson insertI1)
   obtain g where contg: "continuous_on (\<Union>\<F>) g" and gim: "g ` \<Union>\<F> \<subseteq> T" and geq: "\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x"
     using insert by auto
   have fg: "f x = g x" if "x \<in> T" "T \<in> \<F>" "x \<in> S" for x T
   proof -
     have "T \<inter> S \<subseteq> K \<or> S = T"
       using that by (metis (no_types) insert.prems(2) insertCI)
     then show ?thesis
       using UnionI feq geq \<open>S \<notin> \<F>\<close> subsetD that by fastforce
   qed
   show ?case
     apply (rule_tac x="\<lambda>x. if x \<in> S then f x else g x" in exI, simp)
     apply (intro conjI continuous_on_cases)
     using fim gim feq geq
     apply (force simp: insert closed_Union contf contg inf_commute intro: fg)+
     done
 qed
 
 lemma extending_maps_Union:
   assumes fin: "finite \<F>"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>g. continuous_on S g \<and> g ` S \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
       and K: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>; \<not> X \<subseteq> Y; \<not> Y \<subseteq> X\<rbrakk> \<Longrightarrow> X \<inter> Y \<subseteq> K"
     shows "\<exists>g. continuous_on (\<Union>\<F>) g \<and> g ` (\<Union>\<F>) \<subseteq> T \<and> (\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x)"
-apply (simp add: Union_maximal_sets [OF fin, symmetric])
+apply (simp flip: Union_maximal_sets [OF fin])
 apply (rule extending_maps_Union_aux)
 apply (simp_all add: Union_maximal_sets [OF fin] assms)
 by (metis K psubsetI)
 
 
 lemma extend_map_lemma:
   assumes "finite \<F>" "\<G> \<subseteq> \<F>" "convex T" "bounded T"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and aff: "\<And>X. X \<in> \<F> - \<G> \<Longrightarrow> aff_dim X < aff_dim T"
       and face: "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>\<rbrakk> \<Longrightarrow> (S \<inter> T) face_of S"
       and contf: "continuous_on (\<Union>\<G>) f" and fim: "f ` (\<Union>\<G>) \<subseteq> rel_frontier T"
   obtains g where "continuous_on (\<Union>\<F>) g" "g ` (\<Union>\<F>) \<subseteq> rel_frontier T" "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> g x = f x"
 proof (cases "\<F> - \<G> = {}")
   case True
   show ?thesis
   proof
     show "continuous_on (\<Union> \<F>) f"
       using True \<open>\<G> \<subseteq> \<F>\<close> contf by auto
     show "f ` \<Union> \<F> \<subseteq> rel_frontier T"
       using True fim by auto
   qed auto
 next
   case False
   then have "0 \<le> aff_dim T"
     by (metis aff aff_dim_empty aff_dim_geq aff_dim_negative_iff all_not_in_conv not_less)
   then obtain i::nat where i: "int i = aff_dim T"
     by (metis nonneg_eq_int)
   have Union_empty_eq: "\<Union>{D. D = {} \<and> P D} = {}" for P :: "'a set \<Rightarrow> bool"
     by auto
   have face': "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>\<rbrakk> \<Longrightarrow> (S \<inter> T) face_of S \<and> (S \<inter> T) face_of T"
     by (metis face inf_commute)
   have extendf: "\<exists>g. continuous_on (\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i})) g \<and>
                      g ` (\<Union> (\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i})) \<subseteq> rel_frontier T \<and>
                      (\<forall>x \<in> \<Union>\<G>. g x = f x)"
        if "i \<le> aff_dim T" for i::nat
   using that
   proof (induction i)
     case 0
     show ?case
       using 0 contf fim by (auto simp add: Union_empty_eq)
   next
     case (Suc p)
     with \<open>bounded T\<close> have "rel_frontier T \<noteq> {}"
       by (auto simp: rel_frontier_eq_empty affine_bounded_eq_lowdim [of T])
     then obtain t where t: "t \<in> rel_frontier T" by auto
     have ple: "int p \<le> aff_dim T" using Suc.prems by force
     obtain h where conth: "continuous_on (\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p})) h"
                and him: "h ` (\<Union> (\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}))
                          \<subseteq> rel_frontier T"
                and heq: "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> h x = f x"
       using Suc.IH [OF ple] by auto
     let ?Faces = "{D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D \<le> p}"
     have extendh: "\<exists>g. continuous_on D g \<and>
                        g ` D \<subseteq> rel_frontier T \<and>
                        (\<forall>x \<in> D \<inter> \<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}). g x = h x)"
       if D: "D \<in> \<G> \<union> ?Faces" for D
     proof (cases "D \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p})")
       case True
       have "continuous_on D h"
         using True conth continuous_on_subset by blast
       moreover have "h ` D \<subseteq> rel_frontier T"
         using True him by blast
       ultimately show ?thesis
         by blast
     next
       case False
       note notDsub = False
       show ?thesis
       proof (cases "\<exists>a. D = {a}")
         case True
         then obtain a where "D = {a}" by auto
         with notDsub t show ?thesis
           by (rule_tac x="\<lambda>x. t" in exI) simp
       next
         case False
         have "D \<noteq> {}" using notDsub by auto
         have Dnotin: "D \<notin> \<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}"
           using notDsub by auto
         then have "D \<notin> \<G>" by simp
         have "D \<in> ?Faces - {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}"
           using Dnotin that by auto
         then obtain C where "C \<in> \<F>" "D face_of C" and affD: "aff_dim D = int p"
           by auto
         then have "bounded D"
           using face_of_polytope_polytope poly polytope_imp_bounded by blast
         then have [simp]: "\<not> affine D"
           using affine_bounded_eq_trivial False \<open>D \<noteq> {}\<close> \<open>bounded D\<close> by blast
         have "{F. F facet_of D} \<subseteq> {E. E face_of C \<and> aff_dim E < int p}"
           by clarify (metis \<open>D face_of C\<close> affD eq_iff face_of_trans facet_of_def zle_diff1_eq)
         moreover have "polyhedron D"
           using \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> face_of_polytope_polytope poly polytope_imp_polyhedron by auto
         ultimately have relf_sub: "rel_frontier D \<subseteq> \<Union> {E. E face_of C \<and> aff_dim E < p}"
           by (simp add: rel_frontier_of_polyhedron Union_mono)
         then have him_relf: "h ` rel_frontier D \<subseteq> rel_frontier T"
           using \<open>C \<in> \<F>\<close> him by blast
         have "convex D"
           by (simp add: \<open>polyhedron D\<close> polyhedron_imp_convex)
         have affD_lessT: "aff_dim D < aff_dim T"
           using Suc.prems affD by linarith
         have contDh: "continuous_on (rel_frontier D) h"
           using \<open>C \<in> \<F>\<close> relf_sub by (blast intro: continuous_on_subset [OF conth])
         then have *: "(\<exists>c. homotopic_with_canon (\<lambda>x. True) (rel_frontier D) (rel_frontier T) h (\<lambda>x. c)) =
                       (\<exists>g. continuous_on UNIV g \<and>  range g \<subseteq> rel_frontier T \<and>
                            (\<forall>x\<in>rel_frontier D. g x = h x))"
-          apply (rule nullhomotopic_into_rel_frontier_extension [OF closed_rel_frontier])
-          apply (simp_all add: assms rel_frontier_eq_empty him_relf)
-          done
-        have "(\<exists>c. homotopic_with_canon (\<lambda>x. True) (rel_frontier D)
-              (rel_frontier T) h (\<lambda>x. c))"
+          by (simp add: assms rel_frontier_eq_empty him_relf nullhomotopic_into_rel_frontier_extension [OF closed_rel_frontier])
+        have "(\<exists>c. homotopic_with_canon (\<lambda>x. True) (rel_frontier D) (rel_frontier T) h (\<lambda>x. c))"
           by (metis inessential_spheremap_lowdim_gen
                  [OF \<open>convex D\<close> \<open>bounded D\<close> \<open>convex T\<close> \<open>bounded T\<close> affD_lessT contDh him_relf])
         then obtain g where contg: "continuous_on UNIV g"
                         and gim: "range g \<subseteq> rel_frontier T"
                         and gh: "\<And>x. x \<in> rel_frontier D \<Longrightarrow> g x = h x"
           by (metis *)
         have "D \<inter> E \<subseteq> rel_frontier D"
              if "E \<in> \<G> \<union> {D. Bex \<F> ((face_of) D) \<and> aff_dim D < int p}" for E
         proof (rule face_of_subset_rel_frontier)
           show "D \<inter> E face_of D"
             using that
           proof safe
             assume "E \<in> \<G>"
             then show "D \<inter> E face_of D"
               by (meson \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> assms(2) face' face_of_Int_subface face_of_refl_eq poly polytope_imp_convex subsetD)
           next
             fix x
             assume "aff_dim E < int p" "x \<in> \<F>" "E face_of x"
             then show "D \<inter> E face_of D"
               by (meson \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> face' face_of_Int_subface that)
           qed
           show "D \<inter> E \<noteq> D"
             using that notDsub by auto
         qed
         moreover have "continuous_on D g"
           using contg continuous_on_subset by blast
         ultimately show ?thesis
           by (rule_tac x=g in exI) (use gh gim in fastforce)
       qed
     qed
     have intle: "i < 1 + int j \<longleftrightarrow> i \<le> int j" for i j
       by auto
     have "finite \<G>"
       using \<open>finite \<F>\<close> \<open>\<G> \<subseteq> \<F>\<close> rev_finite_subset by blast
     moreover have "finite (?Faces)"
     proof -
       have \<section>: "finite (\<Union> {{D. D face_of C} |C. C \<in> \<F>})"
         by (auto simp: \<open>finite \<F>\<close> finite_polytope_faces poly)
       show ?thesis
         by (auto intro: finite_subset [OF _ \<section>])
     qed
     ultimately have fin: "finite (\<G> \<union> ?Faces)"
       by simp
     have clo: "closed S" if "S \<in> \<G> \<union> ?Faces" for S
       using that \<open>\<G> \<subseteq> \<F>\<close> face_of_polytope_polytope poly polytope_imp_closed by blast
     have K: "X \<inter> Y \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < int p})"
                 if "X \<in> \<G> \<union> ?Faces" "Y \<in> \<G> \<union> ?Faces" "\<not> Y \<subseteq> X" for X Y
     proof -
       have ff: "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
         if XY: "X face_of D" "Y face_of E" and DE: "D \<in> \<F>" "E \<in> \<F>" for D E
         by (rule face_of_Int_subface [OF _ _ XY]) (auto simp: face' DE)
       show ?thesis
         using that
         apply auto
         apply (drule_tac x="X \<inter> Y" in spec, safe)
         using ff face_of_imp_convex [of X] face_of_imp_convex [of Y]
         apply (fastforce dest: face_of_aff_dim_lt)
         by (meson face_of_trans ff)
     qed
     obtain g where "continuous_on (\<Union>(\<G> \<union> ?Faces)) g"
                    "g ` \<Union>(\<G> \<union> ?Faces) \<subseteq> rel_frontier T"
                    "(\<forall>x \<in> \<Union>(\<G> \<union> ?Faces) \<inter>
                           \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < p}). g x = h x)"
       by (rule exE [OF extending_maps_Union [OF fin extendh clo K]], blast+)
     then show ?case
       by (simp add: intle local.heq [symmetric], blast)
   qed
   have eq: "\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i}) = \<Union>\<F>"
   proof
     show "\<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < int i}) \<subseteq> \<Union>\<F>"
       using \<open>\<G> \<subseteq> \<F>\<close> face_of_imp_subset by fastforce
     show "\<Union>\<F> \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < i})"
     proof (rule Union_mono)
       show "\<F> \<subseteq> \<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < int i}"
         using face by (fastforce simp: aff i)
     qed
   qed
   have "int i \<le> aff_dim T" by (simp add: i)
   then show ?thesis
     using extendf [of i] unfolding eq by (metis that)
 qed
 
 lemma extend_map_lemma_cofinite0:
   assumes "finite \<F>"
       and "pairwise (\<lambda>S T. S \<inter> T \<subseteq> K) \<F>"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (S - {a}) g \<and> g ` (S - {a}) \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
     shows "\<exists>C g. finite C \<and> disjnt C U \<and> card C \<le> card \<F> \<and>
                  continuous_on (\<Union>\<F> - C) g \<and> g ` (\<Union>\<F> - C) \<subseteq> T
                   \<and> (\<forall>x \<in> (\<Union>\<F> - C) \<inter> K. g x = h x)"
   using assms
 proof induction
   case empty then show ?case
     by force
 next
   case (insert X \<F>)
   then have "closed X" and clo: "\<And>X. X \<in> \<F> \<Longrightarrow> closed X"
         and \<F>: "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (S - {a}) g \<and> g ` (S - {a}) \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
         and pwX: "\<And>Y. Y \<in> \<F> \<and> Y \<noteq> X \<longrightarrow> X \<inter> Y \<subseteq> K \<and> Y \<inter> X \<subseteq> K"
         and pwF: "pairwise (\<lambda> S T. S \<inter> T \<subseteq> K) \<F>"
     by (simp_all add: pairwise_insert)
   obtain C g where C: "finite C" "disjnt C U" "card C \<le> card \<F>"
                and contg: "continuous_on (\<Union>\<F> - C) g"
                and gim: "g ` (\<Union>\<F> - C) \<subseteq> T"
                and gh:  "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> K \<Longrightarrow> g x = h x"
     using insert.IH [OF pwF \<F> clo] by auto
   obtain a f where "a \<notin> U"
                and contf: "continuous_on (X - {a}) f"
                and fim: "f ` (X - {a}) \<subseteq> T"
                and fh: "(\<forall>x \<in> X \<inter> K. f x = h x)"
     using insert.prems by (meson insertI1)
   show ?case
   proof (intro exI conjI)
     show "finite (insert a C)"
       by (simp add: C)
     show "disjnt (insert a C) U"
       using C \<open>a \<notin> U\<close> by simp
     show "card (insert a C) \<le> card (insert X \<F>)"
       by (simp add: C card_insert_if insert.hyps le_SucI)
     have "closed (\<Union>\<F>)"
       using clo insert.hyps by blast
     have "continuous_on (X - insert a C) f"
       using contf by (force simp: elim: continuous_on_subset)
     moreover have "continuous_on (\<Union> \<F> - insert a C) g"
       using contg by (force simp: elim: continuous_on_subset)
     ultimately
     have "continuous_on (X - insert a C \<union> (\<Union>\<F> - insert a C)) (\<lambda>x. if x \<in> X then f x else g x)"
       apply (intro continuous_on_cases_local; simp add: closedin_closed)
         using \<open>closed X\<close> apply blast
         using \<open>closed (\<Union>\<F>)\<close> apply blast
         using fh gh insert.hyps pwX by fastforce
     then show "continuous_on (\<Union>(insert X \<F>) - insert a C) (\<lambda>a. if a \<in> X then f a else g a)"
       by (blast intro: continuous_on_subset)
     show "\<forall>x\<in>(\<Union>(insert X \<F>) - insert a C) \<inter> K. (if x \<in> X then f x else g x) = h x"
       using gh by (auto simp: fh)
     show "(\<lambda>a. if a \<in> X then f a else g a) ` (\<Union>(insert X \<F>) - insert a C) \<subseteq> T"
       using fim gim by auto force
   qed
 qed
 
 
 lemma extend_map_lemma_cofinite1:
 assumes "finite \<F>"
     and \<F>: "\<And>X. X \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (X - {a}) g \<and> g ` (X - {a}) \<subseteq> T \<and> (\<forall>x \<in> X \<inter> K. g x = h x)"
     and clo: "\<And>X. X \<in> \<F> \<Longrightarrow> closed X"
     and K: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>; \<not> X \<subseteq> Y; \<not> Y \<subseteq> X\<rbrakk> \<Longrightarrow> X \<inter> Y \<subseteq> K"
   obtains C g where "finite C" "disjnt C U" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
                     "g ` (\<Union>\<F> - C) \<subseteq> T"
                     "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> K \<Longrightarrow> g x = h x"
 proof -
   let ?\<F> = "{X \<in> \<F>. \<forall>Y\<in>\<F>. \<not> X \<subset> Y}"
   have [simp]: "\<Union>?\<F> = \<Union>\<F>"
     by (simp add: Union_maximal_sets assms)
   have fin: "finite ?\<F>"
     by (force intro: finite_subset [OF _ \<open>finite \<F>\<close>])
   have pw: "pairwise (\<lambda> S T. S \<inter> T \<subseteq> K) ?\<F>"
     by (simp add: pairwise_def) (metis K psubsetI)
   have "card {X \<in> \<F>. \<forall>Y\<in>\<F>. \<not> X \<subset> Y} \<le> card \<F>"
     by (simp add: \<open>finite \<F>\<close> card_mono)
   moreover
   obtain C g where "finite C \<and> disjnt C U \<and> card C \<le> card ?\<F> \<and>
                  continuous_on (\<Union>?\<F> - C) g \<and> g ` (\<Union>?\<F> - C) \<subseteq> T
                   \<and> (\<forall>x \<in> (\<Union>?\<F> - C) \<inter> K. g x = h x)"
     using extend_map_lemma_cofinite0 [OF fin pw, of U T h] by (fastforce intro!: clo \<F>)
   ultimately show ?thesis
     by (rule_tac C=C and g=g in that) auto
 qed
 
 
 lemma extend_map_lemma_cofinite:
   assumes "finite \<F>" "\<G> \<subseteq> \<F>" and T: "convex T" "bounded T"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and contf: "continuous_on (\<Union>\<G>) f" and fim: "f ` (\<Union>\<G>) \<subseteq> rel_frontier T"
       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X"
       and aff: "\<And>X. X \<in> \<F> - \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T"
   obtains C g where
      "finite C" "disjnt C (\<Union>\<G>)" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
      "g ` (\<Union> \<F> - C) \<subseteq> rel_frontier T" "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> g x = f x"
 proof -
   define \<H> where "\<H> \<equiv> \<G> \<union> {D. \<exists>C \<in> \<F> - \<G>. D face_of C \<and> aff_dim D < aff_dim T}"
   have "finite \<G>"
     using assms finite_subset by blast
   have *: "finite (\<Union>{{D. D face_of C} |C. C \<in> \<F>})"
     using finite_polytope_faces poly \<open>finite \<F>\<close> by force
   then have "finite \<H>"
     by (auto simp: \<H>_def \<open>finite \<G>\<close> intro: finite_subset [OF _ *])
   have face': "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>\<rbrakk> \<Longrightarrow> (S \<inter> T) face_of S \<and> (S \<inter> T) face_of T"
     by (metis face inf_commute)
   have *: "\<And>X Y. \<lbrakk>X \<in> \<H>; Y \<in> \<H>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
     unfolding \<H>_def
     using subsetD [OF \<open>\<G> \<subseteq> \<F>\<close>] apply (auto simp add: face)
     apply (meson face' face_of_Int_subface face_of_refl_eq poly polytope_imp_convex)+
     done
   obtain h where conth: "continuous_on (\<Union>\<H>) h" and him: "h ` (\<Union>\<H>) \<subseteq> rel_frontier T"
              and hf: "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> h x = f x" 
   proof (rule extend_map_lemma [OF \<open>finite \<H>\<close> [unfolded \<H>_def] Un_upper1 T])
     show "\<And>X. \<lbrakk>X \<in> \<G> \<union> {D. \<exists>C\<in>\<F> - \<G>. D face_of C \<and> aff_dim D < aff_dim T}\<rbrakk> \<Longrightarrow> polytope X"
       using \<open>\<G> \<subseteq> \<F>\<close> face_of_polytope_polytope poly by fastforce
   qed (use * \<H>_def contf fim in auto)
   have "bounded (\<Union>\<G>)"
     using \<open>finite \<G>\<close> \<open>\<G> \<subseteq> \<F>\<close> poly polytope_imp_bounded by blast
   then have "\<Union>\<G> \<noteq> UNIV"
     by auto
   then obtain a where a: "a \<notin> \<Union>\<G>"
     by blast
   have \<F>: "\<exists>a g. a \<notin> \<Union>\<G> \<and> continuous_on (D - {a}) g \<and>
                   g ` (D - {a}) \<subseteq> rel_frontier T \<and> (\<forall>x \<in> D \<inter> \<Union>\<H>. g x = h x)"
        if "D \<in> \<F>" for D
   proof (cases "D \<subseteq> \<Union>\<H>")
     case True
+    then have "h ` (D - {a}) \<subseteq> rel_frontier T" "continuous_on (D - {a}) h"
+      using him by (blast intro!: \<open>a \<notin> \<Union>\<G>\<close> continuous_on_subset [OF conth])+
     then show ?thesis
-      apply (rule_tac x=a in exI)
-      apply (rule_tac x=h in exI)
-      using him apply (blast intro!: \<open>a \<notin> \<Union>\<G>\<close> continuous_on_subset [OF conth]) +
-      done
+      using a by blast
   next
     case False
     note D_not_subset = False
     show ?thesis
     proof (cases "D \<in> \<G>")
       case True
       with D_not_subset show ?thesis
         by (auto simp: \<H>_def)
     next
       case False
       then have affD: "aff_dim D \<le> aff_dim T"
         by (simp add: \<open>D \<in> \<F>\<close> aff)
       show ?thesis
       proof (cases "rel_interior D = {}")
         case True
         with \<open>D \<in> \<F>\<close> poly a show ?thesis
           by (force simp: rel_interior_eq_empty polytope_imp_convex)
       next
         case False
         then obtain b where brelD: "b \<in> rel_interior D"
           by blast
         have "polyhedron D"
           by (simp add: poly polytope_imp_polyhedron that)
         have "rel_frontier D retract_of affine hull D - {b}"
           by (simp add: rel_frontier_retract_of_punctured_affine_hull poly polytope_imp_bounded polytope_imp_convex that brelD)
         then obtain r where relfD: "rel_frontier D \<subseteq> affine hull D - {b}"
                         and contr: "continuous_on (affine hull D - {b}) r"
                         and rim: "r ` (affine hull D - {b}) \<subseteq> rel_frontier D"
                         and rid: "\<And>x. x \<in> rel_frontier D \<Longrightarrow> r x = x"
           by (auto simp: retract_of_def retraction_def)
         show ?thesis
         proof (intro exI conjI ballI)
           show "b \<notin> \<Union>\<G>"
           proof clarify
             fix E
             assume "b \<in> E" "E \<in> \<G>"
             then have "E \<inter> D face_of E \<and> E \<inter> D face_of D"
               using \<open>\<G> \<subseteq> \<F>\<close> face' that by auto
             with face_of_subset_rel_frontier \<open>E \<in> \<G>\<close> \<open>b \<in> E\<close> brelD rel_interior_subset [of D]
                  D_not_subset rel_frontier_def \<H>_def
             show False
               by blast
           qed
           have "r ` (D - {b}) \<subseteq> r ` (affine hull D - {b})"
             by (simp add: Diff_mono hull_subset image_mono)
           also have "... \<subseteq> rel_frontier D"
             by (rule rim)
           also have "... \<subseteq> \<Union>{E. E face_of D \<and> aff_dim E < aff_dim T}"
             using affD
             by (force simp: rel_frontier_of_polyhedron [OF \<open>polyhedron D\<close>] facet_of_def)
           also have "... \<subseteq> \<Union>(\<H>)"
             using D_not_subset \<H>_def that by fastforce
           finally have rsub: "r ` (D - {b}) \<subseteq> \<Union>(\<H>)" .
           show "continuous_on (D - {b}) (h \<circ> r)"
-            apply (intro conjI \<open>b \<notin> \<Union>\<G>\<close> continuous_on_compose)
-               apply (rule continuous_on_subset [OF contr])
-            apply (simp add: Diff_mono hull_subset)
-            apply (rule continuous_on_subset [OF conth rsub])
-            done
+          proof (rule continuous_on_compose)
+            show "continuous_on (D - {b}) r"
+              by (meson Diff_mono continuous_on_subset contr hull_subset order_refl)
+            show "continuous_on (r ` (D - {b})) h"
+              by (simp add: Diff_mono hull_subset continuous_on_subset [OF conth rsub])
+          qed
           show "(h \<circ> r) ` (D - {b}) \<subseteq> rel_frontier T"
             using brelD him rsub by fastforce
           show "(h \<circ> r) x = h x" if x: "x \<in> D \<inter> \<Union>\<H>" for x
           proof -
             consider A where "x \<in> D" "A \<in> \<G>" "x \<in> A"
                  | A B where "x \<in> D" "A face_of B" "B \<in> \<F>" "B \<notin> \<G>" "aff_dim A < aff_dim T" "x \<in> A"
               using x by (auto simp: \<H>_def)
             then have xrel: "x \<in> rel_frontier D"
             proof cases
               case 1 show ?thesis
               proof (rule face_of_subset_rel_frontier [THEN subsetD])
                 show "D \<inter> A face_of D"
                   using \<open>A \<in> \<G>\<close> \<open>\<G> \<subseteq> \<F>\<close> face \<open>D \<in> \<F>\<close> by blast
                 show "D \<inter> A \<noteq> D"
                   using \<open>A \<in> \<G>\<close> D_not_subset \<H>_def by blast
               qed (auto simp: 1)
             next
               case 2 show ?thesis
               proof (rule face_of_subset_rel_frontier [THEN subsetD])
                 have "D face_of D"
                   by (simp add: \<open>polyhedron D\<close> polyhedron_imp_convex face_of_refl)
                 then show "D \<inter> A face_of D"
                   by (meson "2"(2) "2"(3) \<open>D \<in> \<F>\<close> face' face_of_Int_Int face_of_face)
                 show "D \<inter> A \<noteq> D"
                   using "2" D_not_subset \<H>_def by blast
               qed (auto simp: 2)
             qed
             show ?thesis
               by (simp add: rid xrel)
           qed
         qed
       qed
     qed
   qed
   have clo: "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
     by (simp add: poly polytope_imp_closed)
   obtain C g where "finite C" "disjnt C (\<Union>\<G>)" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
                    "g ` (\<Union>\<F> - C) \<subseteq> rel_frontier T"
                and gh: "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> \<Union>\<H> \<Longrightarrow> g x = h x"
   proof (rule extend_map_lemma_cofinite1 [OF \<open>finite \<F>\<close> \<F> clo])
     show "X \<inter> Y \<subseteq> \<Union>\<H>" if XY: "X \<in> \<F>" "Y \<in> \<F>" and "\<not> X \<subseteq> Y" "\<not> Y \<subseteq> X" for X Y
     proof (cases "X \<in> \<G>")
       case True
       then show ?thesis
         by (auto simp: \<H>_def)
     next
       case False
       have "X \<inter> Y \<noteq> X"
         using \<open>\<not> X \<subseteq> Y\<close> by blast
       with XY
       show ?thesis
         by (clarsimp simp: \<H>_def)
            (metis Diff_iff Int_iff aff antisym_conv face face_of_aff_dim_lt face_of_refl
                   not_le poly polytope_imp_convex)
     qed
   qed (blast)+
   with \<open>\<G> \<subseteq> \<F>\<close> show ?thesis
-    apply (rule_tac C=C and g=g in that)
-     apply (auto simp: disjnt_def hf [symmetric] \<H>_def intro!: gh)
-    done
+    by (rule_tac C=C and g=g in that) (auto simp: disjnt_def hf [symmetric] \<H>_def intro!: gh)
 qed
 
 text\<open>The next two proofs are similar\<close>
 theorem extend_map_cell_complex_to_sphere:
   assumes "finite \<F>" and S: "S \<subseteq> \<Union>\<F>" "closed S" and T: "convex T" "bounded T"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and aff: "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X < aff_dim T"
       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> rel_frontier T"
   obtains g where "continuous_on (\<Union>\<F>) g"
      "g ` (\<Union>\<F>) \<subseteq> rel_frontier T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   obtain V g where "S \<subseteq> V" "open V" "continuous_on V g" and gim: "g ` V \<subseteq> rel_frontier T" and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     using neighbourhood_extension_into_ANR [OF contf fim _ \<open>closed S\<close>] ANR_rel_frontier_convex T by blast
   have "compact S"
     by (meson assms compact_Union poly polytope_imp_compact seq_compact_closed_subset seq_compact_eq_compact)
   then obtain d where "d > 0" and d: "\<And>x y. \<lbrakk>x \<in> S; y \<in> - V\<rbrakk> \<Longrightarrow> d \<le> dist x y"
     using separate_compact_closed [of S "-V"] \<open>open V\<close> \<open>S \<subseteq> V\<close> by force
   obtain \<G> where "finite \<G>" "\<Union>\<G> = \<Union>\<F>"
              and diaG: "\<And>X. X \<in> \<G> \<Longrightarrow> diameter X < d"
              and polyG: "\<And>X. X \<in> \<G> \<Longrightarrow> polytope X"
              and affG: "\<And>X. X \<in> \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T - 1"
              and faceG: "\<And>X Y. \<lbrakk>X \<in> \<G>; Y \<in> \<G>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
   proof (rule cell_complex_subdivision_exists [OF \<open>d>0\<close> \<open>finite \<F>\<close> poly _ face])
     show "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> aff_dim T - 1"
       by (simp add: aff)
   qed auto
   obtain h where conth: "continuous_on (\<Union>\<G>) h" and him: "h ` \<Union>\<G> \<subseteq> rel_frontier T" and hg: "\<And>x. x \<in> \<Union>(\<G> \<inter> Pow V) \<Longrightarrow> h x = g x"
   proof (rule extend_map_lemma [of \<G> "\<G> \<inter> Pow V" T g])
     show "continuous_on (\<Union>(\<G> \<inter> Pow V)) g"
       by (metis Union_Int_subset Union_Pow_eq \<open>continuous_on V g\<close> continuous_on_subset le_inf_iff)
   qed (use \<open>finite \<G>\<close> T polyG affG faceG gim in fastforce)+
   show ?thesis
   proof
     show "continuous_on (\<Union>\<F>) h"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> conth by auto
     show "h ` \<Union>\<F> \<subseteq> rel_frontier T"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> him by auto
     show "h x = f x" if "x \<in> S" for x
     proof -
       have "x \<in> \<Union>\<G>"
         using \<open>\<Union>\<G> = \<Union>\<F>\<close> \<open>S \<subseteq> \<Union>\<F>\<close> that by auto
       then obtain X where "x \<in> X" "X \<in> \<G>" by blast
       then have "diameter X < d" "bounded X"
         by (auto simp: diaG \<open>X \<in> \<G>\<close> polyG polytope_imp_bounded)
       then have "X \<subseteq> V" using d [OF \<open>x \<in> S\<close>] diameter_bounded_bound [OF \<open>bounded X\<close> \<open>x \<in> X\<close>]
         by fastforce
       have "h x = g x"
-        apply (rule hg)
-        using \<open>X \<in> \<G>\<close> \<open>X \<subseteq> V\<close> \<open>x \<in> X\<close> by blast
+        using \<open>X \<in> \<G>\<close> \<open>X \<subseteq> V\<close> \<open>x \<in> X\<close> hg by auto
       also have "... = f x"
         by (simp add: gf that)
       finally show "h x = f x" .
     qed
   qed
 qed
 
 
 theorem extend_map_cell_complex_to_sphere_cofinite:
   assumes "finite \<F>" and S: "S \<subseteq> \<Union>\<F>" "closed S" and T: "convex T" "bounded T"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and aff: "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> aff_dim T"
       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> rel_frontier T"
   obtains C g where "finite C" "disjnt C S" "continuous_on (\<Union>\<F> - C) g"
      "g ` (\<Union>\<F> - C) \<subseteq> rel_frontier T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   obtain V g where "S \<subseteq> V" "open V" "continuous_on V g" and gim: "g ` V \<subseteq> rel_frontier T" and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     using neighbourhood_extension_into_ANR [OF contf fim _ \<open>closed S\<close>] ANR_rel_frontier_convex T by blast
   have "compact S"
     by (meson assms compact_Union poly polytope_imp_compact seq_compact_closed_subset seq_compact_eq_compact)
   then obtain d where "d > 0" and d: "\<And>x y. \<lbrakk>x \<in> S; y \<in> - V\<rbrakk> \<Longrightarrow> d \<le> dist x y"
     using separate_compact_closed [of S "-V"] \<open>open V\<close> \<open>S \<subseteq> V\<close> by force
   obtain \<G> where "finite \<G>" "\<Union>\<G> = \<Union>\<F>"
              and diaG: "\<And>X. X \<in> \<G> \<Longrightarrow> diameter X < d"
              and polyG: "\<And>X. X \<in> \<G> \<Longrightarrow> polytope X"
              and affG: "\<And>X. X \<in> \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T"
              and faceG: "\<And>X Y. \<lbrakk>X \<in> \<G>; Y \<in> \<G>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
     by (rule cell_complex_subdivision_exists [OF \<open>d>0\<close> \<open>finite \<F>\<close> poly aff face]) auto
   obtain C h where "finite C" and dis: "disjnt C (\<Union>(\<G> \<inter> Pow V))"
                and card: "card C \<le> card \<G>" and conth: "continuous_on (\<Union>\<G> - C) h"
                and him: "h ` (\<Union>\<G> - C) \<subseteq> rel_frontier T"
                and hg: "\<And>x. x \<in> \<Union>(\<G> \<inter> Pow V) \<Longrightarrow> h x = g x"
   proof (rule extend_map_lemma_cofinite [of \<G> "\<G> \<inter> Pow V" T g])
     show "continuous_on (\<Union>(\<G> \<inter> Pow V)) g"
       by (metis Union_Int_subset Union_Pow_eq \<open>continuous_on V g\<close> continuous_on_subset le_inf_iff)
     show "g ` \<Union>(\<G> \<inter> Pow V) \<subseteq> rel_frontier T"
       using gim by force
   qed (auto intro: \<open>finite \<G>\<close> T polyG affG dest: faceG)
   have Ssub: "S \<subseteq> \<Union>(\<G> \<inter> Pow V)"
   proof
     fix x
     assume "x \<in> S"
     then have "x \<in> \<Union>\<G>"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> \<open>S \<subseteq> \<Union>\<F>\<close> by auto
     then obtain X where "x \<in> X" "X \<in> \<G>" by blast
     then have "diameter X < d" "bounded X"
       by (auto simp: diaG \<open>X \<in> \<G>\<close> polyG polytope_imp_bounded)
     then have "X \<subseteq> V" using d [OF \<open>x \<in> S\<close>] diameter_bounded_bound [OF \<open>bounded X\<close> \<open>x \<in> X\<close>]
       by fastforce
     then show "x \<in> \<Union>(\<G> \<inter> Pow V)"
       using \<open>X \<in> \<G>\<close> \<open>x \<in> X\<close> by blast
   qed
   show ?thesis
   proof
     show "continuous_on (\<Union>\<F>-C) h"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> conth by auto
     show "h ` (\<Union>\<F> - C) \<subseteq> rel_frontier T"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> him by auto
     show "h x = f x" if "x \<in> S" for x
     proof -
       have "h x = g x"
         using Ssub hg that by blast
       also have "... = f x"
         by (simp add: gf that)
       finally show "h x = f x" .
     qed
     show "disjnt C S"
       using dis Ssub  by (meson disjnt_iff subset_eq)
   qed (intro \<open>finite C\<close>)
 qed
 
 
 
 subsection\<open> Special cases and corollaries involving spheres\<close>
 
 lemma disjnt_Diff1: "X \<subseteq> Y' \<Longrightarrow> disjnt (X - Y) (X' - Y')"
   by (auto simp: disjnt_def)
 
 proposition extend_map_affine_to_sphere_cofinite_simple:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact S" "convex U" "bounded U"
       and aff: "aff_dim T \<le> aff_dim U"
       and "S \<subseteq> T" and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> rel_frontier U"
  obtains K g where "finite K" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
                    "g ` (T - K) \<subseteq> rel_frontier U"
                    "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   have "\<exists>K g. finite K \<and> disjnt K S \<and> continuous_on (T - K) g \<and>
               g ` (T - K) \<subseteq> rel_frontier U \<and> (\<forall>x \<in> S. g x = f x)"
        if "affine T" "S \<subseteq> T" and aff: "aff_dim T \<le> aff_dim U"  for T
   proof (cases "S = {}")
     case True
     show ?thesis
     proof (cases "rel_frontier U = {}")
       case True
       with \<open>bounded U\<close> have "aff_dim U \<le> 0"
         using affine_bounded_eq_lowdim rel_frontier_eq_empty by auto
       with aff have "aff_dim T \<le> 0" by auto
       then obtain a where "T \<subseteq> {a}"
         using \<open>affine T\<close> affine_bounded_eq_lowdim affine_bounded_eq_trivial by auto
       then show ?thesis
         using \<open>S = {}\<close> fim
         by (metis Diff_cancel contf disjnt_empty2 finite.emptyI finite_insert finite_subset)
     next
       case False
       then obtain a where "a \<in> rel_frontier U"
         by auto
       then show ?thesis
         using continuous_on_const [of _ a] \<open>S = {}\<close> by force
     qed
   next
     case False
     have "bounded S"
       by (simp add: \<open>compact S\<close> compact_imp_bounded)
     then obtain b where b: "S \<subseteq> cbox (-b) b"
       using bounded_subset_cbox_symmetric by blast
     define bbox where "bbox \<equiv> cbox (-(b+One)) (b+One)"
     have "cbox (-b) b \<subseteq> bbox"
       by (auto simp: bbox_def algebra_simps intro!: subset_box_imp)
     with b \<open>S \<subseteq> T\<close> have "S \<subseteq> bbox \<inter> T"
       by auto
     then have Ssub: "S \<subseteq> \<Union>{bbox \<inter> T}"
       by auto
     then have "aff_dim (bbox \<inter> T) \<le> aff_dim U"
       by (metis aff aff_dim_subset inf_commute inf_le1 order_trans)
     obtain K g where K: "finite K" "disjnt K S"
                  and contg: "continuous_on (\<Union>{bbox \<inter> T} - K) g"
                  and gim: "g ` (\<Union>{bbox \<inter> T} - K) \<subseteq> rel_frontier U"
                  and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     proof (rule extend_map_cell_complex_to_sphere_cofinite
               [OF _ Ssub _ \<open>convex U\<close> \<open>bounded U\<close> _ _ _ contf fim])
       show "closed S"
         using \<open>compact S\<close> compact_eq_bounded_closed by auto
       show poly: "\<And>X. X \<in> {bbox \<inter> T} \<Longrightarrow> polytope X"
         by (simp add: polytope_Int_polyhedron bbox_def polytope_interval affine_imp_polyhedron \<open>affine T\<close>)
       show "\<And>X Y. \<lbrakk>X \<in> {bbox \<inter> T}; Y \<in> {bbox \<inter> T}\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
         by (simp add:poly face_of_refl polytope_imp_convex)
       show "\<And>X. X \<in> {bbox \<inter> T} \<Longrightarrow> aff_dim X \<le> aff_dim U"
         by (simp add: \<open>aff_dim (bbox \<inter> T) \<le> aff_dim U\<close>)
     qed auto
     define fro where "fro \<equiv> \<lambda>d. frontier(cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One))"
     obtain d where d12: "1/2 \<le> d" "d \<le> 1" and dd: "disjnt K (fro d)"
     proof (rule disjoint_family_elem_disjnt [OF _ \<open>finite K\<close>])
       show "infinite {1/2..1::real}"
         by (simp add: infinite_Icc)
       have dis1: "disjnt (fro x) (fro y)" if "x<y" for x y
         by (auto simp: algebra_simps that subset_box_imp disjnt_Diff1 frontier_def fro_def)
       then show "disjoint_family_on fro {1/2..1}"
         by (auto simp: disjoint_family_on_def disjnt_def neq_iff)
     qed auto
     define c where "c \<equiv> b + d *\<^sub>R One"
-    have cbsub: "cbox (-b) b \<subseteq> box (-c) c"  "cbox (-b) b \<subseteq> cbox (-c) c"  "cbox (-c) c \<subseteq> bbox"
+    have cbsub: "cbox (-b) b \<subseteq> box (-c) c" "cbox (-b) b \<subseteq> cbox (-c) c"  "cbox (-c) c \<subseteq> bbox"
       using d12 by (auto simp: algebra_simps subset_box_imp c_def bbox_def)
     have clo_cbT: "closed (cbox (- c) c \<inter> T)"
       by (simp add: affine_closed closed_Int closed_cbox \<open>affine T\<close>)
     have cpT_ne: "cbox (- c) c \<inter> T \<noteq> {}"
       using \<open>S \<noteq> {}\<close> b cbsub(2) \<open>S \<subseteq> T\<close> by fastforce
     have "closest_point (cbox (- c) c \<inter> T) x \<notin> K" if "x \<in> T" "x \<notin> K" for x
     proof (cases "x \<in> cbox (-c) c")
       case True with that show ?thesis
         by (simp add: closest_point_self)
     next
       case False
       have int_ne: "interior (cbox (-c) c) \<inter> T \<noteq> {}"
         using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b \<open>cbox (- b) b \<subseteq> box (- c) c\<close> by force
       have "convex T"
         by (meson \<open>affine T\<close> affine_imp_convex)
       then have "x \<in> affine hull (cbox (- c) c \<inter> T)"
           by (metis Int_commute Int_iff \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> cbsub(1) \<open>x \<in> T\<close> affine_hull_convex_Int_nonempty_interior all_not_in_conv b hull_inc inf.orderE interior_cbox)
       then have "x \<in> affine hull (cbox (- c) c \<inter> T) - rel_interior (cbox (- c) c \<inter> T)"
         by (meson DiffI False Int_iff rel_interior_subset subsetCE)
       then have "closest_point (cbox (- c) c \<inter> T) x \<in> rel_frontier (cbox (- c) c \<inter> T)"
         by (rule closest_point_in_rel_frontier [OF clo_cbT cpT_ne])
       moreover have "(rel_frontier (cbox (- c) c \<inter> T)) \<subseteq> fro d"
-        apply (subst convex_affine_rel_frontier_Int [OF _  \<open>affine T\<close> int_ne])
-         apply (auto simp: fro_def c_def)
-        done
+        by (subst convex_affine_rel_frontier_Int [OF _  \<open>affine T\<close> int_ne]) (auto simp: fro_def c_def)
       ultimately show ?thesis
         using dd  by (force simp: disjnt_def)
     qed
     then have cpt_subset: "closest_point (cbox (- c) c \<inter> T) ` (T - K) \<subseteq> \<Union>{bbox \<inter> T} - K"
       using closest_point_in_set [OF clo_cbT cpT_ne] cbsub(3) by force
     show ?thesis
     proof (intro conjI ballI exI)
       have "continuous_on (T - K) (closest_point (cbox (- c) c \<inter> T))"
-        apply (rule continuous_on_closest_point)
-        using \<open>S \<noteq> {}\<close> cbsub(2) b that
-        by (auto simp: affine_imp_convex convex_Int affine_closed closed_Int closed_cbox \<open>affine T\<close>)
+      proof (rule continuous_on_closest_point)
+        show "convex (cbox (- c) c \<inter> T)"
+          by (simp add: affine_imp_convex convex_Int \<open>affine T\<close>)
+        show "closed (cbox (- c) c \<inter> T)"
+          using clo_cbT by blast
+        show "cbox (- c) c \<inter> T \<noteq> {}"
+          using \<open>S \<noteq> {}\<close> cbsub(2) b that by auto
+      qed
       then show "continuous_on (T - K) (g \<circ> closest_point (cbox (- c) c \<inter> T))"
         by (metis continuous_on_compose continuous_on_subset [OF contg cpt_subset])
       have "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K) \<subseteq> g ` (\<Union>{bbox \<inter> T} - K)"
         by (metis image_comp image_mono cpt_subset)
       also have "... \<subseteq> rel_frontier U"
         by (rule gim)
       finally show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K) \<subseteq> rel_frontier U" .
       show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) x = f x" if "x \<in> S" for x
       proof -
         have "(g \<circ> closest_point (cbox (- c) c \<inter> T)) x = g x"
           unfolding o_def
           by (metis IntI \<open>S \<subseteq> T\<close> b cbsub(2) closest_point_self subset_eq that)
         also have "... = f x"
           by (simp add: that gf)
         finally show ?thesis .
       qed
     qed (auto simp: K)
   qed
   then obtain K g where "finite K" "disjnt K S"
                and contg: "continuous_on (affine hull T - K) g"
                and gim:  "g ` (affine hull T - K) \<subseteq> rel_frontier U"
                and gf:   "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     by (metis aff affine_affine_hull aff_dim_affine_hull
               order_trans [OF \<open>S \<subseteq> T\<close> hull_subset [of T affine]])
   then obtain K g where "finite K" "disjnt K S"
                and contg: "continuous_on (T - K) g"
                and gim:  "g ` (T - K) \<subseteq> rel_frontier U"
                and gf:   "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     by (rule_tac K=K and g=g in that) (auto simp: hull_inc elim: continuous_on_subset)
   then show ?thesis
     by (rule_tac K="K \<inter> T" and g=g in that) (auto simp: disjnt_iff Diff_Int contg)
 qed
 
 subsection\<open>Extending maps to spheres\<close>
 
 (*Up to extend_map_affine_to_sphere_cofinite_gen*)
 
 lemma extend_map_affine_to_sphere1:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::topological_space"
   assumes "finite K" "affine U" and contf: "continuous_on (U - K) f"
       and fim: "f ` (U - K) \<subseteq> T"
       and comps: "\<And>C. \<lbrakk>C \<in> components(U - S); C \<inter> K \<noteq> {}\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
       and clo: "closedin (top_of_set U) S" and K: "disjnt K S" "K \<subseteq> U"
   obtains g where "continuous_on (U - L) g" "g ` (U - L) \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof (cases "K = {}")
   case True
   then show ?thesis
     by (metis Diff_empty Diff_subset contf fim continuous_on_subset image_subsetI rev_image_eqI subset_iff that)
 next
   case False
   have "S \<subseteq> U"
     using clo closedin_limpt by blast
   then have "(U - S) \<inter> K \<noteq> {}"
     by (metis Diff_triv False Int_Diff K disjnt_def inf.absorb_iff2 inf_commute)
   then have "\<Union>(components (U - S)) \<inter> K \<noteq> {}"
     using Union_components by simp
   then obtain C0 where C0: "C0 \<in> components (U - S)" "C0 \<inter> K \<noteq> {}"
     by blast
   have "convex U"
     by (simp add: affine_imp_convex \<open>affine U\<close>)
   then have "locally connected U"
     by (rule convex_imp_locally_connected)
   have "\<exists>a g. a \<in> C \<and> a \<in> L \<and> continuous_on (S \<union> (C - {a})) g \<and>
               g ` (S \<union> (C - {a})) \<subseteq> T \<and> (\<forall>x \<in> S. g x = f x)"
        if C: "C \<in> components (U - S)" and CK: "C \<inter> K \<noteq> {}" for C
   proof -
     have "C \<subseteq> U-S" "C \<inter> L \<noteq> {}"
       by (simp_all add: in_components_subset comps that)
     then obtain a where a: "a \<in> C" "a \<in> L" by auto
     have opeUC: "openin (top_of_set U) C"
     proof (rule openin_trans)
       show "openin (top_of_set (U-S)) C"
         by (simp add: \<open>locally connected U\<close> clo locally_diff_closed openin_components_locally_connected [OF _ C])
       show "openin (top_of_set U) (U - S)"
         by (simp add: clo openin_diff)
     qed
     then obtain d where "C \<subseteq> U" "0 < d" and d: "cball a d \<inter> U \<subseteq> C"
       using openin_contains_cball by (metis \<open>a \<in> C\<close>)
     then have "ball a d \<inter> U \<subseteq> C"
       by auto
     obtain h k where homhk: "homeomorphism (S \<union> C) (S \<union> C) h k"
                  and subC: "{x. (\<not> (h x = x \<and> k x = x))} \<subseteq> C"
                  and bou: "bounded {x. (\<not> (h x = x \<and> k x = x))}"
                  and hin: "\<And>x. x \<in> C \<inter> K \<Longrightarrow> h x \<in> ball a d \<inter> U"
     proof (rule homeomorphism_grouping_points_exists_gen [of C "ball a d \<inter> U" "C \<inter> K" "S \<union> C"])
       show "openin (top_of_set C) (ball a d \<inter> U)"
         by (metis open_ball \<open>C \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> inf.absorb_iff2 inf.orderE inf_assoc open_openin openin_subtopology)
       show "openin (top_of_set (affine hull C)) C"
         by (metis \<open>a \<in> C\<close> \<open>openin (top_of_set U) C\<close> affine_hull_eq affine_hull_openin all_not_in_conv \<open>affine U\<close>)
       show "ball a d \<inter> U \<noteq> {}"
         using \<open>0 < d\<close> \<open>C \<subseteq> U\<close> \<open>a \<in> C\<close> by force
       show "finite (C \<inter> K)"
         by (simp add: \<open>finite K\<close>)
       show "S \<union> C \<subseteq> affine hull C"
         by (metis \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> opeUC affine_hull_eq affine_hull_openin all_not_in_conv assms(2) sup.bounded_iff)
       show "connected C"
         by (metis C in_components_connected)
     qed auto
     have a_BU: "a \<in> ball a d \<inter> U"
       using \<open>0 < d\<close> \<open>C \<subseteq> U\<close> \<open>a \<in> C\<close> by auto
     have "rel_frontier (cball a d \<inter> U) retract_of (affine hull (cball a d \<inter> U) - {a})"
-      apply (rule rel_frontier_retract_of_punctured_affine_hull)
-        apply (auto simp: \<open>convex U\<close> convex_Int)
-      by (metis \<open>affine U\<close> convex_cball empty_iff interior_cball a_BU rel_interior_convex_Int_affine)
+    proof (rule rel_frontier_retract_of_punctured_affine_hull)
+      show "bounded (cball a d \<inter> U)" "convex (cball a d \<inter> U)"
+        by (auto simp: \<open>convex U\<close> convex_Int)
+      show "a \<in> rel_interior (cball a d \<inter> U)"
+        by (metis \<open>affine U\<close> convex_cball empty_iff interior_cball a_BU rel_interior_convex_Int_affine)
+    qed
     moreover have "rel_frontier (cball a d \<inter> U) = frontier (cball a d) \<inter> U"
-      apply (rule convex_affine_rel_frontier_Int)
-      using a_BU by (force simp: \<open>affine U\<close>)+
+      by (metis a_BU \<open>affine U\<close> convex_affine_rel_frontier_Int convex_cball equals0D interior_cball)
     moreover have "affine hull (cball a d \<inter> U) = U"
       by (metis \<open>convex U\<close> a_BU affine_hull_convex_Int_nonempty_interior affine_hull_eq \<open>affine U\<close> equals0D inf.commute interior_cball)
     ultimately have "frontier (cball a d) \<inter> U retract_of (U - {a})"
       by metis
     then obtain r where contr: "continuous_on (U - {a}) r"
                     and rim: "r ` (U - {a}) \<subseteq> sphere a d"  "r ` (U - {a}) \<subseteq> U"
                     and req: "\<And>x. x \<in> sphere a d \<inter> U \<Longrightarrow> r x = x"
       using \<open>affine U\<close> by (auto simp: retract_of_def retraction_def hull_same)
     define j where "j \<equiv> \<lambda>x. if x \<in> ball a d then r x else x"
     have kj: "\<And>x. x \<in> S \<Longrightarrow> k (j x) = x"
       using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> j_def subC by auto
     have Uaeq: "U - {a} = (cball a d - {a}) \<inter> U \<union> (U - ball a d)"
       using \<open>0 < d\<close> by auto
     have jim: "j ` (S \<union> (C - {a})) \<subseteq> (S \<union> C) - ball a d"
     proof clarify
       fix y  assume "y \<in> S \<union> (C - {a})"
       then have "y \<in> U - {a}"
         using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> by auto
       then have "r y \<in> sphere a d"
         using rim by auto
       then show "j y \<in> S \<union> C - ball a d"
-        apply (simp add: j_def)
-        using \<open>r y \<in> sphere a d\<close> \<open>y \<in> U - {a}\<close> \<open>y \<in> S \<union> (C - {a})\<close> d rim by fastforce
+        unfolding j_def
+        using \<open>r y \<in> sphere a d\<close> \<open>y \<in> U - {a}\<close> \<open>y \<in> S \<union> (C - {a})\<close> d rim
+        by (metis Diff_iff Int_iff Un_iff subsetD cball_diff_eq_sphere image_subset_iff)
     qed
     have contj: "continuous_on (U - {a}) j"
       unfolding j_def Uaeq
     proof (intro continuous_on_cases_local continuous_on_id, simp_all add: req closedin_closed Uaeq [symmetric])
       show "\<exists>T. closed T \<and> (cball a d - {a}) \<inter> U = (U - {a}) \<inter> T"
-          apply (rule_tac x="(cball a d) \<inter> U" in exI)
-        using affine_closed \<open>affine U\<close> by blast
+        using affine_closed \<open>affine U\<close> by (rule_tac x="(cball a d) \<inter> U" in exI) blast
       show "\<exists>T. closed T \<and> U - ball a d = (U - {a}) \<inter> T"
-         apply (rule_tac x="U - ball a d" in exI)
-        using \<open>0 < d\<close>  by (force simp: affine_closed \<open>affine U\<close> closed_Diff)
+        using \<open>0 < d\<close> \<open>affine U\<close>
+        by (rule_tac x="U - ball a d" in exI) (force simp: affine_closed)
       show "continuous_on ((cball a d - {a}) \<inter> U) r"
         by (force intro: continuous_on_subset [OF contr])
     qed
     have fT: "x \<in> U - K \<Longrightarrow> f x \<in> T" for x
       using fim by blast
     show ?thesis
     proof (intro conjI exI)
       show "continuous_on (S \<union> (C - {a})) (f \<circ> k \<circ> j)"
       proof (intro continuous_on_compose)
-        show "continuous_on (S \<union> (C - {a})) j"
-          apply (rule continuous_on_subset [OF contj])
+        have "S \<union> (C - {a}) \<subseteq> U - {a}"
           using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> by force
-        show "continuous_on (j ` (S \<union> (C - {a}))) k"
-          apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
+        then show "continuous_on (S \<union> (C - {a})) j"
+          by (rule continuous_on_subset [OF contj])
+        have "j ` (S \<union> (C - {a})) \<subseteq> S \<union> C"
           using jim \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> j_def by blast
+        then show "continuous_on (j ` (S \<union> (C - {a}))) k"
+          by (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
         show "continuous_on (k ` j ` (S \<union> (C - {a}))) f"
         proof (clarify intro!: continuous_on_subset [OF contf])
           fix y  assume "y \<in> S \<union> (C - {a})"
           have ky: "k y \<in> S \<union> C"
             using homeomorphism_image2 [OF homhk] \<open>y \<in> S \<union> (C - {a})\<close> by blast
           have jy: "j y \<in> S \<union> C - ball a d"
             using Un_iff \<open>y \<in> S \<union> (C - {a})\<close> jim by auto
-          show "k (j y) \<in> U - K"
-            apply safe
-            using \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close>  homeomorphism_image2 [OF homhk] jy apply blast
-            by (metis DiffD1 DiffD2 Int_iff Un_iff \<open>disjnt K S\<close> disjnt_def empty_iff hin homeomorphism_apply2 homeomorphism_image2 homhk imageI jy)
+          have "k (j y) \<in> U"
+            using \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close>  homeomorphism_image2 [OF homhk] jy by blast
+          moreover have "k (j y) \<notin> K"
+            using K unfolding disjnt_iff
+            by (metis DiffE Int_iff Un_iff hin homeomorphism_def homhk image_eqI jy)
+          ultimately show "k (j y) \<in> U - K"
+            by blast
         qed
       qed
       have ST: "\<And>x. x \<in> S \<Longrightarrow> (f \<circ> k \<circ> j) x \<in> T"
-        apply (simp add: kj)
-        apply (metis DiffI \<open>S \<subseteq> U\<close> \<open>disjnt K S\<close> subsetD disjnt_iff fim image_subset_iff)
-        done
+      proof (simp add: kj)
+        show "\<And>x. x \<in> S \<Longrightarrow> f x \<in> T"
+          using K unfolding disjnt_iff by (metis DiffI \<open>S \<subseteq> U\<close> subsetD fim image_subset_iff)
+      qed
       moreover have "(f \<circ> k \<circ> j) x \<in> T" if "x \<in> C" "x \<noteq> a" "x \<notin> S" for x
       proof -
         have rx: "r x \<in> sphere a d"
           using \<open>C \<subseteq> U\<close> rim that by fastforce
         have jj: "j x \<in> S \<union> C - ball a d"
           using jim that by blast
         have "k (j x) = j x \<longrightarrow> k (j x) \<in> C \<or> j x \<in> C"
           by (metis Diff_iff Int_iff Un_iff \<open>S \<subseteq> U\<close> subsetD d j_def jj rx sphere_cball that(1))
-        then have "k (j x) \<in> C"
+        then have kj: "k (j x) \<in> C"
           using homeomorphism_apply2 [OF homhk, of "j x"]   \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close> a rx
           by (metis (mono_tags, lifting) Diff_iff subsetD jj mem_Collect_eq subC)
-        with jj \<open>C \<subseteq> U\<close> show ?thesis
-          apply safe
-          using ST j_def apply fastforce
-          apply (auto simp: not_less intro!: fT)
-          by (metis DiffD1 DiffD2 Int_iff hin homeomorphism_apply2 [OF homhk] jj)
+        then show ?thesis
+          by (metis DiffE DiffI IntD1 IntI \<open>C \<subseteq> U\<close> comp_apply fT hin homeomorphism_apply2 homhk jj kj subset_eq)
       qed
       ultimately show "(f \<circ> k \<circ> j) ` (S \<union> (C - {a})) \<subseteq> T"
         by force
       show "\<forall>x\<in>S. (f \<circ> k \<circ> j) x = f x" using kj by simp
     qed (auto simp: a)
   qed
   then obtain a h where
     ah: "\<And>C. \<lbrakk>C \<in> components (U - S); C \<inter> K \<noteq> {}\<rbrakk>
            \<Longrightarrow> a C \<in> C \<and> a C \<in> L \<and> continuous_on (S \<union> (C - {a C})) (h C) \<and>
                h C ` (S \<union> (C - {a C})) \<subseteq> T \<and> (\<forall>x \<in> S. h C x = f x)"
     using that by metis
   define F where "F \<equiv> {C \<in> components (U - S). C \<inter> K \<noteq> {}}"
   define G where "G \<equiv> {C \<in> components (U - S). C \<inter> K = {}}"
   define UF where "UF \<equiv> (\<Union>C\<in>F. C - {a C})"
   have "C0 \<in> F"
     by (auto simp: F_def C0)
   have "finite F"
   proof (subst finite_image_iff [of "\<lambda>C. C \<inter> K" F, symmetric])
     show "inj_on (\<lambda>C. C \<inter> K) F"
       unfolding F_def inj_on_def
       using components_nonoverlap by blast
     show "finite ((\<lambda>C. C \<inter> K) ` F)"
       unfolding F_def
       by (rule finite_subset [of _ "Pow K"]) (auto simp: \<open>finite K\<close>)
   qed
   obtain g where contg: "continuous_on (S \<union> UF) g"
              and gh: "\<And>x i. \<lbrakk>i \<in> F; x \<in> (S \<union> UF) \<inter> (S \<union> (i - {a i}))\<rbrakk>
                             \<Longrightarrow> g x = h i x"
   proof (rule pasting_lemma_exists_closed [OF \<open>finite F\<close>])
     let ?X = "top_of_set (S \<union> UF)"
     show "topspace ?X \<subseteq> (\<Union>C\<in>F. S \<union> (C - {a C}))"
       using \<open>C0 \<in> F\<close> by (force simp: UF_def)
     show "closedin (top_of_set (S \<union> UF)) (S \<union> (C - {a C}))"
          if "C \<in> F" for C
     proof (rule closedin_closed_subset [of U "S \<union> C"])
-      show "closedin (top_of_set U) (S \<union> C)"
-        apply (rule closedin_Un_complement_component [OF \<open>locally connected U\<close> clo])
+      have "C \<in> components (U - S)"
         using F_def that by blast
+      then show "closedin (top_of_set U) (S \<union> C)"
+        by (rule closedin_Un_complement_component [OF \<open>locally connected U\<close> clo])
     next
       have "x = a C'" if "C' \<in> F"  "x \<in> C'" "x \<notin> U" for x C'
       proof -
         have "\<forall>A. x \<in> \<Union>A \<or> C' \<notin> A"
           using \<open>x \<in> C'\<close> by blast
         with that show "x = a C'"
           by (metis (lifting) DiffD1 F_def Union_components mem_Collect_eq)
       qed
       then show "S \<union> UF \<subseteq> U"
         using \<open>S \<subseteq> U\<close> by (force simp: UF_def)
     next
       show "S \<union> (C - {a C}) = (S \<union> C) \<inter> (S \<union> UF)"
         using F_def UF_def components_nonoverlap that by auto
     qed
     show "continuous_map (subtopology ?X (S \<union> (C' - {a C'}))) euclidean (h C')" if "C' \<in> F" for C'
     proof -
       have C': "C' \<in> components (U - S)" "C' \<inter> K \<noteq> {}"
         using F_def that by blast+
       show ?thesis
         using ah [OF C'] by (auto simp: F_def subtopology_subtopology intro: continuous_on_subset)
     qed
     show "\<And>i j x. \<lbrakk>i \<in> F; j \<in> F;
                    x \<in> topspace ?X \<inter> (S \<union> (i - {a i})) \<inter> (S \<union> (j - {a j}))\<rbrakk>
                   \<Longrightarrow> h i x = h j x"
       using components_eq by (fastforce simp: components_eq F_def ah)
   qed auto
   have SU': "S \<union> \<Union>G \<union> (S \<union> UF) \<subseteq> U"
     using \<open>S \<subseteq> U\<close> in_components_subset by (auto simp: F_def G_def UF_def)
   have clo1: "closedin (top_of_set (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> \<Union>G)"
   proof (rule closedin_closed_subset [OF _ SU'])
     have *: "\<And>C. C \<in> F \<Longrightarrow> openin (top_of_set U) C"
       unfolding F_def
       by clarify (metis (no_types, lifting) \<open>locally connected U\<close> clo closedin_def locally_diff_closed openin_components_locally_connected openin_trans topspace_euclidean_subtopology)
     show "closedin (top_of_set U) (U - UF)"
       unfolding UF_def
       by (force intro: openin_delete *)
     show "S \<union> \<Union>G = (U - UF) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
       using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
         apply (metis Diff_iff UnionI Union_components)
        apply (metis DiffD1 UnionI Union_components)
       by (metis (no_types, lifting) IntI components_nonoverlap empty_iff)
   qed
   have clo2: "closedin (top_of_set (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> UF)"
   proof (rule closedin_closed_subset [OF _ SU'])
     show "closedin (top_of_set U) (\<Union>C\<in>F. S \<union> C)"
-      apply (rule closedin_Union)
-       apply (simp add: \<open>finite F\<close>)
-      using F_def \<open>locally connected U\<close> clo closedin_Un_complement_component by blast
+    proof (rule closedin_Union)
+      show "\<And>T. T \<in> (\<union>) S ` F \<Longrightarrow> closedin (top_of_set U) T"
+        using F_def \<open>locally connected U\<close> clo closedin_Un_complement_component by blast
+    qed (simp add: \<open>finite F\<close>)
     show "S \<union> UF = (\<Union>C\<in>F. S \<union> C) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
       using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
       using C0 apply blast
-      by (metis components_nonoverlap disjnt_def disjnt_iff)
+      by (metis components_nonoverlap disjoint_iff)
   qed
   have SUG: "S \<union> \<Union>G \<subseteq> U - K"
     using \<open>S \<subseteq> U\<close> K apply (auto simp: G_def disjnt_iff)
     by (meson Diff_iff subsetD in_components_subset)
   then have contf': "continuous_on (S \<union> \<Union>G) f"
     by (rule continuous_on_subset [OF contf])
   have contg': "continuous_on (S \<union> UF) g"
-    apply (rule continuous_on_subset [OF contg])
-    using \<open>S \<subseteq> U\<close> by (auto simp: F_def G_def)
+    by (simp add: contg)
   have  "\<And>x. \<lbrakk>S \<subseteq> U; x \<in> S\<rbrakk> \<Longrightarrow> f x = g x"
     by (subst gh) (auto simp: ah C0 intro: \<open>C0 \<in> F\<close>)
   then have f_eq_g: "\<And>x. x \<in> S \<union> UF \<and> x \<in> S \<union> \<Union>G \<Longrightarrow> f x = g x"
     using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def dest: in_components_subset)
     using components_eq by blast
   have cont: "continuous_on (S \<union> \<Union>G \<union> (S \<union> UF)) (\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x)"
     by (blast intro: continuous_on_cases_local [OF clo1 clo2 contf' contg' f_eq_g, of "\<lambda>x. x \<in> S \<union> \<Union>G"])
   show ?thesis
   proof
     have UF: "\<Union>F - L \<subseteq> UF"
       unfolding F_def UF_def using ah by blast
     have "U - S - L = \<Union>(components (U - S)) - L"
       by simp
     also have "... = \<Union>F \<union> \<Union>G - L"
       unfolding F_def G_def by blast
     also have "... \<subseteq> UF \<union> \<Union>G"
       using UF by blast
     finally have "U - L \<subseteq> S \<union> \<Union>G \<union> (S \<union> UF)"
       by blast
     then show "continuous_on (U - L) (\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x)"
       by (rule continuous_on_subset [OF cont])
     have "((U - L) \<inter> {x. x \<notin> S \<and> (\<forall>xa\<in>G. x \<notin> xa)}) \<subseteq>  ((U - L) \<inter> (-S \<inter> UF))"
       using \<open>U - L \<subseteq> S \<union> \<Union>G \<union> (S \<union> UF)\<close> by auto
     moreover have "g ` ((U - L) \<inter> (-S \<inter> UF)) \<subseteq> T"
     proof -
       have "g x \<in> T" if "x \<in> U" "x \<notin> L" "x \<notin> S" "C \<in> F" "x \<in> C" "x \<noteq> a C" for x C
       proof (subst gh)
         show "x \<in> (S \<union> UF) \<inter> (S \<union> (C - {a C}))"
           using that by (auto simp: UF_def)
         show "h C x \<in> T"
           using ah that by (fastforce simp add: F_def)
       qed (rule that)
       then show ?thesis
         by (force simp: UF_def)
     qed
     ultimately have "g ` ((U - L) \<inter> {x. x \<notin> S \<and> (\<forall>xa\<in>G. x \<notin> xa)}) \<subseteq> T"
       using image_mono order_trans by blast
     moreover have "f ` ((U - L) \<inter> (S \<union> \<Union>G)) \<subseteq> T"
       using fim SUG by blast
     ultimately show "(\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x) ` (U - L) \<subseteq> T"
        by force
     show "\<And>x. x \<in> S \<Longrightarrow> (if x \<in> S \<union> \<Union>G then f x else g x) = f x"
       by (simp add: F_def G_def)
   qed
 qed
 
 
 lemma extend_map_affine_to_sphere2:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact S" "convex U" "bounded U" "affine T" "S \<subseteq> T"
       and affTU: "aff_dim T \<le> aff_dim U"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> rel_frontier U"
       and ovlap: "\<And>C. C \<in> components(T - S) \<Longrightarrow> C \<inter> L \<noteq> {}"
     obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S"
                       "continuous_on (T - K) g" "g ` (T - K) \<subseteq> rel_frontier U"
                       "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   obtain K g where K: "finite K" "K \<subseteq> T" "disjnt K S"
                and contg: "continuous_on (T - K) g"
                and gim: "g ` (T - K) \<subseteq> rel_frontier U"
                and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
      using assms extend_map_affine_to_sphere_cofinite_simple by metis
   have "(\<exists>y C. C \<in> components (T - S) \<and> x \<in> C \<and> y \<in> C \<and> y \<in> L)" if "x \<in> K" for x
   proof -
     have "x \<in> T-S"
       using \<open>K \<subseteq> T\<close> \<open>disjnt K S\<close> disjnt_def that by fastforce
     then obtain C where "C \<in> components(T - S)" "x \<in> C"
       by (metis UnionE Union_components)
     with ovlap [of C] show ?thesis
       by blast
   qed
   then obtain \<xi> where \<xi>: "\<And>x. x \<in> K \<Longrightarrow> \<exists>C. C \<in> components (T - S) \<and> x \<in> C \<and> \<xi> x \<in> C \<and> \<xi> x \<in> L"
     by metis
   obtain h where conth: "continuous_on (T - \<xi> ` K) h"
              and him: "h ` (T - \<xi> ` K) \<subseteq> rel_frontier U"
              and hg: "\<And>x. x \<in> S \<Longrightarrow> h x = g x"
   proof (rule extend_map_affine_to_sphere1 [OF \<open>finite K\<close> \<open>affine T\<close> contg gim, of S "\<xi> ` K"])
     show cloTS: "closedin (top_of_set T) S"
       by (simp add: \<open>compact S\<close> \<open>S \<subseteq> T\<close> closed_subset compact_imp_closed)
     show "\<And>C. \<lbrakk>C \<in> components (T - S); C \<inter> K \<noteq> {}\<rbrakk> \<Longrightarrow> C \<inter> \<xi> ` K \<noteq> {}"
       using \<xi> components_eq by blast
   qed (use K in auto)
   show ?thesis
   proof
     show *: "\<xi> ` K \<subseteq> L"
       using \<xi> by blast
     show "finite (\<xi> ` K)"
       by (simp add: K)
     show "\<xi> ` K \<subseteq> T"
       by clarify (meson \<xi> Diff_iff contra_subsetD in_components_subset)
     show "continuous_on (T - \<xi> ` K) h"
       by (rule conth)
     show "disjnt (\<xi> ` K) S"
-      using K
-      apply (auto simp: disjnt_def)
-      by (metis \<xi> DiffD2 UnionI Union_components)
+      using K \<xi> in_components_subset by (fastforce simp: disjnt_def)
   qed (simp_all add: him hg gf)
 qed
 
 
 proposition extend_map_affine_to_sphere_cofinite_gen:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes SUT: "compact S" "convex U" "bounded U" "affine T" "S \<subseteq> T"
       and aff: "aff_dim T \<le> aff_dim U"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> rel_frontier U"
       and dis: "\<And>C. \<lbrakk>C \<in> components(T - S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
                    "g ` (T - K) \<subseteq> rel_frontier U"
                    "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof (cases "S = {}")
   case True
   show ?thesis
   proof (cases "rel_frontier U = {}")
     case True
     with aff have "aff_dim T \<le> 0"
-      apply (simp add: rel_frontier_eq_empty)
-      using affine_bounded_eq_lowdim \<open>bounded U\<close> order_trans by auto
+      using affine_bounded_eq_lowdim \<open>bounded U\<close> order_trans 
+      by (auto simp add: rel_frontier_eq_empty)
     with aff_dim_geq [of T] consider "aff_dim T = -1" |  "aff_dim T = 0"
       by linarith
     then show ?thesis
     proof cases
       assume "aff_dim T = -1"
       then have "T = {}"
         by (simp add: aff_dim_empty)
       then show ?thesis
         by (rule_tac K="{}" in that) auto
     next
       assume "aff_dim T = 0"
       then obtain a where "T = {a}"
         using aff_dim_eq_0 by blast
       then have "a \<in> L"
         using dis [of "{a}"] \<open>S = {}\<close> by (auto simp: in_components_self)
       with \<open>S = {}\<close> \<open>T = {a}\<close> show ?thesis
         by (rule_tac K="{a}" and g=f in that) auto
     qed
   next
     case False
     then obtain y where "y \<in> rel_frontier U"
       by auto
     with \<open>S = {}\<close> show ?thesis
       by (rule_tac K="{}" and g="\<lambda>x. y" in that)  (auto)
   qed
 next
   case False
   have "bounded S"
     by (simp add: assms compact_imp_bounded)
   then obtain b where b: "S \<subseteq> cbox (-b) b"
     using bounded_subset_cbox_symmetric by blast
   define LU where "LU \<equiv> L \<union> (\<Union> {C \<in> components (T - S). \<not>bounded C} - cbox (-(b+One)) (b+One))"
   obtain K g where "finite K" "K \<subseteq> LU" "K \<subseteq> T" "disjnt K S"
                and contg: "continuous_on (T - K) g"
                and gim: "g ` (T - K) \<subseteq> rel_frontier U"
                and gf:  "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   proof (rule extend_map_affine_to_sphere2 [OF SUT aff contf fim])
     show "C \<inter> LU \<noteq> {}" if "C \<in> components (T - S)" for C
     proof (cases "bounded C")
       case True
       with dis that show ?thesis
         unfolding LU_def by fastforce
     next
       case False
       then have "\<not> bounded (\<Union>{C \<in> components (T - S). \<not> bounded C})"
         by (metis (no_types, lifting) Sup_upper bounded_subset mem_Collect_eq that)
       then show ?thesis
         apply (clarsimp simp: LU_def Int_Un_distrib Diff_Int_distrib Int_UN_distrib)
         by (metis (no_types, lifting) False Sup_upper bounded_cbox bounded_subset inf.orderE mem_Collect_eq that)
     qed
   qed blast
   have *: False if "x \<in> cbox (- b - m *\<^sub>R One) (b + m *\<^sub>R One)"
                    "x \<notin> box (- b - n *\<^sub>R One) (b + n *\<^sub>R One)"
                    "0 \<le> m" "m < n" "n \<le> 1" for m n x
     using that by (auto simp: mem_box algebra_simps)
   have "disjoint_family_on (\<lambda>d. frontier (cbox (- b - d *\<^sub>R One) (b + d *\<^sub>R One))) {1 / 2..1}"
     by (auto simp: disjoint_family_on_def neq_iff frontier_def dest: *)
   then obtain d where d12: "1/2 \<le> d" "d \<le> 1"
                   and ddis: "disjnt K (frontier (cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One)))"
     using disjoint_family_elem_disjnt [of "{1/2..1::real}" K "\<lambda>d. frontier (cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One))"]
     by (auto simp: \<open>finite K\<close>)
   define c where "c \<equiv> b + d *\<^sub>R One"
   have cbsub: "cbox (-b) b \<subseteq> box (-c) c"
               "cbox (-b) b \<subseteq> cbox (-c) c"
               "cbox (-c) c \<subseteq> cbox (-(b+One)) (b+One)"
     using d12 by (simp_all add: subset_box c_def inner_diff_left inner_left_distrib)
   have clo_cT: "closed (cbox (- c) c \<inter> T)"
     using affine_closed \<open>affine T\<close> by blast
   have cT_ne: "cbox (- c) c \<inter> T \<noteq> {}"
     using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub by fastforce
   have S_sub_cc: "S \<subseteq> cbox (- c) c"
     using \<open>cbox (- b) b \<subseteq> cbox (- c) c\<close> b by auto
   show ?thesis
   proof
     show "finite (K \<inter> cbox (-(b+One)) (b+One))"
       using \<open>finite K\<close> by blast
     show "K \<inter> cbox (- (b + One)) (b + One) \<subseteq> L"
       using \<open>K \<subseteq> LU\<close> by (auto simp: LU_def)
     show "K \<inter> cbox (- (b + One)) (b + One) \<subseteq> T"
       using \<open>K \<subseteq> T\<close> by auto
     show "disjnt (K \<inter> cbox (- (b + One)) (b + One)) S"
       using \<open>disjnt K S\<close>  by (simp add: disjnt_def disjoint_eq_subset_Compl inf.coboundedI1)
     have cloTK: "closest_point (cbox (- c) c \<inter> T) x \<in> T - K"
                 if "x \<in> T" and Knot: "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
     proof (cases "x \<in> cbox (- c) c")
       case True
       with \<open>x \<in> T\<close> show ?thesis
         using cbsub(3) Knot  by (force simp: closest_point_self)
     next
       case False
       have clo_in_rf: "closest_point (cbox (- c) c \<inter> T) x \<in> rel_frontier (cbox (- c) c \<inter> T)"
       proof (intro closest_point_in_rel_frontier [OF clo_cT cT_ne] DiffI notI)
         have "T \<inter> interior (cbox (- c) c) \<noteq> {}"
           using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub(1) by fastforce
         then show "x \<in> affine hull (cbox (- c) c \<inter> T)"
           by (simp add: Int_commute affine_hull_affine_Int_nonempty_interior \<open>affine T\<close> hull_inc that(1))
       next
         show "False" if "x \<in> rel_interior (cbox (- c) c \<inter> T)"
         proof -
           have "interior (cbox (- c) c) \<inter> T \<noteq> {}"
             using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub(1) by fastforce
           then have "affine hull (T \<inter> cbox (- c) c) = T"
             using affine_hull_convex_Int_nonempty_interior [of T "cbox (- c) c"]
             by (simp add: affine_imp_convex \<open>affine T\<close> inf_commute)
           then show ?thesis
             by (meson subsetD le_inf_iff rel_interior_subset that False)
         qed
       qed
       have "closest_point (cbox (- c) c \<inter> T) x \<notin> K"
       proof
         assume inK: "closest_point (cbox (- c) c \<inter> T) x \<in> K"
         have "\<And>x. x \<in> K \<Longrightarrow> x \<notin> frontier (cbox (- (b + d *\<^sub>R One)) (b + d *\<^sub>R One))"
           by (metis ddis disjnt_iff)
         then show False
           by (metis DiffI Int_iff \<open>affine T\<close> cT_ne c_def clo_cT clo_in_rf closest_point_in_set
                     convex_affine_rel_frontier_Int convex_box(1) empty_iff frontier_cbox inK interior_cbox)
       qed
       then show ?thesis
         using cT_ne clo_cT closest_point_in_set by blast
     qed
     show "continuous_on (T - K \<inter> cbox (- (b + One)) (b + One)) (g \<circ> closest_point (cbox (-c) c \<inter> T))"
+      using cloTK
       apply (intro continuous_on_compose continuous_on_closest_point continuous_on_subset [OF contg])
-         apply (simp_all add: clo_cT affine_imp_convex \<open>affine T\<close> convex_Int cT_ne)
-      using cloTK by blast
+      by (auto simp add: clo_cT affine_imp_convex \<open>affine T\<close> convex_Int cT_ne)
     have "g (closest_point (cbox (- c) c \<inter> T) x) \<in> rel_frontier U"
          if "x \<in> T" "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
-      apply (rule gim [THEN subsetD])
-      using that cloTK by blast
+      using gim [THEN subsetD] that cloTK by blast
     then show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K \<inter> cbox (- (b + One)) (b + One))
                \<subseteq> rel_frontier U"
       by force
     show "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> closest_point (cbox (- c) c \<inter> T)) x = f x"
       by simp (metis (mono_tags, lifting) IntI \<open>S \<subseteq> T\<close> cT_ne clo_cT closest_point_refl gf subsetD S_sub_cc)
   qed
 qed
 
 
 corollary extend_map_affine_to_sphere_cofinite:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes SUT: "compact S" "affine T" "S \<subseteq> T"
       and aff: "aff_dim T \<le> DIM('b)" and "0 \<le> r"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> sphere a r"
       and dis: "\<And>C. \<lbrakk>C \<in> components(T - S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
   obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
                     "g ` (T - K) \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof (cases "r = 0")
   case True
   with fim show ?thesis
     by (rule_tac K="{}" and g = "\<lambda>x. a" in that) (auto)
 next
   case False
   with assms have "0 < r" by auto
   then have "aff_dim T \<le> aff_dim (cball a r)"
     by (simp add: aff aff_dim_cball)
   then show ?thesis
     apply (rule extend_map_affine_to_sphere_cofinite_gen
             [OF \<open>compact S\<close> convex_cball bounded_cball \<open>affine T\<close> \<open>S \<subseteq> T\<close> _ contf])
     using fim apply (auto simp: assms False that dest: dis)
     done
 qed
 
 corollary extend_map_UNIV_to_sphere_cofinite:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes aff: "DIM('a) \<le> DIM('b)" and "0 \<le> r"
-      and SUT: "compact S"
-      and contf: "continuous_on S f"
-      and fim: "f ` S \<subseteq> sphere a r"
-      and dis: "\<And>C. \<lbrakk>C \<in> components(- S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
+  assumes "DIM('a) \<le> DIM('b)" and "0 \<le> r"
+      and "compact S"
+      and "continuous_on S f"
+      and "f ` S \<subseteq> sphere a r"
+      and "\<And>C. \<lbrakk>C \<in> components(- S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
   obtains K g where "finite K" "K \<subseteq> L" "disjnt K S" "continuous_on (- K) g"
                     "g ` (- K) \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
-apply (rule extend_map_affine_to_sphere_cofinite
-        [OF \<open>compact S\<close> affine_UNIV subset_UNIV _ \<open>0 \<le> r\<close> contf fim dis])
- apply (auto simp: assms that Compl_eq_Diff_UNIV [symmetric])
-done
+  using extend_map_affine_to_sphere_cofinite
+        [OF \<open>compact S\<close> affine_UNIV subset_UNIV] assms
+  by (metis Compl_eq_Diff_UNIV aff_dim_UNIV of_nat_le_iff)
 
 corollary extend_map_UNIV_to_sphere_no_bounded_component:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes aff: "DIM('a) \<le> DIM('b)" and "0 \<le> r"
       and SUT: "compact S"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> sphere a r"
       and dis: "\<And>C. C \<in> components(- S) \<Longrightarrow> \<not> bounded C"
   obtains g where "continuous_on UNIV g" "g ` UNIV \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
-apply (rule extend_map_UNIV_to_sphere_cofinite [OF aff \<open>0 \<le> r\<close> \<open>compact S\<close> contf fim, of "{}"])
-   apply (auto simp: that dest: dis)
+  apply (rule extend_map_UNIV_to_sphere_cofinite [OF aff \<open>0 \<le> r\<close> \<open>compact S\<close> contf fim, of "{}"])
+   apply (auto dest: dis)
 done
 
 theorem Borsuk_separation_theorem_gen:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S"
     shows "(\<forall>c \<in> components(- S). \<not>bounded c) \<longleftrightarrow>
            (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::'a) 1
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)))"
        (is "?lhs = ?rhs")
 proof
   assume L [rule_format]: ?lhs
   show ?rhs
   proof clarify
     fix f :: "'a \<Rightarrow> 'a"
     assume contf: "continuous_on S f" and fim: "f ` S \<subseteq> sphere 0 1"
     obtain g where contg: "continuous_on UNIV g" and gim: "range g \<subseteq> sphere 0 1"
                and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
       by (rule extend_map_UNIV_to_sphere_no_bounded_component [OF _ _ \<open>compact S\<close> contf fim L]) auto
     then obtain c where c: "homotopic_with_canon (\<lambda>h. True) UNIV (sphere 0 1) g (\<lambda>x. c)"
       using contractible_UNIV nullhomotopic_from_contractible by blast
     then show "\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)"
       by (metis assms compact_imp_closed contf contg contractible_empty fim gf gim nullhomotopic_from_contractible nullhomotopic_into_sphere_extension)
   qed
 next
   assume R [rule_format]: ?rhs
   show ?lhs
     unfolding components_def
   proof clarify
     fix a
     assume "a \<notin> S" and a: "bounded (connected_component_set (- S) a)"
-    have cont: "continuous_on S (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a))"
-      apply (intro continuous_intros)
+    have "\<forall>x\<in>S. norm (x - a) \<noteq> 0"
       using \<open>a \<notin> S\<close> by auto
+    then have cont: "continuous_on S (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a))"
+      by (intro continuous_intros)
     have im: "(\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) ` S \<subseteq> sphere 0 1"
       by clarsimp (metis \<open>a \<notin> S\<close> eq_iff_diff_eq_0 left_inverse norm_eq_zero)
     show False
       using R cont im Borsuk_map_essential_bounded_component [OF \<open>compact S\<close> \<open>a \<notin> S\<close>] a by blast
   qed
 qed
 
 
 corollary Borsuk_separation_theorem:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and 2: "2 \<le> DIM('a)"
     shows "connected(- S) \<longleftrightarrow>
            (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::'a) 1
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)))"
        (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof (cases "S = {}")
     case True
     then show ?thesis by auto
   next
     case False
     then have "(\<forall>c\<in>components (- S). \<not> bounded c)"
       by (metis L assms(1) bounded_empty cobounded_imp_unbounded compact_imp_bounded in_components_maximal order_refl)
     then show ?thesis
       by (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>])
   qed
 next
   assume R: ?rhs
   then show ?lhs
     apply (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>, symmetric])
     apply (auto simp: components_def connected_iff_eq_connected_component_set)
     using connected_component_in apply fastforce
     using cobounded_unique_unbounded_component [OF _ 2, of "-S"] \<open>compact S\<close> compact_eq_bounded_closed by fastforce
 qed
 
 
 lemma homotopy_eqv_separation:
   fixes S :: "'a::euclidean_space set" and T :: "'a set"
   assumes "S homotopy_eqv T" and "compact S" and "compact T"
   shows "connected(- S) \<longleftrightarrow> connected(- T)"
 proof -
   consider "DIM('a) = 1" | "2 \<le> DIM('a)"
     by (metis DIM_ge_Suc0 One_nat_def Suc_1 dual_order.antisym not_less_eq_eq)
   then show ?thesis
   proof cases
     case 1
     then show ?thesis
       using bounded_connected_Compl_1 compact_imp_bounded homotopy_eqv_empty1 homotopy_eqv_empty2 assms by metis
   next
     case 2
     with assms show ?thesis
       by (simp add: Borsuk_separation_theorem homotopy_eqv_cohomotopic_triviality_null)
   qed
 qed
 
 proposition Jordan_Brouwer_separation:
   fixes S :: "'a::euclidean_space set" and a::'a
   assumes hom: "S homeomorphic sphere a r" and "0 < r"
     shows "\<not> connected(- S)"
 proof -
   have "- sphere a r \<inter> ball a r \<noteq> {}"
     using \<open>0 < r\<close> by (simp add: Int_absorb1 subset_eq)
   moreover
   have eq: "- sphere a r - ball a r = - cball a r"
     by auto
   have "- cball a r \<noteq> {}"
   proof -
     have "frontier (cball a r) \<noteq> {}"
       using \<open>0 < r\<close> by auto
     then show ?thesis
       by (metis frontier_complement frontier_empty)
   qed
   with eq have "- sphere a r - ball a r \<noteq> {}"
     by auto
   moreover
   have "connected (- S) = connected (- sphere a r)"
   proof (rule homotopy_eqv_separation)
     show "S homotopy_eqv sphere a r"
       using hom homeomorphic_imp_homotopy_eqv by blast
     show "compact (sphere a r)"
       by simp
     then show " compact S"
       using hom homeomorphic_compactness by blast
   qed
   ultimately show ?thesis
     using connected_Int_frontier [of "- sphere a r" "ball a r"] by (auto simp: \<open>0 < r\<close>)
 qed
 
 
 proposition Jordan_Brouwer_frontier:
   fixes S :: "'a::euclidean_space set" and a::'a
   assumes S: "S homeomorphic sphere a r" and T: "T \<in> components(- S)" and 2: "2 \<le> DIM('a)"
     shows "frontier T = S"
 proof (cases r rule: linorder_cases)
   assume "r < 0"
   with S T show ?thesis by auto
 next
   assume "r = 0"
   with S T card_eq_SucD obtain b where "S = {b}"
     by (auto simp: homeomorphic_finite [of "{a}" S])
   have "components (- {b}) = { -{b}}"
     using T \<open>S = {b}\<close> by (auto simp: components_eq_sing_iff connected_punctured_universe 2)
   with T show ?thesis
     by (metis \<open>S = {b}\<close> cball_trivial frontier_cball frontier_complement singletonD sphere_trivial)
 next
   assume "r > 0"
   have "compact S"
     using homeomorphic_compactness compact_sphere S by blast
   show ?thesis
   proof (rule frontier_minimal_separating_closed)
     show "closed S"
       using \<open>compact S\<close> compact_eq_bounded_closed by blast
     show "\<not> connected (- S)"
       using Jordan_Brouwer_separation S \<open>0 < r\<close> by blast
     obtain f g where hom: "homeomorphism S (sphere a r) f g"
       using S by (auto simp: homeomorphic_def)
     show "connected (- T)" if "closed T" "T \<subset> S" for T
     proof -
       have "f ` T \<subseteq> sphere a r"
         using \<open>T \<subset> S\<close> hom homeomorphism_image1 by blast
       moreover have "f ` T \<noteq> sphere a r"
         using \<open>T \<subset> S\<close> hom
         by (metis homeomorphism_image2 homeomorphism_of_subsets order_refl psubsetE)
       ultimately have "f ` T \<subset> sphere a r" by blast
       then have "connected (- f ` T)"
         by (rule psubset_sphere_Compl_connected [OF _ \<open>0 < r\<close> 2])
       moreover have "compact T"
         using \<open>compact S\<close> bounded_subset compact_eq_bounded_closed that by blast
       moreover then have "compact (f ` T)"
         by (meson compact_continuous_image continuous_on_subset hom homeomorphism_def psubsetE \<open>T \<subset> S\<close>)
       moreover have "T homotopy_eqv f ` T"
         by (meson \<open>f ` T \<subseteq> sphere a r\<close> dual_order.strict_implies_order hom homeomorphic_def homeomorphic_imp_homotopy_eqv homeomorphism_of_subsets \<open>T \<subset> S\<close>)
       ultimately show ?thesis
         using homotopy_eqv_separation [of T "f`T"] by blast
     qed
   qed (rule T)
 qed
 
 proposition Jordan_Brouwer_nonseparation:
   fixes S :: "'a::euclidean_space set" and a::'a
   assumes S: "S homeomorphic sphere a r" and "T \<subset> S" and 2: "2 \<le> DIM('a)"
     shows "connected(- T)"
 proof -
   have *: "connected(C \<union> (S - T))" if "C \<in> components(- S)" for C
   proof (rule connected_intermediate_closure)
     show "connected C"
       using in_components_connected that by auto
     have "S = frontier C"
       using "2" Jordan_Brouwer_frontier S that by blast
     with closure_subset show "C \<union> (S - T) \<subseteq> closure C"
       by (auto simp: frontier_def)
   qed auto
   have "components(- S) \<noteq> {}"
     by (metis S bounded_empty cobounded_imp_unbounded compact_eq_bounded_closed compact_sphere
               components_eq_empty homeomorphic_compactness)
   then have "- T = (\<Union>C \<in> components(- S). C \<union> (S - T))"
     using Union_components [of "-S"] \<open>T \<subset> S\<close> by auto
-  then show ?thesis
-    apply (rule ssubst)
-    apply (rule connected_Union)
-    using \<open>T \<subset> S\<close> apply (auto simp: *)
-    done
+  moreover have "connected ..."
+    using \<open>T \<subset> S\<close> by (intro connected_Union) (auto simp: *)
+  ultimately show ?thesis
+    by simp
 qed
 
 subsection\<open> Invariance of domain and corollaries\<close>
 
 lemma invariance_of_domain_ball:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes contf: "continuous_on (cball a r) f" and "0 < r"
      and inj: "inj_on f (cball a r)"
    shows "open(f ` ball a r)"
 proof (cases "DIM('a) = 1")
   case True
   obtain h::"'a\<Rightarrow>real" and k
-        where "linear h" "linear k" "h ` UNIV = UNIV" "k ` UNIV = UNIV"
-              "\<And>x. norm(h x) = norm x" "\<And>x. norm(k x) = norm x"
-              "\<And>x. k(h x) = x" "\<And>x. h(k x) = x"
-    apply (rule isomorphisms_UNIV_UNIV [where 'M='a and 'N=real])
-      using True
-       apply force
-      by (metis UNIV_I UNIV_eq_I imageI)
-    have cont: "continuous_on S h"  "continuous_on T k" for S T
+    where "linear h" "linear k" "h ` UNIV = UNIV" "k ` UNIV = UNIV"
+      "\<And>x. norm(h x) = norm x" "\<And>x. norm(k x) = norm x"
+      and kh: "\<And>x. k(h x) = x" and "\<And>x. h(k x) = x"
+  proof (rule isomorphisms_UNIV_UNIV)
+    show "DIM('a) = DIM(real)"
+      using True by force
+  qed (metis UNIV_I UNIV_eq_I imageI)
+  have cont: "continuous_on S h"  "continuous_on T k" for S T
       by (simp_all add: \<open>linear h\<close> \<open>linear k\<close> linear_continuous_on linear_linear)
     have "continuous_on (h ` cball a r) (h \<circ> f \<circ> k)"
-      apply (intro continuous_on_compose cont continuous_on_subset [OF contf])
-      apply (auto simp: \<open>\<And>x. k (h x) = x\<close>)
-      done
+      by (intro continuous_on_compose cont continuous_on_subset [OF contf]) (auto simp: kh)
     moreover have "is_interval (h ` cball a r)"
       by (simp add: is_interval_connected_1 \<open>linear h\<close> linear_continuous_on linear_linear connected_continuous_image)
     moreover have "inj_on (h \<circ> f \<circ> k) (h ` cball a r)"
       using inj by (simp add: inj_on_def) (metis \<open>\<And>x. k (h x) = x\<close>)
     ultimately have *: "\<And>T. \<lbrakk>open T; T \<subseteq> h ` cball a r\<rbrakk> \<Longrightarrow> open ((h \<circ> f \<circ> k) ` T)"
       using injective_eq_1d_open_map_UNIV by blast
     have "open ((h \<circ> f \<circ> k) ` (h ` ball a r))"
       by (rule *) (auto simp: \<open>linear h\<close> \<open>range h = UNIV\<close> open_surjective_linear_image)
     then have "open ((h \<circ> f) ` ball a r)"
       by (simp add: image_comp \<open>\<And>x. k (h x) = x\<close> cong: image_cong)
     then show ?thesis
-      apply (simp only: image_comp [symmetric])
-
-      apply (metis open_bijective_linear_image_eq \<open>linear h\<close> \<open>\<And>x. k (h x) = x\<close> \<open>range h = UNIV\<close> bijI inj_on_def)
-      done
+      unfolding image_comp [symmetric]
+      by (metis open_bijective_linear_image_eq \<open>linear h\<close> kh \<open>range h = UNIV\<close> bijI inj_on_def)
 next
   case False
   then have 2: "DIM('a) \<ge> 2"
     by (metis DIM_ge_Suc0 One_nat_def Suc_1 antisym not_less_eq_eq)
   have fimsub: "f ` ball a r \<subseteq> - f ` sphere a r"
     using inj  by clarsimp (metis inj_onD less_eq_real_def mem_cball order_less_irrefl)
   have hom: "f ` sphere a r homeomorphic sphere a r"
     by (meson compact_sphere contf continuous_on_subset homeomorphic_compact homeomorphic_sym inj inj_on_subset sphere_cball)
   then have nconn: "\<not> connected (- f ` sphere a r)"
     by (rule Jordan_Brouwer_separation) (auto simp: \<open>0 < r\<close>)
-  obtain C where C: "C \<in> components (- f ` sphere a r)" and "bounded C"
-    apply (rule cobounded_has_bounded_component [OF _ nconn])
-      apply (simp_all add: 2)
+  have "bounded (f ` sphere a r)"
     by (meson compact_imp_bounded compact_continuous_image_eq compact_sphere contf inj sphere_cball)
+  then obtain C where C: "C \<in> components (- f ` sphere a r)" and "bounded C"
+    using cobounded_has_bounded_component [OF _ nconn] "2" by auto
   moreover have "f ` (ball a r) = C"
   proof
     have "C \<noteq> {}"
       by (rule in_components_nonempty [OF C])
     show "C \<subseteq> f ` ball a r"
     proof (rule ccontr)
       assume nonsub: "\<not> C \<subseteq> f ` ball a r"
       have "- f ` cball a r \<subseteq> C"
       proof (rule components_maximal [OF C])
         have "f ` cball a r homeomorphic cball a r"
           using compact_cball contf homeomorphic_compact homeomorphic_sym inj by blast
         then show "connected (- f ` cball a r)"
           by (auto intro: connected_complement_homeomorphic_convex_compact 2)
         show "- f ` cball a r \<subseteq> - f ` sphere a r"
           by auto
         then show "C \<inter> - f ` cball a r \<noteq> {}"
           using \<open>C \<noteq> {}\<close> in_components_subset [OF C] nonsub
           using image_iff by fastforce
       qed
       then have "bounded (- f ` cball a r)"
         using bounded_subset \<open>bounded C\<close> by auto
       then have "\<not> bounded (f ` cball a r)"
         using cobounded_imp_unbounded by blast
       then show "False"
         using compact_continuous_image [OF contf] compact_cball compact_imp_bounded by blast
     qed
     with \<open>C \<noteq> {}\<close> have "C \<inter> f ` ball a r \<noteq> {}"
       by (simp add: inf.absorb_iff1)
     then show "f ` ball a r \<subseteq> C"
       by (metis components_maximal [OF C _ fimsub] connected_continuous_image ball_subset_cball connected_ball contf continuous_on_subset)
   qed
   moreover have "open (- f ` sphere a r)"
     using hom compact_eq_bounded_closed compact_sphere homeomorphic_compactness by blast
   ultimately show ?thesis
     using open_components by blast
 qed
 
 
 text\<open>Proved by L. E. J. Brouwer (1912)\<close>
 theorem invariance_of_domain:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes "continuous_on S f" "open S" "inj_on f S"
     shows "open(f ` S)"
   unfolding open_subopen [of "f`S"]
 proof clarify
   fix a
   assume "a \<in> S"
   obtain \<delta> where "\<delta> > 0" and \<delta>: "cball a \<delta> \<subseteq> S"
     using \<open>open S\<close> \<open>a \<in> S\<close> open_contains_cball_eq by blast
   show "\<exists>T. open T \<and> f a \<in> T \<and> T \<subseteq> f ` S"
   proof (intro exI conjI)
     show "open (f ` (ball a \<delta>))"
       by (meson \<delta> \<open>0 < \<delta>\<close> assms continuous_on_subset inj_on_subset invariance_of_domain_ball)
     show "f a \<in> f ` ball a \<delta>"
       by (simp add: \<open>0 < \<delta>\<close>)
     show "f ` ball a \<delta> \<subseteq> f ` S"
       using \<delta> ball_subset_cball by blast
   qed
 qed
 
 lemma inv_of_domain_ss0:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \<subseteq> S"
       and "subspace S" and dimS: "dim S = DIM('b::euclidean_space)"
       and ope: "openin (top_of_set S) U"
     shows "openin (top_of_set S) (f ` U)"
 proof -
   have "U \<subseteq> S"
     using ope openin_imp_subset by blast
   have "(UNIV::'b set) homeomorphic S"
     by (simp add: \<open>subspace S\<close> dimS homeomorphic_subspaces)
   then obtain h k where homhk: "homeomorphism (UNIV::'b set) S h k"
     using homeomorphic_def by blast
   have homkh: "homeomorphism S (k ` S) k h"
     using homhk homeomorphism_image2 homeomorphism_sym by fastforce
   have "open ((k \<circ> f \<circ> h) ` k ` U)"
   proof (rule invariance_of_domain)
     show "continuous_on (k ` U) (k \<circ> f \<circ> h)"
     proof (intro continuous_intros)
       show "continuous_on (k ` U) h"
         by (meson continuous_on_subset [OF homeomorphism_cont1 [OF homhk]] top_greatest)
-      show "continuous_on (h ` k ` U) f"
-        apply (rule continuous_on_subset [OF contf], clarify)
-        apply (metis homhk homeomorphism_def ope openin_imp_subset rev_subsetD)
-        done
-      show "continuous_on (f ` h ` k ` U) k"
-        apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
-        using fim homhk homeomorphism_apply2 ope openin_subset by fastforce
+      have "h ` k ` U \<subseteq> U"
+        by (metis \<open>U \<subseteq> S\<close> dual_order.eq_iff homeomorphism_image2 homeomorphism_of_subsets homkh)
+      then show "continuous_on (h ` k ` U) f"
+        by (rule continuous_on_subset [OF contf])
+      have "f ` h ` k ` U \<subseteq> S"
+        using \<open>h ` k ` U \<subseteq> U\<close> fim by blast
+      then show "continuous_on (f ` h ` k ` U) k"
+        by (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
     qed
     have ope_iff: "\<And>T. open T \<longleftrightarrow> openin (top_of_set (k ` S)) T"
       using homhk homeomorphism_image2 open_openin by fastforce
     show "open (k ` U)"
       by (simp add: ope_iff homeomorphism_imp_open_map [OF homkh ope])
     show "inj_on (k \<circ> f \<circ> h) (k ` U)"
       apply (clarsimp simp: inj_on_def)
-      by (metis subsetD fim homeomorphism_apply2 [OF homhk] image_subset_iff inj_on_eq_iff injf \<open>U \<subseteq> S\<close>)
+      by (metis \<open>U \<subseteq> S\<close> fim homeomorphism_apply2 homhk image_subset_iff inj_onD injf subsetD)
   qed
   moreover
   have eq: "f ` U = h ` (k \<circ> f \<circ> h \<circ> k) ` U"
     unfolding image_comp [symmetric] using \<open>U \<subseteq> S\<close> fim
     by (metis homeomorphism_image2 homeomorphism_of_subsets homkh subset_image_iff)
   ultimately show ?thesis
     by (metis (no_types, hide_lams) homeomorphism_imp_open_map homhk image_comp open_openin subtopology_UNIV)
 qed
 
 lemma inv_of_domain_ss1:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \<subseteq> S"
       and "subspace S"
       and ope: "openin (top_of_set S) U"
     shows "openin (top_of_set S) (f ` U)"
 proof -
   define S' where "S' \<equiv> {y. \<forall>x \<in> S. orthogonal x y}"
   have "subspace S'"
     by (simp add: S'_def subspace_orthogonal_to_vectors)
   define g where "g \<equiv> \<lambda>z::'a*'a. ((f \<circ> fst)z, snd z)"
   have "openin (top_of_set (S \<times> S')) (g ` (U \<times> S'))"
   proof (rule inv_of_domain_ss0)
     show "continuous_on (U \<times> S') g"
-      apply (simp add: g_def)
-      apply (intro continuous_intros continuous_on_compose2 [OF contf continuous_on_fst], auto)
-      done
+      unfolding  g_def
+      by (auto intro!: continuous_intros continuous_on_compose2 [OF contf continuous_on_fst])
     show "g ` (U \<times> S') \<subseteq> S \<times> S'"
       using fim  by (auto simp: g_def)
     show "inj_on g (U \<times> S')"
       using injf by (auto simp: g_def inj_on_def)
     show "subspace (S \<times> S')"
       by (simp add: \<open>subspace S'\<close> \<open>subspace S\<close> subspace_Times)
     show "openin (top_of_set (S \<times> S')) (U \<times> S')"
       by (simp add: openin_Times [OF ope])
     have "dim (S \<times> S') = dim S + dim S'"
       by (simp add: \<open>subspace S'\<close> \<open>subspace S\<close> dim_Times)
     also have "... = DIM('a)"
       using dim_subspace_orthogonal_to_vectors [OF \<open>subspace S\<close> subspace_UNIV]
       by (simp add: add.commute S'_def)
     finally show "dim (S \<times> S') = DIM('a)" .
   qed
   moreover have "g ` (U \<times> S') = f ` U \<times> S'"
     by (auto simp: g_def image_iff)
   moreover have "0 \<in> S'"
     using \<open>subspace S'\<close> subspace_affine by blast
   ultimately show ?thesis
     by (auto simp: openin_Times_eq)
 qed
 
 
 corollary invariance_of_domain_subspaces:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes ope: "openin (top_of_set U) S"
       and "subspace U" "subspace V" and VU: "dim V \<le> dim U"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
       and injf: "inj_on f S"
     shows "openin (top_of_set V) (f ` S)"
 proof -
   obtain V' where "subspace V'" "V' \<subseteq> U" "dim V' = dim V"
     using choose_subspace_of_subspace [OF VU]
     by (metis span_eq_iff \<open>subspace U\<close>)
   then have "V homeomorphic V'"
     by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
   then obtain h k where homhk: "homeomorphism V V' h k"
     using homeomorphic_def by blast
   have eq: "f ` S = k ` (h \<circ> f) ` S"
   proof -
     have "k ` h ` f ` S = f ` S"
       by (meson fim homeomorphism_def homeomorphism_of_subsets homhk subset_refl)
     then show ?thesis
       by (simp add: image_comp)
   qed
   show ?thesis
     unfolding eq
   proof (rule homeomorphism_imp_open_map)
     show homkh: "homeomorphism V' V k h"
       by (simp add: homeomorphism_symD homhk)
     have hfV': "(h \<circ> f) ` S \<subseteq> V'"
       using fim homeomorphism_image1 homhk by fastforce
     moreover have "openin (top_of_set U) ((h \<circ> f) ` S)"
     proof (rule inv_of_domain_ss1)
       show "continuous_on S (h \<circ> f)"
         by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
       show "inj_on (h \<circ> f) S"
         apply (clarsimp simp: inj_on_def)
         by (metis fim homeomorphism_apply2 [OF homkh] image_subset_iff inj_onD injf)
       show "(h \<circ> f) ` S \<subseteq> U"
         using \<open>V' \<subseteq> U\<close> hfV' by auto
       qed (auto simp: assms)
     ultimately show "openin (top_of_set V') ((h \<circ> f) ` S)"
       using openin_subset_trans \<open>V' \<subseteq> U\<close> by force
   qed
 qed
 
 corollary invariance_of_dimension_subspaces:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes ope: "openin (top_of_set U) S"
       and "subspace U" "subspace V"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
       and injf: "inj_on f S" and "S \<noteq> {}"
     shows "dim U \<le> dim V"
 proof -
   have "False" if "dim V < dim U"
   proof -
     obtain T where "subspace T" "T \<subseteq> U" "dim T = dim V"
       using choose_subspace_of_subspace [of "dim V" U]
       by (metis \<open>dim V < dim U\<close> assms(2) order.strict_implies_order span_eq_iff)
     then have "V homeomorphic T"
       by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
     then obtain h k where homhk: "homeomorphism V T h k"
       using homeomorphic_def  by blast
     have "continuous_on S (h \<circ> f)"
       by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
     moreover have "(h \<circ> f) ` S \<subseteq> U"
       using \<open>T \<subseteq> U\<close> fim homeomorphism_image1 homhk by fastforce
     moreover have "inj_on (h \<circ> f) S"
       apply (clarsimp simp: inj_on_def)
       by (metis fim homeomorphism_apply1 homhk image_subset_iff inj_onD injf)
     ultimately have ope_hf: "openin (top_of_set U) ((h \<circ> f) ` S)"
       using invariance_of_domain_subspaces [OF ope \<open>subspace U\<close> \<open>subspace U\<close>] by blast
     have "(h \<circ> f) ` S \<subseteq> T"
       using fim homeomorphism_image1 homhk by fastforce
     then have "dim ((h \<circ> f) ` S) \<le> dim T"
       by (rule dim_subset)
     also have "dim ((h \<circ> f) ` S) = dim U"
       using \<open>S \<noteq> {}\<close> \<open>subspace U\<close>
       by (blast intro: dim_openin ope_hf)
     finally show False
       using \<open>dim V < dim U\<close> \<open>dim T = dim V\<close> by simp
   qed
   then show ?thesis
     using not_less by blast
 qed
 
 corollary invariance_of_domain_affine_sets:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes ope: "openin (top_of_set U) S"
       and aff: "affine U" "affine V" "aff_dim V \<le> aff_dim U"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
       and injf: "inj_on f S"
     shows "openin (top_of_set V) (f ` S)"
 proof (cases "S = {}")
   case True
   then show ?thesis by auto
 next
   case False
   obtain a b where "a \<in> S" "a \<in> U" "b \<in> V"
     using False fim ope openin_contains_cball by fastforce
   have "openin (top_of_set ((+) (- b) ` V)) (((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S)"
   proof (rule invariance_of_domain_subspaces)
     show "openin (top_of_set ((+) (- a) ` U)) ((+) (- a) ` S)"
       by (metis ope homeomorphism_imp_open_map homeomorphism_translation translation_galois)
     show "subspace ((+) (- a) ` U)"
       by (simp add: \<open>a \<in> U\<close> affine_diffs_subspace_subtract \<open>affine U\<close> cong: image_cong_simp)
     show "subspace ((+) (- b) ` V)"
       by (simp add: \<open>b \<in> V\<close> affine_diffs_subspace_subtract \<open>affine V\<close> cong: image_cong_simp)
     show "dim ((+) (- b) ` V) \<le> dim ((+) (- a) ` U)"
       by (metis \<open>a \<in> U\<close> \<open>b \<in> V\<close> aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff)
     show "continuous_on ((+) (- a) ` S) ((+) (- b) \<circ> f \<circ> (+) a)"
       by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois)
     show "((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S \<subseteq> (+) (- b) ` V"
       using fim by auto
     show "inj_on ((+) (- b) \<circ> f \<circ> (+) a) ((+) (- a) ` S)"
       by (auto simp: inj_on_def) (meson inj_onD injf)
   qed
   then show ?thesis
     by (metis (no_types, lifting) homeomorphism_imp_open_map homeomorphism_translation image_comp translation_galois)
 qed
 
 corollary invariance_of_dimension_affine_sets:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes ope: "openin (top_of_set U) S"
       and aff: "affine U" "affine V"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
       and injf: "inj_on f S" and "S \<noteq> {}"
     shows "aff_dim U \<le> aff_dim V"
 proof -
   obtain a b where "a \<in> S" "a \<in> U" "b \<in> V"
     using \<open>S \<noteq> {}\<close> fim ope openin_contains_cball by fastforce
   have "dim ((+) (- a) ` U) \<le> dim ((+) (- b) ` V)"
   proof (rule invariance_of_dimension_subspaces)
     show "openin (top_of_set ((+) (- a) ` U)) ((+) (- a) ` S)"
       by (metis ope homeomorphism_imp_open_map homeomorphism_translation translation_galois)
     show "subspace ((+) (- a) ` U)"
       by (simp add: \<open>a \<in> U\<close> affine_diffs_subspace_subtract \<open>affine U\<close> cong: image_cong_simp)
     show "subspace ((+) (- b) ` V)"
       by (simp add: \<open>b \<in> V\<close> affine_diffs_subspace_subtract \<open>affine V\<close> cong: image_cong_simp)
     show "continuous_on ((+) (- a) ` S) ((+) (- b) \<circ> f \<circ> (+) a)"
       by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois)
     show "((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S \<subseteq> (+) (- b) ` V"
       using fim by auto
     show "inj_on ((+) (- b) \<circ> f \<circ> (+) a) ((+) (- a) ` S)"
       by (auto simp: inj_on_def) (meson inj_onD injf)
   qed (use \<open>S \<noteq> {}\<close> in auto)
   then show ?thesis
     by (metis \<open>a \<in> U\<close> \<open>b \<in> V\<close> aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff)
 qed
 
 corollary invariance_of_dimension:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and "open S"
       and injf: "inj_on f S" and "S \<noteq> {}"
     shows "DIM('a) \<le> DIM('b)"
   using invariance_of_dimension_subspaces [of UNIV S UNIV f] assms
   by auto
 
 
 corollary continuous_injective_image_subspace_dim_le:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "subspace S" "subspace T"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
       and injf: "inj_on f S"
     shows "dim S \<le> dim T"
-  apply (rule invariance_of_dimension_subspaces [of S S _ f])
-  using assms by (auto simp: subspace_affine)
+  using invariance_of_dimension_subspaces [of S S _ f] assms by (auto simp: subspace_affine)
 
 lemma invariance_of_dimension_convex_domain:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "convex S"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> affine hull T"
       and injf: "inj_on f S"
     shows "aff_dim S \<le> aff_dim T"
 proof (cases "S = {}")
   case True
   then show ?thesis by (simp add: aff_dim_geq)
 next
   case False
   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
   proof (rule invariance_of_dimension_affine_sets)
     show "openin (top_of_set (affine hull S)) (rel_interior S)"
       by (simp add: openin_rel_interior)
     show "continuous_on (rel_interior S) f"
       using contf continuous_on_subset rel_interior_subset by blast
     show "f ` rel_interior S \<subseteq> affine hull T"
       using fim rel_interior_subset by blast
     show "inj_on f (rel_interior S)"
       using inj_on_subset injf rel_interior_subset by blast
     show "rel_interior S \<noteq> {}"
       by (simp add: False \<open>convex S\<close> rel_interior_eq_empty)
   qed auto
   then show ?thesis
     by simp
 qed
 
 
 lemma homeomorphic_convex_sets_le:
   assumes "convex S" "S homeomorphic T"
   shows "aff_dim S \<le> aff_dim T"
 proof -
   obtain h k where homhk: "homeomorphism S T h k"
     using homeomorphic_def assms  by blast
   show ?thesis
   proof (rule invariance_of_dimension_convex_domain [OF \<open>convex S\<close>])
     show "continuous_on S h"
       using homeomorphism_def homhk by blast
     show "h ` S \<subseteq> affine hull T"
       by (metis homeomorphism_def homhk hull_subset)
     show "inj_on h S"
       by (meson homeomorphism_apply1 homhk inj_on_inverseI)
   qed
 qed
 
 lemma homeomorphic_convex_sets:
   assumes "convex S" "convex T" "S homeomorphic T"
   shows "aff_dim S = aff_dim T"
   by (meson assms dual_order.antisym homeomorphic_convex_sets_le homeomorphic_sym)
 
 lemma homeomorphic_convex_compact_sets_eq:
   assumes "convex S" "compact S" "convex T" "compact T"
   shows "S homeomorphic T \<longleftrightarrow> aff_dim S = aff_dim T"
   by (meson assms homeomorphic_convex_compact_sets homeomorphic_convex_sets)
 
 lemma invariance_of_domain_gen:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "open S" "continuous_on S f" "inj_on f S" "DIM('b) \<le> DIM('a)"
     shows "open(f ` S)"
   using invariance_of_domain_subspaces [of UNIV S UNIV f] assms by auto
 
 lemma injective_into_1d_imp_open_map_UNIV:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "open T" "continuous_on S f" "inj_on f S" "T \<subseteq> S"
     shows "open (f ` T)"
   apply (rule invariance_of_domain_gen [OF \<open>open T\<close>])
-  using assms apply (auto simp: elim: continuous_on_subset subset_inj_on)
-  done
+  using assms by (auto simp: elim: continuous_on_subset subset_inj_on)
 
 lemma continuous_on_inverse_open:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" and gf: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
     shows "continuous_on (f ` S) g"
 proof (clarsimp simp add: continuous_openin_preimage_eq)
   fix T :: "'a set"
   assume "open T"
   have eq: "f ` S \<inter> g -` T = f ` (S \<inter> T)"
     by (auto simp: gf)
-  show "openin (top_of_set (f ` S)) (f ` S \<inter> g -` T)"
-    apply (subst eq)
-    apply (rule open_openin_trans)
-      apply (rule invariance_of_domain_gen)
+  have "open (f ` S)"
+    by (rule invariance_of_domain_gen) (use assms inj_on_inverseI in auto)
+  moreover have "open (f ` (S \<inter> T))"
     using assms
-         apply auto
-    using inj_on_inverseI apply auto[1]
     by (metis \<open>open T\<close> continuous_on_subset inj_onI inj_on_subset invariance_of_domain_gen openin_open openin_open_eq)
+  ultimately show "openin (top_of_set (f ` S)) (f ` S \<inter> g -` T)"
+    unfolding eq by (auto intro: open_openin_trans)
 qed
 
 lemma invariance_of_domain_homeomorphism:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" "inj_on f S"
   obtains g where "homeomorphism S (f ` S) f g"
 proof
   show "homeomorphism S (f ` S) f (inv_into S f)"
     by (simp add: assms continuous_on_inverse_open homeomorphism_def)
 qed
 
 corollary invariance_of_domain_homeomorphic:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" "inj_on f S"
   shows "S homeomorphic (f ` S)"
   using invariance_of_domain_homeomorphism [OF assms]
   by (meson homeomorphic_def)
 
 lemma continuous_image_subset_interior:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "continuous_on S f" "inj_on f S" "DIM('b) \<le> DIM('a)"
   shows "f ` (interior S) \<subseteq> interior(f ` S)"
-  apply (rule interior_maximal)
-   apply (simp add: image_mono interior_subset)
-  apply (rule invariance_of_domain_gen)
-  using assms
-     apply (auto simp: subset_inj_on interior_subset continuous_on_subset)
-  done
+proof -
+  have "open (f ` interior S)"
+    using assms
+    by (intro invariance_of_domain_gen) (auto simp: subset_inj_on interior_subset continuous_on_subset)
+  then show ?thesis
+    by (simp add: image_mono interior_maximal interior_subset)
+qed
 
 lemma homeomorphic_interiors_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" and dimeq: "DIM('a) = DIM('b)"
   shows "(interior S) homeomorphic (interior T)"
   using assms [unfolded homeomorphic_minimal]
   unfolding homeomorphic_def
 proof (clarify elim!: ex_forward)
   fix f g
   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
      and contf: "continuous_on S f" and contg: "continuous_on T g"
   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
   have fim: "f ` interior S \<subseteq> interior T"
     using continuous_image_subset_interior [OF contf \<open>inj_on f S\<close>] dimeq fST by simp
   have gim: "g ` interior T \<subseteq> interior S"
     using continuous_image_subset_interior [OF contg \<open>inj_on g T\<close>] dimeq gTS by simp
   show "homeomorphism (interior S) (interior T) f g"
     unfolding homeomorphism_def
   proof (intro conjI ballI)
     show "\<And>x. x \<in> interior S \<Longrightarrow> g (f x) = x"
       by (meson \<open>\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x\<close> subsetD interior_subset)
     have "interior T \<subseteq> f ` interior S"
     proof
       fix x assume "x \<in> interior T"
       then have "g x \<in> interior S"
         using gim by blast
       then show "x \<in> f ` interior S"
         by (metis T \<open>x \<in> interior T\<close> image_iff interior_subset subsetCE)
     qed
     then show "f ` interior S = interior T"
       using fim by blast
     show "continuous_on (interior S) f"
       by (metis interior_subset continuous_on_subset contf)
     show "\<And>y. y \<in> interior T \<Longrightarrow> f (g y) = y"
       by (meson T subsetD interior_subset)
     have "interior S \<subseteq> g ` interior T"
     proof
       fix x assume "x \<in> interior S"
       then have "f x \<in> interior T"
         using fim by blast
       then show "x \<in> g ` interior T"
         by (metis S \<open>x \<in> interior S\<close> image_iff interior_subset subsetCE)
     qed
     then show "g ` interior T = interior S"
       using gim by blast
     show "continuous_on (interior T) g"
       by (metis interior_subset continuous_on_subset contg)
   qed
 qed
 
 lemma homeomorphic_open_imp_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "open S" "S \<noteq> {}" "open T" "T \<noteq> {}"
   shows "DIM('a) = DIM('b)"
     using assms
     apply (simp add: homeomorphic_minimal)
     apply (rule order_antisym; metis inj_onI invariance_of_dimension)
     done
 
 proposition homeomorphic_interiors:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "interior S = {} \<longleftrightarrow> interior T = {}"
     shows "(interior S) homeomorphic (interior T)"
 proof (cases "interior T = {}")
   case True
   with assms show ?thesis by auto
 next
   case False
   then have "DIM('a) = DIM('b)"
     using assms
     apply (simp add: homeomorphic_minimal)
     apply (rule order_antisym; metis continuous_on_subset inj_onI inj_on_subset interior_subset invariance_of_dimension open_interior)
     done
   then show ?thesis
     by (rule homeomorphic_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
 qed
 
 lemma homeomorphic_frontiers_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "closed S" "closed T" and dimeq: "DIM('a) = DIM('b)"
   shows "(frontier S) homeomorphic (frontier T)"
   using assms [unfolded homeomorphic_minimal]
   unfolding homeomorphic_def
 proof (clarify elim!: ex_forward)
   fix f g
   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
      and contf: "continuous_on S f" and contg: "continuous_on T g"
   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
   have "g ` interior T \<subseteq> interior S"
     using continuous_image_subset_interior [OF contg \<open>inj_on g T\<close>] dimeq gTS by simp
   then have fim: "f ` frontier S \<subseteq> frontier T"
-    apply (simp add: frontier_def)
+    unfolding frontier_def
     using continuous_image_subset_interior assms(2) assms(3) S by auto
   have "f ` interior S \<subseteq> interior T"
     using continuous_image_subset_interior [OF contf \<open>inj_on f S\<close>] dimeq fST by simp
   then have gim: "g ` frontier T \<subseteq> frontier S"
-    apply (simp add: frontier_def)
+    unfolding frontier_def
     using continuous_image_subset_interior T assms(2) assms(3) by auto
   show "homeomorphism (frontier S) (frontier T) f g"
     unfolding homeomorphism_def
   proof (intro conjI ballI)
     show gf: "\<And>x. x \<in> frontier S \<Longrightarrow> g (f x) = x"
       by (simp add: S assms(2) frontier_def)
     show fg: "\<And>y. y \<in> frontier T \<Longrightarrow> f (g y) = y"
       by (simp add: T assms(3) frontier_def)
     have "frontier T \<subseteq> f ` frontier S"
     proof
       fix x assume "x \<in> frontier T"
       then have "g x \<in> frontier S"
         using gim by blast
       then show "x \<in> f ` frontier S"
         by (metis fg \<open>x \<in> frontier T\<close> imageI)
     qed
     then show "f ` frontier S = frontier T"
       using fim by blast
     show "continuous_on (frontier S) f"
       by (metis Diff_subset assms(2) closure_eq contf continuous_on_subset frontier_def)
     have "frontier S \<subseteq> g ` frontier T"
     proof
       fix x assume "x \<in> frontier S"
       then have "f x \<in> frontier T"
         using fim by blast
       then show "x \<in> g ` frontier T"
         by (metis gf \<open>x \<in> frontier S\<close> imageI)
     qed
     then show "g ` frontier T = frontier S"
       using gim by blast
     show "continuous_on (frontier T) g"
       by (metis Diff_subset assms(3) closure_closed contg continuous_on_subset frontier_def)
   qed
 qed
 
 lemma homeomorphic_frontiers:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "closed S" "closed T"
           "interior S = {} \<longleftrightarrow> interior T = {}"
     shows "(frontier S) homeomorphic (frontier T)"
 proof (cases "interior T = {}")
   case True
   then show ?thesis
     by (metis Diff_empty assms closure_eq frontier_def)
 next
   case False
-  show ?thesis
-    apply (rule homeomorphic_frontiers_same_dimension)
-       apply (simp_all add: assms)
-    using False assms homeomorphic_interiors homeomorphic_open_imp_same_dimension by blast
+  then have "DIM('a) = DIM('b)"
+    using assms homeomorphic_interiors homeomorphic_open_imp_same_dimension by blast
+  then show ?thesis
+    using assms homeomorphic_frontiers_same_dimension by blast
 qed
 
 lemma continuous_image_subset_rel_interior:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
       and TS: "aff_dim T \<le> aff_dim S"
   shows "f ` (rel_interior S) \<subseteq> rel_interior(f ` S)"
 proof (rule rel_interior_maximal)
   show "f ` rel_interior S \<subseteq> f ` S"
     by(simp add: image_mono rel_interior_subset)
   show "openin (top_of_set (affine hull f ` S)) (f ` rel_interior S)"
   proof (rule invariance_of_domain_affine_sets)
     show "openin (top_of_set (affine hull S)) (rel_interior S)"
       by (simp add: openin_rel_interior)
     show "aff_dim (affine hull f ` S) \<le> aff_dim (affine hull S)"
       by (metis aff_dim_affine_hull aff_dim_subset fim TS order_trans)
     show "f ` rel_interior S \<subseteq> affine hull f ` S"
       by (meson \<open>f ` rel_interior S \<subseteq> f ` S\<close> hull_subset order_trans)
     show "continuous_on (rel_interior S) f"
       using contf continuous_on_subset rel_interior_subset by blast
     show "inj_on f (rel_interior S)"
       using inj_on_subset injf rel_interior_subset by blast
   qed auto
 qed
 
 lemma homeomorphic_rel_interiors_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" and aff: "aff_dim S = aff_dim T"
   shows "(rel_interior S) homeomorphic (rel_interior T)"
   using assms [unfolded homeomorphic_minimal]
   unfolding homeomorphic_def
 proof (clarify elim!: ex_forward)
   fix f g
   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
      and contf: "continuous_on S f" and contg: "continuous_on T g"
   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
   have fim: "f ` rel_interior S \<subseteq> rel_interior T"
     by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
   have gim: "g ` rel_interior T \<subseteq> rel_interior S"
     by (metis \<open>inj_on g T\<close> aff contg continuous_image_subset_rel_interior gTS order_refl)
   show "homeomorphism (rel_interior S) (rel_interior T) f g"
     unfolding homeomorphism_def
   proof (intro conjI ballI)
     show gf: "\<And>x. x \<in> rel_interior S \<Longrightarrow> g (f x) = x"
       using S rel_interior_subset by blast
     show fg: "\<And>y. y \<in> rel_interior T \<Longrightarrow> f (g y) = y"
       using T mem_rel_interior_ball by blast
     have "rel_interior T \<subseteq> f ` rel_interior S"
     proof
       fix x assume "x \<in> rel_interior T"
       then have "g x \<in> rel_interior S"
         using gim by blast
       then show "x \<in> f ` rel_interior S"
         by (metis fg \<open>x \<in> rel_interior T\<close> imageI)
     qed
     moreover have "f ` rel_interior S \<subseteq> rel_interior T"
       by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
     ultimately show "f ` rel_interior S = rel_interior T"
       by blast
     show "continuous_on (rel_interior S) f"
       using contf continuous_on_subset rel_interior_subset by blast
     have "rel_interior S \<subseteq> g ` rel_interior T"
     proof
       fix x assume "x \<in> rel_interior S"
       then have "f x \<in> rel_interior T"
         using fim by blast
       then show "x \<in> g ` rel_interior T"
         by (metis gf \<open>x \<in> rel_interior S\<close> imageI)
     qed
     then show "g ` rel_interior T = rel_interior S"
       using gim by blast
     show "continuous_on (rel_interior T) g"
       using contg continuous_on_subset rel_interior_subset by blast
   qed
 qed
 
+
+lemma homeomorphic_aff_dim_le:
+  fixes S :: "'a::euclidean_space set" 
+  assumes "S homeomorphic T" "rel_interior S \<noteq> {}"
+    shows "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
+proof -
+  obtain f g
+    where S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
+      and contf: "continuous_on S f" and contg: "continuous_on T g"
+    using assms [unfolded homeomorphic_minimal] by auto
+  show ?thesis
+  proof (rule invariance_of_dimension_affine_sets)
+    show "continuous_on (rel_interior S) f"
+      using contf continuous_on_subset rel_interior_subset by blast
+    show "f ` rel_interior S \<subseteq> affine hull T"
+      by (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
+    show "inj_on f (rel_interior S)"
+      by (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
+  qed (simp_all add: openin_rel_interior assms)
+qed
+
 lemma homeomorphic_rel_interiors:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "rel_interior S = {} \<longleftrightarrow> rel_interior T = {}"
     shows "(rel_interior S) homeomorphic (rel_interior T)"
 proof (cases "rel_interior T = {}")
   case True
   with assms show ?thesis by auto
 next
   case False
-  obtain f g
-    where S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
-      and contf: "continuous_on S f" and contg: "continuous_on T g"
-    using  assms [unfolded homeomorphic_minimal] by auto
   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
-    apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior S" _ f])
-          apply (simp_all add: openin_rel_interior False assms)
-    using contf continuous_on_subset rel_interior_subset apply blast
-      apply (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
-    apply (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
-    done
+    using False assms homeomorphic_aff_dim_le by blast
   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
-    apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior T" _ g])
-          apply (simp_all add: openin_rel_interior False assms)
-    using contg continuous_on_subset rel_interior_subset apply blast
-      apply (meson T hull_subset image_subsetI rel_interior_subset rev_subsetD)
-    apply (metis T inj_on_inverseI inj_on_subset rel_interior_subset)
-    done
+    using False assms(1) homeomorphic_aff_dim_le homeomorphic_sym by auto
   ultimately have "aff_dim S = aff_dim T" by force
   then show ?thesis
     by (rule homeomorphic_rel_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
 qed
 
 
 lemma homeomorphic_rel_boundaries_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" and aff: "aff_dim S = aff_dim T"
   shows "(S - rel_interior S) homeomorphic (T - rel_interior T)"
   using assms [unfolded homeomorphic_minimal]
   unfolding homeomorphic_def
 proof (clarify elim!: ex_forward)
   fix f g
   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
      and contf: "continuous_on S f" and contg: "continuous_on T g"
   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
   have fim: "f ` rel_interior S \<subseteq> rel_interior T"
     by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
   have gim: "g ` rel_interior T \<subseteq> rel_interior S"
     by (metis \<open>inj_on g T\<close> aff contg continuous_image_subset_rel_interior gTS order_refl)
   show "homeomorphism (S - rel_interior S) (T - rel_interior T) f g"
     unfolding homeomorphism_def
   proof (intro conjI ballI)
     show gf: "\<And>x. x \<in> S - rel_interior S \<Longrightarrow> g (f x) = x"
       using S rel_interior_subset by blast
     show fg: "\<And>y. y \<in> T - rel_interior T \<Longrightarrow> f (g y) = y"
       using T mem_rel_interior_ball by blast
     show "f ` (S - rel_interior S) = T - rel_interior T"
       using S fST fim gim by auto
     show "continuous_on (S - rel_interior S) f"
       using contf continuous_on_subset rel_interior_subset by blast
     show "g ` (T - rel_interior T) = S - rel_interior S"
       using T gTS gim fim by auto
     show "continuous_on (T - rel_interior T) g"
       using contg continuous_on_subset rel_interior_subset by blast
   qed
 qed
 
 lemma homeomorphic_rel_boundaries:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "rel_interior S = {} \<longleftrightarrow> rel_interior T = {}"
     shows "(S - rel_interior S) homeomorphic (T - rel_interior T)"
 proof (cases "rel_interior T = {}")
   case True
   with assms show ?thesis by auto
 next
   case False
   obtain f g
     where S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
       and contf: "continuous_on S f" and contg: "continuous_on T g"
     using  assms [unfolded homeomorphic_minimal] by auto
   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
-    apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior S" _ f])
-          apply (simp_all add: openin_rel_interior False assms)
-    using contf continuous_on_subset rel_interior_subset apply blast
-      apply (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
-    apply (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
-    done
+    using False assms homeomorphic_aff_dim_le by blast
   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
-    apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior T" _ g])
-          apply (simp_all add: openin_rel_interior False assms)
-    using contg continuous_on_subset rel_interior_subset apply blast
-      apply (meson T hull_subset image_subsetI rel_interior_subset rev_subsetD)
-    apply (metis T inj_on_inverseI inj_on_subset rel_interior_subset)
-    done
+    by (meson False assms(1) homeomorphic_aff_dim_le homeomorphic_sym)
   ultimately have "aff_dim S = aff_dim T" by force
   then show ?thesis
     by (rule homeomorphic_rel_boundaries_same_dimension [OF \<open>S homeomorphic T\<close>])
 qed
 
 proposition uniformly_continuous_homeomorphism_UNIV_trivial:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes contf: "uniformly_continuous_on S f" and hom: "homeomorphism S UNIV f g"
   shows "S = UNIV"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (metis UNIV_I hom empty_iff homeomorphism_def image_eqI)
 next
   case False
   have "inj g"
     by (metis UNIV_I hom homeomorphism_apply2 injI)
   then have "open (g ` UNIV)"
     by (blast intro: invariance_of_domain hom homeomorphism_cont2)
   then have "open S"
     using hom homeomorphism_image2 by blast
   moreover have "complete S"
     unfolding complete_def
   proof clarify
     fix \<sigma>
     assume \<sigma>: "\<forall>n. \<sigma> n \<in> S" and "Cauchy \<sigma>"
     have "Cauchy (f o \<sigma>)"
       using uniformly_continuous_imp_Cauchy_continuous \<open>Cauchy \<sigma>\<close> \<sigma> contf by blast
     then obtain l where "(f \<circ> \<sigma>) \<longlonglongrightarrow> l"
       by (auto simp: convergent_eq_Cauchy [symmetric])
     show "\<exists>l\<in>S. \<sigma> \<longlonglongrightarrow> l"
     proof
       show "g l \<in> S"
         using hom homeomorphism_image2 by blast
       have "(g \<circ> (f \<circ> \<sigma>)) \<longlonglongrightarrow> g l"
         by (meson UNIV_I \<open>(f \<circ> \<sigma>) \<longlonglongrightarrow> l\<close> continuous_on_sequentially hom homeomorphism_cont2)
       then show "\<sigma> \<longlonglongrightarrow> g l"
       proof -
         have "\<forall>n. \<sigma> n = (g \<circ> (f \<circ> \<sigma>)) n"
           by (metis (no_types) \<sigma> comp_eq_dest_lhs hom homeomorphism_apply1)
         then show ?thesis
           by (metis (no_types) LIMSEQ_iff \<open>(g \<circ> (f \<circ> \<sigma>)) \<longlonglongrightarrow> g l\<close>)
       qed
     qed
   qed
   then have "closed S"
     by (simp add: complete_eq_closed)
   ultimately show ?thesis
     using clopen [of S] False  by simp
 qed
 
 subsection\<open>Formulation of loop homotopy in terms of maps out of type complex\<close>
 
 lemma homotopic_circlemaps_imp_homotopic_loops:
   assumes "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
    shows "homotopic_loops S (f \<circ> exp \<circ> (\<lambda>t. 2 * of_real pi * of_real t * \<i>))
                             (g \<circ> exp \<circ> (\<lambda>t. 2 * of_real pi * of_real t * \<i>))"
 proof -
   have "homotopic_with_canon (\<lambda>f. True) {z. cmod z = 1} S f g"
     using assms by (auto simp: sphere_def)
   moreover have "continuous_on {0..1} (exp \<circ> (\<lambda>t. 2 * of_real pi * of_real t * \<i>))"
      by (intro continuous_intros)
   moreover have "(exp \<circ> (\<lambda>t. 2 * of_real pi * of_real t * \<i>)) ` {0..1} \<subseteq> {z. cmod z = 1}"
     by (auto simp: norm_mult)
   ultimately
   show ?thesis
     apply (simp add: homotopic_loops_def comp_assoc)
     apply (rule homotopic_with_compose_continuous_right)
       apply (auto simp: pathstart_def pathfinish_def)
     done
 qed
 
 lemma homotopic_loops_imp_homotopic_circlemaps:
   assumes "homotopic_loops S p q"
     shows "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S
                           (p \<circ> (\<lambda>z. (Arg2pi z / (2 * pi))))
                           (q \<circ> (\<lambda>z. (Arg2pi z / (2 * pi))))"
 proof -
   obtain h where conth: "continuous_on ({0..1::real} \<times> {0..1}) h"
              and him: "h ` ({0..1} \<times> {0..1}) \<subseteq> S"
              and h0: "(\<forall>x. h (0, x) = p x)"
              and h1: "(\<forall>x. h (1, x) = q x)"
              and h01: "(\<forall>t\<in>{0..1}. h (t, 1) = h (t, 0)) "
     using assms
     by (auto simp: homotopic_loops_def sphere_def homotopic_with_def pathstart_def pathfinish_def)
   define j where "j \<equiv> \<lambda>z. if 0 \<le> Im (snd z)
                           then h (fst z, Arg2pi (snd z) / (2 * pi))
                           else h (fst z, 1 - Arg2pi (cnj (snd z)) / (2 * pi))"
   have Arg2pi_eq: "1 - Arg2pi (cnj y) / (2 * pi) = Arg2pi y / (2 * pi) \<or> Arg2pi y = 0 \<and> Arg2pi (cnj y) = 0" if "cmod y = 1" for y
     using that Arg2pi_eq_0_pi Arg2pi_eq_pi by (force simp: Arg2pi_cnj field_split_simps)
   show ?thesis
   proof (simp add: homotopic_with; intro conjI ballI exI)
     show "continuous_on ({0..1} \<times> sphere 0 1) (\<lambda>w. h (fst w, Arg2pi (snd w) / (2 * pi)))"
     proof (rule continuous_on_eq)
       show j: "j x = h (fst x, Arg2pi (snd x) / (2 * pi))" if "x \<in> {0..1} \<times> sphere 0 1" for x
         using Arg2pi_eq that h01 by (force simp: j_def)
       have eq:  "S = S \<inter> (UNIV \<times> {z. 0 \<le> Im z}) \<union> S \<inter> (UNIV \<times> {z. Im z \<le> 0})" for S :: "(real*complex)set"
         by auto
       have c1: "continuous_on ({0..1} \<times> sphere 0 1 \<inter> UNIV \<times> {z. 0 \<le> Im z}) (\<lambda>x. h (fst x, Arg2pi (snd x) / (2 * pi)))"
         apply (intro continuous_intros continuous_on_compose2 [OF conth]  continuous_on_compose2 [OF continuous_on_upperhalf_Arg2pi])
             apply (auto simp: Arg2pi)
         apply (meson Arg2pi_lt_2pi linear not_le)
         done
       have c2: "continuous_on ({0..1} \<times> sphere 0 1 \<inter> UNIV \<times> {z. Im z \<le> 0}) (\<lambda>x. h (fst x, 1 - Arg2pi (cnj (snd x)) / (2 * pi)))"
         apply (intro continuous_intros continuous_on_compose2 [OF conth]  continuous_on_compose2 [OF continuous_on_upperhalf_Arg2pi])
             apply (auto simp: Arg2pi)
         apply (meson Arg2pi_lt_2pi linear not_le)
         done
       show "continuous_on ({0..1} \<times> sphere 0 1) j"
         apply (simp add: j_def)
         apply (subst eq)
         apply (rule continuous_on_cases_local)
-            apply (simp_all add: eq [symmetric] closedin_closed_Int closed_Times closed_halfspace_Im_le closed_halfspace_Im_ge c1 c2)
         using Arg2pi_eq h01
-        by force
+        by (force simp add: eq [symmetric] closedin_closed_Int closed_Times closed_halfspace_Im_le closed_halfspace_Im_ge c1 c2)+
     qed
     have "(\<lambda>w. h (fst w, Arg2pi (snd w) / (2 * pi))) ` ({0..1} \<times> sphere 0 1) \<subseteq> h ` ({0..1} \<times> {0..1})"
       by (auto simp: Arg2pi_ge_0 Arg2pi_lt_2pi less_imp_le)
     also have "... \<subseteq> S"
       using him by blast
     finally show "(\<lambda>w. h (fst w, Arg2pi (snd w) / (2 * pi))) ` ({0..1} \<times> sphere 0 1) \<subseteq> S" .
   qed (auto simp: h0 h1)
 qed
 
 lemma simply_connected_homotopic_loops:
   "simply_connected S \<longleftrightarrow>
        (\<forall>p q. homotopic_loops S p p \<and> homotopic_loops S q q \<longrightarrow> homotopic_loops S p q)"
 unfolding simply_connected_def using homotopic_loops_refl by metis
 
 
 lemma simply_connected_eq_homotopic_circlemaps1:
   fixes f :: "complex \<Rightarrow> 'a::topological_space" and g :: "complex \<Rightarrow> 'a"
   assumes S: "simply_connected S"
       and contf: "continuous_on (sphere 0 1) f" and fim: "f ` (sphere 0 1) \<subseteq> S"
       and contg: "continuous_on (sphere 0 1) g" and gim: "g ` (sphere 0 1) \<subseteq> S"
     shows "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
 proof -
   have "homotopic_loops S (f \<circ> exp \<circ> (\<lambda>t. of_real(2 * pi * t) * \<i>)) (g \<circ> exp \<circ> (\<lambda>t. of_real(2 * pi *  t) * \<i>))"
     apply (rule S [unfolded simply_connected_homotopic_loops, rule_format])
     apply (simp add: homotopic_circlemaps_imp_homotopic_loops contf fim contg gim)
     done
   then show ?thesis
     apply (rule homotopic_with_eq [OF homotopic_loops_imp_homotopic_circlemaps])
       apply (auto simp: o_def complex_norm_eq_1_exp mult.commute)
     done
 qed
 
 lemma simply_connected_eq_homotopic_circlemaps2a:
   fixes h :: "complex \<Rightarrow> 'a::topological_space"
   assumes conth: "continuous_on (sphere 0 1) h" and him: "h ` (sphere 0 1) \<subseteq> S"
       and hom: "\<And>f g::complex \<Rightarrow> 'a.
                 \<lbrakk>continuous_on (sphere 0 1) f; f ` (sphere 0 1) \<subseteq> S;
                 continuous_on (sphere 0 1) g; g ` (sphere 0 1) \<subseteq> S\<rbrakk>
                 \<Longrightarrow> homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
             shows "\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S h (\<lambda>x. a)"
     apply (rule_tac x="h 1" in exI)
     apply (rule hom)
     using assms by (auto)
 
 lemma simply_connected_eq_homotopic_circlemaps2b:
   fixes S :: "'a::real_normed_vector set"
   assumes "\<And>f g::complex \<Rightarrow> 'a.
                 \<lbrakk>continuous_on (sphere 0 1) f; f ` (sphere 0 1) \<subseteq> S;
                 continuous_on (sphere 0 1) g; g ` (sphere 0 1) \<subseteq> S\<rbrakk>
                 \<Longrightarrow> homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
   shows "path_connected S"
 proof (clarsimp simp add: path_connected_eq_homotopic_points)
   fix a b
   assume "a \<in> S" "b \<in> S"
   then show "homotopic_loops S (linepath a a) (linepath b b)"
     using homotopic_circlemaps_imp_homotopic_loops [OF assms [of "\<lambda>x. a" "\<lambda>x. b"]]
     by (auto simp: o_def linepath_def)
 qed
 
 lemma simply_connected_eq_homotopic_circlemaps3:
   fixes h :: "complex \<Rightarrow> 'a::real_normed_vector"
   assumes "path_connected S"
       and hom: "\<And>f::complex \<Rightarrow> 'a.
                   \<lbrakk>continuous_on (sphere 0 1) f; f `(sphere 0 1) \<subseteq> S\<rbrakk>
                   \<Longrightarrow> \<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f (\<lambda>x. a)"
     shows "simply_connected S"
 proof (clarsimp simp add: simply_connected_eq_contractible_loop_some assms)
   fix p
   assume p: "path p" "path_image p \<subseteq> S" "pathfinish p = pathstart p"
   then have "homotopic_loops S p p"
     by (simp add: homotopic_loops_refl)
   then obtain a where homp: "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S (p \<circ> (\<lambda>z. Arg2pi z / (2 * pi))) (\<lambda>x. a)"
     by (metis homotopic_with_imp_subset2 homotopic_loops_imp_homotopic_circlemaps homotopic_with_imp_continuous hom)
   show "\<exists>a. a \<in> S \<and> homotopic_loops S p (linepath a a)"
   proof (intro exI conjI)
     show "a \<in> S"
       using homotopic_with_imp_subset2 [OF homp]
       by (metis dist_0_norm image_subset_iff mem_sphere norm_one)
     have teq: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk>
                \<Longrightarrow> t = Arg2pi (exp (2 * of_real pi * of_real t * \<i>)) / (2 * pi) \<or> t=1 \<and> Arg2pi (exp (2 * of_real pi * of_real t * \<i>)) = 0"
-      apply (rule disjCI)
-      using Arg2pi_of_real [of 1] apply (auto simp: Arg2pi_exp)
-      done
+      using Arg2pi_of_real [of 1] by (force simp: Arg2pi_exp)
     have "homotopic_loops S p (p \<circ> (\<lambda>z. Arg2pi z / (2 * pi)) \<circ> exp \<circ> (\<lambda>t. 2 * complex_of_real pi * complex_of_real t * \<i>))"
-      apply (rule homotopic_loops_eq [OF p])
-      using p teq apply (fastforce simp: pathfinish_def pathstart_def)
-      done
-    then
-    show "homotopic_loops S p (linepath a a)"
+      using p teq by (fastforce simp: pathfinish_def pathstart_def intro: homotopic_loops_eq [OF p])
+    then show "homotopic_loops S p (linepath a a)"
       by (simp add: linepath_refl  homotopic_loops_trans [OF _ homotopic_circlemaps_imp_homotopic_loops [OF homp, simplified K_record_comp]])
   qed
 qed
 
 
 proposition simply_connected_eq_homotopic_circlemaps:
   fixes S :: "'a::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
          (\<forall>f g::complex \<Rightarrow> 'a.
               continuous_on (sphere 0 1) f \<and> f ` (sphere 0 1) \<subseteq> S \<and>
               continuous_on (sphere 0 1) g \<and> g ` (sphere 0 1) \<subseteq> S
               \<longrightarrow> homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g)"
   apply (rule iffI)
-   apply (blast elim: dest: simply_connected_eq_homotopic_circlemaps1)
+   apply (blast dest: simply_connected_eq_homotopic_circlemaps1)
   by (simp add: simply_connected_eq_homotopic_circlemaps2a simply_connected_eq_homotopic_circlemaps2b simply_connected_eq_homotopic_circlemaps3)
 
 proposition simply_connected_eq_contractible_circlemap:
   fixes S :: "'a::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
          path_connected S \<and>
          (\<forall>f::complex \<Rightarrow> 'a.
               continuous_on (sphere 0 1) f \<and> f `(sphere 0 1) \<subseteq> S
               \<longrightarrow> (\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f (\<lambda>x. a)))"
   apply (rule iffI)
    apply (simp add: simply_connected_eq_homotopic_circlemaps1 simply_connected_eq_homotopic_circlemaps2a simply_connected_eq_homotopic_circlemaps2b)
   using simply_connected_eq_homotopic_circlemaps3 by blast
 
 corollary homotopy_eqv_simple_connectedness:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "S homotopy_eqv T \<Longrightarrow> simply_connected S \<longleftrightarrow> simply_connected T"
   by (simp add: simply_connected_eq_homotopic_circlemaps homotopy_eqv_homotopic_triviality)
 
 
 subsection\<open>Homeomorphism of simple closed curves to circles\<close>
 
 proposition homeomorphic_simple_path_image_circle:
   fixes a :: complex and \<gamma> :: "real \<Rightarrow> 'a::t2_space"
   assumes "simple_path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>" and "0 < r"
   shows "(path_image \<gamma>) homeomorphic sphere a r"
 proof -
   have "homotopic_loops (path_image \<gamma>) \<gamma> \<gamma>"
     by (simp add: assms homotopic_loops_refl simple_path_imp_path)
   then have hom: "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) (path_image \<gamma>)
                (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi)))"
     by (rule homotopic_loops_imp_homotopic_circlemaps)
   have "\<exists>g. homeomorphism (sphere 0 1) (path_image \<gamma>) (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) g"
   proof (rule homeomorphism_compact)
     show "continuous_on (sphere 0 1) (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi)))"
       using hom homotopic_with_imp_continuous by blast
     show "inj_on (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) (sphere 0 1)"
     proof
       fix x y
       assume xy: "x \<in> sphere 0 1" "y \<in> sphere 0 1"
          and eq: "(\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) x = (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) y"
       then have "(Arg2pi x / (2*pi)) = (Arg2pi y / (2*pi))"
       proof -
         have "(Arg2pi x / (2*pi)) \<in> {0..1}" "(Arg2pi y / (2*pi)) \<in> {0..1}"
           using Arg2pi_ge_0 Arg2pi_lt_2pi dual_order.strict_iff_order by fastforce+
         with eq show ?thesis
           using \<open>simple_path \<gamma>\<close> Arg2pi_lt_2pi unfolding simple_path_def o_def
           by (metis eq_divide_eq_1 not_less_iff_gr_or_eq)
       qed
       with xy show "x = y"
         by (metis is_Arg_def Arg2pi Arg2pi_0 dist_0_norm divide_cancel_right dual_order.strict_iff_order mem_sphere)
     qed
     have "\<And>z. cmod z = 1 \<Longrightarrow> \<exists>x\<in>{0..1}. \<gamma> (Arg2pi z / (2*pi)) = \<gamma> x"
        by (metis Arg2pi_ge_0 Arg2pi_lt_2pi atLeastAtMost_iff divide_less_eq_1 less_eq_real_def zero_less_mult_iff pi_gt_zero zero_le_divide_iff zero_less_numeral)
      moreover have "\<exists>z\<in>sphere 0 1. \<gamma> x = \<gamma> (Arg2pi z / (2*pi))" if "0 \<le> x" "x \<le> 1" for x
      proof (cases "x=1")
        case True
        with Arg2pi_of_real [of 1] loop show ?thesis
          by (rule_tac x=1 in bexI) (auto simp: pathfinish_def pathstart_def \<open>0 \<le> x\<close>)
      next
        case False
        then have *: "(Arg2pi (exp (\<i>*(2* of_real pi* of_real x))) / (2*pi)) = x"
          using that by (auto simp: Arg2pi_exp field_split_simps)
        show ?thesis
          by (rule_tac x="exp(\<i> * of_real(2*pi*x))" in bexI) (auto simp: *)
     qed
     ultimately show "(\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) ` sphere 0 1 = path_image \<gamma>"
       by (auto simp: path_image_def image_iff)
     qed auto
     then have "path_image \<gamma> homeomorphic sphere (0::complex) 1"
       using homeomorphic_def homeomorphic_sym by blast
   also have "... homeomorphic sphere a r"
     by (simp add: assms homeomorphic_spheres)
   finally show ?thesis .
 qed
 
 lemma homeomorphic_simple_path_images:
   fixes \<gamma>1 :: "real \<Rightarrow> 'a::t2_space" and \<gamma>2 :: "real \<Rightarrow> 'b::t2_space"
   assumes "simple_path \<gamma>1" and loop: "pathfinish \<gamma>1 = pathstart \<gamma>1"
   assumes "simple_path \<gamma>2" and loop: "pathfinish \<gamma>2 = pathstart \<gamma>2"
   shows "(path_image \<gamma>1) homeomorphic (path_image \<gamma>2)"
   by (meson assms homeomorphic_simple_path_image_circle homeomorphic_sym homeomorphic_trans loop pi_gt_zero)
 
 subsection\<open>Dimension-based conditions for various homeomorphisms\<close>
 
 lemma homeomorphic_subspaces_eq:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "subspace S" "subspace T"
   shows "S homeomorphic T \<longleftrightarrow> dim S = dim T"
 proof
   assume "S homeomorphic T"
   then obtain f g where hom: "homeomorphism S T f g"
     using homeomorphic_def by blast
   show "dim S = dim T"
   proof (rule order_antisym)
     show "dim S \<le> dim T"
       by (metis assms dual_order.refl inj_onI homeomorphism_cont1 [OF hom] homeomorphism_apply1 [OF hom] homeomorphism_image1 [OF hom] continuous_injective_image_subspace_dim_le)
     show "dim T \<le> dim S"
       by (metis assms dual_order.refl inj_onI homeomorphism_cont2 [OF hom] homeomorphism_apply2 [OF hom] homeomorphism_image2 [OF hom] continuous_injective_image_subspace_dim_le)
   qed
 next
   assume "dim S = dim T"
   then show "S homeomorphic T"
     by (simp add: assms homeomorphic_subspaces)
 qed
 
 lemma homeomorphic_affine_sets_eq:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "affine S" "affine T"
   shows "S homeomorphic T \<longleftrightarrow> aff_dim S = aff_dim T"
 proof (cases "S = {} \<or> T = {}")
   case True
   then show ?thesis
     using assms homeomorphic_affine_sets by force
 next
   case False
   then obtain a b where "a \<in> S" "b \<in> T"
     by blast
   then have "subspace ((+) (- a) ` S)" "subspace ((+) (- b) ` T)"
     using affine_diffs_subspace assms by blast+
   then show ?thesis
     by (metis affine_imp_convex assms homeomorphic_affine_sets homeomorphic_convex_sets)
 qed
 
 lemma homeomorphic_hyperplanes_eq:
   fixes a :: "'a::euclidean_space" and c :: "'b::euclidean_space"
   assumes "a \<noteq> 0" "c \<noteq> 0"
   shows "({x. a \<bullet> x = b} homeomorphic {x. c \<bullet> x = d} \<longleftrightarrow> DIM('a) = DIM('b))"
   apply (auto simp: homeomorphic_affine_sets_eq affine_hyperplane assms)
   by (metis DIM_positive Suc_pred)
 
 lemma homeomorphic_UNIV_UNIV:
   shows "(UNIV::'a set) homeomorphic (UNIV::'b set) \<longleftrightarrow>
     DIM('a::euclidean_space) = DIM('b::euclidean_space)"
   by (simp add: homeomorphic_subspaces_eq)
 
 lemma simply_connected_sphere_gen:
    assumes "convex S" "bounded S" and 3: "3 \<le> aff_dim S"
    shows "simply_connected(rel_frontier S)"
 proof -
   have pa: "path_connected (rel_frontier S)"
     using assms by (simp add: path_connected_sphere_gen)
   show ?thesis
   proof (clarsimp simp add: simply_connected_eq_contractible_circlemap pa)
     fix f
     assume f: "continuous_on (sphere (0::complex) 1) f" "f ` sphere 0 1 \<subseteq> rel_frontier S"
     have eq: "sphere (0::complex) 1 = rel_frontier(cball 0 1)"
       by simp
     have "convex (cball (0::complex) 1)"
       by (rule convex_cball)
     then obtain c where "homotopic_with_canon (\<lambda>z. True) (sphere (0::complex) 1) (rel_frontier S) f (\<lambda>x. c)"
       apply (rule inessential_spheremap_lowdim_gen [OF _ bounded_cball \<open>convex S\<close> \<open>bounded S\<close>, where f=f])
       using f 3
          apply (auto simp: aff_dim_cball)
       done
     then show "\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) (rel_frontier S) f (\<lambda>x. a)"
       by blast
   qed
 qed
 
 subsection\<open>more invariance of domain\<close>(*FIX ME title? *)
 
 proposition invariance_of_domain_sphere_affine_set_gen:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
       and U: "bounded U" "convex U"
       and "affine T" and affTU: "aff_dim T < aff_dim U"
       and ope: "openin (top_of_set (rel_frontier U)) S"
    shows "openin (top_of_set T) (f ` S)"
 proof (cases "rel_frontier U = {}")
   case True
   then show ?thesis
     using ope openin_subset by force
 next
   case False
   obtain b c where b: "b \<in> rel_frontier U" and c: "c \<in> rel_frontier U" and "b \<noteq> c"
     using \<open>bounded U\<close> rel_frontier_not_sing [of U] subset_singletonD False  by fastforce
   obtain V :: "'a set" where "affine V" and affV: "aff_dim V = aff_dim U - 1"
   proof (rule choose_affine_subset [OF affine_UNIV])
     show "- 1 \<le> aff_dim U - 1"
       by (metis aff_dim_empty aff_dim_geq aff_dim_negative_iff affTU diff_0 diff_right_mono not_le)
     show "aff_dim U - 1 \<le> aff_dim (UNIV::'a set)"
       by (metis aff_dim_UNIV aff_dim_le_DIM le_cases not_le zle_diff1_eq)
   qed auto
   have SU: "S \<subseteq> rel_frontier U"
     using ope openin_imp_subset by auto
   have homb: "rel_frontier U - {b} homeomorphic V"
    and homc: "rel_frontier U - {c} homeomorphic V"
     using homeomorphic_punctured_sphere_affine_gen [of U _ V]
     by (simp_all add: \<open>affine V\<close> affV U b c)
   then obtain g h j k
            where gh: "homeomorphism (rel_frontier U - {b}) V g h"
              and jk: "homeomorphism (rel_frontier U - {c}) V j k"
     by (auto simp: homeomorphic_def)
   with SU have hgsub: "(h ` g ` (S - {b})) \<subseteq> S" and kjsub: "(k ` j ` (S - {c})) \<subseteq> S"
     by (simp_all add: homeomorphism_def subset_eq)
   have [simp]: "aff_dim T \<le> aff_dim V"
     by (simp add: affTU affV)
   have "openin (top_of_set T) ((f \<circ> h) ` g ` (S - {b}))"
   proof (rule invariance_of_domain_affine_sets [OF _ \<open>affine V\<close>])
-    show "openin (top_of_set V) (g ` (S - {b}))"
-      apply (rule homeomorphism_imp_open_map [OF gh])
+    have "openin (top_of_set (rel_frontier U - {b})) (S - {b})"
       by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
+    then show "openin (top_of_set V) (g ` (S - {b}))"
+      by (rule homeomorphism_imp_open_map [OF gh])
     show "continuous_on (g ` (S - {b})) (f \<circ> h)"
-       apply (rule continuous_on_compose)
-        apply (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets gh set_eq_subset)
-      using contf continuous_on_subset hgsub by blast
+    proof (rule continuous_on_compose)
+      show "continuous_on (g ` (S - {b})) h"
+        by (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets gh set_eq_subset)
+    qed (use contf continuous_on_subset hgsub in blast)
     show "inj_on (f \<circ> h) (g ` (S - {b}))"
       using kjsub
       apply (clarsimp simp add: inj_on_def)
       by (metis SU b homeomorphism_def inj_onD injf insert_Diff insert_iff gh rev_subsetD)
     show "(f \<circ> h) ` g ` (S - {b}) \<subseteq> T"
       by (metis fim image_comp image_mono hgsub subset_trans)
   qed (auto simp: assms)
   moreover
   have "openin (top_of_set T) ((f \<circ> k) ` j ` (S - {c}))"
   proof (rule invariance_of_domain_affine_sets [OF _ \<open>affine V\<close>])
     show "openin (top_of_set V) (j ` (S - {c}))"
-      apply (rule homeomorphism_imp_open_map [OF jk])
-      by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
+      by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl homeomorphism_imp_open_map [OF jk])
     show "continuous_on (j ` (S - {c})) (f \<circ> k)"
-       apply (rule continuous_on_compose)
-        apply (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets jk set_eq_subset)
-      using contf continuous_on_subset kjsub by blast
+    proof (rule continuous_on_compose)
+      show "continuous_on (j ` (S - {c})) k"
+        by (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets jk set_eq_subset)
+    qed (use contf continuous_on_subset kjsub in blast)
     show "inj_on (f \<circ> k) (j ` (S - {c}))"
       using kjsub
       apply (clarsimp simp add: inj_on_def)
       by (metis SU c homeomorphism_def inj_onD injf insert_Diff insert_iff jk rev_subsetD)
     show "(f \<circ> k) ` j ` (S - {c}) \<subseteq> T"
       by (metis fim image_comp image_mono kjsub subset_trans)
   qed (auto simp: assms)
   ultimately have "openin (top_of_set T) ((f \<circ> h) ` g ` (S - {b}) \<union> ((f \<circ> k) ` j ` (S - {c})))"
     by (rule openin_Un)
   moreover have "(f \<circ> h) ` g ` (S - {b}) = f ` (S - {b})"
   proof -
     have "h ` g ` (S - {b}) = (S - {b})"
     proof
       show "h ` g ` (S - {b}) \<subseteq> S - {b}"
         using homeomorphism_apply1 [OF gh] SU
         by (fastforce simp add: image_iff image_subset_iff)
       show "S - {b} \<subseteq> h ` g ` (S - {b})"
         apply clarify
         by  (metis SU subsetD homeomorphism_apply1 [OF gh] image_iff member_remove remove_def)
     qed
     then show ?thesis
       by (metis image_comp)
   qed
   moreover have "(f \<circ> k) ` j ` (S - {c}) = f ` (S - {c})"
   proof -
     have "k ` j ` (S - {c}) = (S - {c})"
     proof
       show "k ` j ` (S - {c}) \<subseteq> S - {c}"
         using homeomorphism_apply1 [OF jk] SU
         by (fastforce simp add: image_iff image_subset_iff)
       show "S - {c} \<subseteq> k ` j ` (S - {c})"
         apply clarify
         by  (metis SU subsetD homeomorphism_apply1 [OF jk] image_iff member_remove remove_def)
     qed
     then show ?thesis
       by (metis image_comp)
   qed
   moreover have "f ` (S - {b}) \<union> f ` (S - {c}) = f ` (S)"
     using \<open>b \<noteq> c\<close> by blast
   ultimately show ?thesis
     by simp
 qed
 
 
 lemma invariance_of_domain_sphere_affine_set:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
       and "r \<noteq> 0" "affine T" and affTU: "aff_dim T < DIM('a)"
       and ope: "openin (top_of_set (sphere a r)) S"
    shows "openin (top_of_set T) (f ` S)"
 proof (cases "sphere a r = {}")
   case True
   then show ?thesis
     using ope openin_subset by force
 next
   case False
   show ?thesis
   proof (rule invariance_of_domain_sphere_affine_set_gen [OF contf injf fim bounded_cball convex_cball \<open>affine T\<close>])
     show "aff_dim T < aff_dim (cball a r)"
       by (metis False affTU aff_dim_cball assms(4) linorder_cases sphere_empty)
     show "openin (top_of_set (rel_frontier (cball a r))) S"
       by (simp add: \<open>r \<noteq> 0\<close> ope)
   qed
 qed
 
 lemma no_embedding_sphere_lowdim:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on (sphere a r) f" and injf: "inj_on f (sphere a r)" and "r > 0"
    shows "DIM('a) \<le> DIM('b)"
 proof -
   have "False" if "DIM('a) > DIM('b)"
   proof -
     have "compact (f ` sphere a r)"
       using compact_continuous_image
       by (simp add: compact_continuous_image contf)
     then have "\<not> open (f ` sphere a r)"
       using compact_open
       by (metis assms(3) image_is_empty not_less_iff_gr_or_eq sphere_eq_empty)
     then show False
       using invariance_of_domain_sphere_affine_set [OF contf injf subset_UNIV] \<open>r > 0\<close>
       by (metis aff_dim_UNIV affine_UNIV less_irrefl of_nat_less_iff open_openin openin_subtopology_self subtopology_UNIV that)
   qed
   then show ?thesis
     using not_less by blast
 qed
 
 lemma simply_connected_sphere:
   fixes a :: "'a::euclidean_space"
   assumes "3 \<le> DIM('a)"
     shows "simply_connected(sphere a r)"
 proof (cases rule: linorder_cases [of r 0])
   case less
   then show ?thesis by simp
 next
   case equal
   then show ?thesis  by (auto simp: convex_imp_simply_connected)
 next
   case greater
   then show ?thesis
     using simply_connected_sphere_gen [of "cball a r"] assms
     by (simp add: aff_dim_cball)
 qed
 
 lemma simply_connected_sphere_eq:
   fixes a :: "'a::euclidean_space"
   shows "simply_connected(sphere a r) \<longleftrightarrow> 3 \<le> DIM('a) \<or> r \<le> 0"  (is "?lhs = ?rhs")
 proof (cases "r \<le> 0")
   case True
   have "simply_connected (sphere a r)"
-    apply (rule convex_imp_simply_connected)
-    using True less_eq_real_def by auto
+    using True less_eq_real_def by (auto intro: convex_imp_simply_connected)
   with True show ?thesis by auto
 next
   case False
   show ?thesis
   proof
     assume L: ?lhs
     have "False" if "DIM('a) = 1 \<or> DIM('a) = 2"
       using that
     proof
       assume "DIM('a) = 1"
       with L show False
         using connected_sphere_eq simply_connected_imp_connected
         by (metis False Suc_1 not_less_eq_eq order_refl)
     next
       assume "DIM('a) = 2"
       then have "sphere a r homeomorphic sphere (0::complex) 1"
         by (metis DIM_complex False homeomorphic_spheres_gen not_less zero_less_one)
       then have "simply_connected(sphere (0::complex) 1)"
         using L homeomorphic_simply_connected_eq by blast
       then obtain a::complex where "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) (sphere 0 1) id (\<lambda>x. a)"
-        apply (simp add: simply_connected_eq_contractible_circlemap)
-        by (metis continuous_on_id' id_apply image_id subset_refl)
+        by (metis continuous_on_id' id_apply image_id subset_refl simply_connected_eq_contractible_circlemap)
       then show False
         using contractible_sphere contractible_def not_one_le_zero by blast
     qed
     with False show ?rhs
       apply simp
       by (metis DIM_ge_Suc0 le_antisym not_less_eq_eq numeral_2_eq_2 numeral_3_eq_3)
   next
     assume ?rhs
     with False show ?lhs by (simp add: simply_connected_sphere)
   qed
 qed
 
 
 lemma simply_connected_punctured_universe_eq:
   fixes a :: "'a::euclidean_space"
   shows "simply_connected(- {a}) \<longleftrightarrow> 3 \<le> DIM('a)"
 proof -
   have [simp]: "a \<in> rel_interior (cball a 1)"
     by (simp add: rel_interior_nonempty_interior)
   have [simp]: "affine hull cball a 1 - {a} = -{a}"
     by (metis Compl_eq_Diff_UNIV aff_dim_cball aff_dim_lt_full not_less_iff_gr_or_eq zero_less_one)
-  have "simply_connected(- {a}) \<longleftrightarrow> simply_connected(sphere a 1)"
-    apply (rule sym)
-    apply (rule homotopy_eqv_simple_connectedness)
-    using homotopy_eqv_rel_frontier_punctured_affine_hull [of "cball a 1" a] apply auto
-    done
+  have "sphere a 1 homotopy_eqv - {a}"
+    using homotopy_eqv_rel_frontier_punctured_affine_hull [of "cball a 1" a] by auto
+  then have "simply_connected(- {a}) \<longleftrightarrow> simply_connected(sphere a 1)"
+    using homotopy_eqv_simple_connectedness by blast
   also have "...  \<longleftrightarrow> 3 \<le> DIM('a)"
     by (simp add: simply_connected_sphere_eq)
   finally show ?thesis .
 qed
 
 lemma not_simply_connected_circle:
   fixes a :: complex
   shows "0 < r \<Longrightarrow> \<not> simply_connected(sphere a r)"
 by (simp add: simply_connected_sphere_eq)
 
 
 proposition simply_connected_punctured_convex:
   fixes a :: "'a::euclidean_space"
   assumes "convex S" and 3: "3 \<le> aff_dim S"
     shows "simply_connected(S - {a})"
 proof (cases "a \<in> rel_interior S")
   case True
   then obtain e where "a \<in> S" "0 < e" and e: "cball a e \<inter> affine hull S \<subseteq> S"
     by (auto simp: rel_interior_cball)
   have con: "convex (cball a e \<inter> affine hull S)"
     by (simp add: convex_Int)
   have bo: "bounded (cball a e \<inter> affine hull S)"
     by (simp add: bounded_Int)
   have "affine hull S \<inter> interior (cball a e) \<noteq> {}"
     using \<open>0 < e\<close> \<open>a \<in> S\<close> hull_subset by fastforce
   then have "3 \<le> aff_dim (affine hull S \<inter> cball a e)"
     by (simp add: 3 aff_dim_convex_Int_nonempty_interior [OF convex_affine_hull])
   also have "... = aff_dim (cball a e \<inter> affine hull S)"
     by (simp add: Int_commute)
   finally have "3 \<le> aff_dim (cball a e \<inter> affine hull S)" .
   moreover have "rel_frontier (cball a e \<inter> affine hull S) homotopy_eqv S - {a}"
   proof (rule homotopy_eqv_rel_frontier_punctured_convex)
     show "a \<in> rel_interior (cball a e \<inter> affine hull S)"
       by (meson IntI Int_mono \<open>a \<in> S\<close> \<open>0 < e\<close> e \<open>cball a e \<inter> affine hull S \<subseteq> S\<close> ball_subset_cball centre_in_cball dual_order.strict_implies_order hull_inc hull_mono mem_rel_interior_ball)
     have "closed (cball a e \<inter> affine hull S)"
       by blast
     then show "rel_frontier (cball a e \<inter> affine hull S) \<subseteq> S"
-      apply (simp add: rel_frontier_def)
-      using e by blast
+      by (metis Diff_subset closure_closed dual_order.trans e rel_frontier_def)
     show "S \<subseteq> affine hull (cball a e \<inter> affine hull S)"
       by (metis (no_types, lifting) IntI \<open>a \<in> S\<close> \<open>0 < e\<close> affine_hull_convex_Int_nonempty_interior centre_in_ball convex_affine_hull empty_iff hull_subset inf_commute interior_cball subsetCE subsetI)
     qed (auto simp: assms con bo)
   ultimately show ?thesis
     using homotopy_eqv_simple_connectedness simply_connected_sphere_gen [OF con bo]
     by blast
 next
   case False
-  show ?thesis
-    apply (rule contractible_imp_simply_connected)
-    apply (rule contractible_convex_tweak_boundary_points [OF \<open>convex S\<close>])
-     apply (simp add: False rel_interior_subset subset_Diff_insert)
+  then have "rel_interior S \<subseteq> S - {a}"
+    by (simp add: False rel_interior_subset subset_Diff_insert)
+  moreover have "S - {a} \<subseteq> closure S"
     by (meson Diff_subset closure_subset subset_trans)
+  ultimately show ?thesis
+    by (metis contractible_imp_simply_connected contractible_convex_tweak_boundary_points [OF \<open>convex S\<close>])
 qed
 
 corollary simply_connected_punctured_universe:
   fixes a :: "'a::euclidean_space"
   assumes "3 \<le> DIM('a)"
   shows "simply_connected(- {a})"
 proof -
   have [simp]: "affine hull cball a 1 = UNIV"
-    apply auto
-    by (metis UNIV_I aff_dim_cball aff_dim_lt_full zero_less_one not_less_iff_gr_or_eq)
+    by (simp add: aff_dim_cball affine_hull_UNIV)
+  have "a \<in> rel_interior (cball a 1)"
+    by (simp add: rel_interior_interior)
+  then
   have "simply_connected (rel_frontier (cball a 1)) = simply_connected (affine hull cball a 1 - {a})"
-    apply (rule homotopy_eqv_simple_connectedness)
-    apply (rule homotopy_eqv_rel_frontier_punctured_affine_hull)
-      apply (force simp: rel_interior_cball intro: homotopy_eqv_simple_connectedness homotopy_eqv_rel_frontier_punctured_affine_hull)+
-    done
+    using homotopy_eqv_rel_frontier_punctured_affine_hull homotopy_eqv_simple_connectedness by blast
   then show ?thesis
     using simply_connected_sphere [of a 1, OF assms] by (auto simp: Compl_eq_Diff_UNIV)
 qed
 
 
 subsection\<open>The power, squaring and exponential functions as covering maps\<close>
 
 proposition covering_space_power_punctured_plane:
   assumes "0 < n"
     shows "covering_space (- {0}) (\<lambda>z::complex. z^n) (- {0})"
 proof -
   consider "n = 1" | "2 \<le> n" using assms by linarith
   then obtain e where "0 < e"
                 and e: "\<And>w z. cmod(w - z) < e * cmod z \<Longrightarrow> (w^n = z^n \<longleftrightarrow> w = z)"
   proof cases
     assume "n = 1" then show ?thesis
       by (rule_tac e=1 in that) auto
   next
     assume "2 \<le> n"
     have eq_if_pow_eq:
          "w = z" if lt: "cmod (w - z) < 2 * sin (pi / real n) * cmod z"
                  and eq: "w^n = z^n" for w z
     proof (cases "z = 0")
       case True with eq assms show ?thesis by (auto simp: power_0_left)
     next
       case False
       then have "z \<noteq> 0" by auto
       have "(w/z)^n = 1"
         by (metis False divide_self_if eq power_divide power_one)
       then obtain j where j: "w / z = exp (2 * of_real pi * \<i> * j / n)" and "j < n"
         using Suc_leI assms \<open>2 \<le> n\<close> complex_roots_unity [THEN eqset_imp_iff, of n "w/z"]
         by force
       have "cmod (w/z - 1) < 2 * sin (pi / real n)"
         using lt assms \<open>z \<noteq> 0\<close> by (simp add: field_split_simps norm_divide)
       then have "cmod (exp (\<i> * of_real (2 * pi * j / n)) - 1) < 2 * sin (pi / real n)"
         by (simp add: j field_simps)
       then have "2 * \<bar>sin((2 * pi * j / n) / 2)\<bar> < 2 * sin (pi / real n)"
         by (simp only: dist_exp_i_1)
       then have sin_less: "sin((pi * j / n)) < sin (pi / real n)"
         by (simp add: field_simps)
       then have "w / z = 1"
       proof (cases "j = 0")
         case True then show ?thesis by (auto simp: j)
       next
         case False
         then have "sin (pi / real n) \<le> sin((pi * j / n))"
         proof (cases "j / n \<le> 1/2")
           case True
           show ?thesis
-            apply (rule sin_monotone_2pi_le)
             using \<open>j \<noteq> 0 \<close> \<open>j < n\<close> True
-            apply (auto simp: field_simps intro: order_trans [of _ 0])
-            done
+            by (intro sin_monotone_2pi_le) (auto simp: field_simps intro: order_trans [of _ 0])
         next
           case False
           then have seq: "sin(pi * j / n) = sin(pi * (n - j) / n)"
             using \<open>j < n\<close> by (simp add: algebra_simps diff_divide_distrib of_nat_diff)
           show ?thesis
-            apply (simp only: seq)
-            apply (rule sin_monotone_2pi_le)
+            unfolding  seq
             using \<open>j < n\<close> False
-            apply (auto simp: field_simps intro: order_trans [of _ 0])
-            done
+            by (intro sin_monotone_2pi_le) (auto simp: field_simps intro: order_trans [of _ 0])
         qed
         with sin_less show ?thesis by force
       qed
       then show ?thesis by simp
     qed
     show ?thesis
-      apply (rule_tac e = "2 * sin(pi / n)" in that)
-       apply (force simp: \<open>2 \<le> n\<close> sin_pi_divide_n_gt_0)
-      apply (meson eq_if_pow_eq)
-      done
+    proof
+      show "0 < 2 * sin (pi / real n)"
+        by (force simp: \<open>2 \<le> n\<close> sin_pi_divide_n_gt_0)
+    qed (meson eq_if_pow_eq)
   qed
   have zn1: "continuous_on (- {0}) (\<lambda>z::complex. z^n)"
     by (rule continuous_intros)+
   have zn2: "(\<lambda>z::complex. z^n) ` (- {0}) = - {0}"
     using assms by (auto simp: image_def elim: exists_complex_root_nonzero [where n = n])
   have zn3: "\<exists>T. z^n \<in> T \<and> open T \<and> 0 \<notin> T \<and>
                (\<exists>v. \<Union>v = -{0} \<inter> (\<lambda>z. z ^ n) -` T \<and>
                     (\<forall>u\<in>v. open u \<and> 0 \<notin> u) \<and>
                     pairwise disjnt v \<and>
                     (\<forall>u\<in>v. Ex (homeomorphism u T (\<lambda>z. z^n))))"
            if "z \<noteq> 0" for z::complex
   proof -
     define d where "d \<equiv> min (1/2) (e/4) * norm z"
     have "0 < d"
       by (simp add: d_def \<open>0 < e\<close> \<open>z \<noteq> 0\<close>)
     have iff_x_eq_y: "x^n = y^n \<longleftrightarrow> x = y"
          if eq: "w^n = z^n" and x: "x \<in> ball w d" and y: "y \<in> ball w d" for w x y
     proof -
       have [simp]: "norm z = norm w" using that
         by (simp add: assms power_eq_imp_eq_norm)
       show ?thesis
       proof (cases "w = 0")
         case True with \<open>z \<noteq> 0\<close> assms eq
         show ?thesis by (auto simp: power_0_left)
       next
         case False
         have "cmod (x - y) < 2*d"
           using x y
           by (simp add: dist_norm [symmetric]) (metis dist_commute mult_2 dist_triangle_less_add)
         also have "... \<le> 2 * e / 4 * norm w"
           using \<open>e > 0\<close> by (simp add: d_def min_mult_distrib_right)
         also have "... = e * (cmod w / 2)"
           by simp
         also have "... \<le> e * cmod y"
-          apply (rule mult_left_mono)
-          using \<open>e > 0\<close> y
-           apply (simp_all add: dist_norm d_def min_mult_distrib_right del: divide_const_simps)
-          apply (metis dist_0_norm dist_complex_def dist_triangle_half_l linorder_not_less order_less_irrefl)
-          done
+        proof (rule mult_left_mono)
+          have "cmod (w - y) < cmod w / 2 \<Longrightarrow> cmod w / 2 \<le> cmod y"
+            by (metis (no_types) dist_0_norm dist_norm norm_triangle_half_l not_le order_less_irrefl)
+          then show "cmod w / 2 \<le> cmod y"
+            using y by (simp add: dist_norm d_def min_mult_distrib_right)
+        qed (use \<open>e > 0\<close> in auto)
         finally have "cmod (x - y) < e * cmod y" .
         then show ?thesis by (rule e)
       qed
     qed
     then have inj: "inj_on (\<lambda>w. w^n) (ball z d)"
       by (simp add: inj_on_def)
     have cont: "continuous_on (ball z d) (\<lambda>w. w ^ n)"
       by (intro continuous_intros)
     have noncon: "\<not> (\<lambda>w::complex. w^n) constant_on UNIV"
       by (metis UNIV_I assms constant_on_def power_one zero_neq_one zero_power)
     have im_eq: "(\<lambda>w. w^n) ` ball z' d = (\<lambda>w. w^n) ` ball z d"
                 if z': "z'^n = z^n" for z'
     proof -
       have nz': "norm z' = norm z" using that assms power_eq_imp_eq_norm by blast
       have "(w \<in> (\<lambda>w. w^n) ` ball z' d) = (w \<in> (\<lambda>w. w^n) ` ball z d)" for w
       proof (cases "w=0")
         case True with assms show ?thesis
           by (simp add: image_def ball_def nz')
       next
         case False
         have "z' \<noteq> 0" using \<open>z \<noteq> 0\<close> nz' by force
-        have [simp]: "(z*x / z')^n = x^n" if "x \<noteq> 0" for x
+        have 1: "(z*x / z')^n = x^n" if "x \<noteq> 0" for x
           using z' that by (simp add: field_simps \<open>z \<noteq> 0\<close>)
-        have [simp]: "cmod (z - z * x / z') = cmod (z' - x)" if "x \<noteq> 0" for x
+        have 2: "cmod (z - z * x / z') = cmod (z' - x)" if "x \<noteq> 0" for x
         proof -
           have "cmod (z - z * x / z') = cmod z * cmod (1 - x / z')"
             by (metis (no_types) ab_semigroup_mult_class.mult_ac(1) divide_complex_def mult.right_neutral norm_mult right_diff_distrib')
           also have "... = cmod z' * cmod (1 - x / z')"
             by (simp add: nz')
           also have "... = cmod (z' - x)"
             by (simp add: \<open>z' \<noteq> 0\<close> diff_divide_eq_iff norm_divide)
           finally show ?thesis .
         qed
-        have [simp]: "(z'*x / z)^n = x^n" if "x \<noteq> 0" for x
+        have 3: "(z'*x / z)^n = x^n" if "x \<noteq> 0" for x
           using z' that by (simp add: field_simps \<open>z \<noteq> 0\<close>)
-        have [simp]: "cmod (z' - z' * x / z) = cmod (z - x)" if "x \<noteq> 0" for x
+        have 4: "cmod (z' - z' * x / z) = cmod (z - x)" if "x \<noteq> 0" for x
         proof -
           have "cmod (z * (1 - x * inverse z)) = cmod (z - x)"
             by (metis \<open>z \<noteq> 0\<close> diff_divide_distrib divide_complex_def divide_self_if nonzero_eq_divide_eq semiring_normalization_rules(7))
           then show ?thesis
             by (metis (no_types) mult.assoc divide_complex_def mult.right_neutral norm_mult nz' right_diff_distrib')
         qed
         show ?thesis
-          unfolding image_def ball_def
-          apply safe
-          apply simp_all
-          apply (rule_tac x="z/z' * x" in exI)
-          using assms False apply (simp add: dist_norm)
-          apply (rule_tac x="z'/z * x" in exI)
-          using assms False apply (simp add: dist_norm)
-          done
+          by (simp add: set_eq_iff image_def ball_def) (metis 1 2 3 4 diff_zero dist_norm nz')
       qed
       then show ?thesis by blast
     qed
 
     have ex_ball: "\<exists>B. (\<exists>z'. B = ball z' d \<and> z'^n = z^n) \<and> x \<in> B"
                   if "x \<noteq> 0" and eq: "x^n = w^n" and dzw: "dist z w < d" for x w
     proof -
       have "w \<noteq> 0" by (metis assms power_eq_0_iff that(1) that(2))
       have [simp]: "cmod x = cmod w"
         using assms power_eq_imp_eq_norm eq by blast
       have [simp]: "cmod (x * z / w - x) = cmod (z - w)"
       proof -
         have "cmod (x * z / w - x) = cmod x * cmod (z / w - 1)"
           by (metis (no_types) mult.right_neutral norm_mult right_diff_distrib' times_divide_eq_right)
         also have "... = cmod w * cmod (z / w - 1)"
           by simp
         also have "... = cmod (z - w)"
           by (simp add: \<open>w \<noteq> 0\<close> divide_diff_eq_iff nonzero_norm_divide)
         finally show ?thesis .
       qed
       show ?thesis
-        apply (rule_tac x="ball (z / w * x) d" in exI)
-        using \<open>d > 0\<close> that
-        apply (simp add: ball_eq_ball_iff)
-        apply (simp add: \<open>z \<noteq> 0\<close> \<open>w \<noteq> 0\<close> field_simps)
-        apply (simp add: dist_norm)
-        done
+      proof (intro exI conjI)
+        show "(z / w * x) ^ n = z ^ n"
+          by (metis \<open>w \<noteq> 0\<close> eq nonzero_eq_divide_eq power_mult_distrib)
+        show "x \<in> ball (z / w * x) d"
+          using \<open>d > 0\<close> that
+          by (simp add: ball_eq_ball_iff \<open>z \<noteq> 0\<close> \<open>w \<noteq> 0\<close> field_simps) (simp add: dist_norm)
+      qed auto
     qed
 
     show ?thesis
     proof (rule exI, intro conjI)
       show "z ^ n \<in> (\<lambda>w. w ^ n) ` ball z d"
         using \<open>d > 0\<close> by simp
       show "open ((\<lambda>w. w ^ n) ` ball z d)"
         by (rule invariance_of_domain [OF cont open_ball inj])
       show "0 \<notin> (\<lambda>w. w ^ n) ` ball z d"
         using \<open>z \<noteq> 0\<close> assms by (force simp: d_def)
       show "\<exists>v. \<Union>v = - {0} \<inter> (\<lambda>z. z ^ n) -` (\<lambda>w. w ^ n) ` ball z d \<and>
                 (\<forall>u\<in>v. open u \<and> 0 \<notin> u) \<and>
                 disjoint v \<and>
                 (\<forall>u\<in>v. Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n)))"
       proof (rule exI, intro ballI conjI)
         show "\<Union>{ball z' d |z'. z'^n = z^n} = - {0} \<inter> (\<lambda>z. z ^ n) -` (\<lambda>w. w ^ n) ` ball z d" (is "?l = ?r")
         proof 
-          show "?l \<subseteq> ?r"
-            apply auto
-             apply (simp add: assms d_def power_eq_imp_eq_norm that)
-            by (metis im_eq image_eqI mem_ball)
+          have "\<And>z'. cmod z' < d \<Longrightarrow> z' ^ n \<noteq> z ^ n"
+            by (auto simp add: assms d_def power_eq_imp_eq_norm that)
+          then show "?l \<subseteq> ?r"
+            by auto (metis im_eq image_eqI mem_ball)
           show "?r \<subseteq> ?l"
             by auto (meson ex_ball)
         qed
         show "\<And>u. u \<in> {ball z' d |z'. z' ^ n = z ^ n} \<Longrightarrow> 0 \<notin> u"
           by (force simp add: assms d_def power_eq_imp_eq_norm that)
 
         show "disjoint {ball z' d |z'. z' ^ n = z ^ n}"
         proof (clarsimp simp add: pairwise_def disjnt_iff)
           fix \<xi> \<zeta> x
           assume "\<xi>^n = z^n" "\<zeta>^n = z^n" "ball \<xi> d \<noteq> ball \<zeta> d"
             and "dist \<xi> x < d" "dist \<zeta> x < d"
           then have "dist \<xi> \<zeta> < d+d"
             using dist_triangle_less_add by blast
           then have "cmod (\<xi> - \<zeta>) < 2*d"
             by (simp add: dist_norm)
           also have "... \<le> e * cmod z"
             using mult_right_mono \<open>0 < e\<close> that by (auto simp: d_def)
           finally have "cmod (\<xi> - \<zeta>) < e * cmod z" .
           with e have "\<xi> = \<zeta>"
             by (metis \<open>\<xi>^n = z^n\<close> \<open>\<zeta>^n = z^n\<close> assms power_eq_imp_eq_norm)
           then show "False"
             using \<open>ball \<xi> d \<noteq> ball \<zeta> d\<close> by blast
         qed
         show "Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n))"
           if "u \<in> {ball z' d |z'. z' ^ n = z ^ n}" for u
         proof (rule invariance_of_domain_homeomorphism [of "u" "\<lambda>z. z^n"])
           show "open u"
             using that by auto
           show "continuous_on u (\<lambda>z. z ^ n)"
             by (intro continuous_intros)
           show "inj_on (\<lambda>z. z ^ n) u"
             using that by (auto simp: iff_x_eq_y inj_on_def)
           show "\<And>g. homeomorphism u ((\<lambda>z. z ^ n) ` u) (\<lambda>z. z ^ n) g \<Longrightarrow> Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n))"
             using im_eq that by clarify metis
         qed auto
       qed auto
     qed
   qed
   show ?thesis
     using assms
     apply (simp add: covering_space_def zn1 zn2)
     apply (subst zn2 [symmetric])
-    apply (simp add: openin_open_eq open_Compl)
-    apply (blast intro: zn3)
+    apply (simp add: openin_open_eq open_Compl zn3)
     done
 qed
 
 corollary covering_space_square_punctured_plane:
   "covering_space (- {0}) (\<lambda>z::complex. z^2) (- {0})"
   by (simp add: covering_space_power_punctured_plane)
 
 
 proposition covering_space_exp_punctured_plane:
   "covering_space UNIV (\<lambda>z::complex. exp z) (- {0})"
 proof (simp add: covering_space_def, intro conjI ballI)
   show "continuous_on UNIV (\<lambda>z::complex. exp z)"
     by (rule continuous_on_exp [OF continuous_on_id])
   show "range exp = - {0::complex}"
     by auto (metis exp_Ln range_eqI)
   show "\<exists>T. z \<in> T \<and> openin (top_of_set (- {0})) T \<and>
              (\<exists>v. \<Union>v = exp -` T \<and> (\<forall>u\<in>v. open u) \<and> disjoint v \<and>
                   (\<forall>u\<in>v. \<exists>q. homeomorphism u T exp q))"
         if "z \<in> - {0::complex}" for z
   proof -
     have "z \<noteq> 0"
       using that by auto
-    have inj_exp: "inj_on exp (ball (Ln z) 1)"
-      apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
+    have "ball (Ln z) 1 \<subseteq> ball (Ln z) pi"
       using pi_ge_two by (simp add: ball_subset_ball_iff)
+    then have inj_exp: "inj_on exp (ball (Ln z) 1)"
+      using inj_on_exp_pi inj_on_subset by blast
     define \<V> where "\<V> \<equiv> range (\<lambda>n. (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1))"
     show ?thesis
     proof (intro exI conjI)
       show "z \<in> exp ` (ball(Ln z) 1)"
         by (metis \<open>z \<noteq> 0\<close> centre_in_ball exp_Ln rev_image_eqI zero_less_one)
       have "open (- {0::complex})"
         by blast
-      moreover have "inj_on exp (ball (Ln z) 1)"
-        apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
-        using pi_ge_two by (simp add: ball_subset_ball_iff)
-      ultimately show "openin (top_of_set (- {0})) (exp ` ball (Ln z) 1)"
+      with inj_exp show "openin (top_of_set (- {0})) (exp ` ball (Ln z) 1)"
         by (auto simp: openin_open_eq invariance_of_domain continuous_on_exp [OF continuous_on_id])
       show "\<Union>\<V> = exp -` exp ` ball (Ln z) 1"
         by (force simp: \<V>_def Complex_Transcendental.exp_eq image_iff)
       show "\<forall>V\<in>\<V>. open V"
         by (auto simp: \<V>_def inj_on_def continuous_intros invariance_of_domain)
       have xy: "2 \<le> cmod (2 * of_int x * of_real pi * \<i> - 2 * of_int y * of_real pi * \<i>)"
                if "x < y" for x y
       proof -
         have "1 \<le> abs (x - y)"
           using that by linarith
         then have "1 \<le> cmod (of_int x - of_int y) * 1"
           by (metis mult.right_neutral norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
         also have "... \<le> cmod (of_int x - of_int y) * of_real pi"
-          apply (rule mult_left_mono)
-          using pi_ge_two by auto
+          using pi_ge_two
+           by (intro mult_left_mono) auto
         also have "... \<le> cmod ((of_int x - of_int y) * of_real pi * \<i>)"
           by (simp add: norm_mult)
         also have "... \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)"
           by (simp add: algebra_simps)
         finally have "1 \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)" .
         then have "2 * 1 \<le> cmod (2 * (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>))"
           by (metis mult_le_cancel_left_pos norm_mult_numeral1 zero_less_numeral)
         then show ?thesis
           by (simp add: algebra_simps)
       qed
       show "disjoint \<V>"
         apply (clarsimp simp add: \<V>_def pairwise_def disjnt_def add.commute [of _ "x*y" for x y]
-                        ball_eq_ball_iff)
-        apply (rule disjoint_ballI)
+                        ball_eq_ball_iff intro!: disjoint_ballI)
         apply (auto simp: dist_norm neq_iff)
         by (metis norm_minus_commute xy)+
       show "\<forall>u\<in>\<V>. \<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
       proof
         fix u
         assume "u \<in> \<V>"
         then obtain n where n: "u = (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1)"
           by (auto simp: \<V>_def)
         have "compact (cball (Ln z) 1)"
           by simp
         moreover have "continuous_on (cball (Ln z) 1) exp"
           by (rule continuous_on_exp [OF continuous_on_id])
         moreover have "inj_on exp (cball (Ln z) 1)"
           apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
           using pi_ge_two by (simp add: cball_subset_ball_iff)
         ultimately obtain \<gamma> where hom: "homeomorphism (cball (Ln z) 1) (exp ` cball (Ln z) 1) exp \<gamma>"
           using homeomorphism_compact  by blast
         have eq1: "exp ` u = exp ` ball (Ln z) 1"
-          unfolding n
-          apply (auto simp: algebra_simps)
-          apply (rename_tac w)
-          apply (rule_tac x = "w + \<i> * (of_int n * (of_real pi * 2))" in image_eqI)
+          apply (auto simp: algebra_simps n)
+          apply (rule_tac x = "_ + \<i> * (of_int n * (of_real pi * 2))" in image_eqI)
           apply (auto simp: image_iff)
           done
         have \<gamma>exp: "\<gamma> (exp x) + 2 * of_int n * of_real pi * \<i> = x" if "x \<in> u" for x
         proof -
           have "exp x = exp (x - 2 * of_int n * of_real pi * \<i>)"
             by (simp add: exp_eq)
           then have "\<gamma> (exp x) = \<gamma> (exp (x - 2 * of_int n * of_real pi * \<i>))"
             by simp
           also have "... = x - 2 * of_int n * of_real pi * \<i>"
-            apply (rule homeomorphism_apply1 [OF hom])
-            using \<open>x \<in> u\<close> by (auto simp: n)
+            using \<open>x \<in> u\<close> by (auto simp: n intro: homeomorphism_apply1 [OF hom])
           finally show ?thesis
             by simp
         qed
         have exp2n: "exp (\<gamma> (exp x) + 2 * of_int n * complex_of_real pi * \<i>) = exp x"
                 if "dist (Ln z) x < 1" for x
           using that by (auto simp: exp_eq homeomorphism_apply1 [OF hom])
-        have cont: "continuous_on (exp ` ball (Ln z) 1) (\<lambda>x. \<gamma> x + 2 * of_int n * complex_of_real pi * \<i>)"
-          apply (intro continuous_intros)
-          apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF hom]])
-          apply (force simp:)
-          done
+        have "continuous_on (exp ` ball (Ln z) 1) \<gamma>"
+          by (meson ball_subset_cball continuous_on_subset hom homeomorphism_cont2 image_mono)
+        then have cont: "continuous_on (exp ` ball (Ln z) 1) (\<lambda>x. \<gamma> x + 2 * of_int n * complex_of_real pi * \<i>)"
+          by (intro continuous_intros)
         show "\<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
           apply (rule_tac x="(\<lambda>x. x + of_real(2 * n * pi) * \<i>) \<circ> \<gamma>" in exI)
           unfolding homeomorphism_def
           apply (intro conjI ballI eq1 continuous_on_exp [OF continuous_on_id])
              apply (auto simp: \<gamma>exp exp2n cont n)
-           apply (simp add:  homeomorphism_apply1 [OF hom])
-          using hom homeomorphism_apply1  apply (force simp: image_iff)
+           apply (force simp: image_iff homeomorphism_apply1 [OF hom])+
           done
       qed
     qed
   qed
 qed
 
 
 subsection\<open>Hence the Borsukian results about mappings into circles\<close>(*FIX ME title *)
 
 lemma inessential_eq_continuous_logarithm:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   shows "(\<exists>a. homotopic_with_canon (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)) \<longleftrightarrow>
          (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x)))"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs thus ?rhs
     by (metis covering_space_lift_inessential_function covering_space_exp_punctured_plane)
 next
   assume ?rhs
   then obtain g where contg: "continuous_on S g" and f: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     by metis
   obtain a where "homotopic_with_canon (\<lambda>h. True) S (- {of_real 0}) (exp \<circ> g) (\<lambda>x. a)"
   proof (rule nullhomotopic_through_contractible [OF contg subset_UNIV _ _ contractible_UNIV])
     show "continuous_on (UNIV::complex set) exp"
       by (intro continuous_intros)
     show "range exp \<subseteq> - {0}"
       by auto
   qed force
   then have "homotopic_with_canon (\<lambda>h. True) S (- {0}) f (\<lambda>t. a)"
     using f homotopic_with_eq by fastforce
   then show ?lhs ..
 qed
 
 corollary inessential_imp_continuous_logarithm_circle:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "homotopic_with_canon (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)"
   obtains g where "continuous_on S g" and "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
 proof -
   have "homotopic_with_canon (\<lambda>h. True) S (- {0}) f (\<lambda>t. a)"
     using assms homotopic_with_subset_right by fastforce
   then show ?thesis
     by (metis inessential_eq_continuous_logarithm that)
 qed
 
 
 lemma inessential_eq_continuous_logarithm_circle:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   shows "(\<exists>a. homotopic_with_canon (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)) \<longleftrightarrow>
          (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(\<i> * of_real(g x))))"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume L: ?lhs
   then obtain g where contg: "continuous_on S g" and g: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using inessential_imp_continuous_logarithm_circle by blast
   have "f ` S \<subseteq> sphere 0 1"
     by (metis L homotopic_with_imp_subset1)
   then have "\<And>x. x \<in> S \<Longrightarrow> Re (g x) = 0"
     using g by auto
   then show ?rhs
-    apply (rule_tac x="Im \<circ> g" in exI)
-     apply (intro conjI contg continuous_intros)
-    apply (auto simp: Euler g)
-    done
+    by (rule_tac x="Im \<circ> g" in exI) (auto simp: Euler g intro: contg continuous_intros)
 next
   assume ?rhs
   then obtain g where contg: "continuous_on S g" and g: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(\<i>* of_real(g x))"
     by metis
   obtain a where "homotopic_with_canon (\<lambda>h. True) S (sphere 0 1) ((exp \<circ> (\<lambda>z. \<i>*z)) \<circ> (of_real \<circ> g)) (\<lambda>x. a)"
   proof (rule nullhomotopic_through_contractible)
     show "continuous_on S (complex_of_real \<circ> g)"
       by (intro conjI contg continuous_intros)
     show "(complex_of_real \<circ> g) ` S \<subseteq> \<real>"
       by auto
     show "continuous_on \<real> (exp \<circ> (*)\<i>)"
       by (intro continuous_intros)
     show "(exp \<circ> (*)\<i>) ` \<real> \<subseteq> sphere 0 1"
       by (auto simp: complex_is_Real_iff)
   qed (auto simp: convex_Reals convex_imp_contractible)
   moreover have "\<And>x. x \<in> S \<Longrightarrow> (exp \<circ> (*)\<i> \<circ> (complex_of_real \<circ> g)) x = f x"
     by (simp add: g)
   ultimately have "homotopic_with_canon (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)"
     using homotopic_with_eq by force
   then show ?lhs ..
 qed
 
 proposition homotopic_with_sphere_times:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes hom: "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f g" and conth: "continuous_on S h"
       and hin: "\<And>x. x \<in> S \<Longrightarrow> h x \<in> sphere 0 1"
     shows "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x * h x) (\<lambda>x. g x * h x)"
 proof -
   obtain k where contk: "continuous_on ({0..1::real} \<times> S) k"
              and kim: "k ` ({0..1} \<times> S) \<subseteq> sphere 0 1"
              and k0:  "\<And>x. k(0, x) = f x"
              and k1: "\<And>x. k(1, x) = g x"
     using hom by (auto simp: homotopic_with_def)
   show ?thesis
     apply (simp add: homotopic_with)
     apply (rule_tac x="\<lambda>z. k z*(h \<circ> snd)z" in exI)
-    apply (intro conjI contk continuous_intros)
-       apply (simp add: conth)
-    using kim hin apply (force simp: norm_mult k0 k1)+
-    done
+    using kim hin by (fastforce simp: conth norm_mult k0 k1 intro!: contk continuous_intros)+
 qed
 
 proposition homotopic_circlemaps_divide:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
     shows "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f g \<longleftrightarrow>
            continuous_on S f \<and> f ` S \<subseteq> sphere 0 1 \<and>
            continuous_on S g \<and> g ` S \<subseteq> sphere 0 1 \<and>
            (\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c))"
 proof -
   have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
        if "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c)" for c
   proof -
     have "S = {} \<or> path_component (sphere 0 1) 1 c"
       using homotopic_with_imp_subset2 [OF that] path_connected_sphere [of "0::complex" 1]
       by (auto simp: path_connected_component)
     then have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. 1) (\<lambda>x. c)"
       by (simp add: homotopic_constant_maps)
     then show ?thesis
       using homotopic_with_symD homotopic_with_trans that by blast
   qed
   then have *: "(\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c)) \<longleftrightarrow>
                 homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
     by auto
   have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f g \<longleftrightarrow>
            continuous_on S f \<and> f ` S \<subseteq> sphere 0 1 \<and>
            continuous_on S g \<and> g ` S \<subseteq> sphere 0 1 \<and>
            homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
         (is "?lhs \<longleftrightarrow> ?rhs")
   proof
     assume L: ?lhs
     have geq1 [simp]: "\<And>x. x \<in> S \<Longrightarrow> cmod (g x) = 1"
       using homotopic_with_imp_subset2 [OF L]
       by (simp add: image_subset_iff)
     have cont: "continuous_on S (inverse \<circ> g)"
-      apply (rule continuous_intros)
-      using homotopic_with_imp_continuous [OF L] apply blast
-      apply (rule continuous_on_subset [of "sphere 0 1", OF continuous_on_inverse])
-        apply (auto)
-      done
+    proof (rule continuous_intros)
+      show "continuous_on S g"
+        using homotopic_with_imp_continuous [OF L] by blast
+      show "continuous_on (g ` S) inverse"
+        by (rule continuous_on_subset [of "sphere 0 1", OF continuous_on_inverse]) auto
+    qed
+    have [simp]: "\<And>x. x \<in> S \<Longrightarrow> g x \<noteq> 0"
+      using geq1 by fastforce
     have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
-      using homotopic_with_sphere_times [OF L cont]
-      apply (rule homotopic_with_eq)
-         apply (auto simp: division_ring_class.divide_inverse norm_inverse)
-      by (metis geq1 norm_zero right_inverse zero_neq_one)
+      apply (rule homotopic_with_eq [OF homotopic_with_sphere_times [OF L cont]])
+      by (auto simp: divide_inverse norm_inverse)
     with L show ?rhs
       by (auto simp: homotopic_with_imp_continuous dest: homotopic_with_imp_subset1 homotopic_with_imp_subset2)
   next
     assume ?rhs then show ?lhs
       by (elim conjE homotopic_with_eq [OF homotopic_with_sphere_times]; force)
   qed
   then show ?thesis
     by (simp add: *)
 qed
 
 subsection\<open>Upper and lower hemicontinuous functions\<close>
 
 text\<open>And relation in the case of preimage map to open and closed maps, and fact that upper and lower
 hemicontinuity together imply continuity in the sense of the Hausdorff metric (at points where the
 function gives a bounded and nonempty set).\<close>
 
 
 text\<open>Many similar proofs below.\<close>
 lemma upper_hemicontinuous:
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
     shows "((\<forall>U. openin (top_of_set T) U
                  \<longrightarrow> openin (top_of_set S) {x \<in> S. f x \<subseteq> U}) \<longleftrightarrow>
             (\<forall>U. closedin (top_of_set T) U
                  \<longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}))"
           (is "?lhs = ?rhs")
 proof (intro iffI allI impI)
   fix U
   assume * [rule_format]: ?lhs and "closedin (top_of_set T) U"
   then have "openin (top_of_set T) (T - U)"
     by (simp add: openin_diff)
   then have "openin (top_of_set S) {x \<in> S. f x \<subseteq> T - U}"
     using * [of "T-U"] by blast
   moreover have "S - {x \<in> S. f x \<subseteq> T - U} = {x \<in> S. f x \<inter> U \<noteq> {}}"
     using assms by blast
   ultimately show "closedin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
     by (simp add: openin_closedin_eq)
 next
   fix U
   assume * [rule_format]: ?rhs and "openin (top_of_set T) U"
   then have "closedin (top_of_set T) (T - U)"
     by (simp add: closedin_diff)
   then have "closedin (top_of_set S) {x \<in> S. f x \<inter> (T - U) \<noteq> {}}"
     using * [of "T-U"] by blast
   moreover have "{x \<in> S. f x \<inter> (T - U) \<noteq> {}} = S - {x \<in> S. f x \<subseteq> U}"
     using assms by auto
   ultimately show "openin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
     by (simp add: openin_closedin_eq)
 qed
 
 lemma lower_hemicontinuous:
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
     shows "((\<forall>U. closedin (top_of_set T) U
                  \<longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}) \<longleftrightarrow>
             (\<forall>U. openin (top_of_set T) U
                  \<longrightarrow> openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}))"
           (is "?lhs = ?rhs")
 proof (intro iffI allI impI)
   fix U
   assume * [rule_format]: ?lhs and "openin (top_of_set T) U"
   then have "closedin (top_of_set T) (T - U)"
     by (simp add: closedin_diff)
   then have "closedin (top_of_set S) {x \<in> S. f x \<subseteq> T-U}"
     using * [of "T-U"] by blast
   moreover have "{x \<in> S. f x \<subseteq> T-U} = S - {x \<in> S. f x \<inter> U \<noteq> {}}"
     using assms by auto
   ultimately show "openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
     by (simp add: openin_closedin_eq)
 next
   fix U
   assume * [rule_format]: ?rhs and "closedin (top_of_set T) U"
   then have "openin (top_of_set T) (T - U)"
     by (simp add: openin_diff)
   then have "openin (top_of_set S) {x \<in> S. f x \<inter> (T - U) \<noteq> {}}"
     using * [of "T-U"] by blast
   moreover have "S - {x \<in> S. f x \<inter> (T - U) \<noteq> {}} = {x \<in> S. f x \<subseteq> U}"
     using assms by blast
   ultimately show "closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
     by (simp add: openin_closedin_eq)
 qed
 
 lemma open_map_iff_lower_hemicontinuous_preimage:
   assumes "f ` S \<subseteq> T"
     shows "((\<forall>U. openin (top_of_set S) U
                  \<longrightarrow> openin (top_of_set T) (f ` U)) \<longleftrightarrow>
             (\<forall>U. closedin (top_of_set S) U
                  \<longrightarrow> closedin (top_of_set T) {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}))"
           (is "?lhs = ?rhs")
 proof (intro iffI allI impI)
   fix U
   assume * [rule_format]: ?lhs and "closedin (top_of_set S) U"
   then have "openin (top_of_set S) (S - U)"
     by (simp add: openin_diff)
   then have "openin (top_of_set T) (f ` (S - U))"
     using * [of "S-U"] by blast
   moreover have "T - (f ` (S - U)) = {y \<in> T. {x \<in> S. f x = y} \<subseteq> U}"
     using assms by blast
   ultimately show "closedin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> U}"
     by (simp add: openin_closedin_eq)
 next
   fix U
   assume * [rule_format]: ?rhs and opeSU: "openin (top_of_set S) U"
   then have "closedin (top_of_set S) (S - U)"
     by (simp add: closedin_diff)
   then have "closedin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
     using * [of "S-U"] by blast
   moreover have "{y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U} = T - (f ` U)"
     using assms openin_imp_subset [OF opeSU] by auto
   ultimately show "openin (top_of_set T) (f ` U)"
     using assms openin_imp_subset [OF opeSU] by (force simp: openin_closedin_eq)
 qed
 
 lemma closed_map_iff_upper_hemicontinuous_preimage:
   assumes "f ` S \<subseteq> T"
     shows "((\<forall>U. closedin (top_of_set S) U
                  \<longrightarrow> closedin (top_of_set T) (f ` U)) \<longleftrightarrow>
             (\<forall>U. openin (top_of_set S) U
                  \<longrightarrow> openin (top_of_set T) {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}))"
           (is "?lhs = ?rhs")
 proof (intro iffI allI impI)
   fix U
   assume * [rule_format]: ?lhs and opeSU: "openin (top_of_set S) U"
   then have "closedin (top_of_set S) (S - U)"
     by (simp add: closedin_diff)
   then have "closedin (top_of_set T) (f ` (S - U))"
     using * [of "S-U"] by blast
   moreover have "f ` (S - U) = T -  {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}"
     using assms openin_imp_subset [OF opeSU] by auto
   ultimately show "openin (top_of_set T)  {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}"
     using assms openin_imp_subset [OF opeSU] by (force simp: openin_closedin_eq)
 next
   fix U
   assume * [rule_format]: ?rhs and cloSU: "closedin (top_of_set S) U"
   then have "openin (top_of_set S) (S - U)"
     by (simp add: openin_diff)
   then have "openin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
     using * [of "S-U"] by blast
   moreover have "(f ` U) = T - {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
     using assms closedin_imp_subset [OF cloSU]  by auto
   ultimately show "closedin (top_of_set T) (f ` U)"
     by (simp add: openin_closedin_eq)
 qed
 
 proposition upper_lower_hemicontinuous_explicit:
   fixes T :: "('b::{real_normed_vector,heine_borel}) set"
   assumes fST: "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
       and ope: "\<And>U. openin (top_of_set T) U
                      \<Longrightarrow> openin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
       and clo: "\<And>U. closedin (top_of_set T) U
                      \<Longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
       and "x \<in> S" "0 < e" and bofx: "bounded(f x)" and fx_ne: "f x \<noteq> {}"
   obtains d where "0 < d"
              "\<And>x'. \<lbrakk>x' \<in> S; dist x x' < d\<rbrakk>
                            \<Longrightarrow> (\<forall>y \<in> f x. \<exists>y'. y' \<in> f x' \<and> dist y y' < e) \<and>
                                (\<forall>y' \<in> f x'. \<exists>y. y \<in> f x \<and> dist y' y < e)"
 proof -
   have "openin (top_of_set T) (T \<inter> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b}))"
     by (auto simp: open_sums openin_open_Int)
   with ope have "openin (top_of_set S)
                     {u \<in> S. f u \<subseteq> T \<inter> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b})}" by blast
   with \<open>0 < e\<close> \<open>x \<in> S\<close> obtain d1 where "d1 > 0" and
          d1: "\<And>x'. \<lbrakk>x' \<in> S; dist x' x < d1\<rbrakk> \<Longrightarrow> f x' \<subseteq> T \<and> f x' \<subseteq> (\<Union>a \<in> f x. \<Union>b \<in> ball 0 e. {a + b})"
     by (force simp: openin_euclidean_subtopology_iff dest: fST)
   have oo: "\<And>U. openin (top_of_set T) U \<Longrightarrow>
                  openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
     apply (rule lower_hemicontinuous [THEN iffD1, rule_format])
     using fST clo by auto
   have "compact (closure(f x))"
     by (simp add: bofx)
   moreover have "closure(f x) \<subseteq> (\<Union>a \<in> f x. ball a (e/2))"
     using \<open>0 < e\<close> by (force simp: closure_approachable simp del: divide_const_simps)
   ultimately obtain C where "C \<subseteq> f x" "finite C" "closure(f x) \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
     apply (rule compactE, force)
     by (metis finite_subset_image)
   then have fx_cover: "f x \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
     by (meson closure_subset order_trans)
   with fx_ne have "C \<noteq> {}"
     by blast
   have xin: "x \<in> (\<Inter>a \<in> C. {x \<in> S. f x \<inter> T \<inter> ball a (e/2) \<noteq> {}})"
     using \<open>x \<in> S\<close> \<open>0 < e\<close> fST \<open>C \<subseteq> f x\<close> by force
   have "openin (top_of_set S) {x \<in> S. f x \<inter> (T \<inter> ball a (e/2)) \<noteq> {}}" for a
     by (simp add: openin_open_Int oo)
   then have "openin (top_of_set S) (\<Inter>a \<in> C. {x \<in> S. f x \<inter> T \<inter> ball a (e/2) \<noteq> {}})"
     by (simp add: Int_assoc openin_INT2 [OF \<open>finite C\<close> \<open>C \<noteq> {}\<close>])
   with xin obtain d2 where "d2>0"
               and d2: "\<And>u v. \<lbrakk>u \<in> S; dist u x < d2; v \<in> C\<rbrakk> \<Longrightarrow> f u \<inter> T \<inter> ball v (e/2) \<noteq> {}"
     unfolding openin_euclidean_subtopology_iff using xin by fastforce
   show ?thesis
   proof (intro that conjI ballI)
     show "0 < min d1 d2"
       using \<open>0 < d1\<close> \<open>0 < d2\<close> by linarith
   next
     fix x' y
     assume "x' \<in> S" "dist x x' < min d1 d2" "y \<in> f x"
     then have dd2: "dist x' x < d2"
       by (auto simp: dist_commute)
     obtain a where "a \<in> C" "y \<in> ball a (e/2)"
       using fx_cover \<open>y \<in> f x\<close> by auto
     then show "\<exists>y'. y' \<in> f x' \<and> dist y y' < e"
       using d2 [OF \<open>x' \<in> S\<close> dd2] dist_triangle_half_r by fastforce
   next
     fix x' y'
     assume "x' \<in> S" "dist x x' < min d1 d2" "y' \<in> f x'"
     then have "dist x' x < d1"
       by (auto simp: dist_commute)
     then have "y' \<in> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b})"
       using d1 [OF \<open>x' \<in> S\<close>] \<open>y' \<in> f x'\<close> by force
     then show "\<exists>y. y \<in> f x \<and> dist y' y < e"
-      apply auto
-      by (metis add_diff_cancel_left' dist_norm)
+      by clarsimp (metis add_diff_cancel_left' dist_norm)
   qed
 qed
 
 
 subsection\<open>Complex logs exist on various "well-behaved" sets\<close>
 
 lemma continuous_logarithm_on_contractible:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "continuous_on S f" "contractible S" "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
 proof -
   obtain c where hom: "homotopic_with_canon (\<lambda>h. True) S (-{0}) f (\<lambda>x. c)"
     using nullhomotopic_from_contractible assms
     by (metis imageE subset_Compl_singleton)
   then show ?thesis
     by (metis inessential_eq_continuous_logarithm that)
 qed
 
 lemma continuous_logarithm_on_simply_connected:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes contf: "continuous_on S f" and S: "simply_connected S" "locally path_connected S"
       and f: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
   using covering_space_lift [OF covering_space_exp_punctured_plane S contf]
   by (metis (full_types) f imageE subset_Compl_singleton)
 
 lemma continuous_logarithm_on_cball:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "continuous_on (cball a r) f" and "\<And>z. z \<in> cball a r \<Longrightarrow> f z \<noteq> 0"
     obtains h where "continuous_on (cball a r) h" "\<And>z. z \<in> cball a r \<Longrightarrow> f z = exp(h z)"
   using assms continuous_logarithm_on_contractible convex_imp_contractible by blast
 
 lemma continuous_logarithm_on_ball:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "continuous_on (ball a r) f" and "\<And>z. z \<in> ball a r \<Longrightarrow> f z \<noteq> 0"
   obtains h where "continuous_on (ball a r) h" "\<And>z. z \<in> ball a r \<Longrightarrow> f z = exp(h z)"
   using assms continuous_logarithm_on_contractible convex_imp_contractible by blast
 
 lemma continuous_sqrt_on_contractible:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "continuous_on S f" "contractible S"
       and "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = (g x) ^ 2"
 proof -
   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using continuous_logarithm_on_contractible [OF assms] by blast
   show ?thesis
   proof
     show "continuous_on S (\<lambda>z. exp (g z / 2))"
       by (rule continuous_on_compose2 [of UNIV exp]; intro continuous_intros contg subset_UNIV) auto
     show "\<And>x. x \<in> S \<Longrightarrow> f x = (exp (g x / 2))\<^sup>2"
       by (metis exp_double feq nonzero_mult_div_cancel_left times_divide_eq_right zero_neq_numeral)
   qed
 qed
 
 lemma continuous_sqrt_on_simply_connected:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes contf: "continuous_on S f" and S: "simply_connected S" "locally path_connected S"
       and f: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = (g x) ^ 2"
 proof -
   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using continuous_logarithm_on_simply_connected [OF assms] by blast
   show ?thesis
   proof
     show "continuous_on S (\<lambda>z. exp (g z / 2))"
       by (rule continuous_on_compose2 [of UNIV exp]; intro continuous_intros contg subset_UNIV) auto
     show "\<And>x. x \<in> S \<Longrightarrow> f x = (exp (g x / 2))\<^sup>2"
       by (metis exp_double feq nonzero_mult_div_cancel_left times_divide_eq_right zero_neq_numeral)
   qed
 qed
 
 
 subsection\<open>Another simple case where sphere maps are nullhomotopic\<close>
 
 lemma inessential_spheremap_2_aux:
   fixes f :: "'a::euclidean_space \<Rightarrow> complex"
   assumes 2: "2 < DIM('a)" and contf: "continuous_on (sphere a r) f" 
       and fim: "f `(sphere a r) \<subseteq> (sphere 0 1)" 
   obtains c where "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere 0 1) f (\<lambda>x. c)"
 proof -
   obtain g where contg: "continuous_on (sphere a r) g" 
              and feq: "\<And>x. x \<in> sphere a r \<Longrightarrow> f x = exp(g x)"
   proof (rule continuous_logarithm_on_simply_connected [OF contf])
     show "simply_connected (sphere a r)"
       using 2 by (simp add: simply_connected_sphere_eq)
     show "locally path_connected (sphere a r)"
       by (simp add: locally_path_connected_sphere)
     show "\<And>z.  z \<in> sphere a r \<Longrightarrow> f z \<noteq> 0"
       using fim by force
   qed auto
   have "\<exists>g. continuous_on (sphere a r) g \<and> (\<forall>x\<in>sphere a r. f x = exp (\<i> * complex_of_real (g x)))"
   proof (intro exI conjI)
     show "continuous_on (sphere a r) (Im \<circ> g)"
       by (intro contg continuous_intros continuous_on_compose)
     show "\<forall>x\<in>sphere a r. f x = exp (\<i> * complex_of_real ((Im \<circ> g) x))"
       using exp_eq_polar feq fim norm_exp_eq_Re by auto
   qed
   with inessential_eq_continuous_logarithm_circle that show ?thesis 
     by metis
 qed
 
 lemma inessential_spheremap_2:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes a2: "2 < DIM('a)" and b2: "DIM('b) = 2" 
       and contf: "continuous_on (sphere a r) f" and fim: "f `(sphere a r) \<subseteq> (sphere b s)"
   obtains c where "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. c)"
 proof (cases "s \<le> 0")
   case True
   then show ?thesis
     using contf contractible_sphere fim nullhomotopic_into_contractible that by blast
 next
   case False
   then have "sphere b s homeomorphic sphere (0::complex) 1"
     using assms by (simp add: homeomorphic_spheres_gen)
   then obtain h k where hk: "homeomorphism (sphere b s) (sphere (0::complex) 1) h k"
     by (auto simp: homeomorphic_def)
   then have conth: "continuous_on (sphere b s) h"
        and  contk: "continuous_on (sphere 0 1) k"
        and  him: "h ` sphere b s \<subseteq> sphere 0 1"
        and  kim: "k ` sphere 0 1 \<subseteq> sphere b s"
     by (simp_all add: homeomorphism_def)
   obtain c where "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere 0 1) (h \<circ> f) (\<lambda>x. c)"
   proof (rule inessential_spheremap_2_aux [OF a2])
     show "continuous_on (sphere a r) (h \<circ> f)"
       by (meson continuous_on_compose [OF contf] conth continuous_on_subset fim)
     show "(h \<circ> f) ` sphere a r \<subseteq> sphere 0 1"
       using fim him by force
   qed auto
   then have "homotopic_with_canon (\<lambda>f. True) (sphere a r) (sphere b s) (k \<circ> (h \<circ> f)) (k \<circ> (\<lambda>x. c))"
     by (rule homotopic_with_compose_continuous_left [OF _ contk kim])
   then have "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. k c)"
     apply (rule homotopic_with_eq, auto)
     by (metis fim hk homeomorphism_def image_subset_iff mem_sphere)
   then show ?thesis
     by (metis that)
 qed
 
 
 subsection\<open>Holomorphic logarithms and square roots\<close>
 
-lemma contractible_imp_holomorphic_log:
+lemma g_imp_holomorphic_log:
   assumes holf: "f holomorphic_on S"
-      and S: "contractible S"
+      and contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
 proof -
   have contf: "continuous_on S f"
     by (simp add: holf holomorphic_on_imp_continuous_on)
-  obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
-    by (metis continuous_logarithm_on_contractible [OF contf S fnz])
   have "g field_differentiable at z within S" if "f field_differentiable at z within S" "z \<in> S" for z
   proof -
     obtain f' where f': "((\<lambda>y. (f y - f z) / (y - z)) \<longlongrightarrow> f') (at z within S)"
       using \<open>f field_differentiable at z within S\<close> by (auto simp: field_differentiable_def has_field_derivative_iff)
     then have ee: "((\<lambda>x. (exp(g x) - exp(g z)) / (x - z)) \<longlongrightarrow> f') (at z within S)"
       by (simp add: feq \<open>z \<in> S\<close> Lim_transform_within [OF _ zero_less_one])
     have "(((\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<circ> g) \<longlongrightarrow> exp (g z))
           (at z within S)"
     proof (rule tendsto_compose_at)
       show "(g \<longlongrightarrow> g z) (at z within S)"
         using contg continuous_on \<open>z \<in> S\<close> by blast
       show "(\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<midarrow>g z\<rightarrow> exp (g z)"
-        apply (subst Lim_at_zero)
-        apply (simp add: DERIV_D cong: if_cong Lim_cong_within)
-        done
+        by (simp add: LIM_offset_zero_iff DERIV_D cong: if_cong Lim_cong_within)
       qed auto
     then have dd: "((\<lambda>x. if g x = g z then exp(g z) else (exp(g x) - exp(g z)) / (g x - g z)) \<longlongrightarrow> exp(g z)) (at z within S)"
       by (simp add: o_def)
     have "continuous (at z within S) g"
       using contg continuous_on_eq_continuous_within \<open>z \<in> S\<close> by blast
     then have "(\<forall>\<^sub>F x in at z within S. dist (g x) (g z) < 2*pi)"
       by (simp add: continuous_within tendsto_iff)
     then have "\<forall>\<^sub>F x in at z within S. exp (g x) = exp (g z) \<longrightarrow> g x \<noteq> g z \<longrightarrow> x = z"
-      apply (rule eventually_mono)
-      apply (auto simp: exp_eq dist_norm norm_mult)
-      done
+      by (rule eventually_mono) (auto simp: exp_eq dist_norm norm_mult)
     then have "((\<lambda>y. (g y - g z) / (y - z)) \<longlongrightarrow> f' / exp (g z)) (at z within S)"
       by (auto intro!: Lim_transform_eventually [OF tendsto_divide [OF ee dd]])
     then show ?thesis
       by (auto simp: field_differentiable_def has_field_derivative_iff)
   qed
   then have "g holomorphic_on S"
     using holf holomorphic_on_def by auto
   then show ?thesis
     using feq that by auto
 qed
 
-(*Identical proofs*)
+lemma contractible_imp_holomorphic_log:
+  assumes holf: "f holomorphic_on S"
+      and S: "contractible S"
+      and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
+  obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
+proof -
+  have contf: "continuous_on S f"
+    by (simp add: holf holomorphic_on_imp_continuous_on)
+  obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
+    by (metis continuous_logarithm_on_contractible [OF contf S fnz])
+  then show thesis
+    using fnz g_imp_holomorphic_log holf that by blast
+qed
+
 lemma simply_connected_imp_holomorphic_log:
   assumes holf: "f holomorphic_on S"
       and S: "simply_connected S" "locally path_connected S"
       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
 proof -
   have contf: "continuous_on S f"
     by (simp add: holf holomorphic_on_imp_continuous_on)
   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
     by (metis continuous_logarithm_on_simply_connected [OF contf S fnz])
-  have "g field_differentiable at z within S" if "f field_differentiable at z within S" "z \<in> S" for z
-  proof -
-    obtain f' where f': "((\<lambda>y. (f y - f z) / (y - z)) \<longlongrightarrow> f') (at z within S)"
-      using \<open>f field_differentiable at z within S\<close> by (auto simp: field_differentiable_def has_field_derivative_iff)
-    then have ee: "((\<lambda>x. (exp(g x) - exp(g z)) / (x - z)) \<longlongrightarrow> f') (at z within S)"
-      by (simp add: feq \<open>z \<in> S\<close> Lim_transform_within [OF _ zero_less_one])
-    have "(((\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<circ> g) \<longlongrightarrow> exp (g z))
-          (at z within S)"
-    proof (rule tendsto_compose_at)
-      show "(g \<longlongrightarrow> g z) (at z within S)"
-        using contg continuous_on \<open>z \<in> S\<close> by blast
-      show "(\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<midarrow>g z\<rightarrow> exp (g z)"
-        apply (subst Lim_at_zero)
-        apply (simp add: DERIV_D cong: if_cong Lim_cong_within)
-        done
-      qed auto
-    then have dd: "((\<lambda>x. if g x = g z then exp(g z) else (exp(g x) - exp(g z)) / (g x - g z)) \<longlongrightarrow> exp(g z)) (at z within S)"
-      by (simp add: o_def)
-    have "continuous (at z within S) g"
-      using contg continuous_on_eq_continuous_within \<open>z \<in> S\<close> by blast
-    then have "(\<forall>\<^sub>F x in at z within S. dist (g x) (g z) < 2*pi)"
-      by (simp add: continuous_within tendsto_iff)
-    then have "\<forall>\<^sub>F x in at z within S. exp (g x) = exp (g z) \<longrightarrow> g x \<noteq> g z \<longrightarrow> x = z"
-      apply (rule eventually_mono)
-      apply (auto simp: exp_eq dist_norm norm_mult)
-      done
-    then have "((\<lambda>y. (g y - g z) / (y - z)) \<longlongrightarrow> f' / exp (g z)) (at z within S)"
-      by (auto intro!: Lim_transform_eventually [OF tendsto_divide [OF ee dd]])
-    then show ?thesis
-      by (auto simp: field_differentiable_def has_field_derivative_iff)
-  qed
-  then have "g holomorphic_on S"
-    using holf holomorphic_on_def by auto
-  then show ?thesis
-    using feq that by auto
+  then show thesis
+    using fnz g_imp_holomorphic_log holf that by blast
 qed
 
-
 lemma contractible_imp_holomorphic_sqrt:
   assumes holf: "f holomorphic_on S"
       and S: "contractible S"
       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = g z ^ 2"
 proof -
   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
     using contractible_imp_holomorphic_log [OF assms] by blast
   show ?thesis
   proof
     show "exp \<circ> (\<lambda>z. z / 2) \<circ> g holomorphic_on S"
       by (intro holomorphic_on_compose holg holomorphic_intros) auto
     show "\<And>z. z \<in> S \<Longrightarrow> f z = ((exp \<circ> (\<lambda>z. z / 2) \<circ> g) z)\<^sup>2"
-      apply (auto simp: feq)
-      by (metis eq_divide_eq_numeral1(1) exp_double mult.commute zero_neq_numeral)
+      by (simp add: feq flip: exp_double)
   qed
 qed
 
 lemma simply_connected_imp_holomorphic_sqrt:
   assumes holf: "f holomorphic_on S"
       and S: "simply_connected S" "locally path_connected S"
       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = g z ^ 2"
 proof -
   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
     using simply_connected_imp_holomorphic_log [OF assms] by blast
   show ?thesis
   proof
     show "exp \<circ> (\<lambda>z. z / 2) \<circ> g holomorphic_on S"
       by (intro holomorphic_on_compose holg holomorphic_intros) auto
     show "\<And>z. z \<in> S \<Longrightarrow> f z = ((exp \<circ> (\<lambda>z. z / 2) \<circ> g) z)\<^sup>2"
-      apply (auto simp: feq)
-      by (metis eq_divide_eq_numeral1(1) exp_double mult.commute zero_neq_numeral)
+      by (simp add: feq flip: exp_double)
   qed
 qed
 
 text\<open> Related theorems about holomorphic inverse cosines.\<close>
 
 lemma contractible_imp_holomorphic_arccos:
   assumes holf: "f holomorphic_on S" and S: "contractible S"
       and non1: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 1 \<and> f z \<noteq> -1"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = cos(g z)"
 proof -
   have hol1f: "(\<lambda>z. 1 - f z ^ 2) holomorphic_on S"
     by (intro holomorphic_intros holf)
   obtain g where holg: "g holomorphic_on S" and eq: "\<And>z. z \<in> S \<Longrightarrow> 1 - (f z)\<^sup>2 = (g z)\<^sup>2"
     using contractible_imp_holomorphic_sqrt [OF hol1f S]
     by (metis eq_iff_diff_eq_0 non1 power2_eq_1_iff)
   have holfg: "(\<lambda>z. f z + \<i>*g z) holomorphic_on S"
     by (intro holf holg holomorphic_intros)
   have "\<And>z. z \<in> S \<Longrightarrow> f z + \<i>*g z \<noteq> 0"
     by (metis Arccos_body_lemma eq add.commute add.inverse_unique complex_i_mult_minus power2_csqrt power2_eq_iff)
   then obtain h where holh: "h holomorphic_on S" and fgeq: "\<And>z. z \<in> S \<Longrightarrow> f z + \<i>*g z = exp (h z)"
     using contractible_imp_holomorphic_log [OF holfg S] by metis
   show ?thesis
   proof
     show "(\<lambda>z. -\<i>*h z) holomorphic_on S"
       by (intro holh holomorphic_intros)
     show "f z = cos (- \<i>*h z)" if "z \<in> S" for z
     proof -
       have "(f z + \<i>*g z)*(f z - \<i>*g z) = 1"
         using that eq by (auto simp: algebra_simps power2_eq_square)
       then have "f z - \<i>*g z = inverse (f z + \<i>*g z)"
         using inverse_unique by force
       also have "... = exp (- h z)"
         by (simp add: exp_minus fgeq that)
       finally have "f z = exp (- h z) + \<i>*g z"
         by (simp add: diff_eq_eq)
       then show ?thesis
         apply (simp add: cos_exp_eq)
         by (metis fgeq add.assoc mult_2_right that)
     qed
   qed
 qed
 
 
 lemma contractible_imp_holomorphic_arccos_bounded:
   assumes holf: "f holomorphic_on S" and S: "contractible S" and "a \<in> S"
       and non1: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 1 \<and> f z \<noteq> -1"
   obtains g where "g holomorphic_on S" "norm(g a) \<le> pi + norm(f a)" "\<And>z. z \<in> S \<Longrightarrow> f z = cos(g z)"
 proof -
   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = cos (g z)"
     using contractible_imp_holomorphic_arccos [OF holf S non1] by blast
   obtain b where "cos b = f a" "norm b \<le> pi + norm (f a)"
     using cos_Arccos norm_Arccos_bounded by blast
   then have "cos b = cos (g a)"
     by (simp add: \<open>a \<in> S\<close> feq)
   then consider n where "n \<in> \<int>" "b = g a + of_real(2*n*pi)" | n where "n \<in> \<int>" "b = -g a + of_real(2*n*pi)"
     by (auto simp: complex_cos_eq)
   then show ?thesis
   proof cases
     case 1
     show ?thesis
     proof
       show "(\<lambda>z. g z + of_real(2*n*pi)) holomorphic_on S"
         by (intro holomorphic_intros holg)
       show "cmod (g a + of_real(2*n*pi)) \<le> pi + cmod (f a)"
         using "1" \<open>cmod b \<le> pi + cmod (f a)\<close> by blast
       show "\<And>z. z \<in> S \<Longrightarrow> f z = cos (g z + complex_of_real (2*n*pi))"
         by (metis \<open>n \<in> \<int>\<close> complex_cos_eq feq)
     qed
   next
     case 2
     show ?thesis
     proof
       show "(\<lambda>z. -g z + of_real(2*n*pi)) holomorphic_on S"
         by (intro holomorphic_intros holg)
       show "cmod (-g a + of_real(2*n*pi)) \<le> pi + cmod (f a)"
         using "2" \<open>cmod b \<le> pi + cmod (f a)\<close> by blast
       show "\<And>z. z \<in> S \<Longrightarrow> f z = cos (-g z + complex_of_real (2*n*pi))"
         by (metis \<open>n \<in> \<int>\<close> complex_cos_eq feq)
     qed
   qed
 qed
 
 
 subsection\<open>The "Borsukian" property of sets\<close>
 
 text\<open>This doesn't have a standard name. Kuratowski uses ``contractible with respect to \<open>[S\<^sup>1]\<close>''
  while Whyburn uses ``property b''. It's closely related to unicoherence.\<close>
 
 definition\<^marker>\<open>tag important\<close> Borsukian where
     "Borsukian S \<equiv>
         \<forall>f. continuous_on S f \<and> f ` S \<subseteq> (- {0::complex})
             \<longrightarrow> (\<exists>a. homotopic_with_canon (\<lambda>h. True) S (- {0}) f (\<lambda>x. a))"
 
 lemma Borsukian_retraction_gen:
   assumes "Borsukian S" "continuous_on S h" "h ` S = T"
           "continuous_on T k"  "k ` T \<subseteq> S"  "\<And>y. y \<in> T \<Longrightarrow> h(k y) = y"
     shows "Borsukian T"
 proof -
   interpret R: Retracts S h T k
     using assms by (simp add: Retracts.intro)
   show ?thesis
     using assms
-    apply (simp add: Borsukian_def, clarify)
+    apply (clarsimp simp add: Borsukian_def)
     apply (rule R.cohomotopically_trivial_retraction_null_gen [OF TrueI TrueI refl, of "-{0}"], auto)
     done
 qed
 
 lemma retract_of_Borsukian: "\<lbrakk>Borsukian T; S retract_of T\<rbrakk> \<Longrightarrow> Borsukian S"
   apply (auto simp: retract_of_def retraction_def)
   apply (erule (1) Borsukian_retraction_gen)
   apply (meson retraction retraction_def)
     apply (auto)
     done
 
 lemma homeomorphic_Borsukian: "\<lbrakk>Borsukian S; S homeomorphic T\<rbrakk> \<Longrightarrow> Borsukian T"
   using Borsukian_retraction_gen order_refl
   by (fastforce simp add: homeomorphism_def homeomorphic_def)
 
 lemma homeomorphic_Borsukian_eq:
    "S homeomorphic T \<Longrightarrow> Borsukian S \<longleftrightarrow> Borsukian T"
   by (meson homeomorphic_Borsukian homeomorphic_sym)
 
 lemma Borsukian_translation:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian (image (\<lambda>x. a + x) S) \<longleftrightarrow> Borsukian S"
-  apply (rule homeomorphic_Borsukian_eq)
-    using homeomorphic_translation homeomorphic_sym by blast
+  using homeomorphic_Borsukian_eq homeomorphic_translation by blast
 
 lemma Borsukian_injective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "Borsukian(f ` S) \<longleftrightarrow> Borsukian S"
-  apply (rule homeomorphic_Borsukian_eq)
-  using assms homeomorphic_sym linear_homeomorphic_image by blast
+  using assms homeomorphic_Borsukian_eq linear_homeomorphic_image by blast
 
 lemma homotopy_eqv_Borsukianness:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
    assumes "S homotopy_eqv T"
      shows "(Borsukian S \<longleftrightarrow> Borsukian T)"
   by (meson Borsukian_def assms homotopy_eqv_cohomotopic_triviality_null)
 
 lemma Borsukian_alt:
   fixes S :: "'a::real_normed_vector set"
   shows
    "Borsukian S \<longleftrightarrow>
         (\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> -{0} \<and>
                continuous_on S g \<and> g ` S \<subseteq> -{0}
                \<longrightarrow> homotopic_with_canon (\<lambda>h. True) S (- {0::complex}) f g)"
   unfolding Borsukian_def homotopic_triviality
   by (simp add: path_connected_punctured_universe)
 
 lemma Borsukian_continuous_logarithm:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian S \<longleftrightarrow>
             (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> (- {0::complex})
                  \<longrightarrow> (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))))"
   by (simp add: Borsukian_def inessential_eq_continuous_logarithm)
 
 lemma Borsukian_continuous_logarithm_circle:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian S \<longleftrightarrow>
              (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
                   \<longrightarrow> (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (force simp: Borsukian_continuous_logarithm)
 next
   assume RHS [rule_format]: ?rhs
   show ?lhs
   proof (clarsimp simp: Borsukian_continuous_logarithm)
     fix f :: "'a \<Rightarrow> complex"
     assume contf: "continuous_on S f" and 0: "0 \<notin> f ` S"
     then have "continuous_on S (\<lambda>x. f x / complex_of_real (cmod (f x)))"
       by (intro continuous_intros) auto
     moreover have "(\<lambda>x. f x / complex_of_real (cmod (f x))) ` S \<subseteq> sphere 0 1"
       using 0 by (auto simp: norm_divide)
     ultimately obtain g where contg: "continuous_on S g"
                   and fg: "\<forall>x \<in> S. f x / complex_of_real (cmod (f x)) = exp(g x)"
       using RHS [of "\<lambda>x. f x / of_real(norm(f x))"] by auto
     show "\<exists>g. continuous_on S g \<and> (\<forall>x\<in>S. f x = exp (g x))"
     proof (intro exI ballI conjI)
       show "continuous_on S (\<lambda>x. (Ln \<circ> of_real \<circ> norm \<circ> f)x + g x)"
         by (intro continuous_intros contf contg conjI) (use "0" in auto)
       show "f x = exp ((Ln \<circ> complex_of_real \<circ> cmod \<circ> f) x + g x)" if "x \<in> S" for x
         using 0 that
-        apply (clarsimp simp: exp_add)
-        apply (subst exp_Ln, force)
-        by (metis eq_divide_eq exp_not_eq_zero fg mult.commute)
+        apply (simp add: exp_add)
+        by (metis div_by_0 exp_Ln exp_not_eq_zero fg mult.commute nonzero_eq_divide_eq)
     qed
   qed
 qed
 
 
 lemma Borsukian_continuous_logarithm_circle_real:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian S \<longleftrightarrow>
          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
               \<longrightarrow> (\<exists>g. continuous_on S (complex_of_real \<circ> g) \<and> (\<forall>x \<in> S. f x = exp(\<i> * of_real(g x)))))"
    (is "?lhs = ?rhs")
 proof
   assume LHS: ?lhs
   show ?rhs
   proof (clarify)
     fix f :: "'a \<Rightarrow> complex"
     assume "continuous_on S f" and f01: "f ` S \<subseteq> sphere 0 1"
     then obtain g where contg: "continuous_on S g" and "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
       using LHS by (auto simp: Borsukian_continuous_logarithm_circle)
     then have "\<forall>x\<in>S. f x = exp (\<i> * complex_of_real ((Im \<circ> g) x))"
-      using f01 apply (simp add: image_iff subset_iff)
-        by (metis cis_conv_exp exp_eq_polar mult.left_neutral norm_exp_eq_Re of_real_1)
+      using f01 exp_eq_polar norm_exp_eq_Re by auto
     then show "\<exists>g. continuous_on S (complex_of_real \<circ> g) \<and> (\<forall>x\<in>S. f x = exp (\<i> * complex_of_real (g x)))"
       by (rule_tac x="Im \<circ> g" in exI) (force intro: continuous_intros contg)
   qed
 next
   assume RHS [rule_format]: ?rhs
   show ?lhs
   proof (clarsimp simp: Borsukian_continuous_logarithm_circle)
     fix f :: "'a \<Rightarrow> complex"
     assume "continuous_on S f" and f01: "f ` S \<subseteq> sphere 0 1"
     then obtain g where contg: "continuous_on S (complex_of_real \<circ> g)" and "\<And>x. x \<in> S \<Longrightarrow> f x =  exp(\<i> * of_real(g x))"
       by (metis RHS)
     then show "\<exists>g. continuous_on S g \<and> (\<forall>x\<in>S. f x = exp (g x))"
       by (rule_tac x="\<lambda>x. \<i>* of_real(g x)" in exI) (auto simp: continuous_intros contg)
   qed
 qed
 
 lemma Borsukian_circle:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian S \<longleftrightarrow>
          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
               \<longrightarrow> (\<exists>a. homotopic_with_canon (\<lambda>h. True) S (sphere (0::complex) 1) f (\<lambda>x. a)))"
 by (simp add: inessential_eq_continuous_logarithm_circle Borsukian_continuous_logarithm_circle_real)
 
 lemma contractible_imp_Borsukian: "contractible S \<Longrightarrow> Borsukian S"
   by (meson Borsukian_def nullhomotopic_from_contractible)
 
 lemma simply_connected_imp_Borsukian:
   fixes S :: "'a::real_normed_vector set"
   shows  "\<lbrakk>simply_connected S; locally path_connected S\<rbrakk> \<Longrightarrow> Borsukian S"
-  apply (simp add: Borsukian_continuous_logarithm)
-  by (metis (no_types, lifting) continuous_logarithm_on_simply_connected image_iff)
+  by (metis (no_types, lifting) Borsukian_continuous_logarithm continuous_logarithm_on_simply_connected image_eqI subset_Compl_singleton)
 
 lemma starlike_imp_Borsukian:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> Borsukian S"
   by (simp add: contractible_imp_Borsukian starlike_imp_contractible)
 
 lemma Borsukian_empty: "Borsukian {}"
   by (auto simp: contractible_imp_Borsukian)
 
 lemma Borsukian_UNIV: "Borsukian (UNIV :: 'a::real_normed_vector set)"
   by (auto simp: contractible_imp_Borsukian)
 
 lemma convex_imp_Borsukian:
   fixes S :: "'a::real_normed_vector set"
   shows "convex S \<Longrightarrow> Borsukian S"
   by (meson Borsukian_def convex_imp_contractible nullhomotopic_from_contractible)
 
 proposition Borsukian_sphere:
   fixes a :: "'a::euclidean_space"
   shows "3 \<le> DIM('a) \<Longrightarrow> Borsukian (sphere a r)"
-  apply (rule simply_connected_imp_Borsukian)
-  using simply_connected_sphere apply blast
-  using ENR_imp_locally_path_connected ENR_sphere by blast
-
-proposition Borsukian_open_Un:
+  using ENR_sphere 
+  by (blast intro: simply_connected_imp_Borsukian ENR_imp_locally_path_connected simply_connected_sphere)
+
+lemma Borsukian_Un_lemma:
   fixes S :: "'a::real_normed_vector set"
-  assumes opeS: "openin (top_of_set (S \<union> T)) S"
-      and opeT: "openin (top_of_set (S \<union> T)) T"
-      and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
-    shows "Borsukian(S \<union> T)"
+  assumes BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
+    and *:  "\<And>f g::'a \<Rightarrow> complex. 
+                 \<lbrakk>continuous_on S f; continuous_on T g; \<And>x. x \<in> S \<and> x \<in> T \<Longrightarrow> f x = g x\<rbrakk>
+           \<Longrightarrow> continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then f x else g x)"
+  shows "Borsukian(S \<union> T)"
 proof (clarsimp simp add: Borsukian_continuous_logarithm)
   fix f :: "'a \<Rightarrow> complex"
   assume contf: "continuous_on (S \<union> T) f" and 0: "0 \<notin> f ` (S \<union> T)"
   then have contfS: "continuous_on S f" and contfT: "continuous_on T f"
     using continuous_on_subset by auto
   have "\<lbrakk>continuous_on S f; f ` S \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))"
     using BS by (auto simp: Borsukian_continuous_logarithm)
   then obtain g where contg: "continuous_on S g" and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using "0" contfS by blast
   have "\<lbrakk>continuous_on T f; f ` T \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on T g \<and> (\<forall>x \<in> T. f x = exp(g x))"
     using BT by (auto simp: Borsukian_continuous_logarithm)
   then obtain h where conth: "continuous_on T h" and fh: "\<And>x. x \<in> T \<Longrightarrow> f x = exp(h x)"
     using "0" contfT by blast
   show "\<exists>g. continuous_on (S \<union> T) g \<and> (\<forall>x\<in>S \<union> T. f x = exp (g x))"
   proof (cases "S \<inter> T = {}")
     case True
     show ?thesis
     proof (intro exI conjI)
       show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
-        apply (rule continuous_on_cases_local_open [OF opeS opeT contg conth])
-        using True by blast
+        using True * [OF contg conth]
+        by (meson disjoint_iff)
       show "\<forall>x\<in>S \<union> T. f x = exp (if x \<in> S then g x else h x)"
         using fg fh by auto
     qed
   next
     case False
     have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
     proof (rule continuous_discrete_range_constant [OF ST])
       show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
-        apply (intro continuous_intros)
-        apply (meson contg continuous_on_subset inf_le1)
-        by (meson conth continuous_on_subset inf_sup_ord(2))
+      proof (intro continuous_intros)
+        show "continuous_on (S \<inter> T) g"
+          by (meson contg continuous_on_subset inf_le1)
+        show "continuous_on (S \<inter> T) h"
+          by (meson conth continuous_on_subset inf_sup_ord(2))
+      qed
       show "\<exists>e>0. \<forall>y. y \<in> S \<inter> T \<and> g y - h y \<noteq> g x - h x \<longrightarrow> e \<le> cmod (g y - h y - (g x - h x))"
            if "x \<in> S \<inter> T" for x
       proof -
         have "g y - g x = h y - h x"
               if "y \<in> S" "y \<in> T" "cmod (g y - g x - (h y - h x)) < 2 * pi" for y
         proof (rule exp_complex_eqI)
           have "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> \<le> cmod (g y - g x - (h y - h x))"
             by (metis abs_Im_le_cmod minus_complex.simps(2))
           then show "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> < 2 * pi"
             using that by linarith
           have "exp (g x) = exp (h x)" "exp (g y) = exp (h y)"
             using fg fh that \<open>x \<in> S \<inter> T\<close> by fastforce+
           then show "exp (g y - g x) = exp (h y - h x)"
             by (simp add: exp_diff)
         qed
         then show ?thesis
           by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
       qed
     qed 
     then obtain a where a: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = a"
       by (auto simp: constant_on_def)
     with False have "exp a = 1"
       by (metis IntI disjoint_iff_not_equal divide_self_if exp_diff exp_not_eq_zero fg fh)
     with a show ?thesis
       apply (rule_tac x="\<lambda>x. if x \<in> S then g x else a + h x" in exI)
-      apply (intro continuous_on_cases_local_open opeS opeT contg conth continuous_intros conjI)
+      apply (intro * contg conth continuous_intros conjI)
        apply (auto simp: algebra_simps fg fh exp_add)
       done
   qed
 qed
 
-text\<open>The proof is a duplicate of that of \<open>Borsukian_open_Un\<close>.\<close>
+proposition Borsukian_open_Un:
+  fixes S :: "'a::real_normed_vector set"
+  assumes opeS: "openin (top_of_set (S \<union> T)) S"
+      and opeT: "openin (top_of_set (S \<union> T)) T"
+      and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
+    shows "Borsukian(S \<union> T)"
+  by (force intro: Borsukian_Un_lemma [OF BS BT ST] continuous_on_cases_local_open [OF opeS opeT])
+
 lemma Borsukian_closed_Un:
   fixes S :: "'a::real_normed_vector set"
   assumes cloS: "closedin (top_of_set (S \<union> T)) S"
       and cloT: "closedin (top_of_set (S \<union> T)) T"
       and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
     shows "Borsukian(S \<union> T)"
-proof (clarsimp simp add: Borsukian_continuous_logarithm)
-  fix f :: "'a \<Rightarrow> complex"
-  assume contf: "continuous_on (S \<union> T) f" and 0: "0 \<notin> f ` (S \<union> T)"
-  then have contfS: "continuous_on S f" and contfT: "continuous_on T f"
-    using continuous_on_subset by auto
-  have "\<lbrakk>continuous_on S f; f ` S \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))"
-    using BS by (auto simp: Borsukian_continuous_logarithm)
-  then obtain g where contg: "continuous_on S g" and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
-    using "0" contfS by blast
-  have "\<lbrakk>continuous_on T f; f ` T \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on T g \<and> (\<forall>x \<in> T. f x = exp(g x))"
-    using BT by (auto simp: Borsukian_continuous_logarithm)
-  then obtain h where conth: "continuous_on T h" and fh: "\<And>x. x \<in> T \<Longrightarrow> f x = exp(h x)"
-    using "0" contfT by blast
-  show "\<exists>g. continuous_on (S \<union> T) g \<and> (\<forall>x\<in>S \<union> T. f x = exp (g x))"
-  proof (cases "S \<inter> T = {}")
-    case True
-    show ?thesis
-    proof (intro exI conjI)
-      show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
-        apply (rule continuous_on_cases_local [OF cloS cloT contg conth])
-        using True by blast
-      show "\<forall>x\<in>S \<union> T. f x = exp (if x \<in> S then g x else h x)"
-        using fg fh by auto
-    qed
-  next
-    case False
-    have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
-    proof (rule continuous_discrete_range_constant [OF ST])
-      show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
-        apply (intro continuous_intros)
-        apply (meson contg continuous_on_subset inf_le1)
-        by (meson conth continuous_on_subset inf_sup_ord(2))
-      show "\<exists>e>0. \<forall>y. y \<in> S \<inter> T \<and> g y - h y \<noteq> g x - h x \<longrightarrow> e \<le> cmod (g y - h y - (g x - h x))"
-           if "x \<in> S \<inter> T" for x
-      proof -
-        have "g y - g x = h y - h x"
-              if "y \<in> S" "y \<in> T" "cmod (g y - g x - (h y - h x)) < 2 * pi" for y
-        proof (rule exp_complex_eqI)
-          have "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> \<le> cmod (g y - g x - (h y - h x))"
-            by (metis abs_Im_le_cmod minus_complex.simps(2))
-          then show "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> < 2 * pi"
-            using that by linarith
-          have "exp (g x) = exp (h x)" "exp (g y) = exp (h y)"
-            using fg fh that \<open>x \<in> S \<inter> T\<close> by fastforce+
-          then show "exp (g y - g x) = exp (h y - h x)"
-            by (simp add: exp_diff)
-        qed
-        then show ?thesis
-          by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
-      qed
-    qed
-    then obtain a where a: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = a"
-      by (auto simp: constant_on_def)
-    with False have "exp a = 1"
-      by (metis IntI disjoint_iff_not_equal divide_self_if exp_diff exp_not_eq_zero fg fh)
-    with a show ?thesis
-      apply (rule_tac x="\<lambda>x. if x \<in> S then g x else a + h x" in exI)
-      apply (intro continuous_on_cases_local cloS cloT contg conth continuous_intros conjI)
-       apply (auto simp: algebra_simps fg fh exp_add)
-      done
-  qed
-qed
+  by (force intro: Borsukian_Un_lemma [OF BS BT ST] continuous_on_cases_local [OF cloS cloT])
 
 lemma Borsukian_separation_compact:
   fixes S :: "complex set"
   assumes "compact S"
     shows "Borsukian S \<longleftrightarrow> connected(- S)"
   by (simp add: Borsuk_separation_theorem Borsukian_circle assms)
 
 lemma Borsukian_monotone_image_compact:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "Borsukian S" and contf: "continuous_on S f" and fim: "f ` S = T"
       and "compact S" and conn: "\<And>y. y \<in> T \<Longrightarrow> connected {x. x \<in> S \<and> f x = y}"
     shows "Borsukian T"
 proof (clarsimp simp add: Borsukian_continuous_logarithm)
   fix g :: "'b \<Rightarrow> complex"
   assume contg: "continuous_on T g" and 0: "0 \<notin> g ` T"
   have "continuous_on S (g \<circ> f)"
     using contf contg continuous_on_compose fim by blast
   moreover have "(g \<circ> f) ` S \<subseteq> -{0}"
     using fim 0 by auto
   ultimately obtain h where conth: "continuous_on S h" and gfh: "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> f) x = exp(h x)"
     using \<open>Borsukian S\<close> by (auto simp: Borsukian_continuous_logarithm)
   have "\<And>y. \<exists>x. y \<in> T \<longrightarrow> x \<in> S \<and> f x = y"
     using fim by auto
   then obtain f' where f': "\<And>y. y \<in> T \<longrightarrow> f' y \<in> S \<and> f (f' y) = y"
     by metis
   have *: "(\<lambda>x. h x - h(f' y)) constant_on {x. x \<in> S \<and> f x = y}" if "y \<in> T" for y
   proof (rule continuous_discrete_range_constant [OF conn [OF that], of "\<lambda>x. h x - h (f' y)"], simp_all add: algebra_simps)
     show "continuous_on {x \<in> S. f x = y} (\<lambda>x. h x - h (f' y))"
       by (intro continuous_intros continuous_on_subset [OF conth]) auto
     show "\<exists>e>0. \<forall>u. u \<in> S \<and> f u = y \<and> h u \<noteq> h x \<longrightarrow> e \<le> cmod (h u - h x)"
       if x: "x \<in> S \<and> f x = y" for x
     proof -
       have "h u = h x" if "u \<in> S" "f u = y" "cmod (h u - h x) < 2 * pi" for u
       proof (rule exp_complex_eqI)
         have "\<bar>Im (h u) - Im (h x)\<bar> \<le> cmod (h u - h x)"
           by (metis abs_Im_le_cmod minus_complex.simps(2))
         then show "\<bar>Im (h u) - Im (h x)\<bar> < 2 * pi"
           using that by linarith
         show "exp (h u) = exp (h x)"
           by (simp add: gfh [symmetric] x that)
       qed
       then show ?thesis
         by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
     qed
   qed 
-  have "h x = h (f' (f x))" if "x \<in> S" for x
-    using * [of "f x"] fim that unfolding constant_on_def by clarsimp (metis f' imageI right_minus_eq)
-  moreover have "\<And>x. x \<in> T \<Longrightarrow> \<exists>u. u \<in> S \<and> x = f u \<and> h (f' x) = h u"
-    using f' by fastforce
-  ultimately
-  have eq: "((\<lambda>x. (x, (h \<circ> f') x)) ` T) =
-            {p. \<exists>x. x \<in> S \<and> (x, p) \<in> (S \<times> UNIV) \<inter> ((\<lambda>z. snd z - ((f \<circ> fst) z, (h \<circ> fst) z)) -` {0})}"
-    using fim by (auto simp: image_iff)
   show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (h x))"
   proof (intro exI conjI)
     show "continuous_on T (h \<circ> f')"
     proof (rule continuous_from_closed_graph [of "h ` S"])
       show "compact (h ` S)"
         by (simp add: \<open>compact S\<close> compact_continuous_image conth)
       show "(h \<circ> f') ` T \<subseteq> h ` S"
         by (auto simp: f')
-      show "closed ((\<lambda>x. (x, (h \<circ> f') x)) ` T)"
-        apply (subst eq)
+      have "h x = h (f' (f x))" if "x \<in> S" for x
+        using * [of "f x"] fim that unfolding constant_on_def by clarsimp (metis f' imageI right_minus_eq)
+      moreover have "\<And>x. x \<in> T \<Longrightarrow> \<exists>u. u \<in> S \<and> x = f u \<and> h (f' x) = h u"
+        using f' by fastforce
+      ultimately
+      have eq: "((\<lambda>x. (x, (h \<circ> f') x)) ` T) =
+                {p. \<exists>x. x \<in> S \<and> (x, p) \<in> (S \<times> UNIV) \<inter> ((\<lambda>z. snd z - ((f \<circ> fst) z, (h \<circ> fst) z)) -` {0})}"
+        using fim by (auto simp: image_iff)
+      moreover have "closed \<dots>"
         apply (intro closed_compact_projection [OF \<open>compact S\<close>] continuous_closed_preimage
                      continuous_intros continuous_on_subset [OF contf] continuous_on_subset [OF conth])
-           apply (auto simp: \<open>compact S\<close> closed_Times compact_imp_closed)
-        done
+        by (auto simp: \<open>compact S\<close> closed_Times compact_imp_closed)
+      ultimately show "closed ((\<lambda>x. (x, (h \<circ> f') x)) ` T)"
+        by simp
     qed
   qed (use f' gfh in fastforce)
 qed
 
 
 lemma Borsukian_open_map_image_compact:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "Borsukian S" and contf: "continuous_on S f" and fim: "f ` S = T" and "compact S"
       and ope: "\<And>U. openin (top_of_set S) U
                      \<Longrightarrow> openin (top_of_set T) (f ` U)"
     shows "Borsukian T"
 proof (clarsimp simp add: Borsukian_continuous_logarithm_circle_real)
   fix g :: "'b \<Rightarrow> complex"
   assume contg: "continuous_on T g" and gim: "g ` T \<subseteq> sphere 0 1"
   have "continuous_on S (g \<circ> f)"
     using contf contg continuous_on_compose fim by blast
   moreover have "(g \<circ> f) ` S \<subseteq> sphere 0 1"
     using fim gim by auto
   ultimately obtain h where cont_cxh: "continuous_on S (complex_of_real \<circ> h)"
                        and gfh: "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> f) x = exp(\<i> * of_real(h x))"
     using \<open>Borsukian S\<close> Borsukian_continuous_logarithm_circle_real  by metis
   then have conth: "continuous_on S h"
     by simp
   have "\<exists>x. x \<in> S \<and> f x = y \<and> (\<forall>x' \<in> S. f x' = y \<longrightarrow> h x \<le> h x')" if "y \<in> T" for y
   proof -
     have 1: "compact (h ` {x \<in> S. f x = y})"
     proof (rule compact_continuous_image)
       show "continuous_on {x \<in> S. f x = y} h"
         by (rule continuous_on_subset [OF conth]) auto
       have "compact (S \<inter> f -` {y})"
         by (rule proper_map_from_compact [OF contf _ \<open>compact S\<close>, of T]) (simp_all add: fim that)
       then show "compact {x \<in> S. f x = y}" 
         by (auto simp: vimage_def Int_def)
     qed
     have 2: "h ` {x \<in> S. f x = y} \<noteq> {}"
       using fim that by auto
     have "\<exists>s \<in> h ` {x \<in> S. f x = y}. \<forall>t \<in> h ` {x \<in> S. f x = y}. s \<le> t"
       using compact_attains_inf [OF 1 2] by blast
     then show ?thesis by auto
   qed
   then obtain k where kTS: "\<And>y. y \<in> T \<Longrightarrow> k y \<in> S"
                   and fk:  "\<And>y. y \<in> T \<Longrightarrow> f (k y) = y "
                   and hle: "\<And>x' y. \<lbrakk>y \<in> T; x' \<in> S; f x' = y\<rbrakk> \<Longrightarrow> h (k y) \<le> h x'"
     by metis
   have "continuous_on T (h \<circ> k)"
   proof (clarsimp simp add: continuous_on_iff)
     fix y and e::real
     assume "y \<in> T" "0 < e"
     moreover have "uniformly_continuous_on S (complex_of_real \<circ> h)"
       using \<open>compact S\<close> cont_cxh compact_uniformly_continuous by blast
     ultimately obtain d where "0 < d"
                   and d: "\<And>x x'. \<lbrakk>x\<in>S; x'\<in>S; dist x' x < d\<rbrakk> \<Longrightarrow> dist (h x') (h x) < e"
       by (force simp: uniformly_continuous_on_def)
     obtain \<delta> where "0 < \<delta>" and \<delta>:
       "\<And>x'. \<lbrakk>x' \<in> T; dist y x' < \<delta>\<rbrakk>
                \<Longrightarrow> (\<forall>v \<in> {z \<in> S. f z = y}. \<exists>v'. v' \<in> {z \<in> S. f z = x'} \<and> dist v v' < d) \<and>
                    (\<forall>v' \<in> {z \<in> S. f z = x'}. \<exists>v. v \<in> {z \<in> S. f z = y} \<and> dist v' v < d)"
     proof (rule upper_lower_hemicontinuous_explicit [of T "\<lambda>y. {z \<in> S. f z = y}" S])
       show "\<And>U. openin (top_of_set S) U
                  \<Longrightarrow> openin (top_of_set T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
         using closed_map_iff_upper_hemicontinuous_preimage [OF fim [THEN equalityD1]]
         by (simp add: Abstract_Topology_2.continuous_imp_closed_map \<open>compact S\<close> contf fim)
       show "\<And>U. closedin (top_of_set S) U \<Longrightarrow>
                  closedin (top_of_set T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
         using  ope open_map_iff_lower_hemicontinuous_preimage [OF fim [THEN equalityD1]]
         by meson
       show "bounded {z \<in> S. f z = y}"
         by (metis (no_types, lifting) compact_imp_bounded [OF \<open>compact S\<close>] bounded_subset mem_Collect_eq subsetI)
     qed (use \<open>y \<in> T\<close> \<open>0 < d\<close> fk kTS in \<open>force+\<close>)
     have "dist (h (k y')) (h (k y)) < e" if "y' \<in> T" "dist y y' < \<delta>" for y'
     proof -
       have k1: "k y \<in> S" "f (k y) = y" and k2: "k y' \<in> S" "f (k y') = y'"
         by (auto simp: \<open>y \<in> T\<close> \<open>y' \<in> T\<close> kTS fk)
       have 1: "\<And>v. \<lbrakk>v \<in> S; f v = y\<rbrakk> \<Longrightarrow> \<exists>v'. v' \<in> {z \<in> S. f z = y'} \<and> dist v v' < d"
        and 2: "\<And>v'. \<lbrakk>v' \<in> S; f v' = y'\<rbrakk> \<Longrightarrow> \<exists>v. v \<in> {z \<in> S. f z = y} \<and> dist v' v < d"
         using \<delta> [OF that] by auto
       then obtain w' w where "w' \<in> S" "f w' = y'" "dist (k y) w' < d"
         and "w \<in> S" "f w = y" "dist (k y') w < d"
         using 1 [OF k1] 2 [OF k2] by auto
       then show ?thesis
         using d [of w "k y'"] d [of w' "k y"] k1 k2 \<open>y' \<in> T\<close>  \<open>y \<in> T\<close> hle
         by (fastforce simp: dist_norm abs_diff_less_iff algebra_simps)
     qed
     then show "\<exists>d>0. \<forall>x'\<in>T. dist x' y < d \<longrightarrow> dist (h (k x')) (h (k y)) < e"
       using  \<open>0 < \<delta>\<close> by (auto simp: dist_commute)
   qed
   then show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (\<i> * complex_of_real (h x)))"
     using fk gfh kTS by force
 qed
 
 
 text\<open>If two points are separated by a closed set, there's a minimal one.\<close>
 proposition closed_irreducible_separator:
   fixes a :: "'a::real_normed_vector"
   assumes "closed S" and ab: "\<not> connected_component (- S) a b"
   obtains T where "T \<subseteq> S" "closed T" "T \<noteq> {}" "\<not> connected_component (- T) a b"
                   "\<And>U. U \<subset> T \<Longrightarrow> connected_component (- U) a b"
 proof (cases "a \<in> S \<or> b \<in> S")
   case True
   then show ?thesis
   proof
     assume *: "a \<in> S"
     show ?thesis
     proof
       show "{a} \<subseteq> S"
         using * by blast
       show "\<not> connected_component (- {a}) a b"
         using connected_component_in by auto
       show "\<And>U. U \<subset> {a} \<Longrightarrow> connected_component (- U) a b"
         by (metis connected_component_UNIV UNIV_I compl_bot_eq connected_component_eq_eq less_le_not_le subset_singletonD)
     qed auto
   next
     assume *: "b \<in> S"
     show ?thesis
     proof
       show "{b} \<subseteq> S"
         using * by blast
       show "\<not> connected_component (- {b}) a b"
         using connected_component_in by auto
       show "\<And>U. U \<subset> {b} \<Longrightarrow> connected_component (- U) a b"
         by (metis connected_component_UNIV UNIV_I compl_bot_eq connected_component_eq_eq less_le_not_le subset_singletonD)
     qed auto
   qed
 next
   case False
   define A where "A \<equiv> connected_component_set (- S) a"
   define B where "B \<equiv> connected_component_set (- (closure A)) b"
   have "a \<in> A"
     using False A_def by auto
   have "b \<in> B"
     unfolding A_def B_def closure_Un_frontier
     using ab False \<open>closed S\<close> frontier_complement frontier_of_connected_component_subset frontier_subset_closed by force
   have "frontier B \<subseteq> frontier (connected_component_set (- closure A) b)"
     using B_def by blast
   also have frsub: "... \<subseteq> frontier A"
   proof -
     have "\<And>A. closure (- closure (- A)) \<subseteq> closure A"
       by (metis (no_types) closure_mono closure_subset compl_le_compl_iff double_compl)
     then show ?thesis
       by (metis (no_types) closure_closure double_compl frontier_closures frontier_of_connected_component_subset le_inf_iff subset_trans)
   qed
   finally have frBA: "frontier B \<subseteq> frontier A" .
   show ?thesis
   proof
     show "frontier B \<subseteq> S"
     proof -
       have "frontier S \<subseteq> S"
         by (simp add: \<open>closed S\<close> frontier_subset_closed)
       then show ?thesis
         using frsub frontier_complement frontier_of_connected_component_subset
         unfolding A_def B_def by blast
     qed
     show "closed (frontier B)"
       by simp
     show "\<not> connected_component (- frontier B) a b"
       unfolding connected_component_def
     proof clarify
       fix T
       assume "connected T" and TB: "T \<subseteq> - frontier B" and "a \<in> T" and "b \<in> T"
       have "a \<notin> B"
         by (metis A_def B_def ComplD \<open>a \<in> A\<close> assms(1) closed_open connected_component_subset in_closure_connected_component subsetD)
       have "T \<inter> B \<noteq> {}"
         using \<open>b \<in> B\<close> \<open>b \<in> T\<close> by blast
       moreover have "T - B \<noteq> {}"
         using \<open>a \<notin> B\<close> \<open>a \<in> T\<close> by blast
       ultimately show "False"
         using connected_Int_frontier [of T B] TB \<open>connected T\<close> by blast
     qed
     moreover have "connected_component (- frontier B) a b" if "frontier B = {}"
-      apply (simp add: that)
-      using connected_component_eq_UNIV by blast
+      using connected_component_eq_UNIV that by auto
     ultimately show "frontier B \<noteq> {}"
       by blast
     show "connected_component (- U) a b" if "U \<subset> frontier B" for U
     proof -
       obtain p where Usub: "U \<subseteq> frontier B" and p: "p \<in> frontier B" "p \<notin> U"
         using \<open>U \<subset> frontier B\<close> by blast
       show ?thesis
         unfolding connected_component_def
       proof (intro exI conjI)
         have "connected ((insert p A) \<union> (insert p B))"
         proof (rule connected_Un)
           show "connected (insert p A)"
             by (metis A_def IntD1 frBA \<open>p \<in> frontier B\<close> closure_insert closure_subset connected_connected_component connected_intermediate_closure frontier_closures insert_absorb subsetCE subset_insertI)
           show "connected (insert p B)"
             by (metis B_def IntD1 \<open>p \<in> frontier B\<close> closure_insert closure_subset connected_connected_component connected_intermediate_closure frontier_closures insert_absorb subset_insertI)
         qed blast
         then show "connected (insert p (B \<union> A))"
           by (simp add: sup.commute)
         have "A \<subseteq> - U"
           using A_def Usub \<open>frontier B \<subseteq> S\<close> connected_component_subset by fastforce
         moreover have "B \<subseteq> - U"
           using B_def Usub connected_component_subset frBA frontier_closures by fastforce
         ultimately show "insert p (B \<union> A) \<subseteq> - U"
           using p by auto
       qed (auto simp: \<open>a \<in> A\<close> \<open>b \<in> B\<close>)
     qed
   qed
 qed
 
 lemma frontier_minimal_separating_closed_pointwise:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "closed S" "a \<notin> S" and nconn: "\<not> connected_component (- S) a b"
       and conn: "\<And>T. \<lbrakk>closed T; T \<subset> S\<rbrakk> \<Longrightarrow> connected_component (- T) a b"
     shows "frontier(connected_component_set (- S) a) = S" (is "?F = S")
 proof -
   have "?F \<subseteq> S"
     by (simp add: S componentsI frontier_of_components_closed_complement)
   moreover have False if "?F \<subset> S"
   proof -
     have "connected_component (- ?F) a b"
       by (simp add: conn that)
     then obtain T where "connected T" "T \<subseteq> -?F" "a \<in> T" "b \<in> T"
       by (auto simp: connected_component_def)
     moreover have "T \<inter> ?F \<noteq> {}"
     proof (rule connected_Int_frontier [OF \<open>connected T\<close>])
       show "T \<inter> connected_component_set (- S) a \<noteq> {}"
         using \<open>a \<notin> S\<close> \<open>a \<in> T\<close> by fastforce
       show "T - connected_component_set (- S) a \<noteq> {}"
         using \<open>b \<in> T\<close> nconn by blast
     qed
     ultimately show ?thesis
       by blast
   qed
   ultimately show ?thesis
     by blast
 qed
 
 
 subsection\<open>Unicoherence (closed)\<close>
 
 definition\<^marker>\<open>tag important\<close> unicoherent where
   "unicoherent U \<equiv>
   \<forall>S T. connected S \<and> connected T \<and> S \<union> T = U \<and>
         closedin (top_of_set U) S \<and> closedin (top_of_set U) T
         \<longrightarrow> connected (S \<inter> T)"
 
 lemma unicoherentI [intro?]:
   assumes "\<And>S T. \<lbrakk>connected S; connected T; U = S \<union> T; closedin (top_of_set U) S; closedin (top_of_set U) T\<rbrakk>
           \<Longrightarrow> connected (S \<inter> T)"
   shows "unicoherent U"
   using assms unfolding unicoherent_def by blast
 
 lemma unicoherentD:
   assumes "unicoherent U" "connected S" "connected T" "U = S \<union> T" "closedin (top_of_set U) S" "closedin (top_of_set U) T"
   shows "connected (S \<inter> T)"
   using assms unfolding unicoherent_def by blast
 
 proposition homeomorphic_unicoherent:
   assumes ST: "S homeomorphic T" and S: "unicoherent S"
   shows "unicoherent T"
 proof -
   obtain f g where gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x" and fim: "T = f ` S" and gfim: "g ` f ` S = S"
     and contf: "continuous_on S f" and contg: "continuous_on (f ` S) g"
     using ST by (auto simp: homeomorphic_def homeomorphism_def)
   show ?thesis
   proof
     fix U V
     assume "connected U" "connected V" and T: "T = U \<union> V"
       and cloU: "closedin (top_of_set T) U"
       and cloV: "closedin (top_of_set T) V"
     have "f ` (g ` U \<inter> g ` V) \<subseteq> U" "f ` (g ` U \<inter> g ` V) \<subseteq> V"
       using gf fim T by auto (metis UnCI image_iff)+
     moreover have "U \<inter> V \<subseteq> f ` (g ` U \<inter> g ` V)"
       using gf fim by (force simp: image_iff T)
     ultimately have "U \<inter> V = f ` (g ` U \<inter> g ` V)" by blast
     moreover have "connected (f ` (g ` U \<inter> g ` V))"
     proof (rule connected_continuous_image)
       show "continuous_on (g ` U \<inter> g ` V) f"
-        apply (rule continuous_on_subset [OF contf])
-        using T fim gfim by blast
+        using T fim gfim by (metis Un_upper1 contf continuous_on_subset image_mono inf_le1) 
       show "connected (g ` U \<inter> g ` V)"
       proof (intro conjI unicoherentD [OF S])
         show "connected (g ` U)" "connected (g ` V)"
           using \<open>connected U\<close> cloU \<open>connected V\<close> cloV
           by (metis Topological_Spaces.connected_continuous_image closedin_imp_subset contg continuous_on_subset fim)+
         show "S = g ` U \<union> g ` V"
           using T fim gfim by auto
         have hom: "homeomorphism T S g f"
           by (simp add: contf contg fim gf gfim homeomorphism_def)
         have "closedin (top_of_set T) U" "closedin (top_of_set T) V"
           by (simp_all add: cloU cloV)
         then show "closedin (top_of_set S) (g ` U)"
                   "closedin (top_of_set S) (g ` V)"
           by (blast intro: homeomorphism_imp_closed_map [OF hom])+
       qed
     qed
     ultimately show "connected (U \<inter> V)" by metis
   qed
 qed
 
 
 lemma homeomorphic_unicoherent_eq:
    "S homeomorphic T \<Longrightarrow> (unicoherent S \<longleftrightarrow> unicoherent T)"
   by (meson homeomorphic_sym homeomorphic_unicoherent)
 
 lemma unicoherent_translation:
   fixes S :: "'a::real_normed_vector set"
   shows
    "unicoherent (image (\<lambda>x. a + x) S) \<longleftrightarrow> unicoherent S"
   using homeomorphic_translation homeomorphic_unicoherent_eq by blast
 
 lemma unicoherent_injective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
   shows "(unicoherent(f ` S) \<longleftrightarrow> unicoherent S)"
   using assms homeomorphic_unicoherent_eq linear_homeomorphic_image by blast
 
 
 lemma Borsukian_imp_unicoherent:
   fixes U :: "'a::euclidean_space set"
   assumes "Borsukian U"  shows "unicoherent U"
   unfolding unicoherent_def
 proof clarify
   fix S T
   assume "connected S" "connected T" "U = S \<union> T"
      and cloS: "closedin (top_of_set (S \<union> T)) S"
      and cloT: "closedin (top_of_set (S \<union> T)) T"
   show "connected (S \<inter> T)"
     unfolding connected_closedin_eq
   proof clarify
     fix V W
     assume "closedin (top_of_set (S \<inter> T)) V"
        and "closedin (top_of_set (S \<inter> T)) W"
        and VW: "V \<union> W = S \<inter> T" "V \<inter> W = {}" and "V \<noteq> {}" "W \<noteq> {}"
     then have cloV: "closedin (top_of_set U) V" and cloW: "closedin (top_of_set U) W"
       using \<open>U = S \<union> T\<close> cloS cloT closedin_trans by blast+
     obtain q where contq: "continuous_on U q"
          and q01: "\<And>x. x \<in> U \<Longrightarrow> q x \<in> {0..1::real}"
          and qV: "\<And>x. x \<in> V \<Longrightarrow> q x = 0" and qW: "\<And>x. x \<in> W \<Longrightarrow> q x = 1"
       by (rule Urysohn_local [OF cloV cloW \<open>V \<inter> W = {}\<close>, of 0 1])
          (fastforce simp: closed_segment_eq_real_ivl)
     let ?h = "\<lambda>x. if x \<in> S then exp(pi * \<i> * q x) else 1 / exp(pi * \<i> * q x)"
     have eqST: "exp(pi * \<i> * q x) = 1 / exp(pi * \<i> * q x)" if "x \<in> S \<inter> T" for x
     proof -
       have "x \<in> V \<union> W"
         using that \<open>V \<union> W = S \<inter> T\<close> by blast
       with qV qW show ?thesis by force
     qed
     obtain g where contg: "continuous_on U g"
       and circle: "g ` U \<subseteq> sphere 0 1"
       and S: "\<And>x. x \<in> S \<Longrightarrow> g x = exp(pi * \<i> * q x)"
       and T: "\<And>x. x \<in> T \<Longrightarrow> g x = 1 / exp(pi * \<i> * q x)"
     proof
       show "continuous_on U ?h"
         unfolding \<open>U = S \<union> T\<close>
       proof (rule continuous_on_cases_local [OF cloS cloT])
         show "continuous_on S (\<lambda>x. exp (pi * \<i> * q x))"
-          apply (intro continuous_intros)
-          using \<open>U = S \<union> T\<close> continuous_on_subset contq by blast
+        proof (intro continuous_intros)
+          show "continuous_on S q"
+            using \<open>U = S \<union> T\<close> continuous_on_subset contq by blast
+        qed
         show "continuous_on T (\<lambda>x. 1 / exp (pi * \<i> * q x))"
-          apply (intro continuous_intros)
-          using \<open>U = S \<union> T\<close> continuous_on_subset contq by auto
+        proof (intro continuous_intros)
+          show "continuous_on T q"
+            using \<open>U = S \<union> T\<close> continuous_on_subset contq by auto
+        qed auto
       qed (use eqST in auto)
     qed (use eqST in \<open>auto simp: norm_divide\<close>)
     then obtain h where conth: "continuous_on U h" and heq: "\<And>x. x \<in> U \<Longrightarrow> g x = exp (h x)"
       by (metis Borsukian_continuous_logarithm_circle assms)
     obtain v w where "v \<in> V" "w \<in> W"
       using \<open>V \<noteq> {}\<close> \<open>W \<noteq> {}\<close> by blast
     then have vw: "v \<in> S \<inter> T" "w \<in> S \<inter> T"
       using VW by auto
     have iff: "2 * pi \<le> cmod (2 * of_int m * of_real pi * \<i> - 2 * of_int n * of_real pi * \<i>)
           \<longleftrightarrow> 1 \<le> abs (m - n)" for m n
     proof -
       have "2 * pi \<le> cmod (2 * of_int m * of_real pi * \<i> - 2 * of_int n * of_real pi * \<i>)
             \<longleftrightarrow> 2 * pi \<le> cmod ((2 * pi * \<i>) * (of_int m - of_int n))"
         by (simp add: algebra_simps)
       also have "... \<longleftrightarrow> 2 * pi \<le> 2 * pi * cmod (of_int m - of_int n)"
         by (simp add: norm_mult)
       also have "... \<longleftrightarrow> 1 \<le> abs (m - n)"
         by simp (metis norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
       finally show ?thesis .
     qed
     have *: "\<exists>n::int. h x - (pi * \<i> * q x) = (of_int(2*n) * pi) * \<i>" if "x \<in> S" for x
       using that S \<open>U = S \<union> T\<close> heq exp_eq [symmetric] by (simp add: algebra_simps)
     moreover have "(\<lambda>x. h x - (pi * \<i> * q x)) constant_on S"
     proof (rule continuous_discrete_range_constant [OF \<open>connected S\<close>])
       have "continuous_on S h" "continuous_on S q"
         using \<open>U = S \<union> T\<close> continuous_on_subset conth contq by blast+
       then show "continuous_on S (\<lambda>x. h x - (pi * \<i> * q x))"
         by (intro continuous_intros)
       have "2*pi \<le> cmod (h y - (pi * \<i> * q y) - (h x - (pi * \<i> * q x)))"
         if "x \<in> S" "y \<in> S" and ne: "h y - (pi * \<i> * q y) \<noteq> h x - (pi * \<i> * q x)" for x y
         using * [OF \<open>x \<in> S\<close>] * [OF \<open>y \<in> S\<close>] ne by (auto simp: iff)
       then show "\<And>x. x \<in> S \<Longrightarrow>
          \<exists>e>0. \<forall>y. y \<in> S \<and> h y - (pi * \<i> * q y) \<noteq> h x - (pi * \<i> * q x) \<longrightarrow>
                    e \<le> cmod (h y - (pi * \<i> * q y) - (h x - (pi * \<i> * q x)))"
         by (rule_tac x="2*pi" in exI) auto
     qed
     ultimately
     obtain m where m: "\<And>x. x \<in> S \<Longrightarrow> h x - (pi * \<i> * q x) = (of_int(2*m) * pi) * \<i>"
       using vw by (force simp: constant_on_def)
     have *: "\<exists>n::int. h x = - (pi * \<i> * q x) + (of_int(2*n) * pi) * \<i>" if "x \<in> T" for x
       unfolding exp_eq [symmetric]
       using that T \<open>U = S \<union> T\<close> by (simp add: exp_minus field_simps  heq [symmetric])
     moreover have "(\<lambda>x. h x + (pi * \<i> * q x)) constant_on T"
     proof (rule continuous_discrete_range_constant [OF \<open>connected T\<close>])
       have "continuous_on T h" "continuous_on T q"
         using \<open>U = S \<union> T\<close> continuous_on_subset conth contq by blast+
       then show "continuous_on T (\<lambda>x. h x + (pi * \<i> * q x))"
         by (intro continuous_intros)
       have "2*pi \<le> cmod (h y + (pi * \<i> * q y) - (h x + (pi * \<i> * q x)))"
         if "x \<in> T" "y \<in> T" and ne: "h y + (pi * \<i> * q y) \<noteq> h x + (pi * \<i> * q x)" for x y
         using * [OF \<open>x \<in> T\<close>] * [OF \<open>y \<in> T\<close>] ne by (auto simp: iff)
       then show "\<And>x. x \<in> T \<Longrightarrow>
          \<exists>e>0. \<forall>y. y \<in> T \<and> h y + (pi * \<i> * q y) \<noteq> h x + (pi * \<i> * q x) \<longrightarrow>
                    e \<le> cmod (h y + (pi * \<i> * q y) - (h x + (pi * \<i> * q x)))"
         by (rule_tac x="2*pi" in exI) auto
     qed
     ultimately
     obtain n where n: "\<And>x. x \<in> T \<Longrightarrow> h x + (pi * \<i> * q x) = (of_int(2*n) * pi) * \<i>"
       using vw by (force simp: constant_on_def)
     show "False"
       using m [of v] m [of w] n [of v] n [of w] vw
       by (auto simp: algebra_simps \<open>v \<in> V\<close> \<open>w \<in> W\<close> qV qW)
   qed
 qed
 
 
 corollary contractible_imp_unicoherent:
   fixes U :: "'a::euclidean_space set"
   assumes "contractible U"  shows "unicoherent U"
   by (simp add: Borsukian_imp_unicoherent assms contractible_imp_Borsukian)
 
 corollary convex_imp_unicoherent:
   fixes U :: "'a::euclidean_space set"
   assumes "convex U"  shows "unicoherent U"
   by (simp add: Borsukian_imp_unicoherent assms convex_imp_Borsukian)
 
 text\<open>If the type class constraint can be relaxed, I don't know how!\<close>
 corollary unicoherent_UNIV: "unicoherent (UNIV :: 'a :: euclidean_space set)"
   by (simp add: convex_imp_unicoherent)
 
 
 lemma unicoherent_monotone_image_compact:
   fixes T :: "'b :: t2_space set"
   assumes S: "unicoherent S" "compact S" and contf: "continuous_on S f" and fim: "f ` S = T"
   and conn: "\<And>y. y \<in> T \<Longrightarrow> connected (S \<inter> f -` {y})"
   shows "unicoherent T"
 proof
   fix U V
   assume UV: "connected U" "connected V" "T = U \<union> V"
      and cloU: "closedin (top_of_set T) U"
      and cloV: "closedin (top_of_set T) V"
   moreover have "compact T"
     using \<open>compact S\<close> compact_continuous_image contf fim by blast
   ultimately have "closed U" "closed V"
     by (auto simp: closedin_closed_eq compact_imp_closed)
   let ?SUV = "(S \<inter> f -` U) \<inter> (S \<inter> f -` V)"
   have UV_eq: "f ` ?SUV = U \<inter> V"
     using \<open>T = U \<union> V\<close> fim by force+
   have "connected (f ` ?SUV)"
   proof (rule connected_continuous_image)
     show "continuous_on ?SUV f"
       by (meson contf continuous_on_subset inf_le1)
     show "connected ?SUV"
     proof (rule unicoherentD [OF \<open>unicoherent S\<close>, of "S \<inter> f -` U" "S \<inter> f -` V"])
       have "\<And>C. closedin (top_of_set S) C \<Longrightarrow> closedin (top_of_set T) (f ` C)"
         by (metis \<open>compact S\<close> closed_subset closedin_compact closedin_imp_subset compact_continuous_image compact_imp_closed contf continuous_on_subset fim image_mono)
       then show "connected (S \<inter> f -` U)" "connected (S \<inter> f -` V)"
         using UV by (auto simp: conn intro: connected_closed_monotone_preimage [OF contf fim])
       show "S = (S \<inter> f -` U) \<union> (S \<inter> f -` V)"
         using UV fim by blast
       show "closedin (top_of_set S) (S \<inter> f -` U)"
             "closedin (top_of_set S) (S \<inter> f -` V)"
         by (auto simp: continuous_on_imp_closedin cloU cloV contf fim)
     qed
   qed
   with UV_eq show "connected (U \<inter> V)"
     by simp
 qed
 
 
 subsection\<open>Several common variants of unicoherence\<close>
 
 lemma connected_frontier_simple:
   fixes S :: "'a :: euclidean_space set"
   assumes "connected S" "connected(- S)" shows "connected(frontier S)"
   unfolding frontier_closures
-  apply (rule unicoherentD [OF unicoherent_UNIV])
-      apply (simp_all add: assms connected_imp_connected_closure)
-  by (simp add: closure_def)
+  by (rule unicoherentD [OF unicoherent_UNIV]; simp add: assms connected_imp_connected_closure flip: closure_Un)
 
 lemma connected_frontier_component_complement:
   fixes S :: "'a :: euclidean_space set"
-  assumes "connected S" and C: "C \<in> components(- S)" shows "connected(frontier C)"
-  apply (rule connected_frontier_simple)
-  using C in_components_connected apply blast
-  by (metis assms component_complement_connected)
+  assumes "connected S" "C \<in> components(- S)" shows "connected(frontier C)"
+  by (meson assms component_complement_connected connected_frontier_simple in_components_connected)
 
 lemma connected_frontier_disjoint:
   fixes S :: "'a :: euclidean_space set"
   assumes "connected S" "connected T" "disjnt S T" and ST: "frontier S \<subseteq> frontier T"
   shows "connected(frontier S)"
 proof (cases "S = UNIV")
   case True then show ?thesis
     by simp
 next
   case False
   then have "-S \<noteq> {}"
     by blast
   then obtain C where C: "C \<in> components(- S)" and "T \<subseteq> C"
     by (metis ComplI disjnt_iff subsetI exists_component_superset \<open>disjnt S T\<close> \<open>connected T\<close>)
   moreover have "frontier S = frontier C"
   proof -
     have "frontier C \<subseteq> frontier S"
       using C frontier_complement frontier_of_components_subset by blast
     moreover have "x \<in> frontier C" if "x \<in> frontier S" for x
     proof -
       have "x \<in> closure C"
         using that unfolding frontier_def
         by (metis (no_types) Diff_eq ST \<open>T \<subseteq> C\<close> closure_mono contra_subsetD frontier_def le_inf_iff that)
       moreover have "x \<notin> interior C"
         using that unfolding frontier_def
         by (metis C Compl_eq_Diff_UNIV Diff_iff subsetD in_components_subset interior_diff interior_mono)
       ultimately show ?thesis
         by (auto simp: frontier_def)
     qed
     ultimately show ?thesis
       by blast
   qed
   ultimately show ?thesis
     using \<open>connected S\<close> connected_frontier_component_complement by auto
 qed
 
 
 subsection\<open>Some separation results\<close>
 
 lemma separation_by_component_closed_pointwise:
   fixes S :: "'a :: euclidean_space set"
   assumes "closed S" "\<not> connected_component (- S) a b"
   obtains C where "C \<in> components S" "\<not> connected_component(- C) a b"
 proof (cases "a \<in> S \<or> b \<in> S")
   case True
   then show ?thesis
     using connected_component_in componentsI that by fastforce
 next
   case False
   obtain T where "T \<subseteq> S" "closed T" "T \<noteq> {}"
              and nab: "\<not> connected_component (- T) a b"
              and conn: "\<And>U. U \<subset> T \<Longrightarrow> connected_component (- U) a b"
     using closed_irreducible_separator [OF assms] by metis
   moreover have "connected T"
   proof -
     have ab: "frontier(connected_component_set (- T) a) = T" "frontier(connected_component_set (- T) b) = T"
       using frontier_minimal_separating_closed_pointwise
       by (metis False \<open>T \<subseteq> S\<close> \<open>closed T\<close> connected_component_sym conn connected_component_eq_empty connected_component_intermediate_subset empty_subsetI nab)+
     have "connected (frontier (connected_component_set (- T) a))"
     proof (rule connected_frontier_disjoint)
       show "disjnt (connected_component_set (- T) a) (connected_component_set (- T) b)"
         unfolding disjnt_iff
         by (metis connected_component_eq connected_component_eq_empty connected_component_idemp mem_Collect_eq nab)
       show "frontier (connected_component_set (- T) a) \<subseteq> frontier (connected_component_set (- T) b)"
         by (simp add: ab)
     qed auto
     with ab \<open>closed T\<close> show ?thesis
       by simp
   qed
   ultimately obtain C where "C \<in> components S" "T \<subseteq> C"
     using exists_component_superset [of T S] by blast
   then show ?thesis
     by (meson Compl_anti_mono connected_component_of_subset nab that)
 qed
 
 
 lemma separation_by_component_closed:
   fixes S :: "'a :: euclidean_space set"
   assumes "closed S" "\<not> connected(- S)"
   obtains C where "C \<in> components S" "\<not> connected(- C)"
 proof -
   obtain x y where "closed S" "x \<notin> S" "y \<notin> S" and "\<not> connected_component (- S) x y"
     using assms by (auto simp: connected_iff_connected_component)
   then obtain C where "C \<in> components S" "\<not> connected_component(- C) x y"
     using separation_by_component_closed_pointwise by metis
   then show "thesis"
-    apply (clarify elim!: componentsE)
-    by (metis Compl_iff \<open>C \<in> components S\<close> \<open>x \<notin> S\<close> \<open>y \<notin> S\<close> connected_component_eq connected_component_eq_eq connected_iff_connected_component that)
+    by (metis Compl_iff \<open>x \<notin> S\<close> \<open>y \<notin> S\<close> connected_component_eq_self in_components_subset mem_Collect_eq subsetD that)
 qed
 
 lemma separation_by_Un_closed_pointwise:
   fixes S :: "'a :: euclidean_space set"
   assumes ST: "closed S" "closed T" "S \<inter> T = {}"
       and conS: "connected_component (- S) a b" and conT: "connected_component (- T) a b"
     shows "connected_component (- (S \<union> T)) a b"
 proof (rule ccontr)
   have "a \<notin> S" "b \<notin> S" "a \<notin> T" "b \<notin> T"
     using conS conT connected_component_in by auto
   assume "\<not> connected_component (- (S \<union> T)) a b"
   then obtain C where "C \<in> components (S \<union> T)" and C: "\<not> connected_component(- C) a b"
     using separation_by_component_closed_pointwise assms by blast
   then have "C \<subseteq> S \<or> C \<subseteq> T"
   proof -
     have "connected C" "C \<subseteq> S \<union> T"
       using \<open>C \<in> components (S \<union> T)\<close> in_components_subset by (blast elim: componentsE)+
     moreover then have "C \<inter> T = {} \<or> C \<inter> S = {}"
       by (metis Int_empty_right ST inf.commute connected_closed)
     ultimately show ?thesis
       by blast
   qed
   then show False
     by (meson Compl_anti_mono C conS conT connected_component_of_subset)
 qed
 
 lemma separation_by_Un_closed:
   fixes S :: "'a :: euclidean_space set"
   assumes ST: "closed S" "closed T" "S \<inter> T = {}" and conS: "connected(- S)" and conT: "connected(- T)"
   shows "connected(- (S \<union> T))"
   using assms separation_by_Un_closed_pointwise
   by (fastforce simp add: connected_iff_connected_component)
 
 lemma open_unicoherent_UNIV:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S" "open T" "connected S" "connected T" "S \<union> T = UNIV"
   shows "connected(S \<inter> T)"
 proof -
   have "connected(- (-S \<union> -T))"
     by (metis closed_Compl compl_sup compl_top_eq double_compl separation_by_Un_closed assms)
   then show ?thesis
     by simp
 qed
 
 lemma separation_by_component_open_aux:
   fixes S :: "'a :: euclidean_space set"
   assumes ST: "closed S" "closed T" "S \<inter> T = {}"
       and "S \<noteq> {}" "T \<noteq> {}"
   obtains C where "C \<in> components(-(S \<union> T))" "C \<noteq> {}" "frontier C \<inter> S \<noteq> {}" "frontier C \<inter> T \<noteq> {}"
 proof (rule ccontr)
   let ?S = "S \<union> \<Union>{C \<in> components(- (S \<union> T)). frontier C \<subseteq> S}"
   let ?T = "T \<union> \<Union>{C \<in> components(- (S \<union> T)). frontier C \<subseteq> T}"
   assume "\<not> thesis"
   with that have *: "frontier C \<inter> S = {} \<or> frontier C \<inter> T = {}"
             if C: "C \<in> components (- (S \<union> T))" "C \<noteq> {}" for C
     using C by blast
   have "\<exists>A B::'a set. closed A \<and> closed B \<and> UNIV \<subseteq> A \<union> B \<and> A \<inter> B = {} \<and> A \<noteq> {} \<and> B \<noteq> {}"
   proof (intro exI conjI)
     have "frontier (\<Union>{C \<in> components (- S \<inter> - T). frontier C \<subseteq> S}) \<subseteq> S"
-      apply (rule subset_trans [OF frontier_Union_subset_closure])
+      using subset_trans [OF frontier_Union_subset_closure]
       by (metis (no_types, lifting) SUP_least \<open>closed S\<close> closure_minimal mem_Collect_eq)
     then have "frontier ?S \<subseteq> S"
       by (simp add: frontier_subset_eq assms  subset_trans [OF frontier_Un_subset])
     then show "closed ?S"
       using frontier_subset_eq by fastforce
     have "frontier (\<Union>{C \<in> components (- S \<inter> - T). frontier C \<subseteq> T}) \<subseteq> T"
-      apply (rule subset_trans [OF frontier_Union_subset_closure])
+      using subset_trans [OF frontier_Union_subset_closure]
       by (metis (no_types, lifting) SUP_least \<open>closed T\<close> closure_minimal mem_Collect_eq)
     then have "frontier ?T \<subseteq> T"
       by (simp add: frontier_subset_eq assms  subset_trans [OF frontier_Un_subset])
     then show "closed ?T"
       using frontier_subset_eq by fastforce
     have "UNIV \<subseteq> (S \<union> T) \<union> \<Union>(components(- (S \<union> T)))"
       using Union_components by blast
     also have "...  \<subseteq> ?S \<union> ?T"
     proof -
       have "C \<in> components (-(S \<union> T)) \<and> frontier C \<subseteq> S \<or>
             C \<in> components (-(S \<union> T)) \<and> frontier C \<subseteq> T"
         if "C \<in> components (- (S \<union> T))" "C \<noteq> {}" for C
         using * [OF that] that
         by clarify (metis (no_types, lifting) UnE \<open>closed S\<close> \<open>closed T\<close> closed_Un disjoint_iff_not_equal frontier_of_components_closed_complement subsetCE)
       then show ?thesis
         by blast
     qed
     finally show "UNIV \<subseteq> ?S \<union> ?T" .
     have "\<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> S} \<union>
           \<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> T} \<subseteq> - (S \<union> T)"
       using in_components_subset by fastforce
     moreover have "\<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> S} \<inter>
                    \<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> T} = {}"
     proof -
       have "C \<inter> C' = {}" if "C \<in> components (- (S \<union> T))" "frontier C \<subseteq> S"
                             "C' \<in> components (- (S \<union> T))" "frontier C' \<subseteq> T" for C C'
       proof -
         have NUN: "- S \<inter> - T \<noteq> UNIV"
           using \<open>T \<noteq> {}\<close> by blast
         have "C \<noteq> C'"
         proof
           assume "C = C'"
           with that have "frontier C' \<subseteq> S \<inter> T"
             by simp
           also have "... = {}"
             using \<open>S \<inter> T = {}\<close> by blast
           finally have "C' = {} \<or> C' = UNIV"
             using frontier_eq_empty by auto
           then show False
             using \<open>C = C'\<close> NUN that by (force simp: dest: in_components_nonempty in_components_subset)
         qed
         with that show ?thesis
           by (simp add: components_nonoverlap [of _ "-(S \<union> T)"])
       qed
       then show ?thesis
         by blast
     qed
     ultimately show "?S \<inter> ?T = {}"
       using ST by blast
     show "?S \<noteq> {}" "?T \<noteq> {}"
       using \<open>S \<noteq> {}\<close> \<open>T \<noteq> {}\<close> by blast+
   qed
     then show False
       by (metis Compl_disjoint connected_UNIV compl_bot_eq compl_unique connected_closedD inf_sup_absorb sup_compl_top_left1 top.extremum_uniqueI)
 qed
 
 
 proposition separation_by_component_open:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S" and non: "\<not> connected(- S)"
   obtains C where "C \<in> components S" "\<not> connected(- C)"
 proof -
   obtain T U
     where "closed T" "closed U" and TU: "T \<union> U = - S" "T \<inter> U = {}" "T \<noteq> {}" "U \<noteq> {}"
     using assms by (auto simp: connected_closed_set closed_def)
   then obtain C where C: "C \<in> components(-(T \<union> U))" "C \<noteq> {}"
           and "frontier C \<inter> T \<noteq> {}" "frontier C \<inter> U \<noteq> {}"
     using separation_by_component_open_aux [OF \<open>closed T\<close> \<open>closed U\<close> \<open>T \<inter> U = {}\<close>] by force
   show "thesis"
   proof
     show "C \<in> components S"
       using C(1) TU(1) by auto
     show "\<not> connected (- C)"
     proof
       assume "connected (- C)"
       then have "connected (frontier C)"
         using connected_frontier_simple [of C] \<open>C \<in> components S\<close> in_components_connected by blast
       then show False
         unfolding connected_closed
         by (metis C(1) TU(2) \<open>closed T\<close> \<open>closed U\<close> \<open>frontier C \<inter> T \<noteq> {}\<close> \<open>frontier C \<inter> U \<noteq> {}\<close> closed_Un frontier_of_components_closed_complement inf_bot_right inf_commute)
     qed
   qed
 qed
 
 lemma separation_by_Un_open:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S" "open T" "S \<inter> T = {}" and cS: "connected(-S)" and cT: "connected(-T)"
     shows "connected(- (S \<union> T))"
   using assms unicoherent_UNIV unfolding unicoherent_def by force
 
 
 lemma nonseparation_by_component_eq:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S \<or> closed S"
   shows "((\<forall>C \<in> components S. connected(-C)) \<longleftrightarrow> connected(- S))" (is "?lhs = ?rhs")
 proof
   assume ?lhs with assms show ?rhs
     by (meson separation_by_component_closed separation_by_component_open)
 next
   assume ?rhs with assms show ?lhs
     using component_complement_connected by force
 qed
 
 
 text\<open>Another interesting equivalent of an inessential mapping into C-{0}\<close>
 proposition inessential_eq_extensible:
   fixes f :: "'a::euclidean_space \<Rightarrow> complex"
   assumes "closed S"
   shows "(\<exists>a. homotopic_with_canon (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)) \<longleftrightarrow>
          (\<exists>g. continuous_on UNIV g \<and> (\<forall>x \<in> S. g x = f x) \<and> (\<forall>x. g x \<noteq> 0))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain a where a: "homotopic_with_canon (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)" ..
   show ?rhs
   proof (cases "S = {}")
     case True
     with a show ?thesis by force
   next
     case False
     have anr: "ANR (-{0::complex})"
       by (simp add: ANR_delete open_Compl open_imp_ANR)
     obtain g where contg: "continuous_on UNIV g" and gim: "g ` UNIV \<subseteq> -{0}"
                    and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     proof (rule Borsuk_homotopy_extension_homotopic [OF _ _ continuous_on_const _ homotopic_with_symD [OF a]])
       show "closedin (top_of_set UNIV) S"
         using assms by auto
       show "range (\<lambda>t. a) \<subseteq> - {0}"
         using a homotopic_with_imp_subset2 False by blast
     qed (use anr that in \<open>force+\<close>)
     then show ?thesis
       by force
   qed
 next
   assume ?rhs
   then obtain g where contg: "continuous_on UNIV g"
           and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x" and non0: "\<And>x. g x \<noteq> 0"
     by metis
   obtain h k::"'a\<Rightarrow>'a" where hk: "homeomorphism (ball 0 1) UNIV h k"
     using homeomorphic_ball01_UNIV homeomorphic_def by blast
   then have "continuous_on (ball 0 1) (g \<circ> h)"
     by (meson contg continuous_on_compose continuous_on_subset homeomorphism_cont1 top_greatest)
   then obtain j where contj: "continuous_on (ball 0 1) j"
                   and j: "\<And>z. z \<in> ball 0 1 \<Longrightarrow> exp(j z) = (g \<circ> h) z"
     by (metis (mono_tags, hide_lams) continuous_logarithm_on_ball comp_apply non0)
   have [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (k x) = x"
     using hk homeomorphism_apply2 by blast
   have "\<exists>\<zeta>. continuous_on S \<zeta>\<and> (\<forall>x\<in>S. f x = exp (\<zeta> x))"
   proof (intro exI conjI ballI)
     show "continuous_on S (j \<circ> k)"
     proof (rule continuous_on_compose)
       show "continuous_on S k"
         by (meson continuous_on_subset hk homeomorphism_cont2 top_greatest)
       show "continuous_on (k ` S) j"
-        apply (rule continuous_on_subset [OF contj])
-        using homeomorphism_image2 [OF hk] continuous_on_subset [OF contj] by blast
+        by (auto intro: continuous_on_subset [OF contj] simp flip: homeomorphism_image2 [OF hk])
     qed
     show "f x = exp ((j \<circ> k) x)" if "x \<in> S" for x
     proof -
       have "f x = (g \<circ> h) (k x)"
         by (simp add: gf that)
       also have "... = exp (j (k x))"
         by (metis rangeI homeomorphism_image2 [OF hk] j)
       finally show ?thesis by simp
     qed
   qed
   then show ?lhs
     by (simp add: inessential_eq_continuous_logarithm)
 qed
 
 lemma inessential_on_clopen_Union:
   fixes \<F> :: "'a::euclidean_space set set"
   assumes T: "path_connected T"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (top_of_set (\<Union>\<F>)) S"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set (\<Union>\<F>)) S"
       and hom: "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. a)"
   obtains a where "homotopic_with_canon (\<lambda>x. True) (\<Union>\<F>) T f (\<lambda>x. a)"
 proof (cases "\<Union>\<F> = {}")
   case True
   with that show ?thesis
     by force
 next
   case False
   then obtain C where "C \<in> \<F>" "C \<noteq> {}"
     by blast
   then obtain a where clo: "closedin (top_of_set (\<Union>\<F>)) C"
     and ope: "openin (top_of_set (\<Union>\<F>)) C"
     and "homotopic_with_canon (\<lambda>x. True) C T f (\<lambda>x. a)"
     using assms by blast
   with \<open>C \<noteq> {}\<close> have "f ` C \<subseteq> T" "a \<in> T"
     using homotopic_with_imp_subset1 homotopic_with_imp_subset2 by blast+
   have "homotopic_with_canon (\<lambda>x. True) (\<Union>\<F>) T f (\<lambda>x. a)"
   proof (rule homotopic_on_clopen_Union)
     show "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (top_of_set (\<Union>\<F>)) S"
          "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set (\<Union>\<F>)) S"
       by (simp_all add: assms)
     show "homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. a)" if "S \<in> \<F>" for S
     proof (cases "S = {}")
       case True
       then show ?thesis
         by auto
     next
       case False
       then obtain b where "b \<in> S"
         by blast
       obtain c where c: "homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)"
         using \<open>S \<in> \<F>\<close> hom by blast
       then have "c \<in> T"
         using \<open>b \<in> S\<close> homotopic_with_imp_subset2 by blast
       then have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. c)"
         using T \<open>a \<in> T\<close> homotopic_constant_maps path_connected_component
         by (simp add: homotopic_constant_maps path_connected_component)
       then show ?thesis
         using c homotopic_with_symD homotopic_with_trans by blast
     qed
   qed
   then show ?thesis ..
 qed
 
 proposition Janiszewski_dual:
   fixes S :: "complex set"
   assumes
    "compact S" "compact T" "connected S" "connected T" "connected(- (S \<union> T))"
  shows "connected(S \<inter> T)"
 proof -
   have ST: "compact (S \<union> T)"
     by (simp add: assms compact_Un)
   with Borsukian_imp_unicoherent [of "S \<union> T"] ST assms
   show ?thesis
     by (auto simp: closed_subset compact_imp_closed Borsukian_separation_compact unicoherent_def)
 qed
 
 end
diff --git a/src/HOL/Deriv.thy b/src/HOL/Deriv.thy
--- a/src/HOL/Deriv.thy
+++ b/src/HOL/Deriv.thy
@@ -1,2370 +1,2370 @@
 (*  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)"
-  unfolding has_derivative_iff_norm LIM_offset_zero_iff[of _ _ x] by simp
+  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)
 
 lemmas has_derivative_within_subset = has_derivative_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_within_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_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_within_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,3035 @@
 (*  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
 
 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 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: "f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L"
+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 "a \<in> S" "open S"
+  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)"
-  by (metis LIM_offset_zero_iff assms tendsto_within_open)
+  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