diff --git a/src/HOL/Analysis/Abstract_Metric_Spaces.thy b/src/HOL/Analysis/Abstract_Metric_Spaces.thy
--- a/src/HOL/Analysis/Abstract_Metric_Spaces.thy
+++ b/src/HOL/Analysis/Abstract_Metric_Spaces.thy
@@ -1,3348 +1,4565 @@
 section \<open>Abstract Metric Spaces\<close>
 
 theory Abstract_Metric_Spaces
   imports Elementary_Metric_Spaces Abstract_Limits Abstract_Topological_Spaces
 begin
 
 (*Avoid a clash with the existing metric_space locale (from the type class)*)
 locale Metric_space =
   fixes M :: "'a set" and d :: "'a \<Rightarrow> 'a \<Rightarrow> real"
   assumes nonneg [simp]: "\<And>x y. 0 \<le> d x y"
   assumes commute: "\<And>x y. d x y = d y x"
   assumes zero [simp]: "\<And>x y. \<lbrakk>x \<in> M; y \<in> M\<rbrakk> \<Longrightarrow> d x y = 0 \<longleftrightarrow> x=y"
   assumes triangle: "\<And>x y z. \<lbrakk>x \<in> M; y \<in> M; z \<in> M\<rbrakk> \<Longrightarrow> d x z \<le> d x y + d y z"
 
 text \<open>Link with the type class version\<close>
 interpretation Met_TC: Metric_space UNIV dist
   by (simp add: dist_commute dist_triangle Metric_space.intro)
 
 context Metric_space
 begin
 
 lemma subspace: "M' \<subseteq> M \<Longrightarrow> Metric_space M' d"
   by (simp add: commute in_mono Metric_space.intro triangle)
 
 lemma abs_mdist [simp] : "\<bar>d x y\<bar> = d x y"
   by simp
 
 lemma mdist_pos_less: "\<lbrakk>x \<noteq> y; x \<in> M; y \<in> M\<rbrakk> \<Longrightarrow> 0 < d x y"
   by (metis less_eq_real_def nonneg zero)
 
 lemma mdist_zero [simp]: "x \<in> M \<Longrightarrow> d x x = 0"
   by simp
 
 lemma mdist_pos_eq [simp]: "\<lbrakk>x \<in> M; y \<in> M\<rbrakk> \<Longrightarrow> 0 < d x y \<longleftrightarrow> x \<noteq> y"
   using mdist_pos_less zero by fastforce
 
 lemma triangle': "\<lbrakk>x \<in> M; y \<in> M; z \<in> M\<rbrakk> \<Longrightarrow> d x z \<le> d x y + d z y"
   by (simp add: commute triangle)
 
 lemma triangle'': "\<lbrakk>x \<in> M; y \<in> M; z \<in> M\<rbrakk> \<Longrightarrow> d x z \<le> d y x + d y z"
   by (simp add: commute triangle)
 
 lemma mdist_reverse_triangle: "\<lbrakk>x \<in> M; y \<in> M; z \<in> M\<rbrakk> \<Longrightarrow> \<bar>d x y - d y z\<bar> \<le> d x z"
   by (smt (verit) commute triangle)
 
 text\<open> Open and closed balls                                                                \<close>
 
 definition mball where "mball x r \<equiv> {y. x \<in> M \<and> y \<in> M \<and> d x y < r}"
 definition mcball where "mcball x r \<equiv> {y. x \<in> M \<and> y \<in> M \<and> d x y \<le> r}"
 
 lemma in_mball [simp]: "y \<in> mball x r \<longleftrightarrow> x \<in> M \<and> y \<in> M \<and> d x y < r"
   by (simp add: local.Metric_space_axioms Metric_space.mball_def)
 
 lemma centre_in_mball_iff [iff]: "x \<in> mball x r \<longleftrightarrow> x \<in> M \<and> 0 < r"
   using in_mball mdist_zero by force
 
 lemma mball_subset_mspace: "mball x r \<subseteq> M"
   by auto
 
 lemma mball_eq_empty: "mball x r = {} \<longleftrightarrow> (x \<notin> M) \<or> r \<le> 0"
   by (smt (verit, best) Collect_empty_eq centre_in_mball_iff mball_def nonneg)
 
 lemma mball_subset: "\<lbrakk>d x y + a \<le> b; y \<in> M\<rbrakk> \<Longrightarrow> mball x a \<subseteq> mball y b"
   by (smt (verit) commute in_mball subsetI triangle)
 
 lemma disjoint_mball: "r + r' \<le> d x x' \<Longrightarrow> disjnt (mball x r) (mball x' r')"
   by (smt (verit) commute disjnt_iff in_mball triangle)
 
 lemma mball_subset_concentric: "r \<le> s \<Longrightarrow> mball x r \<subseteq> mball x s"
   by auto
 
 lemma in_mcball [simp]: "y \<in> mcball x r \<longleftrightarrow> x \<in> M \<and> y \<in> M \<and> d x y \<le> r"
   by (simp add: local.Metric_space_axioms Metric_space.mcball_def)
 
 lemma centre_in_mcball_iff [iff]: "x \<in> mcball x r \<longleftrightarrow> x \<in> M \<and> 0 \<le> r"
   using mdist_zero by force
 
 lemma mcball_eq_empty: "mcball x r = {} \<longleftrightarrow> (x \<notin> M) \<or> r < 0"
   by (smt (verit, best) Collect_empty_eq centre_in_mcball_iff empty_iff mcball_def nonneg)
 
 lemma mcball_subset_mspace: "mcball x r \<subseteq> M"
   by auto
 
 lemma mball_subset_mcball: "mball x r \<subseteq> mcball x r"
   by auto
 
 lemma mcball_subset: "\<lbrakk>d x y + a \<le> b; y \<in> M\<rbrakk> \<Longrightarrow> mcball x a \<subseteq> mcball y b"
   by (smt (verit) in_mcball mdist_reverse_triangle subsetI)
 
 lemma mcball_subset_concentric: "r \<le> s \<Longrightarrow> mcball x r \<subseteq> mcball x s"
   by force
 
 lemma mcball_subset_mball: "\<lbrakk>d x y + a < b; y \<in> M\<rbrakk> \<Longrightarrow> mcball x a \<subseteq> mball y b"
   by (smt (verit) commute in_mball in_mcball subsetI triangle)
 
 lemma mcball_subset_mball_concentric: "a < b \<Longrightarrow> mcball x a \<subseteq> mball x b"
   by force
 
 end
 
 
 
 subsection \<open>Metric topology                                                           \<close>
 
 context Metric_space
 begin
 
 definition mopen where 
   "mopen U \<equiv> U \<subseteq> M \<and> (\<forall>x. x \<in> U \<longrightarrow> (\<exists>r>0. mball x r \<subseteq> U))"
 
 definition mtopology :: "'a topology" where 
   "mtopology \<equiv> topology mopen"
 
 lemma is_topology_metric_topology [iff]: "istopology mopen"
 proof -
   have "\<And>S T. \<lbrakk>mopen S; mopen T\<rbrakk> \<Longrightarrow> mopen (S \<inter> T)"
     by (smt (verit, del_insts) Int_iff in_mball mopen_def subset_eq)
   moreover have "\<And>\<K>. (\<forall>K\<in>\<K>. mopen K) \<longrightarrow> mopen (\<Union>\<K>)"
     using mopen_def by fastforce
   ultimately show ?thesis
     by (simp add: istopology_def)
 qed
 
 lemma openin_mtopology: "openin mtopology U \<longleftrightarrow> U \<subseteq> M \<and> (\<forall>x. x \<in> U \<longrightarrow> (\<exists>r>0. mball x r \<subseteq> U))"
   by (simp add: mopen_def mtopology_def)
 
 lemma topspace_mtopology [simp]: "topspace mtopology = M"
   by (meson order.refl mball_subset_mspace openin_mtopology openin_subset openin_topspace subset_antisym zero_less_one)
 
 lemma subtopology_mspace [simp]: "subtopology mtopology M = mtopology"
   by (metis subtopology_topspace topspace_mtopology)
 
 lemma open_in_mspace [iff]: "openin mtopology M"
   by (metis openin_topspace topspace_mtopology)
 
 lemma closedin_mspace [iff]: "closedin mtopology M"
   by (metis closedin_topspace topspace_mtopology)
 
 lemma openin_mball [iff]: "openin mtopology (mball x r)"
 proof -
   have "\<And>y. \<lbrakk>x \<in> M; d x y < r\<rbrakk> \<Longrightarrow> \<exists>s>0. mball y s \<subseteq> mball x r"
     by (metis add_diff_cancel_left' add_diff_eq commute less_add_same_cancel1 mball_subset order_refl)
   then show ?thesis
     by (auto simp: openin_mtopology)
 qed
 
 lemma mcball_eq_cball [simp]: "Met_TC.mcball = cball"
   by force
 
 lemma mball_eq_ball [simp]: "Met_TC.mball = ball"
   by force
 
 lemma mopen_eq_open [simp]: "Met_TC.mopen = open"
   by (force simp: open_contains_ball Met_TC.mopen_def)
 
 lemma limitin_iff_tendsto [iff]: "limitin Met_TC.mtopology \<sigma> x F = tendsto \<sigma> x F"
   by (simp add: Met_TC.mtopology_def)
 
 lemma mtopology_is_euclideanreal [simp]: "Met_TC.mtopology = euclideanreal"
   by (simp add: Met_TC.mtopology_def)
 
 (*
 lemma metric_injective_image:
    "\<And>f m s.
         f ` s \<subseteq> M \<and>
         (\<forall>x y. x \<in> s \<and> y \<in> s \<and> f x = f y \<Longrightarrow> x = y)
         \<Longrightarrow> (mspace(metric(s,\<lambda>(x,y). d (f x) (f y))) = s) \<and>
             (d(metric(s,\<lambda>(x,y). d (f x) (f y))) =
              \<lambda>(x,y). d (f x) (f y))"
 oops
   REWRITE_TAC[\<subseteq>; FORALL_IN_IMAGE; INJECTIVE_ON_ALT] THEN
   REPEAT GEN_TAC THEN STRIP_TAC THEN
   REWRITE_TAC[mspace; d; GSYM PAIR_EQ] THEN
   REWRITE_TAC[GSYM(CONJUNCT2 metric_tybij); is_metric_space] THEN
   REWRITE_TAC[GSYM mspace; GSYM d] THEN
   ASM_SIMP_TAC[MDIST_POS_LE; MDIST_TRIANGLE; MDIST_0] THEN
   ASM_MESON_TAC[MDIST_SYM]);;
 *)
 
 lemma mtopology_base:
    "mtopology = topology(arbitrary union_of (\<lambda>U. \<exists>x \<in> M. \<exists>r>0. U = mball x r))"
 proof -
   have "\<And>S. \<exists>x r. x \<in> M \<and> 0 < r \<and> S = mball x r \<Longrightarrow> openin mtopology S"
     using openin_mball by blast
   moreover have "\<And>U x. \<lbrakk>openin mtopology U; x \<in> U\<rbrakk> \<Longrightarrow> \<exists>B. (\<exists>x r. x \<in> M \<and> 0 < r \<and> B = mball x r) \<and> x \<in> B \<and> B \<subseteq> U"
     by (metis centre_in_mball_iff in_mono openin_mtopology)
   ultimately show ?thesis
     by (smt (verit) topology_base_unique)
 qed
 
 lemma closedin_metric:
    "closedin mtopology C \<longleftrightarrow> C \<subseteq> M \<and> (\<forall>x. x \<in> M - C \<longrightarrow> (\<exists>r>0. disjnt C (mball x r)))"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding closedin_def openin_mtopology
     by (metis Diff_disjoint disjnt_def disjnt_subset2 topspace_mtopology)
   show "?rhs \<Longrightarrow> ?lhs"
     unfolding closedin_def openin_mtopology disjnt_def
     by (metis Diff_subset Diff_triv Int_Diff Int_commute inf.absorb_iff2 mball_subset_mspace topspace_mtopology)
 qed
 
 lemma closedin_mcball [iff]: "closedin mtopology (mcball x r)"
 proof -
   have "\<exists>ra>0. disjnt (mcball x r) (mball y ra)" if "x \<notin> M" for y
     by (metis disjnt_empty1 gt_ex mcball_eq_empty that)
   moreover have "disjnt (mcball x r) (mball y (d x y - r))" if "y \<in> M" "d x y > r" for y
     using that disjnt_iff in_mball in_mcball mdist_reverse_triangle by force
   ultimately show ?thesis
     using closedin_metric mcball_subset_mspace by fastforce
 qed
 
 lemma mball_iff_mcball: "(\<exists>r>0. mball x r \<subseteq> U) = (\<exists>r>0. mcball x r \<subseteq> U)"
   by (meson dense mball_subset_mcball mcball_subset_mball_concentric order_trans)
 
 lemma openin_mtopology_mcball:
   "openin mtopology U \<longleftrightarrow> U \<subseteq> M \<and> (\<forall>x. x \<in> U \<longrightarrow> (\<exists>r. 0 < r \<and> mcball x r \<subseteq> U))"
   using mball_iff_mcball openin_mtopology by presburger
 
 lemma metric_derived_set_of:
   "mtopology derived_set_of S = {x \<in> M. \<forall>r>0. \<exists>y\<in>S. y\<noteq>x \<and> y \<in> mball x r}" (is "?lhs=?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     unfolding openin_mtopology derived_set_of_def 
     by clarsimp (metis in_mball openin_mball openin_mtopology zero)
   show "?rhs \<subseteq> ?lhs"
     unfolding openin_mtopology derived_set_of_def 
     by clarify (metis subsetD topspace_mtopology)
 qed
 
 lemma metric_closure_of:
    "mtopology closure_of S = {x \<in> M. \<forall>r>0. \<exists>y \<in> S. y \<in> mball x r}"
 proof -
   have "\<And>x r. \<lbrakk>0 < r; x \<in> mtopology closure_of S\<rbrakk> \<Longrightarrow> \<exists>y\<in>S. y \<in> mball x r"
     by (metis centre_in_mball_iff in_closure_of openin_mball topspace_mtopology)
   moreover have "\<And>x T. \<lbrakk>x \<in> M; \<forall>r>0. \<exists>y\<in>S. y \<in> mball x r\<rbrakk> \<Longrightarrow> x \<in> mtopology closure_of S"
     by (smt (verit) in_closure_of in_mball openin_mtopology subsetD topspace_mtopology)
   ultimately show ?thesis
     by (auto simp: in_closure_of)
 qed
 
 lemma metric_closure_of_alt:
   "mtopology closure_of S = {x \<in> M. \<forall>r>0. \<exists>y \<in> S. y \<in> mcball x r}"
 proof -
   have "\<And>x r. \<lbrakk>\<forall>r>0. x \<in> M \<and> (\<exists>y\<in>S. y \<in> mcball x r); 0 < r\<rbrakk> \<Longrightarrow> \<exists>y\<in>S. y \<in> M \<and> d x y < r"
     by (meson dense in_mcball le_less_trans)
   then show ?thesis
     by (fastforce simp: metric_closure_of in_closure_of)
 qed
 
 lemma metric_interior_of:
    "mtopology interior_of S = {x \<in> M. \<exists>\<epsilon>>0. mball x \<epsilon> \<subseteq> S}" (is "?lhs=?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     using interior_of_maximal_eq openin_mtopology by fastforce
   show "?rhs \<subseteq> ?lhs"
     using interior_of_def openin_mball by fastforce
 qed
 
 lemma metric_interior_of_alt:
    "mtopology interior_of S = {x \<in> M. \<exists>\<epsilon>>0. mcball x \<epsilon> \<subseteq> S}"
   by (fastforce simp: mball_iff_mcball metric_interior_of)
 
 lemma in_interior_of_mball:
    "x \<in> mtopology interior_of S \<longleftrightarrow> x \<in> M \<and> (\<exists>\<epsilon>>0. mball x \<epsilon> \<subseteq> S)"
   using metric_interior_of by force
 
 lemma in_interior_of_mcball:
    "x \<in> mtopology interior_of S \<longleftrightarrow> x \<in> M \<and> (\<exists>\<epsilon>>0. mcball x \<epsilon> \<subseteq> S)"
   using metric_interior_of_alt by force
 
 lemma Hausdorff_space_mtopology: "Hausdorff_space mtopology"
   unfolding Hausdorff_space_def
 proof clarify
   fix x y
   assume x: "x \<in> topspace mtopology" and y: "y \<in> topspace mtopology" and "x \<noteq> y"
   then have gt0: "d x y / 2 > 0"
     by auto
   have "disjnt (mball x (d x y / 2)) (mball y (d x y / 2))"
     by (simp add: disjoint_mball)
   then show "\<exists>U V. openin mtopology U \<and> openin mtopology V \<and> x \<in> U \<and> y \<in> V \<and> disjnt U V"
     by (metis centre_in_mball_iff gt0 openin_mball topspace_mtopology x y)
 qed
 
 
 
 subsection\<open>Bounded sets\<close>
 
 definition mbounded where "mbounded S \<longleftrightarrow> (\<exists>x B. S \<subseteq> mcball x B)"
 
 lemma mbounded_pos: "mbounded S \<longleftrightarrow> (\<exists>x B. 0 < B \<and> S \<subseteq> mcball x B)"
 proof -
   have "\<exists>x' r'. 0 < r' \<and> S \<subseteq> mcball x' r'" if "S \<subseteq> mcball x r" for x r
     by (metis gt_ex less_eq_real_def linorder_not_le mcball_subset_concentric order_trans that)
   then show ?thesis
     by (auto simp: mbounded_def)
 qed
 
 lemma mbounded_alt:
   "mbounded S \<longleftrightarrow> S \<subseteq> M \<and> (\<exists>B. \<forall>x \<in> S. \<forall>y \<in> S. d x y \<le> B)"
 proof -
   have "\<And>x B. S \<subseteq> mcball x B \<Longrightarrow> \<forall>x\<in>S. \<forall>y\<in>S. d x y \<le> 2 * B"
     by (smt (verit, best) commute in_mcball subsetD triangle)
   then show ?thesis
     apply (auto simp: mbounded_def subset_iff)
      apply blast+
     done
 qed
 
 
 lemma mbounded_alt_pos:
   "mbounded S \<longleftrightarrow> S \<subseteq> M \<and> (\<exists>B>0. \<forall>x \<in> S. \<forall>y \<in> S. d x y \<le> B)"
   by (smt (verit, del_insts) gt_ex mbounded_alt)
 
 lemma mbounded_subset: "\<lbrakk>mbounded T; S \<subseteq> T\<rbrakk> \<Longrightarrow> mbounded S"
   by (meson mbounded_def order_trans)
 
 lemma mbounded_subset_mspace: "mbounded S \<Longrightarrow> S \<subseteq> M"
   by (simp add: mbounded_alt)
 
 lemma mbounded:
    "mbounded S \<longleftrightarrow> S = {} \<or> (\<forall>x \<in> S. x \<in> M) \<and> (\<exists>y B. y \<in> M \<and> (\<forall>x \<in> S. d y x \<le> B))"
   by (meson all_not_in_conv in_mcball mbounded_def subset_iff)
 
 lemma mbounded_empty [iff]: "mbounded {}"
   by (simp add: mbounded)
 
 lemma mbounded_mcball: "mbounded (mcball x r)"
   using mbounded_def by auto
 
 lemma mbounded_mball [iff]: "mbounded (mball x r)"
   by (meson mball_subset_mcball mbounded_def)
 
 lemma mbounded_insert: "mbounded (insert a S) \<longleftrightarrow> a \<in> M \<and> mbounded S"
 proof -
   have "\<And>y B. \<lbrakk>y \<in> M; \<forall>x\<in>S. d y x \<le> B\<rbrakk>
            \<Longrightarrow> \<exists>y. y \<in> M \<and> (\<exists>B \<ge> d y a. \<forall>x\<in>S. d y x \<le> B)"
     by (metis order.trans nle_le)
   then show ?thesis
     by (auto simp: mbounded)
 qed
 
 lemma mbounded_Int: "mbounded S \<Longrightarrow> mbounded (S \<inter> T)"
   by (meson inf_le1 mbounded_subset)
 
 lemma mbounded_Un: "mbounded (S \<union> T) \<longleftrightarrow> mbounded S \<and> mbounded T" (is "?lhs=?rhs")
 proof
   assume R: ?rhs
   show ?lhs
   proof (cases "S={} \<or> T={}")
     case True then show ?thesis
       using R by auto
   next
     case False
     obtain x y B C where "S \<subseteq> mcball x B" "T \<subseteq> mcball y C" "B > 0" "C > 0" "x \<in> M" "y \<in> M"
       using R mbounded_pos
       by (metis False mcball_eq_empty subset_empty)
     then have "S \<union> T \<subseteq> mcball x (B + C + d x y)"
       by (smt (verit) commute dual_order.trans le_supI mcball_subset mdist_pos_eq)
     then show ?thesis
       using mbounded_def by blast
   qed
 next
   show "?lhs \<Longrightarrow> ?rhs"
     using mbounded_def by auto
 qed
 
 lemma mbounded_Union:
   "\<lbrakk>finite \<F>; \<And>X. X \<in> \<F> \<Longrightarrow> mbounded X\<rbrakk> \<Longrightarrow> mbounded (\<Union>\<F>)"
   by (induction \<F> rule: finite_induct) (auto simp: mbounded_Un)
 
 lemma mbounded_closure_of:
    "mbounded S \<Longrightarrow> mbounded (mtopology closure_of S)"
   by (meson closedin_mcball closure_of_minimal mbounded_def)
 
 lemma mbounded_closure_of_eq:
    "S \<subseteq> M \<Longrightarrow> (mbounded (mtopology closure_of S) \<longleftrightarrow> mbounded S)"
   by (metis closure_of_subset mbounded_closure_of mbounded_subset topspace_mtopology)
 
 
 lemma maxdist_thm:
   assumes "mbounded S"
       and "x \<in> S"
       and "y \<in> S"
     shows  "d x y = (SUP z\<in>S. \<bar>d x z - d z y\<bar>)"
 proof -
   have "\<bar>d x z - d z y\<bar> \<le> d x y" if "z \<in> S" for z
     by (metis all_not_in_conv assms mbounded mdist_reverse_triangle that) 
   moreover have "d x y \<le> r"
     if "\<And>z. z \<in> S \<Longrightarrow> \<bar>d x z - d z y\<bar> \<le> r" for r :: real
     using that assms mbounded_subset_mspace mdist_zero by fastforce
   ultimately show ?thesis
     by (intro cSup_eq [symmetric]) auto
 qed
 
 
 lemma metric_eq_thm: "\<lbrakk>S \<subseteq> M; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> (x = y) = (\<forall>z\<in>S. d x z = d y z)"
   by (metis commute  subset_iff zero)
 
 lemma compactin_imp_mbounded:
   assumes "compactin mtopology S"
   shows "mbounded S"
 proof -
   have "S \<subseteq> M"
     and com: "\<And>\<U>. \<lbrakk>\<forall>U\<in>\<U>. openin mtopology U; S \<subseteq> \<Union>\<U>\<rbrakk> \<Longrightarrow> \<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>"
     using assms by (auto simp: compactin_def mbounded_def)
   show ?thesis
   proof (cases "S = {}")
     case False
     with \<open>S \<subseteq> M\<close> obtain a where "a \<in> S" "a \<in> M"
       by blast
     with \<open>S \<subseteq> M\<close> gt_ex have "S \<subseteq> \<Union>(range (mball a))"
       by force
     moreover have "\<forall>U \<in> range (mball a). openin mtopology U"
       by (simp add: openin_mball)
     ultimately obtain \<F> where "finite \<F>" "\<F> \<subseteq> range (mball a)" "S \<subseteq> \<Union>\<F>"
       by (meson com)
   then show ?thesis
       using mbounded_Union mbounded_subset by fastforce
   qed auto
 qed
 
 end
 
 
 subsection\<open>Subspace of a metric space\<close>
 
 locale Submetric = Metric_space + 
   fixes A
   assumes subset: "A \<subseteq> M"
 
 sublocale Submetric \<subseteq> sub: Metric_space A d
   by (simp add: subset subspace)
 
 context Submetric
 begin 
 
 lemma mball_submetric_eq: "sub.mball a r = (if a \<in> A then A \<inter> mball a r else {})"
 and mcball_submetric_eq: "sub.mcball a r = (if a \<in> A then A \<inter> mcball a r else {})"
   using subset by force+
 
 lemma mtopology_submetric: "sub.mtopology = subtopology mtopology A"
   unfolding topology_eq
 proof (intro allI iffI)
   fix S
   assume "openin sub.mtopology S"
   then have "\<exists>T. openin (subtopology mtopology A) T \<and> x \<in> T \<and> T \<subseteq> S" if "x \<in> S" for x
     by (metis mball_submetric_eq openin_mball openin_subtopology_Int2 sub.centre_in_mball_iff sub.openin_mtopology subsetD that)
   then show "openin (subtopology mtopology A) S"
     by (meson openin_subopen)
 next
   fix S
   assume "openin (subtopology mtopology A) S"
   then obtain T where "openin mtopology T" "S = T \<inter> A"
     by (meson openin_subtopology)
   then have "mopen T"
     by (simp add: mopen_def openin_mtopology)
   then have "sub.mopen (T \<inter> A)"
     unfolding sub.mopen_def mopen_def
     by (metis inf.coboundedI2 mball_submetric_eq Int_iff \<open>S = T \<inter> A\<close> inf.bounded_iff subsetI)
   then show "openin sub.mtopology S"
     using \<open>S = T \<inter> A\<close> sub.mopen_def sub.openin_mtopology by force
 qed
 
 lemma mbounded_submetric: "sub.mbounded T \<longleftrightarrow> mbounded T \<and> T \<subseteq> A"
   by (meson mbounded_alt sub.mbounded_alt subset subset_trans)
 
 end
 
 lemma (in Metric_space) submetric_empty [iff]: "Submetric M d {}"
   by (simp add: Metric_space_axioms Submetric.intro Submetric_axioms_def)
 
 
 subsection \<open>Abstract type of metric spaces\<close>
 
 
 typedef 'a metric = "{(M::'a set,d). Metric_space M d}"
   morphisms "dest_metric" "metric"
 proof -
   have "Metric_space {} (\<lambda>x y. 0)"
     by (auto simp: Metric_space_def)
   then show ?thesis
     by blast
 qed
 
 definition mspace where "mspace m \<equiv> fst (dest_metric m)"
 
 definition mdist where "mdist m \<equiv> snd (dest_metric m)"
 
 lemma Metric_space_mspace_mdist: "Metric_space (mspace m) (mdist m)"
   by (metis Product_Type.Collect_case_prodD dest_metric mdist_def mspace_def)
 
 lemma mdist_nonneg [simp]: "\<And>x y. 0 \<le> mdist m x y"
   by (metis Metric_space_def Metric_space_mspace_mdist)
 
 lemma mdist_commute: "\<And>x y. mdist m x y = mdist m y x"
   by (metis Metric_space_def Metric_space_mspace_mdist)
 
 lemma mdist_zero [simp]: "\<And>x y. \<lbrakk>x \<in> mspace m; y \<in> mspace m\<rbrakk> \<Longrightarrow> mdist m x y = 0 \<longleftrightarrow> x=y"
   by (meson Metric_space.zero Metric_space_mspace_mdist)
 
 lemma mdist_triangle: "\<And>x y z. \<lbrakk>x \<in> mspace m; y \<in> mspace m; z \<in> mspace m\<rbrakk> \<Longrightarrow> mdist m x z \<le> mdist m x y + mdist m y z"
   by (meson Metric_space.triangle Metric_space_mspace_mdist)
 
 lemma (in Metric_space) mspace_metric[simp]: 
   "mspace (metric (M,d)) = M"
   by (simp add: mspace_def Metric_space_axioms metric_inverse)
 
 lemma (in Metric_space) mdist_metric[simp]: 
   "mdist (metric (M,d)) = d"
   by (simp add: mdist_def Metric_space_axioms metric_inverse)
 
 lemma metric_collapse [simp]: "metric (mspace m, mdist m) = m"
   by (simp add: dest_metric_inverse mdist_def mspace_def)
 
 definition mtopology_of :: "'a metric \<Rightarrow> 'a topology"
   where "mtopology_of \<equiv> \<lambda>m. Metric_space.mtopology (mspace m) (mdist m)"
 
 lemma topspace_mtopology_of [simp]: "topspace (mtopology_of m) = mspace m"
   by (simp add: Metric_space.topspace_mtopology Metric_space_mspace_mdist mtopology_of_def)
 
 lemma (in Metric_space) mtopology_of [simp]:
   "mtopology_of (metric (M,d)) = mtopology"
   by (simp add: mtopology_of_def)
 
 definition "mball_of \<equiv> \<lambda>m. Metric_space.mball (mspace m) (mdist m)"
 
 lemma (in Metric_space) mball_of [simp]:
   "mball_of (metric (M,d)) = mball"
   by (simp add: mball_of_def)
 
 definition "mcball_of \<equiv> \<lambda>m. Metric_space.mcball (mspace m) (mdist m)"
 
 lemma (in Metric_space) mcball_of [simp]:
   "mcball_of (metric (M,d)) = mcball"
   by (simp add: mcball_of_def)
 
 definition "euclidean_metric \<equiv> metric (UNIV,dist)"
 
 lemma mspace_euclidean_metric [simp]: "mspace euclidean_metric = UNIV"
   by (simp add: euclidean_metric_def)
 
 lemma mdist_euclidean_metric [simp]: "mdist euclidean_metric = dist"
   by (simp add: euclidean_metric_def)
 
+lemma mtopology_of_euclidean [simp]: "mtopology_of euclidean_metric = euclidean"
+  by (simp add: Met_TC.mtopology_def mtopology_of_def)
+
 text\<open> Subspace of a metric space\<close>
 
 definition submetric where
   "submetric \<equiv> \<lambda>m S. metric (S \<inter> mspace m, mdist m)"
 
 lemma mspace_submetric [simp]: "mspace (submetric m S) = S \<inter> mspace m" 
   unfolding submetric_def
   by (meson Metric_space.subspace inf_le2 Metric_space_mspace_mdist Metric_space.mspace_metric)
 
 lemma mdist_submetric [simp]: "mdist (submetric m S) = mdist m"
   unfolding submetric_def
   by (meson Metric_space.subspace inf_le2 Metric_space.mdist_metric Metric_space_mspace_mdist)
 
 lemma submetric_UNIV [simp]: "submetric m UNIV = m"
   by (simp add: submetric_def dest_metric_inverse mdist_def mspace_def)
 
 lemma submetric_submetric [simp]:
    "submetric (submetric m S) T = submetric m (S \<inter> T)"
   by (metis submetric_def Int_assoc inf_commute mdist_submetric mspace_submetric)
 
 lemma submetric_mspace [simp]:
    "submetric m (mspace m) = m"
   by (simp add: submetric_def dest_metric_inverse mdist_def mspace_def)
 
 lemma submetric_restrict:
    "submetric m S = submetric m (mspace m \<inter> S)"
   by (metis submetric_mspace submetric_submetric)
 
+lemma mtopology_of_submetric: "mtopology_of (submetric m A) = subtopology (mtopology_of m) A"
+proof -
+  interpret Submetric "mspace m" "mdist m" "A \<inter> mspace m"
+    using Metric_space_mspace_mdist Submetric.intro Submetric_axioms.intro inf_le2 by blast
+  have "sub.mtopology = subtopology (mtopology_of m) A"
+    by (metis inf_commute mtopology_of_def mtopology_submetric subtopology_mspace subtopology_subtopology)
+  then show ?thesis
+    by (simp add: submetric_def)
+qed
+
 
 subsection\<open>The discrete metric\<close>
 
 locale discrete_metric =
   fixes M :: "'a set"
 
 definition (in discrete_metric) dd :: "'a \<Rightarrow> 'a \<Rightarrow> real"
   where "dd \<equiv> \<lambda>x y::'a. if x=y then 0 else 1"
 
 lemma metric_M_dd: "Metric_space M discrete_metric.dd"
   by (simp add: discrete_metric.dd_def Metric_space.intro)
 
 sublocale discrete_metric \<subseteq> disc: Metric_space M dd
   by (simp add: metric_M_dd)
 
 
 lemma (in discrete_metric) mopen_singleton:
   assumes "x \<in> M" shows "disc.mopen {x}"
 proof -
   have "disc.mball x (1/2) \<subseteq> {x}"
     by (smt (verit) dd_def disc.in_mball less_divide_eq_1_pos singleton_iff subsetI)
   with assms show ?thesis
     using disc.mopen_def half_gt_zero_iff zero_less_one by blast
 qed
 
 lemma (in discrete_metric) mtopology_discrete_metric:
    "disc.mtopology = discrete_topology M"
 proof -
   have "\<And>x. x \<in> M \<Longrightarrow> openin disc.mtopology {x}"
     by (simp add: disc.mtopology_def mopen_singleton)
   then show ?thesis
     by (metis disc.topspace_mtopology discrete_topology_unique)
 qed
 
 lemma (in discrete_metric) discrete_ultrametric:
    "dd x z \<le> max (dd x y) (dd y z)"
   by (simp add: dd_def)
 
 
 lemma (in discrete_metric) dd_le1: "dd x y \<le> 1"
   by (simp add: dd_def)
 
 lemma (in discrete_metric) mbounded_discrete_metric: "disc.mbounded S \<longleftrightarrow> S \<subseteq> M"
   by (meson dd_le1 disc.mbounded_alt)
 
 
 
 subsection\<open>Metrizable spaces\<close>
 
 definition metrizable_space where
   "metrizable_space X \<equiv> \<exists>M d. Metric_space M d \<and> X = Metric_space.mtopology M d"
 
 lemma (in Metric_space) metrizable_space_mtopology: "metrizable_space mtopology"
   using local.Metric_space_axioms metrizable_space_def by blast
 
 lemma openin_mtopology_eq_open [simp]: "openin Met_TC.mtopology = open"
   by (simp add: Met_TC.mtopology_def)
 
 lemma closedin_mtopology_eq_closed [simp]: "closedin Met_TC.mtopology = closed"
 proof -
   have "(euclidean::'a topology) = Met_TC.mtopology"
     by (simp add: Met_TC.mtopology_def)
   then show ?thesis
     using closed_closedin by fastforce
 qed
 
 lemma compactin_mtopology_eq_compact [simp]: "compactin Met_TC.mtopology = compact"
   by (simp add: compactin_def compact_eq_Heine_Borel fun_eq_iff) meson
 
 lemma metrizable_space_discrete_topology:
    "metrizable_space(discrete_topology U)"
   by (metis discrete_metric.mtopology_discrete_metric metric_M_dd metrizable_space_def)
 
 lemma empty_metrizable_space: "topspace X = {} \<Longrightarrow> metrizable_space X"
   by (metis metrizable_space_discrete_topology subtopology_eq_discrete_topology_empty)
 
 lemma metrizable_space_subtopology:
   assumes "metrizable_space X"
   shows "metrizable_space(subtopology X S)"
 proof -
   obtain M d where "Metric_space M d" and X: "X = Metric_space.mtopology M d"
     using assms metrizable_space_def by blast
   then interpret Submetric M d "M \<inter> S"
     by (simp add: Submetric.intro Submetric_axioms_def)
   show ?thesis
     unfolding metrizable_space_def
     by (metis X mtopology_submetric sub.Metric_space_axioms subtopology_restrict topspace_mtopology)
 qed
 
 lemma homeomorphic_metrizable_space_aux:
   assumes "X homeomorphic_space Y" "metrizable_space X"
   shows "metrizable_space Y"
 proof -
   obtain M d where "Metric_space M d" and X: "X = Metric_space.mtopology M d"
     using assms by (auto simp: metrizable_space_def)
   then interpret m: Metric_space M d 
     by simp
   obtain f g where hmf: "homeomorphic_map X Y f" and hmg: "homeomorphic_map Y X g"
     and fg: "(\<forall>x \<in> M. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
     using assms X homeomorphic_maps_map homeomorphic_space_def by fastforce
   define d' where "d' x y \<equiv> d (g x) (g y)" for x y
   interpret m': Metric_space "topspace Y" "d'"
     unfolding d'_def
   proof
     show "(d (g x) (g y) = 0) = (x = y)" if "x \<in> topspace Y" "y \<in> topspace Y" for x y
       by (metis fg X hmg homeomorphic_imp_surjective_map imageI m.topspace_mtopology m.zero that)
     show "d (g x) (g z) \<le> d (g x) (g y) + d (g y) (g z)"
       if "x \<in> topspace Y" and "y \<in> topspace Y" and "z \<in> topspace Y" for x y z
       by (metis X that hmg homeomorphic_eq_everything_map imageI m.topspace_mtopology m.triangle)
   qed (auto simp: m.nonneg m.commute)
   have "Y = Metric_space.mtopology (topspace Y) d'"
     unfolding topology_eq
   proof (intro allI)
     fix S
     have "openin m'.mtopology S" if S: "S \<subseteq> topspace Y" and "openin X (g ` S)"
       unfolding m'.openin_mtopology
     proof (intro conjI that strip)
       fix y
       assume "y \<in> S"
       then obtain r where "r>0" and r: "m.mball (g y) r \<subseteq> g ` S" 
         using X \<open>openin X (g ` S)\<close> m.openin_mtopology using \<open>y \<in> S\<close> by auto
       then have "g ` m'.mball y r \<subseteq> m.mball (g y) r"
         using X d'_def hmg homeomorphic_imp_surjective_map by fastforce
       with S fg have "m'.mball y r \<subseteq> S"
         by (smt (verit, del_insts) image_iff m'.in_mball r subset_iff)
       then show "\<exists>r>0. m'.mball y r \<subseteq> S"
         using \<open>0 < r\<close> by blast 
     qed
     moreover have "openin X (g ` S)" if ope': "openin m'.mtopology S"
     proof -
       have "\<exists>r>0. m.mball (g y) r \<subseteq> g ` S" if "y \<in> S" for y
       proof -
         have y: "y \<in> topspace Y"
           using m'.openin_mtopology ope' that by blast
         obtain r where "r > 0" and r: "m'.mball y r \<subseteq> S"
           using ope' by (meson \<open>y \<in> S\<close> m'.openin_mtopology)
         moreover have "\<And>x. \<lbrakk>x \<in> M; d (g y) x < r\<rbrakk> \<Longrightarrow> \<exists>u. u \<in> topspace Y \<and> d' y u < r \<and> x = g u"
           using fg X d'_def hmf homeomorphic_imp_surjective_map by fastforce
         ultimately have "m.mball (g y) r \<subseteq> g ` m'.mball y r"
           using y by (force simp: m'.openin_mtopology)
         then show ?thesis
           using \<open>0 < r\<close> r by blast
       qed
       then show ?thesis
         using X hmg homeomorphic_imp_surjective_map m.openin_mtopology ope' openin_subset by fastforce
     qed
     ultimately have "(S \<subseteq> topspace Y \<and> openin X (g ` S)) = openin m'.mtopology S"
       using m'.topspace_mtopology openin_subset by blast
     then show "openin Y S = openin m'.mtopology S"
       by (simp add: m'.mopen_def homeomorphic_map_openness_eq [OF hmg])
   qed
   then show ?thesis
     using m'.metrizable_space_mtopology by force
 qed
 
 lemma homeomorphic_metrizable_space:
   assumes "X homeomorphic_space Y"
   shows "metrizable_space X \<longleftrightarrow> metrizable_space Y"
   using assms homeomorphic_metrizable_space_aux homeomorphic_space_sym by metis
 
 lemma metrizable_space_retraction_map_image:
    "retraction_map X Y r \<and> metrizable_space X
         \<Longrightarrow> metrizable_space Y"
   using hereditary_imp_retractive_property metrizable_space_subtopology homeomorphic_metrizable_space
   by blast
 
 
 lemma metrizable_imp_Hausdorff_space:
    "metrizable_space X \<Longrightarrow> Hausdorff_space X"
   by (metis Metric_space.Hausdorff_space_mtopology metrizable_space_def)
 
 (**
 lemma metrizable_imp_kc_space:
    "metrizable_space X \<Longrightarrow> kc_space X"
 oops
   MESON_TAC[METRIZABLE_IMP_HAUSDORFF_SPACE; HAUSDORFF_IMP_KC_SPACE]);;
 
 lemma kc_space_mtopology:
    "kc_space mtopology"
 oops
   REWRITE_TAC[GSYM FORALL_METRIZABLE_SPACE; METRIZABLE_IMP_KC_SPACE]);;
 **)
 
 lemma metrizable_imp_t1_space:
    "metrizable_space X \<Longrightarrow> t1_space X"
   by (simp add: Hausdorff_imp_t1_space metrizable_imp_Hausdorff_space)
 
 lemma closed_imp_gdelta_in:
   assumes X: "metrizable_space X" and S: "closedin X S"
   shows "gdelta_in X S"
 proof -
   obtain M d where "Metric_space M d" and Xeq: "X = Metric_space.mtopology M d"
     using X metrizable_space_def by blast
   then interpret M: Metric_space M d
     by blast
   have "S \<subseteq> M"
     using M.closedin_metric \<open>X = M.mtopology\<close> S by blast
   show ?thesis
   proof (cases "S = {}")
     case True
     then show ?thesis
       by simp
   next
     case False
     have "\<exists>y\<in>S. d x y < inverse (1 + real n)" if "x \<in> S" for x n
       using \<open>S \<subseteq> M\<close> M.mdist_zero [of x] that by force
     moreover
     have "x \<in> S" if "x \<in> M" and \<section>: "\<And>n. \<exists>y\<in>S. d x y < inverse(Suc n)" for x
     proof -
       have *: "\<exists>y\<in>S. d x y < \<epsilon>" if "\<epsilon> > 0" for \<epsilon>
         by (metis \<section> that not0_implies_Suc order_less_le order_less_le_trans real_arch_inverse)
       have "closedin M.mtopology S"
         using S by (simp add: Xeq)
       then show ?thesis
         apply (simp add: M.closedin_metric)
         by (metis * \<open>x \<in> M\<close> M.in_mball disjnt_insert1 insert_absorb subsetD)
     qed
     ultimately have Seq: "S = \<Inter>(range (\<lambda>n. {x\<in>M. \<exists>y\<in>S. d x y < inverse(Suc n)}))"
       using \<open>S \<subseteq> M\<close> by force
     have "openin M.mtopology {xa \<in> M. \<exists>y\<in>S. d xa y < inverse (1 + real n)}" for n
     proof (clarsimp simp: M.openin_mtopology)
       fix x y
       assume "x \<in> M" "y \<in> S" and dxy: "d x y < inverse (1 + real n)"
       then have "\<And>z. \<lbrakk>z \<in> M; d x z < inverse (1 + real n) - d x y\<rbrakk> \<Longrightarrow> \<exists>y\<in>S. d z y < inverse (1 + real n)"
         by (smt (verit) M.commute M.triangle \<open>S \<subseteq> M\<close> in_mono)
       with dxy show "\<exists>r>0. M.mball x r \<subseteq> {z \<in> M. \<exists>y\<in>S. d z y < inverse (1 + real n)}"
         by (rule_tac x="inverse(Suc n) - d x y" in exI) auto
     qed
     then show ?thesis
       apply (subst Seq)
       apply (force simp: Xeq intro: gdelta_in_Inter open_imp_gdelta_in)
       done
   qed
 qed
 
 lemma open_imp_fsigma_in:
    "\<lbrakk>metrizable_space X; openin X S\<rbrakk> \<Longrightarrow> fsigma_in X S"
   by (meson closed_imp_gdelta_in fsigma_in_gdelta_in openin_closedin openin_subset)
 
-(*NEEDS first_countable
-lemma first_countable_mtopology:
-   "first_countable mtopology"
-oops
-  GEN_TAC THEN REWRITE_TAC[first_countable; TOPSPACE_MTOPOLOGY] THEN
-  X_GEN_TAC `x::A` THEN DISCH_TAC THEN
-  EXISTS_TAC `{ mball m (x::A,r) | rational r \<and> 0 < r}` THEN
-  REWRITE_TAC[FORALL_IN_GSPEC; OPEN_IN_MBALL; EXISTS_IN_GSPEC] THEN
-  ONCE_REWRITE_TAC[SET_RULE
-   `{f x | S x \<and> Q x} = f ` {x \<in> S. Q x}`] THEN
-  SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RATIONAL; COUNTABLE_RESTRICT] THEN
-  REWRITE_TAC[OPEN_IN_MTOPOLOGY] THEN
-  X_GEN_TAC `U::A=>bool` THEN STRIP_TAC THEN
-  FIRST_X_ASSUM(MP_TAC \<circ> SPEC `x::A`) THEN
-  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
-  X_GEN_TAC `r::real` THEN STRIP_TAC THEN FIRST_ASSUM
-   (MP_TAC \<circ> SPEC `r::real` \<circ> MATCH_MP RATIONAL_APPROXIMATION_BELOW) THEN
-  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q::real` THEN
-  REWRITE_TAC[REAL_SUB_REFL] THEN STRIP_TAC THEN
-  ASM_SIMP_TAC[CENTRE_IN_MBALL] THEN
-  TRANS_TAC SUBSET_TRANS `mball m (x::A,r)` THEN
-  ASM_SIMP_TAC[MBALL_SUBSET_CONCENTRIC; REAL_LT_IMP_LE]);;
-
-lemma metrizable_imp_first_countable:
-   "metrizable_space X \<Longrightarrow> first_countable X"
-oops
-  REWRITE_TAC[FORALL_METRIZABLE_SPACE; FIRST_COUNTABLE_MTOPOLOGY]);;
-*)
-
 lemma mball_eq_ball [simp]: "Met_TC.mball = ball"
   by force
 
 lemma mopen_eq_open [simp]: "Met_TC.mopen = open"
   by (force simp: open_contains_ball Met_TC.mopen_def)
 
 lemma metrizable_space_euclidean:
   "metrizable_space (euclidean :: 'a::metric_space topology)"
   unfolding metrizable_space_def
   by (metis Met_TC.Metric_space_axioms Met_TC.mtopology_def mopen_eq_open)
 
 lemma (in Metric_space) regular_space_mtopology:
    "regular_space mtopology"
 unfolding regular_space_def
 proof clarify
   fix C a
   assume C: "closedin mtopology C" and a: "a \<in> topspace mtopology" and "a \<notin> C"
   have "openin mtopology (topspace mtopology - C)"
     by (simp add: C openin_diff)
   then obtain r where "r>0" and r: "mball a r \<subseteq> topspace mtopology - C"
     unfolding openin_mtopology using \<open>a \<notin> C\<close> a by auto
   show "\<exists>U V. openin mtopology U \<and> openin mtopology V \<and> a \<in> U \<and> C \<subseteq> V \<and> disjnt U V"
   proof (intro exI conjI)
     show "a \<in> mball a (r/2)"
       using \<open>0 < r\<close> a by force
     show "C \<subseteq> topspace mtopology - mcball a (r/2)"
       using C \<open>0 < r\<close> r by (fastforce simp: closedin_metric)
   qed (auto simp: openin_mball closedin_mcball openin_diff disjnt_iff)
 qed
 
 lemma metrizable_imp_regular_space:
    "metrizable_space X \<Longrightarrow> regular_space X"
   by (metis Metric_space.regular_space_mtopology metrizable_space_def)
 
 lemma regular_space_euclidean:
  "regular_space (euclidean :: 'a::metric_space topology)"
   by (simp add: metrizable_imp_regular_space metrizable_space_euclidean)
 
 
 subsection\<open>Limits at a point in a topological space\<close>
 
 lemma (in Metric_space) eventually_atin_metric:
    "eventually P (atin mtopology a) \<longleftrightarrow>
         (a \<in> M \<longrightarrow> (\<exists>\<delta>>0. \<forall>x. x \<in> M \<and> 0 < d x a \<and> d x a < \<delta> \<longrightarrow> P x))"  (is "?lhs=?rhs")
 proof (cases "a \<in> M")
   case True
   show ?thesis
   proof
     assume L: ?lhs 
     with True obtain U where "openin mtopology U" "a \<in> U" and U: "\<forall>x\<in>U - {a}. P x"
       by (auto simp: eventually_atin)
     then obtain r where "r>0" and "mball a r \<subseteq> U"
       by (meson openin_mtopology)
     with U show ?rhs
       by (smt (verit, ccfv_SIG) commute in_mball insert_Diff_single insert_iff subset_iff)
   next
     assume ?rhs 
     then obtain \<delta> where "\<delta>>0" and \<delta>: "\<forall>x. x \<in> M \<and> 0 < d x a \<and> d x a < \<delta> \<longrightarrow> P x"
       using True by blast
     then have "\<forall>x \<in> mball a \<delta> - {a}. P x"
       by (simp add: commute)
     then show ?lhs
       unfolding eventually_atin openin_mtopology
       by (metis True \<open>0 < \<delta>\<close> centre_in_mball_iff openin_mball openin_mtopology) 
   qed
 qed auto
 
 subsection \<open>Normal spaces and metric spaces\<close>
 
 lemma (in Metric_space) normal_space_mtopology:
    "normal_space mtopology"
   unfolding normal_space_def
 proof clarify
   fix S T
   assume "closedin mtopology S"
   then have "\<And>x. x \<in> M - S \<Longrightarrow> (\<exists>r>0. mball x r \<subseteq> M - S)"
     by (simp add: closedin_def openin_mtopology)
   then obtain \<delta> where d0: "\<And>x. x \<in> M - S \<Longrightarrow> \<delta> x > 0 \<and> mball x (\<delta> x) \<subseteq> M - S"
     by metis
   assume "closedin mtopology T"
   then have "\<And>x. x \<in> M - T \<Longrightarrow> (\<exists>r>0. mball x r \<subseteq> M - T)"
     by (simp add: closedin_def openin_mtopology)
   then obtain \<epsilon> where e: "\<And>x. x \<in> M - T \<Longrightarrow> \<epsilon> x > 0 \<and> mball x (\<epsilon> x) \<subseteq> M - T"
     by metis
   assume "disjnt S T"
   have "S \<subseteq> M" "T \<subseteq> M"
     using \<open>closedin mtopology S\<close> \<open>closedin mtopology T\<close> closedin_metric by blast+
   have \<delta>: "\<And>x. x \<in> T \<Longrightarrow> \<delta> x > 0 \<and> mball x (\<delta> x) \<subseteq> M - S"
     by (meson DiffI \<open>T \<subseteq> M\<close> \<open>disjnt S T\<close> d0 disjnt_iff subsetD)
   have \<epsilon>: "\<And>x. x \<in> S \<Longrightarrow> \<epsilon> x > 0 \<and> mball x (\<epsilon> x) \<subseteq> M - T"
     by (meson Diff_iff \<open>S \<subseteq> M\<close> \<open>disjnt S T\<close> disjnt_iff e subsetD)
   show "\<exists>U V. openin mtopology U \<and> openin mtopology V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
   proof (intro exI conjI)
     show "openin mtopology (\<Union>x\<in>S. mball x (\<epsilon> x / 2))" "openin mtopology (\<Union>x\<in>T. mball x (\<delta> x / 2))"
       by force+
     show "S \<subseteq> (\<Union>x\<in>S. mball x (\<epsilon> x / 2))"
       using \<epsilon> \<open>S \<subseteq> M\<close> by force
     show "T \<subseteq> (\<Union>x\<in>T. mball x (\<delta> x / 2))"
       using \<delta> \<open>T \<subseteq> M\<close> by force
     show "disjnt (\<Union>x\<in>S. mball x (\<epsilon> x / 2)) (\<Union>x\<in>T. mball x (\<delta> x / 2))"
       using \<epsilon> \<delta> 
       apply (clarsimp simp: disjnt_iff subset_iff)
       by (smt (verit, ccfv_SIG) field_sum_of_halves triangle')
   qed 
 qed
 
 lemma metrizable_imp_normal_space:
    "metrizable_space X \<Longrightarrow> normal_space X"
   by (metis Metric_space.normal_space_mtopology metrizable_space_def)
 
 subsection\<open>Topological limitin in metric spaces\<close>
 
 
 lemma (in Metric_space) limitin_mspace:
    "limitin mtopology f l F \<Longrightarrow> l \<in> M"
   using limitin_topspace by fastforce
 
 lemma (in Metric_space) limitin_metric_unique:
    "\<lbrakk>limitin mtopology f l1 F; limitin mtopology f l2 F; F \<noteq> bot\<rbrakk> \<Longrightarrow> l1 = l2"
   by (meson Hausdorff_space_mtopology limitin_Hausdorff_unique)
 
 lemma (in Metric_space) limitin_metric:
    "limitin mtopology f l F \<longleftrightarrow> l \<in> M \<and> (\<forall>\<epsilon>>0. eventually (\<lambda>x. f x \<in> M \<and> d (f x) l < \<epsilon>) F)"  
    (is "?lhs=?rhs")
 proof
   assume L: ?lhs
   show ?rhs
     unfolding limitin_def
   proof (intro conjI strip)
     show "l \<in> M"
       using L limitin_mspace by blast
     fix \<epsilon>::real
     assume "\<epsilon>>0"
     then have "\<forall>\<^sub>F x in F. f x \<in> mball l \<epsilon>"
       using L openin_mball by (fastforce simp: limitin_def)
     then show "\<forall>\<^sub>F x in F. f x \<in> M \<and> d (f x) l < \<epsilon>"
       using commute eventually_mono by fastforce
   qed
 next
   assume R: ?rhs 
   then show ?lhs
     by (force simp: limitin_def commute openin_mtopology subset_eq elim: eventually_mono)
 qed
 
 lemma (in Metric_space) limit_metric_sequentially:
    "limitin mtopology f l sequentially \<longleftrightarrow>
      l \<in> M \<and> (\<forall>\<epsilon>>0. \<exists>N. \<forall>n\<ge>N. f n \<in> M \<and> d (f n) l < \<epsilon>)"
   by (auto simp: limitin_metric eventually_sequentially)
 
 lemma (in Submetric) limitin_submetric_iff:
    "limitin sub.mtopology f l F \<longleftrightarrow>
      l \<in> A \<and> eventually (\<lambda>x. f x \<in> A) F \<and> limitin mtopology f l F" (is "?lhs=?rhs")
   by (simp add: limitin_subtopology mtopology_submetric)
 
 lemma (in Metric_space) metric_closedin_iff_sequentially_closed:
    "closedin mtopology S \<longleftrightarrow>
     S \<subseteq> M \<and> (\<forall>\<sigma> l. range \<sigma> \<subseteq> S \<and> limitin mtopology \<sigma> l sequentially \<longrightarrow> l \<in> S)" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     by (force simp: closedin_metric limitin_closedin range_subsetD)
 next
   assume R: ?rhs
   show ?lhs
     unfolding closedin_metric
   proof (intro conjI strip)
     show "S \<subseteq> M"
       using R by blast
     fix x
     assume "x \<in> M - S"
     have False if "\<forall>r>0. \<exists>y. y \<in> M \<and> y \<in> S \<and> d x y < r"
     proof -
       have "\<forall>n. \<exists>y. y \<in> M \<and> y \<in> S \<and> d x y < inverse(Suc n)"
         using that by auto
       then obtain \<sigma> where \<sigma>: "\<And>n. \<sigma> n \<in> M \<and> \<sigma> n \<in> S \<and> d x (\<sigma> n) < inverse(Suc n)"
         by metis
       then have "range \<sigma> \<subseteq> M"
         by blast
       have "\<exists>N. \<forall>n\<ge>N. d x (\<sigma> n) < \<epsilon>" if "\<epsilon>>0" for \<epsilon>
       proof -
         have "real (Suc (nat \<lceil>inverse \<epsilon>\<rceil>)) \<ge> inverse \<epsilon>"
           by linarith
         then have "\<forall>n \<ge> nat \<lceil>inverse \<epsilon>\<rceil>. d x (\<sigma> n) < \<epsilon>"
           by (metis \<sigma> inverse_inverse_eq inverse_le_imp_le nat_ceiling_le_eq nle_le not_less_eq_eq order.strict_trans2 that)
         then show ?thesis ..
       qed
       with \<sigma> have "limitin mtopology \<sigma> x sequentially"
         using \<open>x \<in> M - S\<close> commute limit_metric_sequentially by auto
       then show ?thesis
         by (metis R DiffD2 \<sigma> image_subset_iff \<open>x \<in> M - S\<close>)
     qed
     then show "\<exists>r>0. disjnt S (mball x r)"
       by (meson disjnt_iff in_mball)
   qed
 qed
 
 lemma (in Metric_space) limit_atin_metric:
    "limitin X f y (atin mtopology x) \<longleftrightarrow>
       y \<in> topspace X \<and>
       (x \<in> M
        \<longrightarrow> (\<forall>V. openin X V \<and> y \<in> V
                \<longrightarrow> (\<exists>\<delta>>0.  \<forall>x'. x' \<in> M \<and> 0 < d x' x \<and> d x' x < \<delta> \<longrightarrow> f x' \<in> V)))"
   by (force simp: limitin_def eventually_atin_metric)
 
 lemma (in Metric_space) limitin_metric_dist_null:
    "limitin mtopology f l F \<longleftrightarrow> l \<in> M \<and> eventually (\<lambda>x. f x \<in> M) F \<and> ((\<lambda>x. d (f x) l) \<longlongrightarrow> 0) F"
   by (simp add: limitin_metric tendsto_iff eventually_conj_iff all_conj_distrib imp_conjR gt_ex)
 
 
 subsection\<open>Cauchy sequences and complete metric spaces\<close>
 
 context Metric_space
 begin
 
 definition MCauchy :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool"
   where "MCauchy \<sigma> \<equiv> range \<sigma> \<subseteq> M \<and> (\<forall>\<epsilon>>0. \<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>)"
 
 definition mcomplete
   where "mcomplete \<equiv> (\<forall>\<sigma>. MCauchy \<sigma> \<longrightarrow> (\<exists>x. limitin mtopology \<sigma> x sequentially))"
 
 lemma mcomplete_empty [iff]: "Metric_space.mcomplete {} d"
   by (simp add: Metric_space.MCauchy_def Metric_space.mcomplete_def subspace)
 
 lemma MCauchy_imp_MCauchy_suffix: "MCauchy \<sigma> \<Longrightarrow> MCauchy (\<sigma> \<circ> (+)n)"
   unfolding MCauchy_def image_subset_iff comp_apply
   by (metis UNIV_I add.commute trans_le_add1) 
 
 lemma mcomplete:
    "mcomplete \<longleftrightarrow>
     (\<forall>\<sigma>. (\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M) \<and>
      (\<forall>\<epsilon>>0. \<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>) \<longrightarrow>
      (\<exists>x. limitin mtopology \<sigma> x sequentially))" (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
   proof clarify
     fix \<sigma>
     assume "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M"
       and \<sigma>: "\<forall>\<epsilon>>0. \<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>"
     then obtain N where "\<And>n. n\<ge>N \<Longrightarrow> \<sigma> n \<in> M"
       by (auto simp: eventually_sequentially)
     with \<sigma> have "MCauchy (\<sigma> \<circ> (+)N)"
       unfolding MCauchy_def image_subset_iff comp_apply by (meson le_add1 trans_le_add2)
     then obtain x where "limitin mtopology (\<sigma> \<circ> (+)N) x sequentially"
       using L MCauchy_imp_MCauchy_suffix mcomplete_def by blast
     then have "limitin mtopology \<sigma> x sequentially"
       unfolding o_def by (auto simp: add.commute limitin_sequentially_offset_rev)
     then show "\<exists>x. limitin mtopology \<sigma> x sequentially" ..
   qed
 qed (simp add: mcomplete_def MCauchy_def image_subset_iff)
 
 lemma mcomplete_empty_mspace: "M = {} \<Longrightarrow> mcomplete"
   using MCauchy_def mcomplete_def by blast
 
 lemma MCauchy_const [simp]: "MCauchy (\<lambda>n. a) \<longleftrightarrow> a \<in> M"
   using MCauchy_def mdist_zero by auto
 
 lemma convergent_imp_MCauchy:
   assumes "range \<sigma> \<subseteq> M" and lim: "limitin mtopology \<sigma> l sequentially"
   shows "MCauchy \<sigma>"
   unfolding MCauchy_def image_subset_iff
 proof (intro conjI strip)
   fix \<epsilon>::real
   assume "\<epsilon> > 0"
   then have "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M \<and> d (\<sigma> n) l < \<epsilon>/2"
     using half_gt_zero lim limitin_metric by blast
   then obtain N where "\<And>n. n\<ge>N \<Longrightarrow> \<sigma> n \<in> M \<and> d (\<sigma> n) l < \<epsilon>/2"
     by (force simp: eventually_sequentially)
   then show "\<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>"
     by (smt (verit) Metric_space.limitin_mspace Metric_space.mdist_reverse_triangle Metric_space_axioms field_sum_of_halves lim)
 qed (use assms in blast)
 
 
 lemma mcomplete_alt:
    "mcomplete \<longleftrightarrow> (\<forall>\<sigma>. MCauchy \<sigma> \<longleftrightarrow> range \<sigma> \<subseteq> M \<and> (\<exists>x. limitin mtopology \<sigma> x sequentially))"
   using MCauchy_def convergent_imp_MCauchy mcomplete_def by blast
 
 lemma MCauchy_subsequence:
   assumes "strict_mono r" "MCauchy \<sigma>"
   shows "MCauchy (\<sigma> \<circ> r)"
 proof -
   have "d (\<sigma> (r n)) (\<sigma> (r n')) < \<epsilon>"
     if "N \<le> n" "N \<le> n'" "strict_mono r" "\<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>"
     for \<epsilon> N n n'
     using that by (meson le_trans strict_mono_imp_increasing)
   moreover have "range (\<lambda>x. \<sigma> (r x)) \<subseteq> M"
     using MCauchy_def assms by blast
   ultimately show ?thesis
     using assms by (simp add: MCauchy_def) metis
 qed
 
 lemma MCauchy_offset:
   assumes cau: "MCauchy (\<sigma> \<circ> (+)k)" and \<sigma>: "\<And>n. n < k \<Longrightarrow> \<sigma> n \<in> M" 
   shows "MCauchy \<sigma>"
   unfolding MCauchy_def image_subset_iff
 proof (intro conjI strip)
   fix n
   show "\<sigma> n \<in> M"
     using assms
     unfolding MCauchy_def image_subset_iff
     by (metis UNIV_I comp_apply le_iff_add linorder_not_le)
 next
   fix \<epsilon> :: real
   assume "\<epsilon> > 0"
   obtain N where "\<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d ((\<sigma> \<circ> (+)k) n) ((\<sigma> \<circ> (+)k) n') < \<epsilon>"
     using cau \<open>\<epsilon> > 0\<close> by (fastforce simp: MCauchy_def)
   then show "\<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>"
     unfolding o_def
     apply (rule_tac x="k+N" in exI)
     by (smt (verit, del_insts) add.assoc le_add1 less_eqE)
 qed
 
 lemma MCauchy_convergent_subsequence:
   assumes cau: "MCauchy \<sigma>" and "strict_mono r" 
      and lim: "limitin mtopology (\<sigma> \<circ> r) a sequentially"
   shows "limitin mtopology \<sigma> a sequentially"
   unfolding limitin_metric
 proof (intro conjI strip)
   show "a \<in> M"
     by (meson assms limitin_mspace)
   fix \<epsilon> :: real
   assume "\<epsilon> > 0"
   then obtain N1 where N1: "\<And>n n'. \<lbrakk>n\<ge>N1; n'\<ge>N1\<rbrakk> \<Longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>/2"
     using cau unfolding MCauchy_def by (meson half_gt_zero)
   obtain N2 where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> (\<sigma> \<circ> r) n \<in> M \<and> d ((\<sigma> \<circ> r) n) a < \<epsilon>/2"
     by (metis (no_types, lifting) lim \<open>\<epsilon> > 0\<close> half_gt_zero limit_metric_sequentially)
   have "\<sigma> n \<in> M \<and> d (\<sigma> n) a < \<epsilon>" if "n \<ge> max N1 N2" for n
   proof (intro conjI)
     show "\<sigma> n \<in> M"
       using MCauchy_def cau by blast
     have "N1 \<le> r n"
       by (meson \<open>strict_mono r\<close> le_trans max.cobounded1 strict_mono_imp_increasing that)
     then show "d (\<sigma> n) a < \<epsilon>"
       using N1[of n "r n"] N2[of n] \<open>\<sigma> n \<in> M\<close> \<open>a \<in> M\<close> triangle that by fastforce
   qed
   then show "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M \<and> d (\<sigma> n) a < \<epsilon>"
     using eventually_sequentially by blast
 qed
 
 lemma MCauchy_interleaving_gen:
   "MCauchy (\<lambda>n. if even n then x(n div 2) else y(n div 2)) \<longleftrightarrow>
     (MCauchy x \<and> MCauchy y \<and> (\<lambda>n. d (x n) (y n)) \<longlonglongrightarrow> 0)" (is "?lhs=?rhs")
 proof
   assume L: ?lhs
   have evens: "strict_mono (\<lambda>n::nat. 2 * n)" and odds: "strict_mono (\<lambda>n::nat. Suc (2 * n))"
     by (auto simp: strict_mono_def)
   show ?rhs
   proof (intro conjI)
     show "MCauchy x" "MCauchy y"
       using MCauchy_subsequence [OF evens L] MCauchy_subsequence [OF odds L] by (auto simp: o_def)
     show "(\<lambda>n. d (x n) (y n)) \<longlonglongrightarrow> 0"
       unfolding LIMSEQ_iff
     proof (intro strip)
       fix \<epsilon> :: real
       assume "\<epsilon> > 0"
       then obtain N where N: 
         "\<And>n n'. \<lbrakk>n\<ge>N; n'\<ge>N\<rbrakk> \<Longrightarrow> d (if even n then x (n div 2) else y (n div 2))
                                    (if even n' then x (n' div 2) else y (n' div 2))  < \<epsilon>"
         using L MCauchy_def by fastforce
       have "d (x n) (y n) < \<epsilon>" if "n\<ge>N" for n
         using N [of "2*n" "Suc(2*n)"] that by auto
       then show "\<exists>N. \<forall>n\<ge>N. norm (d (x n) (y n) - 0) < \<epsilon>"
         by auto
     qed
   qed
 next
   assume R: ?rhs
   show ?lhs
     unfolding MCauchy_def
   proof (intro conjI strip)
     show "range (\<lambda>n. if even n then x (n div 2) else y (n div 2)) \<subseteq> M"
       using R by (auto simp: MCauchy_def)
     fix \<epsilon> :: real
     assume "\<epsilon> > 0"
     obtain Nx where Nx: "\<And>n n'. \<lbrakk>n\<ge>Nx; n'\<ge>Nx\<rbrakk> \<Longrightarrow> d (x n) (x n')  < \<epsilon>/2"
       by (meson half_gt_zero MCauchy_def R \<open>\<epsilon> > 0\<close>)
     obtain Ny where Ny: "\<And>n n'. \<lbrakk>n\<ge>Ny; n'\<ge>Ny\<rbrakk> \<Longrightarrow> d (y n) (y n')  < \<epsilon>/2"
       by (meson half_gt_zero MCauchy_def R \<open>\<epsilon> > 0\<close>)
     obtain Nxy where Nxy: "\<And>n. n\<ge>Nxy \<Longrightarrow> d (x n) (y n) < \<epsilon>/2"
       using R \<open>\<epsilon> > 0\<close> half_gt_zero unfolding LIMSEQ_iff
       by (metis abs_mdist diff_zero real_norm_def)
     define N where "N \<equiv> 2 * Max{Nx,Ny,Nxy}"
     show "\<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (if even n then x (n div 2) else y (n div 2)) (if even n' then x (n' div 2) else y (n' div 2)) < \<epsilon>"
     proof (intro exI strip)
       fix n n'
       assume "N \<le> n" and "N \<le> n'"
       then have "n div 2 \<ge> Nx" "n div 2 \<ge> Ny" "n div 2 \<ge> Nxy" "n' div 2 \<ge> Nx" "n' div 2 \<ge> Ny" 
         by (auto simp: N_def)
       then have dxyn: "d (x (n div 2)) (y (n div 2)) < \<epsilon>/2" 
             and dxnn': "d (x (n div 2)) (x (n' div 2)) < \<epsilon>/2"
             and dynn': "d (y (n div 2)) (y (n' div 2)) < \<epsilon>/2"
         using Nx Ny Nxy by blast+
       have inM: "x (n div 2) \<in> M" "x (n' div 2) \<in> M""y (n div 2) \<in> M" "y (n' div 2) \<in> M"
         using Metric_space.MCauchy_def Metric_space_axioms R by blast+
       show "d (if even n then x (n div 2) else y (n div 2)) (if even n' then x (n' div 2) else y (n' div 2)) < \<epsilon>"
       proof (cases "even n")
         case nt: True
         show ?thesis
         proof (cases "even n'")
           case True
           with \<open>\<epsilon> > 0\<close> nt dxnn' show ?thesis by auto
         next
           case False
           with nt dxyn dynn' inM triangle show ?thesis
             by fastforce
         qed
       next
         case nf: False
         show ?thesis 
         proof (cases "even n'")
           case True
           then show ?thesis
             by (smt (verit) \<open>\<epsilon> > 0\<close> dxyn dxnn' triangle commute inM field_sum_of_halves)
         next
           case False
           with \<open>\<epsilon> > 0\<close> nf dynn' show ?thesis by auto
         qed
       qed
     qed
   qed
 qed
 
 lemma MCauchy_interleaving:
    "MCauchy (\<lambda>n. if even n then \<sigma>(n div 2) else a) \<longleftrightarrow>
     range \<sigma> \<subseteq> M \<and> limitin mtopology \<sigma> a sequentially"  (is "?lhs=?rhs")
 proof -
   have "?lhs \<longleftrightarrow> (MCauchy \<sigma> \<and> a \<in> M \<and> (\<lambda>n. d (\<sigma> n) a) \<longlonglongrightarrow> 0)"
     by (simp add: MCauchy_interleaving_gen [where y = "\<lambda>n. a"])
   also have "... = ?rhs"
     by (metis MCauchy_def always_eventually convergent_imp_MCauchy limitin_metric_dist_null range_subsetD)
   finally show ?thesis .
 qed
 
 lemma mcomplete_nest:
    "mcomplete \<longleftrightarrow>
       (\<forall>C::nat \<Rightarrow>'a set. (\<forall>n. closedin mtopology (C n)) \<and>
           (\<forall>n. C n \<noteq> {}) \<and> decseq C \<and> (\<forall>\<epsilon>>0. \<exists>n a. C n \<subseteq> mcball a \<epsilon>)
           \<longrightarrow> \<Inter> (range C) \<noteq> {})" (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
     unfolding imp_conjL
   proof (intro strip)
     fix C :: "nat \<Rightarrow> 'a set"
     assume clo: "\<forall>n. closedin mtopology (C n)"
       and ne: "\<forall>n. C n \<noteq> ({}::'a set)"
       and dec: "decseq C"
       and cover [rule_format]: "\<forall>\<epsilon>>0. \<exists>n a. C n \<subseteq> mcball a \<epsilon>"
     obtain \<sigma> where \<sigma>: "\<And>n. \<sigma> n \<in> C n"
       by (meson ne empty_iff set_eq_iff)
     have "MCauchy \<sigma>"
       unfolding MCauchy_def
     proof (intro conjI strip)
       show "range \<sigma> \<subseteq> M"
         using \<sigma> clo metric_closedin_iff_sequentially_closed by auto 
       fix \<epsilon> :: real
       assume "\<epsilon> > 0"
       then obtain N a where N: "C N \<subseteq> mcball a (\<epsilon>/3)"
         using cover by fastforce
       have "d (\<sigma> m) (\<sigma> n) < \<epsilon>" if "N \<le> m" "N \<le> n" for m n
       proof -
         have "d a (\<sigma> m) \<le> \<epsilon>/3" "d a (\<sigma> n) \<le> \<epsilon>/3"
           using dec N \<sigma> that by (fastforce simp: decseq_def)+
         then have "d (\<sigma> m) (\<sigma> n) \<le> \<epsilon>/3 + \<epsilon>/3"
           using triangle \<sigma> commute dec decseq_def subsetD that N
           by (smt (verit, ccfv_threshold) in_mcball)
         also have "... < \<epsilon>"
           using \<open>\<epsilon> > 0\<close> by auto
         finally show ?thesis .
       qed
       then show "\<exists>N. \<forall>m n. N \<le> m \<longrightarrow> N \<le> n \<longrightarrow> d (\<sigma> m) (\<sigma> n) < \<epsilon>"
         by blast
     qed
     then obtain x where x: "limitin mtopology \<sigma> x sequentially"
       using L mcomplete_def by blast
     have "x \<in> C n" for n
     proof (rule limitin_closedin [OF x])
       show "closedin mtopology (C n)"
         by (simp add: clo)
       show "\<forall>\<^sub>F x in sequentially. \<sigma> x \<in> C n"
         by (metis \<sigma> dec decseq_def eventually_sequentiallyI subsetD)
     qed auto
     then show "\<Inter> (range C) \<noteq> {}"
       by blast
 qed
 next
   assume R: ?rhs  
   show ?lhs
     unfolding mcomplete_def
   proof (intro strip)
     fix \<sigma>
     assume "MCauchy \<sigma>"
     then have "range \<sigma> \<subseteq> M"
       using MCauchy_def by blast
     define C where "C \<equiv> \<lambda>n. mtopology closure_of (\<sigma> ` {n..})"
     have "\<forall>n. closedin mtopology (C n)" 
       by (auto simp: C_def)
     moreover
     have ne: "\<And>n. C n \<noteq> {}"
       using \<open>MCauchy \<sigma>\<close> by (auto simp: C_def MCauchy_def disjnt_iff closure_of_eq_empty_gen)
     moreover
     have dec: "decseq C"
       unfolding monotone_on_def
     proof (intro strip)
       fix m n::nat
       assume "m \<le> n"
       then have "{n..} \<subseteq> {m..}"
         by auto
       then show "C n \<subseteq> C m"
         unfolding C_def by (meson closure_of_mono image_mono)
     qed
     moreover
     have C: "\<exists>N u. C N \<subseteq> mcball u \<epsilon>" if "\<epsilon>>0" for \<epsilon>
     proof -
       obtain N where "\<And>m n. N \<le> m \<and> N \<le> n \<Longrightarrow> d (\<sigma> m) (\<sigma> n) < \<epsilon>"
         by (meson MCauchy_def \<open>0 < \<epsilon>\<close> \<open>MCauchy \<sigma>\<close>)
       then have "\<sigma> ` {N..} \<subseteq> mcball (\<sigma> N) \<epsilon>"
         using MCauchy_def \<open>MCauchy \<sigma>\<close> by (force simp: less_eq_real_def)
       then have "C N \<subseteq> mcball (\<sigma> N) \<epsilon>"
         by (simp add: C_def closure_of_minimal)
       then show ?thesis
         by blast
     qed
     ultimately obtain l where x: "l \<in> \<Inter> (range C)"
       by (metis R ex_in_conv)
     then have *: "\<And>\<epsilon> N. 0 < \<epsilon> \<Longrightarrow> \<exists>n'. N \<le> n' \<and> l \<in> M \<and> \<sigma> n' \<in> M \<and> d l (\<sigma> n') < \<epsilon>"
       by (force simp: C_def metric_closure_of)
     then have "l \<in> M"
       using gt_ex by blast
     show "\<exists>l. limitin mtopology \<sigma> l sequentially"
       unfolding limitin_metric
     proof (intro conjI strip exI)
       show "l \<in> M"
         using \<open>\<forall>n. closedin mtopology (C n)\<close> closedin_subset x by fastforce
       fix \<epsilon>::real
       assume "\<epsilon> > 0"
       obtain N where N: "\<And>m n. N \<le> m \<and> N \<le> n \<Longrightarrow> d (\<sigma> m) (\<sigma> n) < \<epsilon>/2"
         by (meson MCauchy_def \<open>0 < \<epsilon>\<close> \<open>MCauchy \<sigma>\<close> half_gt_zero)
       with * [of "\<epsilon>/2" N]
       have "\<forall>n\<ge>N. \<sigma> n \<in> M \<and> d (\<sigma> n) l < \<epsilon>"
         by (smt (verit) \<open>range \<sigma> \<subseteq> M\<close> commute field_sum_of_halves range_subsetD triangle)
       then show "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M \<and> d (\<sigma> n) l < \<epsilon>"
         using eventually_sequentially by blast
     qed
   qed
 qed
 
 
 lemma mcomplete_nest_sing:
    "mcomplete \<longleftrightarrow>
     (\<forall>C. (\<forall>n. closedin mtopology (C n)) \<and>
           (\<forall>n. C n \<noteq> {}) \<and> decseq C \<and> (\<forall>e>0. \<exists>n a. C n \<subseteq> mcball a e)
          \<longrightarrow> (\<exists>l. l \<in> M \<and> \<Inter> (range C) = {l}))"
 proof -
   have *: False
     if clo: "\<forall>n. closedin mtopology (C n)"
       and cover: "\<forall>\<epsilon>>0. \<exists>n a. C n \<subseteq> mcball a \<epsilon>"
       and no_sing: "\<And>y. y \<in> M \<Longrightarrow> \<Inter> (range C) \<noteq> {y}"
       and l: "\<forall>n. l \<in> C n"
     for C :: "nat \<Rightarrow> 'a set" and l
   proof -
     have inM: "\<And>x. x \<in> \<Inter> (range C) \<Longrightarrow> x \<in> M"
       using closedin_metric clo by fastforce
     then have "l \<in> M"
       by (simp add: l)
     have False if l': "l' \<in> \<Inter> (range C)" and "l' \<noteq> l" for l'
     proof -
       have "l' \<in> M"
         using inM l' by blast
       obtain n a where na: "C n \<subseteq> mcball a (d l l' / 3)"
         using inM \<open>l \<in> M\<close> l' \<open>l' \<noteq> l\<close> cover by force
       then have "d a l \<le> (d l l' / 3)" "d a l' \<le> (d l l' / 3)" "a \<in> M"
         using l l' na in_mcball by auto
       then have "d l l' \<le> (d l l' / 3) + (d l l' / 3)"
         using \<open>l \<in> M\<close> \<open>l' \<in> M\<close> mdist_reverse_triangle by fastforce
       then show False
         using nonneg [of l l'] \<open>l' \<noteq> l\<close> \<open>l \<in> M\<close> \<open>l' \<in> M\<close> zero by force
     qed
     then show False
       by (metis l \<open>l \<in> M\<close> no_sing INT_I empty_iff insertI1 is_singletonE is_singletonI')
   qed
   show ?thesis
     unfolding mcomplete_nest imp_conjL 
     apply (intro all_cong1 imp_cong refl)
     using * 
     by (smt (verit) Inter_iff ex_in_conv range_constant range_eqI)
 qed
 
 lemma mcomplete_fip:
    "mcomplete \<longleftrightarrow>
     (\<forall>\<C>. (\<forall>C \<in> \<C>. closedin mtopology C) \<and>
          (\<forall>e>0. \<exists>C a. C \<in> \<C> \<and> C \<subseteq> mcball a e) \<and> (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<C> \<longrightarrow> \<Inter> \<F> \<noteq> {})
         \<longrightarrow> \<Inter> \<C> \<noteq> {})" 
    (is "?lhs = ?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
     unfolding mcomplete_nest_sing imp_conjL
   proof (intro strip)
     fix \<C> :: "'a set set"
     assume clo: "\<forall>C\<in>\<C>. closedin mtopology C"
       and cover: "\<forall>e>0. \<exists>C a. C \<in> \<C> \<and> C \<subseteq> mcball a e"
       and fip: "\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> \<C> \<longrightarrow> \<Inter> \<F> \<noteq> {}"
     then have "\<forall>n. \<exists>C. C \<in> \<C> \<and> (\<exists>a. C \<subseteq> mcball a (inverse (Suc n)))"
       by simp
     then obtain C where C: "\<And>n. C n \<in> \<C>" 
           and coverC: "\<And>n. \<exists>a. C n \<subseteq> mcball a (inverse (Suc n))"
       by metis
     define D where "D \<equiv> \<lambda>n. \<Inter> (C ` {..n})"
     have cloD: "closedin mtopology (D n)" for n
       unfolding D_def using clo C by blast
     have neD: "D n \<noteq> {}" for n
       using fip C by (simp add: D_def image_subset_iff)
     have decD: "decseq D"
       by (force simp: D_def decseq_def)
     have coverD: "\<exists>n a. D n \<subseteq> mcball a \<epsilon>" if " \<epsilon> >0" for \<epsilon>
     proof -
       obtain n where "inverse (Suc n) < \<epsilon>"
         using \<open>0 < \<epsilon>\<close> reals_Archimedean by blast
       then obtain a where "C n \<subseteq> mcball a \<epsilon>"
         by (meson coverC less_eq_real_def mcball_subset_concentric order_trans)
       then show ?thesis
         unfolding D_def by blast
     qed
     have *: "a \<in> \<Inter>\<C>" if a: "\<Inter> (range D) = {a}" and "a \<in> M" for a
     proof -
       have aC: "a \<in> C n" for n
         using that by (auto simp: D_def)
       have eqa: "\<And>u. (\<forall>n. u \<in> C n) \<Longrightarrow> a = u"
         using that by (auto simp: D_def)
       have "a \<in> T" if "T \<in> \<C>" for T
       proof -
         have cloT: "closedin mtopology (T \<inter> D n)" for n
           using clo cloD that by blast
         have "\<Inter> (insert T (C ` {..n})) \<noteq> {}" for n
           using that C by (intro fip [rule_format]) auto
         then have neT: "T \<inter> D n \<noteq> {}" for n
           by (simp add: D_def)
         have decT: "decseq (\<lambda>n. T \<inter> D n)"
           by (force simp: D_def decseq_def)
         have coverT: "\<exists>n a. T \<inter> D n \<subseteq> mcball a \<epsilon>" if " \<epsilon> >0" for \<epsilon>
           by (meson coverD le_infI2 that)
         show ?thesis
           using L [unfolded mcomplete_nest_sing, rule_format, of "\<lambda>n. T \<inter> D n"] a
           by (force simp: cloT neT decT coverT)
       qed
       then show ?thesis by auto
     qed
     show "\<Inter> \<C> \<noteq> {}"
       by (metis L cloD neD decD coverD * empty_iff mcomplete_nest_sing)
   qed
 next
   assume R [rule_format]: ?rhs
   show ?lhs
     unfolding mcomplete_nest imp_conjL
   proof (intro strip)
     fix C :: "nat \<Rightarrow> 'a set"
     assume clo: "\<forall>n. closedin mtopology (C n)"
       and ne: "\<forall>n. C n \<noteq> {}"
       and dec: "decseq C"
       and cover: "\<forall>\<epsilon>>0. \<exists>n a. C n \<subseteq> mcball a \<epsilon>"
     have "\<Inter>(C ` N) \<noteq> {}" if "finite N" for N
     proof -
       obtain k where "N \<subseteq> {..k}"
         using \<open>finite N\<close> finite_nat_iff_bounded_le by auto
       with dec have "C k \<subseteq> \<Inter>(C ` N)" by (auto simp: decseq_def)
       then show ?thesis
         using ne by force
     qed
     with clo cover R [of "range C"] show "\<Inter> (range C) \<noteq> {}"
       by (metis (no_types, opaque_lifting) finite_subset_image image_iff UNIV_I)
   qed
 qed
 
 
 lemma mcomplete_fip_sing:
    "mcomplete \<longleftrightarrow>
     (\<forall>\<C>. (\<forall>C\<in>\<C>. closedin mtopology C) \<and>
      (\<forall>e>0. \<exists>c a. c \<in> \<C> \<and> c \<subseteq> mcball a e) \<and>
      (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<C> \<longrightarrow> \<Inter> \<F> \<noteq> {}) \<longrightarrow>
      (\<exists>l. l \<in> M \<and> \<Inter> \<C> = {l}))"
    (is "?lhs = ?rhs")
 proof
   have *: "l \<in> M" "\<Inter> \<C> = {l}"
     if clo: "Ball \<C> (closedin mtopology)"
       and cover: "\<forall>e>0. \<exists>C a. C \<in> \<C> \<and> C \<subseteq> mcball a e"
       and fin: "\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> \<C> \<longrightarrow> \<Inter> \<F> \<noteq> {}"
       and l: "l \<in> \<Inter> \<C>"
     for \<C> :: "'a set set" and l
   proof -
     show "l \<in> M"
       by (meson Inf_lower2 clo cover gt_ex metric_closedin_iff_sequentially_closed subsetD that(4))
     show  "\<Inter> \<C> = {l}"
     proof (cases "\<C> = {}")
       case True
       then show ?thesis
         using cover mbounded_pos by auto
     next
       case False
       have CM: "\<And>a. a \<in> \<Inter>\<C> \<Longrightarrow> a \<in> M"
         using False clo closedin_subset by fastforce
       have "l' \<notin> \<Inter> \<C>" if "l' \<noteq> l" for l'
       proof 
         assume l': "l' \<in> \<Inter> \<C>"
         with CM have "l' \<in> M" by blast
         with that \<open>l \<in> M\<close> have gt0: "0 < d l l'"
           by simp
         then obtain C a where "C \<in> \<C>" and C: "C \<subseteq> mcball a (d l l' / 3)"
           using cover [rule_format, of "d l l' / 3"] by auto
         then have "d a l \<le> (d l l' / 3)" "d a l' \<le> (d l l' / 3)" "a \<in> M"
           using l l' in_mcball by auto
         then have "d l l' \<le> (d l l' / 3) + (d l l' / 3)"
           using \<open>l \<in> M\<close> \<open>l' \<in> M\<close> mdist_reverse_triangle by fastforce
         with gt0 show False by auto
       qed
       then show ?thesis
         using l by fastforce
     qed
   qed
   assume L: ?lhs
   with * show ?rhs
     unfolding mcomplete_fip imp_conjL ex_in_conv [symmetric]
     by (elim all_forward imp_forward2 asm_rl) (blast intro:  elim: )
 next
   assume ?rhs then show ?lhs
     unfolding mcomplete_fip by (force elim!: all_forward)
 qed
 
 end
 
 lemma MCauchy_iff_Cauchy [iff]: "Met_TC.MCauchy = Cauchy"
   by (force simp: Cauchy_def Met_TC.MCauchy_def)
 
 lemma mcomplete_iff_complete [iff]:
   "Met_TC.mcomplete (Pure.type ::'a::metric_space itself) \<longleftrightarrow> complete (UNIV::'a set)"
   by (auto simp: Met_TC.mcomplete_def complete_def)
 
 lemma euclidean_metric: "Met_TC.mcomplete (Pure.type ::'a::euclidean_space itself)"
   using complete_UNIV mcomplete_iff_complete by blast
 
 context Submetric
 begin 
 
 lemma MCauchy_submetric:
    "sub.MCauchy \<sigma> \<longleftrightarrow> range \<sigma> \<subseteq> A \<and> MCauchy \<sigma>"
   using MCauchy_def sub.MCauchy_def subset by force
 
 lemma closedin_mcomplete_imp_mcomplete:
   assumes clo: "closedin mtopology A" and "mcomplete"
   shows "sub.mcomplete"
   unfolding sub.mcomplete_def
 proof (intro strip)
   fix \<sigma>
   assume "sub.MCauchy \<sigma>"
   then have \<sigma>: "MCauchy \<sigma>" "range \<sigma> \<subseteq> A"
     using MCauchy_submetric by blast+
   then obtain x where x: "limitin mtopology \<sigma> x sequentially"
     using \<open>mcomplete\<close> unfolding mcomplete_def by blast
   then have "x \<in> A"
     using \<sigma> clo metric_closedin_iff_sequentially_closed by force
   with \<sigma> x show "\<exists>x. limitin sub.mtopology \<sigma> x sequentially"
     using limitin_submetric_iff range_subsetD by fastforce
 qed
 
 
 lemma sequentially_closedin_mcomplete_imp_mcomplete:
   assumes "mcomplete" and "\<And>\<sigma> l. range \<sigma> \<subseteq> A \<and> limitin mtopology \<sigma> l sequentially \<Longrightarrow> l \<in> A"
   shows "sub.mcomplete"
   using assms closedin_mcomplete_imp_mcomplete metric_closedin_iff_sequentially_closed subset by blast
 
 end
 
 
 context Metric_space
 begin
 
 lemma mcomplete_Un:
   assumes A: "Submetric M d A" "Metric_space.mcomplete A d" 
       and B: "Submetric M d B" "Metric_space.mcomplete B d"
   shows   "Submetric M d (A \<union> B)" "Metric_space.mcomplete (A \<union> B) d" 
 proof -
   show "Submetric M d (A \<union> B)"
     by (meson assms le_sup_iff Submetric_axioms_def Submetric_def) 
   then interpret MAB: Metric_space "A \<union> B" d
     by (meson Submetric.subset subspace)
   interpret MA: Metric_space A d
     by (meson A Submetric.subset subspace)
   interpret MB: Metric_space B d
     by (meson B Submetric.subset subspace)
   show "Metric_space.mcomplete (A \<union> B) d"
     unfolding MAB.mcomplete_def
   proof (intro strip)
     fix \<sigma>
     assume "MAB.MCauchy \<sigma>"
     then have "range \<sigma> \<subseteq> A \<union> B"
       using MAB.MCauchy_def by blast
     then have "UNIV \<subseteq> \<sigma> -` A \<union> \<sigma> -` B"
       by blast
     then consider "infinite (\<sigma> -` A)" | "infinite (\<sigma> -` B)"
       using finite_subset by auto
     then show "\<exists>x. limitin MAB.mtopology \<sigma> x sequentially"
     proof cases
       case 1
       then obtain r where "strict_mono r" and r: "\<And>n::nat. r n \<in> \<sigma> -` A"
         using infinite_enumerate by blast 
       then have "MA.MCauchy (\<sigma> \<circ> r)"
         using MA.MCauchy_def MAB.MCauchy_def MAB.MCauchy_subsequence \<open>MAB.MCauchy \<sigma>\<close> by auto
       with A obtain x where "limitin MA.mtopology (\<sigma> \<circ> r) x sequentially"
         using MA.mcomplete_def by blast
       then have "limitin MAB.mtopology (\<sigma> \<circ> r) x sequentially"
         by (metis MA.limit_metric_sequentially MAB.limit_metric_sequentially UnCI)
       then show ?thesis
         using MAB.MCauchy_convergent_subsequence \<open>MAB.MCauchy \<sigma>\<close> \<open>strict_mono r\<close> by blast
     next
       case 2
       then obtain r where "strict_mono r" and r: "\<And>n::nat. r n \<in> \<sigma> -` B"
         using infinite_enumerate by blast 
       then have "MB.MCauchy (\<sigma> \<circ> r)"
         using MB.MCauchy_def MAB.MCauchy_def MAB.MCauchy_subsequence \<open>MAB.MCauchy \<sigma>\<close> by auto
       with B obtain x where "limitin MB.mtopology (\<sigma> \<circ> r) x sequentially"
         using MB.mcomplete_def by blast
       then have "limitin MAB.mtopology (\<sigma> \<circ> r) x sequentially"
         by (metis MB.limit_metric_sequentially MAB.limit_metric_sequentially UnCI)
       then show ?thesis
         using MAB.MCauchy_convergent_subsequence \<open>MAB.MCauchy \<sigma>\<close> \<open>strict_mono r\<close> by blast
     qed
   qed
 qed
 
 lemma mcomplete_Union:
   assumes "finite \<S>"
     and "\<And>A. A \<in> \<S> \<Longrightarrow> Submetric M d A" "\<And>A. A \<in> \<S> \<Longrightarrow> Metric_space.mcomplete A d"
   shows   "Submetric M d (\<Union>\<S>)" "Metric_space.mcomplete (\<Union>\<S>) d" 
   using assms
   by (induction rule: finite_induct) (auto simp: mcomplete_Un)
 
 lemma mcomplete_Inter:
   assumes "finite \<S>" "\<S> \<noteq> {}"
     and sub: "\<And>A. A \<in> \<S> \<Longrightarrow> Submetric M d A" 
     and comp: "\<And>A. A \<in> \<S> \<Longrightarrow> Metric_space.mcomplete A d"
   shows "Submetric M d (\<Inter>\<S>)" "Metric_space.mcomplete (\<Inter>\<S>) d"
 proof -
   show "Submetric M d (\<Inter>\<S>)"
     using assms unfolding Submetric_def Submetric_axioms_def
     by (metis Inter_lower equals0I inf.orderE le_inf_iff) 
   then interpret MS: Submetric M d "\<Inter>\<S>" 
     by (meson Submetric.subset subspace)
   show "Metric_space.mcomplete (\<Inter>\<S>) d"
     unfolding MS.sub.mcomplete_def
   proof (intro strip)
     fix \<sigma>
     assume "MS.sub.MCauchy \<sigma>"
     then have "range \<sigma> \<subseteq> \<Inter>\<S>"
       using MS.MCauchy_submetric by blast
     obtain A where "A \<in> \<S>" and A: "Metric_space.mcomplete A d"
       using assms by blast
     then have "range \<sigma> \<subseteq> A"
       using \<open>range \<sigma> \<subseteq> \<Inter>\<S>\<close> by blast
     interpret SA: Submetric M d A
       by (meson \<open>A \<in> \<S>\<close> sub Submetric.subset subspace)
     have "MCauchy \<sigma>"
       using MS.MCauchy_submetric \<open>MS.sub.MCauchy \<sigma>\<close> by blast
     then obtain x where x: "limitin SA.sub.mtopology \<sigma> x sequentially"
       by (metis A SA.sub.MCauchy_def SA.sub.mcomplete_alt MCauchy_def \<open>range \<sigma> \<subseteq> A\<close>)
     show "\<exists>x. limitin MS.sub.mtopology \<sigma> x sequentially"
       apply (rule_tac x="x" in exI)
       unfolding MS.limitin_submetric_iff
     proof (intro conjI)
       show "x \<in> \<Inter> \<S>"
       proof clarsimp
         fix U
         assume "U \<in> \<S>"
         interpret SU: Submetric M d U 
           by (meson \<open>U \<in> \<S>\<close> sub Submetric.subset subspace)
         have "range \<sigma> \<subseteq> U"
           using \<open>U \<in> \<S>\<close> \<open>range \<sigma> \<subseteq> \<Inter> \<S>\<close> by blast
         moreover have "Metric_space.mcomplete U d"
           by (simp add: \<open>U \<in> \<S>\<close> comp)
         ultimately obtain x' where x': "limitin SU.sub.mtopology \<sigma> x' sequentially"
           using MCauchy_def SU.sub.MCauchy_def SU.sub.mcomplete_alt \<open>MCauchy \<sigma>\<close> by meson 
         have "x' = x"
         proof (intro limitin_metric_unique)
           show "limitin mtopology \<sigma> x' sequentially"
             by (meson SU.Submetric_axioms Submetric.limitin_submetric_iff x')
           show "limitin mtopology \<sigma> x sequentially"
             by (meson SA.Submetric_axioms Submetric.limitin_submetric_iff x)
         qed auto
         then show "x \<in> U"
           using SU.sub.limitin_mspace x' by blast
       qed
       show "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> \<Inter>\<S>"
         by (meson \<open>range \<sigma> \<subseteq> \<Inter> \<S>\<close> always_eventually range_subsetD)
       show "limitin mtopology \<sigma> x sequentially"
         by (meson SA.Submetric_axioms Submetric.limitin_submetric_iff x)
     qed
   qed
 qed
 
 
 lemma mcomplete_Int:
   assumes A: "Submetric M d A" "Metric_space.mcomplete A d" 
       and B: "Submetric M d B" "Metric_space.mcomplete B d"
     shows   "Submetric M d (A \<inter> B)" "Metric_space.mcomplete (A \<inter> B) d"
   using mcomplete_Inter [of "{A,B}"] assms by force+
 
 subsection\<open>Totally bounded subsets of metric spaces\<close>
 
 definition mtotally_bounded 
   where "mtotally_bounded S \<equiv> \<forall>\<epsilon>>0. \<exists>K. finite K \<and> K \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
 
 lemma mtotally_bounded_empty [iff]: "mtotally_bounded {}"
 by (simp add: mtotally_bounded_def)
 
 lemma finite_imp_mtotally_bounded:
    "\<lbrakk>finite S; S \<subseteq> M\<rbrakk> \<Longrightarrow> mtotally_bounded S"
   by (auto simp: mtotally_bounded_def)
 
 lemma mtotally_bounded_imp_subset: "mtotally_bounded S \<Longrightarrow> S \<subseteq> M"
   by (force simp: mtotally_bounded_def intro!: zero_less_one)
 
 lemma mtotally_bounded_sing [simp]:
    "mtotally_bounded {x} \<longleftrightarrow> x \<in> M"
   by (meson empty_subsetI finite.simps finite_imp_mtotally_bounded insert_subset mtotally_bounded_imp_subset)
 
 lemma mtotally_bounded_Un:
   assumes  "mtotally_bounded S" "mtotally_bounded T"
   shows "mtotally_bounded (S \<union> T)"
 proof -
   have "\<exists>K. finite K \<and> K \<subseteq> S \<union> T \<and> S \<union> T \<subseteq> (\<Union>x\<in>K. mball x e)"
     if  "e>0" and K: "finite K \<and> K \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>K. mball x e)"
       and L: "finite L \<and> L \<subseteq> T \<and> T \<subseteq> (\<Union>x\<in>L. mball x e)" for K L e
     using that by (rule_tac x="K \<union> L" in exI) auto
   with assms show ?thesis
     unfolding mtotally_bounded_def by presburger
 qed
  
 lemma mtotally_bounded_Union:
   assumes "finite f" "\<And>S. S \<in> f \<Longrightarrow> mtotally_bounded S"
   shows "mtotally_bounded (\<Union>f)"
   using assms by (induction f) (auto simp: mtotally_bounded_Un)
 
 lemma mtotally_bounded_imp_mbounded:
   assumes "mtotally_bounded S"
   shows "mbounded S"
 proof -
   obtain K where "finite K \<and> K \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>K. mball x 1)" 
     using assms by (force simp: mtotally_bounded_def)
   then show ?thesis
     by (smt (verit) finite_imageI image_iff mbounded_Union mbounded_mball mbounded_subset)
 qed
 
 
 lemma mtotally_bounded_sequentially:
   "mtotally_bounded S \<longleftrightarrow>
     S \<subseteq> M \<and> (\<forall>\<sigma>::nat \<Rightarrow> 'a. range \<sigma> \<subseteq> S \<longrightarrow> (\<exists>r. strict_mono r \<and> MCauchy (\<sigma> \<circ> r)))"
   (is "_ \<longleftrightarrow> _ \<and> ?rhs")
 proof (cases "S \<subseteq> M")
   case True
   show ?thesis
   proof -
     { fix \<sigma> :: "nat \<Rightarrow> 'a"                                                            
       assume L: "mtotally_bounded S" and \<sigma>: "range \<sigma> \<subseteq> S"
       have "\<exists>j > i. d (\<sigma> i) (\<sigma> j) < 3*\<epsilon>/2 \<and> infinite (\<sigma> -` mball (\<sigma> j) (\<epsilon>/2))"
         if inf: "infinite (\<sigma> -` mball (\<sigma> i) \<epsilon>)" and "\<epsilon> > 0" for i \<epsilon>
       proof -
         obtain K where "finite K" "K \<subseteq> S" and K: "S \<subseteq> (\<Union>x\<in>K. mball x (\<epsilon>/4))"
           by (metis L mtotally_bounded_def \<open>\<epsilon> > 0\<close> zero_less_divide_iff zero_less_numeral)
         then have K_imp_ex: "\<And>y. y \<in> S \<Longrightarrow> \<exists>x\<in>K. d x y < \<epsilon>/4"
           by fastforce
         have False if "\<forall>x\<in>K. d x (\<sigma> i) < \<epsilon> + \<epsilon>/4 \<longrightarrow> finite (\<sigma> -` mball x (\<epsilon>/4))"
         proof -
           have "\<exists>w. w \<in> K \<and> d w (\<sigma> i) < 5 * \<epsilon>/4 \<and> d w (\<sigma> j) < \<epsilon>/4"
             if "d (\<sigma> i) (\<sigma> j) < \<epsilon>" for j
           proof -
             obtain w where w: "d w (\<sigma> j) < \<epsilon>/4" "w \<in> K"
               using K_imp_ex \<sigma> by blast
             then have "d w (\<sigma> i) < \<epsilon> + \<epsilon>/4"
               by (smt (verit, ccfv_SIG) True \<open>K \<subseteq> S\<close> \<sigma> rangeI subset_eq that triangle')
             with w show ?thesis
               using in_mball by auto
           qed
           then have "(\<sigma> -` mball (\<sigma> i) \<epsilon>) \<subseteq> (\<Union>x\<in>K. if d x (\<sigma> i) < \<epsilon> + \<epsilon>/4 then \<sigma> -` mball x (\<epsilon>/4) else {})"
             using True \<open>K \<subseteq> S\<close> by force
           then show False
             using finite_subset inf \<open>finite K\<close> that by fastforce
         qed
         then obtain x where "x \<in> K" and dxi: "d x (\<sigma> i) < \<epsilon> + \<epsilon>/4" and infx: "infinite (\<sigma> -` mball x (\<epsilon>/4))"
           by blast
         then obtain j where "j \<in> (\<sigma> -` mball x (\<epsilon>/4)) - {..i}"
           using bounded_nat_set_is_finite by (meson Diff_infinite_finite finite_atMost)
         then have "j > i" and dxj: "d x (\<sigma> j) < \<epsilon>/4" 
           by auto
         have "(\<sigma> -` mball x (\<epsilon>/4)) \<subseteq> (\<sigma> -` mball y (\<epsilon>/2))" if "d x y < \<epsilon>/4" "y \<in> M" for y
           using that by (simp add: mball_subset Metric_space_axioms vimage_mono)
         then have infj: "infinite (\<sigma> -` mball (\<sigma> j) (\<epsilon>/2))"
           by (meson True \<open>d x (\<sigma> j) < \<epsilon>/4\<close> \<sigma> in_mono infx rangeI finite_subset)
         have "\<sigma> i \<in> M" "\<sigma> j \<in> M" "x \<in> M"  
           using True \<open>K \<subseteq> S\<close> \<open>x \<in> K\<close> \<sigma> by force+
         then have "d (\<sigma> i) (\<sigma> j) \<le> d x (\<sigma> i) + d x (\<sigma> j)"
           using triangle'' by blast
         also have "\<dots> < 3*\<epsilon>/2"
           using dxi dxj by auto
         finally have "d (\<sigma> i) (\<sigma> j) < 3*\<epsilon>/2" .
         with \<open>i < j\<close> infj show ?thesis by blast
       qed
       then obtain nxt where nxt: "\<And>i \<epsilon>. \<lbrakk>\<epsilon> > 0; infinite (\<sigma> -` mball (\<sigma> i) \<epsilon>)\<rbrakk> \<Longrightarrow> 
                  nxt i \<epsilon> > i \<and> d (\<sigma> i) (\<sigma> (nxt i \<epsilon>)) < 3*\<epsilon>/2 \<and> infinite (\<sigma> -` mball (\<sigma> (nxt i \<epsilon>)) (\<epsilon>/2))"
         by metis
       have "mbounded S"
         using L by (simp add: mtotally_bounded_imp_mbounded)
       then obtain B where B: "\<forall>y \<in> S. d (\<sigma> 0) y \<le> B" and "B > 0"
         by (meson \<sigma> mbounded_alt_pos range_subsetD)
       define eps where "eps \<equiv> \<lambda>n. (B+1) / 2^n"
       have [simp]: "eps (Suc n) = eps n / 2" "eps n > 0" for n
         using \<open>B > 0\<close> by (auto simp: eps_def)
       have "UNIV \<subseteq> \<sigma> -` mball (\<sigma> 0) (B+1)"
         using B True \<sigma> unfolding image_iff subset_iff
         by (smt (verit, best) UNIV_I in_mball vimageI)
       then have inf0: "infinite (\<sigma> -` mball (\<sigma> 0) (eps 0))"
         using finite_subset by (auto simp: eps_def)
       define r where "r \<equiv> rec_nat 0 (\<lambda>n rec. nxt rec (eps n))"
       have [simp]: "r 0 = 0" "r (Suc n) = nxt (r n) (eps n)" for n
         by (auto simp: r_def)
       have \<sigma>rM[simp]: "\<sigma> (r n) \<in> M" for n
         using True \<sigma> by blast
       have inf: "infinite (\<sigma> -` mball (\<sigma> (r n)) (eps n))" for n
       proof (induction n)
         case 0 then show ?case  
           by (simp add: inf0)
       next
         case (Suc n) then show ?case
           using nxt [of "eps n" "r n"] by simp
       qed
       then have "r (Suc n) > r n" for n
         by (simp add: nxt)
       then have "strict_mono r"
         by (simp add: strict_mono_Suc_iff)
       have d_less: "d (\<sigma> (r n)) (\<sigma> (r (Suc n))) < 3 * eps n / 2" for n
         using nxt [OF _ inf] by simp
       have eps_plus: "eps (k + n) = eps n * (1/2)^k" for k n
         by (simp add: eps_def power_add field_simps)
       have *: "d (\<sigma> (r n)) (\<sigma> (r (k + n))) < 3 * eps n" for n k
       proof -
         have "d (\<sigma> (r n)) (\<sigma> (r (k+n))) \<le> 3/2 * eps n * (\<Sum>i<k. (1/2)^i)"
         proof (induction k)
           case 0 then show ?case 
             by simp
         next
           case (Suc k)
           have "d (\<sigma> (r n)) (\<sigma> (r (Suc k + n))) \<le> d (\<sigma> (r n)) (\<sigma> (r (k + n))) + d (\<sigma> (r (k + n))) (\<sigma> (r (Suc (k + n))))"
             by (metis \<sigma>rM add.commute add_Suc_right triangle)
           with d_less[of "k+n"] Suc show ?case
             by (simp add: algebra_simps eps_plus)
         qed
         also have "\<dots> < 3/2 * eps n * 2"
           using geometric_sum [of "1/2::real" k] by simp
         finally show ?thesis by simp
       qed
       have "\<exists>N. \<forall>n\<ge>N. \<forall>n'\<ge>N. d (\<sigma> (r n)) (\<sigma> (r n')) < \<epsilon>" if "\<epsilon> > 0" for \<epsilon>
       proof -
         define N where "N \<equiv> nat \<lceil>(log 2 (6*(B+1) / \<epsilon>))\<rceil>"
         have \<section>: "b \<le> 2 ^ nat \<lceil>log 2 b\<rceil>" for b
           by (smt (verit) less_log_of_power real_nat_ceiling_ge)
         have N: "6 * eps N \<le> \<epsilon>"
           using \<section> [of "(6*(B+1) / \<epsilon>)"] that by (auto simp: N_def eps_def field_simps)
         have "d (\<sigma> (r N)) (\<sigma> (r n)) < 3 * eps N" if "n \<ge> N" for n
           by (metis * add.commute nat_le_iff_add that)
         then have "\<forall>n\<ge>N. \<forall>n'\<ge>N. d (\<sigma> (r n)) (\<sigma> (r n')) < 3 * eps N + 3 * eps N"
           by (smt (verit, best) \<sigma>rM triangle'')
         with N show ?thesis
           by fastforce
       qed
       then have "MCauchy (\<sigma> \<circ> r)"
         unfolding MCauchy_def using True \<sigma> by auto
       then have "\<exists>r. strict_mono r \<and> MCauchy (\<sigma> \<circ> r)"
         using \<open>strict_mono r\<close> by blast      
     }
     moreover
     { assume R: ?rhs
       have "mtotally_bounded S"
         unfolding mtotally_bounded_def
       proof (intro strip)
         fix \<epsilon> :: real
         assume "\<epsilon> > 0"
         have False if \<section>: "\<And>K. \<lbrakk>finite K; K \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>s\<in>S. s \<notin> (\<Union>x\<in>K. mball x \<epsilon>)"
         proof -
           obtain f where f: "\<And>K. \<lbrakk>finite K; K \<subseteq> S\<rbrakk> \<Longrightarrow> f K \<in> S \<and> f K \<notin> (\<Union>x\<in>K. mball x \<epsilon>)"
             using \<section> by metis
           define \<sigma> where "\<sigma> \<equiv> wfrec less_than (\<lambda>seq n. f (seq ` {..<n}))"
           have \<sigma>_eq: "\<sigma> n = f (\<sigma> ` {..<n})" for n
             by (simp add: cut_apply def_wfrec [OF \<sigma>_def])
           have [simp]: "\<sigma> n \<in> S" for n
             using wf_less_than
           proof (induction n rule: wf_induct_rule)
             case (less n) with f show ?case
               by (auto simp: \<sigma>_eq [of n])
           qed
           then have "range \<sigma> \<subseteq> S" by blast
           have \<sigma>: "p < n \<Longrightarrow> \<epsilon> \<le> d (\<sigma> p) (\<sigma> n)" for n p
             using f[of "\<sigma> ` {..<n}"] True by (fastforce simp: \<sigma>_eq [of n] Ball_def)
           then obtain r where "strict_mono r" "MCauchy (\<sigma> \<circ> r)"
             by (meson R \<open>range \<sigma> \<subseteq> S\<close>)
           with \<open>0 < \<epsilon>\<close> obtain N 
             where N: "\<And>n n'. \<lbrakk>n\<ge>N; n'\<ge>N\<rbrakk> \<Longrightarrow> d (\<sigma> (r n)) (\<sigma> (r n')) < \<epsilon>"
             by (force simp: MCauchy_def)
           show ?thesis
             using N [of N "Suc (r N)"] \<open>strict_mono r\<close>
             by (smt (verit) Suc_le_eq \<sigma> le_SucI order_refl strict_mono_imp_increasing)
         qed
         then show "\<exists>K. finite K \<and> K \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
           by blast
       qed
     }
     ultimately show ?thesis 
       using True by blast
   qed
 qed (use mtotally_bounded_imp_subset in auto)
 
 
 lemma mtotally_bounded_subset:
    "\<lbrakk>mtotally_bounded S; T \<subseteq> S\<rbrakk> \<Longrightarrow> mtotally_bounded T"
   by (meson mtotally_bounded_sequentially order_trans) 
 
 lemma mtotally_bounded_submetric:
   assumes "mtotally_bounded S" "S \<subseteq> T" "T \<subseteq> M"
   shows "Metric_space.mtotally_bounded T d S"
 proof -
   interpret Submetric M d T
     by (simp add: Metric_space_axioms assms Submetric.intro Submetric_axioms.intro)
   show ?thesis
     using assms
     unfolding sub.mtotally_bounded_def mtotally_bounded_def
     by (force simp: subset_iff elim!: all_forward ex_forward)
 qed
 
 lemma mtotally_bounded_absolute:
    "mtotally_bounded S \<longleftrightarrow> S \<subseteq> M \<and> Metric_space.mtotally_bounded S d S "
 proof -
   have "mtotally_bounded S" if "S \<subseteq> M" "Metric_space.mtotally_bounded S d S"
   proof -
     interpret Submetric M d S
       by (simp add: Metric_space_axioms Submetric_axioms.intro Submetric_def \<open>S \<subseteq> M\<close>)
     show ?thesis
       using that
       by (metis MCauchy_submetric Metric_space.mtotally_bounded_sequentially Metric_space_axioms subspace)
   qed
   moreover have "mtotally_bounded S \<Longrightarrow> Metric_space.mtotally_bounded S d S"
     by (simp add: mtotally_bounded_imp_subset mtotally_bounded_submetric)
   ultimately show ?thesis
     using mtotally_bounded_imp_subset by blast
 qed
 
 lemma mtotally_bounded_closure_of:
   assumes "mtotally_bounded S"
   shows "mtotally_bounded (mtopology closure_of S)"
 proof -
   have "S \<subseteq> M"
     by (simp add: assms mtotally_bounded_imp_subset)
   have "mtotally_bounded(mtopology closure_of S)"
     unfolding mtotally_bounded_def
   proof (intro strip)
     fix \<epsilon>::real
     assume "\<epsilon> > 0"
     then obtain K where "finite K" "K \<subseteq> S" and K: "S \<subseteq> (\<Union>x\<in>K. mball x (\<epsilon>/2))"
       by (metis assms mtotally_bounded_def half_gt_zero)
     have "mtopology closure_of S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
       unfolding metric_closure_of
     proof clarsimp
       fix x
       assume "x \<in> M" and x: "\<forall>r>0. \<exists>y\<in>S. y \<in> M \<and> d x y < r"
       then obtain y where "y \<in> S" and y: "d x y < \<epsilon>/2"
         using \<open>0 < \<epsilon>\<close> half_gt_zero by blast
       then obtain x' where "x' \<in> K" "y \<in> mball x' (\<epsilon>/2)"
         using K by auto
       then have "d x' x < \<epsilon>/2 + \<epsilon>/2"
         using triangle y \<open>x \<in> M\<close> commute by fastforce
       then show "\<exists>x'\<in>K. x' \<in> M \<and> d x' x < \<epsilon>"
         using \<open>K \<subseteq> S\<close> \<open>S \<subseteq> M\<close> \<open>x' \<in> K\<close> by force
     qed
     then show "\<exists>K. finite K \<and> K \<subseteq> mtopology closure_of S \<and> mtopology closure_of S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
       using closure_of_subset_Int  \<open>K \<subseteq> S\<close> \<open>finite K\<close> K by fastforce
   qed
   then show ?thesis
     by (simp add: assms inf.absorb2 mtotally_bounded_imp_subset)
 qed
 
 lemma mtotally_bounded_closure_of_eq:
    "S \<subseteq> M \<Longrightarrow> mtotally_bounded (mtopology closure_of S) \<longleftrightarrow> mtotally_bounded S"
   by (metis closure_of_subset mtotally_bounded_closure_of mtotally_bounded_subset topspace_mtopology)
 
 lemma mtotally_bounded_cauchy_sequence:
   assumes "MCauchy \<sigma>"
   shows "mtotally_bounded (range \<sigma>)"
   unfolding MCauchy_def mtotally_bounded_def
 proof (intro strip)
   fix \<epsilon>::real
   assume "\<epsilon> > 0"
   then obtain N where "\<And>n. N \<le> n \<Longrightarrow> d (\<sigma> N) (\<sigma> n) < \<epsilon>"
     using assms by (force simp: MCauchy_def)
   then have "\<And>m. \<exists>n\<le>N. \<sigma> n \<in> M \<and> \<sigma> m \<in> M \<and> d (\<sigma> n) (\<sigma> m) < \<epsilon>"
     by (metis MCauchy_def assms mdist_zero nle_le range_subsetD)
   then
   show "\<exists>K. finite K \<and> K \<subseteq> range \<sigma> \<and> range \<sigma> \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
     by (rule_tac x="\<sigma> ` {0..N}" in exI) force
 qed
 
 lemma MCauchy_imp_mbounded:
    "MCauchy \<sigma> \<Longrightarrow> mbounded (range \<sigma>)"
   by (simp add: mtotally_bounded_cauchy_sequence mtotally_bounded_imp_mbounded)
 
 subsection\<open>Compactness in metric spaces\<close>
 
 lemma Bolzano_Weierstrass_property:
   assumes "S \<subseteq> U" "S \<subseteq> M"
   shows
    "(\<forall>\<sigma>::nat\<Rightarrow>'a. range \<sigma> \<subseteq> S
          \<longrightarrow> (\<exists>l r. l \<in> U \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially)) \<longleftrightarrow>
     (\<forall>T. T \<subseteq> S \<and> infinite T \<longrightarrow> U \<inter> mtopology derived_set_of T \<noteq> {})"  (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
   proof clarify
     fix T
     assume "T \<subseteq> S" and "infinite T"
       and T: "U \<inter> mtopology derived_set_of T = {}"
     then obtain \<sigma> :: "nat\<Rightarrow>'a" where "inj \<sigma>" "range \<sigma> \<subseteq> T"
       by (meson infinite_countable_subset)
     with L obtain l r where "l \<in> U" "strict_mono r" 
            and lr: "limitin mtopology (\<sigma> \<circ> r) l sequentially"
       by (meson \<open>T \<subseteq> S\<close> subset_trans)
     then obtain \<epsilon> where "\<epsilon> > 0" and \<epsilon>: "\<And>y. y \<in> T \<Longrightarrow> y = l \<or> \<not> d l y < \<epsilon>"
       using T \<open>T \<subseteq> S\<close> \<open>S \<subseteq> M\<close> 
       by (force simp: metric_derived_set_of limitin_metric disjoint_iff)
     with lr have "\<forall>\<^sub>F n in sequentially. \<sigma> (r n) \<in> M \<and> d (\<sigma> (r n)) l < \<epsilon>"
       by (auto simp: limitin_metric)
     then obtain N where N: "d (\<sigma> (r N)) l < \<epsilon>" "d (\<sigma> (r (Suc N))) l < \<epsilon>"
       using less_le_not_le by (auto simp: eventually_sequentially)
     moreover have "\<sigma> (r N) \<noteq> l \<or> \<sigma> (r (Suc N)) \<noteq> l"
       by (meson \<open>inj \<sigma>\<close> \<open>strict_mono r\<close> injD n_not_Suc_n strict_mono_eq)
     ultimately
     show False
        using \<epsilon> \<open>range \<sigma> \<subseteq> T\<close> commute by fastforce
   qed
 next
   assume R: ?rhs 
   show ?lhs
   proof (intro strip)
     fix \<sigma> :: "nat \<Rightarrow> 'a"
     assume "range \<sigma> \<subseteq> S"
     show "\<exists>l r. l \<in> U \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially"
     proof (cases "finite (range \<sigma>)")
       case True
       then obtain m where "infinite (\<sigma> -` {\<sigma> m})"
         by (metis image_iff inf_img_fin_dom nat_not_finite)
       then obtain r where [iff]: "strict_mono r" and r: "\<And>n::nat. r n \<in> \<sigma> -` {\<sigma> m}"
         using infinite_enumerate by blast 
       have [iff]: "\<sigma> m \<in> U" "\<sigma> m \<in> M"
         using \<open>range \<sigma> \<subseteq> S\<close> assms by blast+
       show ?thesis
       proof (intro conjI exI)
         show "limitin mtopology (\<sigma> \<circ> r) (\<sigma> m) sequentially"
           using r by (simp add: limitin_metric)
       qed auto
     next
       case False
       then obtain l where "l \<in> U" and l: "l \<in> mtopology derived_set_of (range \<sigma>)"
         by (meson R \<open>range \<sigma> \<subseteq> S\<close> disjoint_iff)
       then obtain g where g: "\<And>\<epsilon>. \<epsilon>>0 \<Longrightarrow> \<sigma> (g \<epsilon>) \<noteq> l \<and> d l (\<sigma> (g \<epsilon>)) < \<epsilon>"
         by (simp add: metric_derived_set_of) metis
       have "range \<sigma> \<subseteq> M"
         using \<open>range \<sigma> \<subseteq> S\<close> assms by auto
       have "l \<in> M"
         using l metric_derived_set_of by auto
       define E where  \<comment>\<open>a construction to ensure monotonicity\<close>
         "E \<equiv> \<lambda>rec n. insert (inverse (Suc n)) ((\<lambda>i. d l (\<sigma> i)) ` (\<Union>k<n. {0..rec k})) - {0}"
       define r where "r \<equiv> wfrec less_than (\<lambda>rec n. g (Min (E rec n)))"
       have "(\<Union>k<n. {0..cut r less_than n k}) = (\<Union>k<n. {0..r k})" for n
         by (auto simp: cut_apply)
       then have r_eq: "r n = g (Min (E r n))" for n
         by (metis E_def def_wfrec [OF r_def] wf_less_than)
       have dl_pos[simp]: "d l (\<sigma> (r n)) > 0" for n
         using wf_less_than
       proof (induction n rule: wf_induct_rule)
         case (less n) 
         then have *: "Min (E r n) > 0"
           using \<open>l \<in> M\<close> \<open>range \<sigma> \<subseteq> M\<close> by (auto simp: E_def image_subset_iff)
         show ?case
           using g [OF *] r_eq [of n]
           by (metis \<open>l \<in> M\<close> \<open>range \<sigma> \<subseteq> M\<close> mdist_pos_less range_subsetD)
       qed
       then have non_l: "\<sigma> (r n) \<noteq> l" for n
         using \<open>range \<sigma> \<subseteq> M\<close> mdist_pos_eq by blast
       have Min_pos: "Min (E r n) > 0" for n
         using dl_pos \<open>l \<in> M\<close> \<open>range \<sigma> \<subseteq> M\<close> by (auto simp: E_def image_subset_iff)
       have d_small: "d (\<sigma>(r n)) l < inverse(Suc n)" for n
       proof -
         have "d (\<sigma>(r n)) l < Min (E r n)"
           by (simp add: \<open>0 < Min (E r n)\<close> commute g r_eq) 
         also have "... \<le> inverse(Suc n)"
           by (simp add: E_def)
         finally show ?thesis .
       qed
       have d_lt_d: "d l (\<sigma> (r n)) < d l (\<sigma> i)" if \<section>: "p < n" "i \<le> r p" "\<sigma> i \<noteq> l" for i p n
       proof -
         have 1: "d l (\<sigma> i) \<in> E r n"
           using \<section> \<open>l \<in> M\<close> \<open>range \<sigma> \<subseteq> M\<close> 
           by (force simp: E_def image_subset_iff image_iff)
         have "d l (\<sigma> (g (Min (E r n)))) < Min (E r n)"
           by (rule conjunct2 [OF g [OF Min_pos]])
         also have "Min (E r n) \<le> d l (\<sigma> i)"
           using 1 unfolding E_def by (force intro!: Min.coboundedI)
         finally show ?thesis
           by (simp add: r_eq) 
       qed
       have r: "r p < r n" if "p < n" for p n
         using d_lt_d [OF that] non_l by (meson linorder_not_le order_less_irrefl) 
       show ?thesis
       proof (intro exI conjI)
         show "strict_mono r"
           by (simp add: r strict_monoI)
         show "limitin mtopology (\<sigma> \<circ> r) l sequentially"
           unfolding limitin_metric
         proof (intro conjI strip \<open>l \<in> M\<close>)
           fix \<epsilon> :: real
           assume "\<epsilon> > 0"
           then have "\<forall>\<^sub>F n in sequentially. inverse(Suc n) < \<epsilon>"
             using Archimedean_eventually_inverse by auto
           then show "\<forall>\<^sub>F n in sequentially. (\<sigma> \<circ> r) n \<in> M \<and> d ((\<sigma> \<circ> r) n) l < \<epsilon>"
             by (smt (verit) \<open>range \<sigma> \<subseteq> M\<close> commute comp_apply d_small eventually_mono range_subsetD)
         qed
       qed (use \<open>l \<in> U\<close> in auto)
     qed
   qed
 qed
 
 subsubsection \<open>More on Bolzano Weierstrass\<close>
 
 lemma Bolzano_Weierstrass_A: 
   assumes "compactin mtopology S" "T \<subseteq> S" "infinite T"
   shows "S \<inter> mtopology derived_set_of T \<noteq> {}"
   by (simp add: assms compactin_imp_Bolzano_Weierstrass)
 
 lemma Bolzano_Weierstrass_B:
   fixes \<sigma> :: "nat \<Rightarrow> 'a"
   assumes "S \<subseteq> M" "range \<sigma> \<subseteq> S"
     and "\<And>T. \<lbrakk>T \<subseteq> S \<and> infinite T\<rbrakk> \<Longrightarrow> S \<inter> mtopology derived_set_of T \<noteq> {}"
   shows "\<exists>l r. l \<in> S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially"
   using Bolzano_Weierstrass_property assms by blast
 
 lemma Bolzano_Weierstrass_C:
   assumes "S \<subseteq> M"
   assumes "\<And>\<sigma>:: nat \<Rightarrow> 'a. range \<sigma> \<subseteq> S \<Longrightarrow>
                 (\<exists>l r. l \<in> S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially)"
   shows "mtotally_bounded S"
   unfolding mtotally_bounded_sequentially
   by (metis convergent_imp_MCauchy assms image_comp image_mono subset_UNIV subset_trans)
 
 lemma Bolzano_Weierstrass_D:
   assumes "S \<subseteq> M" "S \<subseteq> \<Union>\<C>" and opeU: "\<And>U. U \<in> \<C> \<Longrightarrow> openin mtopology U"
   assumes \<section>: "(\<forall>\<sigma>::nat\<Rightarrow>'a. range \<sigma> \<subseteq> S
          \<longrightarrow> (\<exists>l r. l \<in> S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially))"
   shows "\<exists>\<epsilon>>0. \<forall>x \<in> S. \<exists>U \<in> \<C>. mball x \<epsilon> \<subseteq> U"
 proof (rule ccontr)
   assume "\<not> (\<exists>\<epsilon>>0. \<forall>x \<in> S. \<exists>U \<in> \<C>. mball x \<epsilon> \<subseteq> U)"
   then have "\<forall>n. \<exists>x\<in>S. \<forall>U\<in>\<C>. \<not> mball x (inverse (Suc n)) \<subseteq> U"
     by simp
   then obtain \<sigma> where "\<And>n. \<sigma> n \<in> S" 
        and \<sigma>: "\<And>n U. U \<in> \<C> \<Longrightarrow> \<not> mball (\<sigma> n) (inverse (Suc n)) \<subseteq> U"
     by metis
   then obtain l r where "l \<in> S" "strict_mono r" 
          and lr: "limitin mtopology (\<sigma> \<circ> r) l sequentially"
     by (meson \<section> image_subsetI)
   with \<open>S \<subseteq> \<Union>\<C>\<close> obtain B where "l \<in> B" "B \<in> \<C>"
     by auto
   then obtain \<epsilon> where "\<epsilon> > 0" and \<epsilon>: "\<And>z. \<lbrakk>z \<in> M; d z l < \<epsilon>\<rbrakk> \<Longrightarrow> z \<in> B"
     by (metis opeU [OF \<open>B \<in> \<C>\<close>] commute in_mball openin_mtopology subset_iff)
   then have "\<forall>\<^sub>F n in sequentially. \<sigma> (r n) \<in> M \<and> d (\<sigma> (r n)) l < \<epsilon>/2"
     using lr half_gt_zero unfolding limitin_metric o_def by blast
   moreover have "\<forall>\<^sub>F n in sequentially. inverse (real (Suc n)) < \<epsilon>/2"
     using Archimedean_eventually_inverse \<open>0 < \<epsilon>\<close> half_gt_zero by blast
   ultimately obtain n where n: "d (\<sigma> (r n)) l < \<epsilon>/2" "inverse (real (Suc n)) < \<epsilon>/2"
     by (smt (verit, del_insts) eventually_sequentially le_add1 le_add2)
   have "x \<in> B" if "d (\<sigma> (r n)) x < inverse (Suc(r n))" "x \<in> M" for x
   proof -
     have rle: "inverse (real (Suc (r n))) \<le> inverse (real (Suc n))"
       using \<open>strict_mono r\<close> strict_mono_imp_increasing by auto
     have "d x l \<le> d (\<sigma> (r n)) x + d (\<sigma> (r n)) l"
       using that by (metis triangle \<open>\<And>n. \<sigma> n \<in> S\<close> \<open>l \<in> S\<close> \<open>S \<subseteq> M\<close> commute subsetD)
     also have "... < \<epsilon>"
       using that n rle by linarith
     finally show ?thesis
       by (simp add: \<epsilon> that)
   qed
   then show False
     using \<sigma> [of B "r n"] by (simp add: \<open>B \<in> \<C>\<close> subset_iff)
 qed
 
 
 lemma Bolzano_Weierstrass_E:
   assumes "mtotally_bounded S" "S \<subseteq> M"
   and S: "\<And>\<C>. \<lbrakk>\<And>U. U \<in> \<C> \<Longrightarrow> openin mtopology U; S \<subseteq> \<Union>\<C>\<rbrakk> \<Longrightarrow> \<exists>\<epsilon>>0. \<forall>x \<in> S. \<exists>U \<in> \<C>. mball x \<epsilon> \<subseteq> U"
   shows "compactin mtopology S"
 proof (clarsimp simp: compactin_def assms)
   fix \<U> :: "'a set set"
   assume \<U>: "\<forall>x\<in>\<U>. openin mtopology x" and "S \<subseteq> \<Union>\<U>"
   then obtain \<epsilon> where "\<epsilon>>0" and \<epsilon>: "\<And>x. x \<in> S \<Longrightarrow> \<exists>U \<in> \<U>. mball x \<epsilon> \<subseteq> U"
     by (metis S)
   then obtain f where f: "\<And>x. x \<in> S \<Longrightarrow> f x \<in> \<U> \<and> mball x \<epsilon> \<subseteq> f x"
     by metis
   then obtain K where "finite K" "K \<subseteq> S" and K: "S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
     by (metis \<open>0 < \<epsilon>\<close> \<open>mtotally_bounded S\<close> mtotally_bounded_def)
   show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>"
   proof (intro conjI exI)
     show "finite (f ` K)"
       by (simp add: \<open>finite K\<close>)
     show "f ` K \<subseteq> \<U>"
       using \<open>K \<subseteq> S\<close> f by blast
     show "S \<subseteq> \<Union>(f ` K)"
       using K \<open>K \<subseteq> S\<close> by (force dest: f)
   qed
 qed
 
 
 lemma compactin_eq_Bolzano_Weierstrass:
   "compactin mtopology S \<longleftrightarrow>
    S \<subseteq> M \<and> (\<forall>T. T \<subseteq> S \<and> infinite T \<longrightarrow> S \<inter> mtopology derived_set_of T \<noteq> {})"
   using Bolzano_Weierstrass_C Bolzano_Weierstrass_D Bolzano_Weierstrass_E
   by (smt (verit, del_insts) Bolzano_Weierstrass_property compactin_imp_Bolzano_Weierstrass compactin_subspace subset_refl topspace_mtopology)
 
 lemma compactin_sequentially:
   shows "compactin mtopology S \<longleftrightarrow>
         S \<subseteq> M \<and>
         ((\<forall>\<sigma>::nat\<Rightarrow>'a. range \<sigma> \<subseteq> S
          \<longrightarrow> (\<exists>l r. l \<in> S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially)))"
   by (metis Bolzano_Weierstrass_property compactin_eq_Bolzano_Weierstrass subset_refl)
 
 lemma compactin_imp_mtotally_bounded: 
   "compactin mtopology S \<Longrightarrow> mtotally_bounded S"
   by (simp add: Bolzano_Weierstrass_C compactin_sequentially)
 
 lemma lebesgue_number:
     "\<lbrakk>compactin mtopology S; S \<subseteq> \<Union>\<C>; \<And>U. U \<in> \<C> \<Longrightarrow> openin mtopology U\<rbrakk>
     \<Longrightarrow> \<exists>\<epsilon>>0. \<forall>x \<in> S. \<exists>U \<in> \<C>. mball x \<epsilon> \<subseteq> U"
   by (simp add: Bolzano_Weierstrass_D compactin_sequentially)
 
 lemma compact_space_sequentially:
    "compact_space mtopology \<longleftrightarrow>
     (\<forall>\<sigma>::nat\<Rightarrow>'a. range \<sigma> \<subseteq> M
          \<longrightarrow> (\<exists>l r. l \<in> M \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially))"
   by (simp add: compact_space_def compactin_sequentially)
 
 lemma compact_space_eq_Bolzano_Weierstrass:
    "compact_space mtopology \<longleftrightarrow>
     (\<forall>S. S \<subseteq> M \<and> infinite S \<longrightarrow> mtopology derived_set_of S \<noteq> {})"
   using Int_absorb1 [OF derived_set_of_subset_topspace [of mtopology]]
   by (force simp: compact_space_def compactin_eq_Bolzano_Weierstrass)
 
 lemma compact_space_nest:
    "compact_space mtopology \<longleftrightarrow>
     (\<forall>C. (\<forall>n::nat. closedin mtopology (C n)) \<and> (\<forall>n. C n \<noteq> {}) \<and> decseq C \<longrightarrow> \<Inter>(range C) \<noteq> {})"
    (is "?lhs=?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof clarify
     fix C :: "nat \<Rightarrow> 'a set"
     assume "\<forall>n. closedin mtopology (C n)"
       and "\<forall>n. C n \<noteq> {}"
       and "decseq C"
       and "\<Inter> (range C) = {}"
     then obtain K where K: "finite K" "\<Inter>(C ` K) = {}"
       by (metis L compact_space_imp_nest)
     then obtain k where "K \<subseteq> {..k}"
       using finite_nat_iff_bounded_le by auto
     then have "C k \<subseteq> \<Inter>(C ` K)"
       using \<open>decseq C\<close> by (auto simp:decseq_def)
     then show False
       by (simp add: K \<open>\<forall>n. C n \<noteq> {}\<close>)
   qed
 next
   assume R [rule_format]: ?rhs
   show ?lhs
     unfolding compact_space_sequentially
   proof (intro strip)
     fix \<sigma> :: "nat \<Rightarrow> 'a"
     assume \<sigma>: "range \<sigma> \<subseteq> M"
     have "mtopology closure_of \<sigma> ` {n..} \<noteq> {}" for n
       using \<open>range \<sigma> \<subseteq> M\<close> by (auto simp: closure_of_eq_empty image_subset_iff)
     moreover have "decseq (\<lambda>n. mtopology closure_of \<sigma> ` {n..})"
       using closure_of_mono image_mono by (smt (verit) atLeast_subset_iff decseq_def) 
     ultimately obtain l where l: "\<And>n. l \<in> mtopology closure_of \<sigma> ` {n..}"
       using R [of "\<lambda>n. mtopology closure_of (\<sigma> ` {n..})"] by auto
     then have "l \<in> M" and "\<And>n. \<forall>r>0. \<exists>k\<ge>n. \<sigma> k \<in> M \<and> d l (\<sigma> k) < r"
       using metric_closure_of by fastforce+
     then obtain f where f: "\<And>n r. r>0 \<Longrightarrow> f n r \<ge> n \<and> \<sigma> (f n r) \<in> M \<and> d l (\<sigma> (f n r)) < r"
       by metis
     define r where "r = rec_nat (f 0 1) (\<lambda>n rec. (f (Suc rec) (inverse (Suc (Suc n)))))"
     have r: "d l (\<sigma>(r n)) < inverse(Suc n)" for n
       by (induction n) (auto simp: rec_nat_0_imp [OF r_def] rec_nat_Suc_imp [OF r_def] f)
     have "r n < r(Suc n)" for n
       by (simp add: Suc_le_lessD f r_def)
     then have "strict_mono r"
       by (simp add: strict_mono_Suc_iff)
     moreover have "limitin mtopology (\<sigma> \<circ> r) l sequentially"
       proof (clarsimp simp: limitin_metric \<open>l \<in> M\<close>)
         fix \<epsilon> :: real
         assume "\<epsilon> > 0"
         then have "(\<forall>\<^sub>F n in sequentially. inverse (real (Suc n)) < \<epsilon>)"
           using Archimedean_eventually_inverse by blast
         then show "\<forall>\<^sub>F n in sequentially. \<sigma> (r n) \<in> M \<and> d (\<sigma> (r n)) l < \<epsilon>"
           by eventually_elim (metis commute \<open>range \<sigma> \<subseteq> M\<close>  order_less_trans r range_subsetD)
       qed
     ultimately show "\<exists>l r. l \<in> M \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially"
       using \<open>l \<in> M\<close> by blast
   qed
 qed
 
 
 lemma (in discrete_metric) mcomplete_discrete_metric: "disc.mcomplete"
 proof (clarsimp simp: disc.mcomplete_def)
   fix \<sigma> :: "nat \<Rightarrow> 'a"
   assume "disc.MCauchy \<sigma>"
   then obtain N where "\<And>n. N \<le> n \<Longrightarrow> \<sigma> N = \<sigma> n"
     unfolding disc.MCauchy_def by (metis dd_def dual_order.refl order_less_irrefl zero_less_one)
   moreover have "range \<sigma> \<subseteq> M"
     using \<open>disc.MCauchy \<sigma>\<close> disc.MCauchy_def by blast
   ultimately have "limitin disc.mtopology \<sigma> (\<sigma> N) sequentially"
     by (metis disc.limit_metric_sequentially disc.zero range_subsetD)
   then show "\<exists>x. limitin disc.mtopology \<sigma> x sequentially" ..
 qed
 
 lemma compact_space_imp_mcomplete: "compact_space mtopology \<Longrightarrow> mcomplete"
   by (simp add: compact_space_nest mcomplete_nest)
 
 lemma (in Submetric) compactin_imp_mcomplete:
    "compactin mtopology A \<Longrightarrow> sub.mcomplete"
   by (simp add: compactin_subspace mtopology_submetric sub.compact_space_imp_mcomplete)
 
 lemma (in Submetric) mcomplete_imp_closedin:
   assumes "sub.mcomplete"
   shows "closedin mtopology A"
 proof -
   have "l \<in> A"
     if "range \<sigma> \<subseteq> A" and l: "limitin mtopology \<sigma> l sequentially"
     for \<sigma> :: "nat \<Rightarrow> 'a" and l
   proof -
     have "sub.MCauchy \<sigma>"
       using convergent_imp_MCauchy subset that by (force simp: MCauchy_submetric)
     then have "limitin sub.mtopology \<sigma> l sequentially"
       using assms unfolding sub.mcomplete_def
       using l limitin_metric_unique limitin_submetric_iff trivial_limit_sequentially by blast
     then show ?thesis
       using limitin_submetric_iff by blast
   qed
   then show ?thesis
     using metric_closedin_iff_sequentially_closed subset by auto
 qed
 
 lemma (in Submetric) closedin_eq_mcomplete:
    "mcomplete \<Longrightarrow> (closedin mtopology A \<longleftrightarrow> sub.mcomplete)"
   using closedin_mcomplete_imp_mcomplete mcomplete_imp_closedin by blast
 
 lemma compact_space_eq_mcomplete_mtotally_bounded:
    "compact_space mtopology \<longleftrightarrow> mcomplete \<and> mtotally_bounded M"
   by (meson Bolzano_Weierstrass_C compact_space_imp_mcomplete compact_space_sequentially limitin_mspace 
             mcomplete_alt mtotally_bounded_sequentially subset_refl)
 
 
 lemma compact_closure_of_imp_mtotally_bounded:
    "\<lbrakk>compactin mtopology (mtopology closure_of S); S \<subseteq> M\<rbrakk>
       \<Longrightarrow> mtotally_bounded S"
   using compactin_imp_mtotally_bounded mtotally_bounded_closure_of_eq by blast
 
 lemma mtotally_bounded_eq_compact_closure_of:
   assumes "mcomplete"
   shows "mtotally_bounded S \<longleftrightarrow> S \<subseteq> M \<and> compactin mtopology (mtopology closure_of S)"
   (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
     unfolding compactin_subspace
   proof (intro conjI)
     show "S \<subseteq> M"
       using L by (simp add: mtotally_bounded_imp_subset)
     show "mtopology closure_of S \<subseteq> topspace mtopology"
       by (simp add: \<open>S \<subseteq> M\<close> closure_of_minimal)
     then have MSM: "mtopology closure_of S \<subseteq> M"
       by auto
     interpret S: Submetric M d "mtopology closure_of S"
     proof qed (use MSM in auto)
     have "S.sub.mtotally_bounded (mtopology closure_of S)"
       using L mtotally_bounded_absolute mtotally_bounded_closure_of by blast
     then
     show "compact_space (subtopology mtopology (mtopology closure_of S))"
       using S.closedin_mcomplete_imp_mcomplete S.mtopology_submetric S.sub.compact_space_eq_mcomplete_mtotally_bounded assms by force
   qed
 qed (auto simp: compact_closure_of_imp_mtotally_bounded)
 
 
 
 lemma compact_closure_of_eq_Bolzano_Weierstrass:
    "compactin mtopology (mtopology closure_of S) \<longleftrightarrow>
     (\<forall>T. infinite T \<and> T \<subseteq> S \<and> T \<subseteq> M \<longrightarrow> mtopology derived_set_of T \<noteq> {})"  (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
   proof (intro strip)
     fix T
     assume T: "infinite T \<and> T \<subseteq> S \<and> T \<subseteq> M"
     show "mtopology derived_set_of T \<noteq> {}"
     proof (intro compact_closure_of_imp_Bolzano_Weierstrass)
       show "compactin mtopology (mtopology closure_of S)"
         by (simp add: L)
     qed (use T in auto)
   qed
 next
   have "compactin mtopology (mtopology closure_of S)"
     if \<section>: "\<And>T. \<lbrakk>infinite T; T \<subseteq> S\<rbrakk> \<Longrightarrow> mtopology derived_set_of T \<noteq> {}" and "S \<subseteq> M" for S
     unfolding compactin_sequentially
   proof (intro conjI strip)
     show MSM: "mtopology closure_of S \<subseteq> M"
       using closure_of_subset_topspace by fastforce
     fix \<sigma> :: "nat \<Rightarrow> 'a"
     assume \<sigma>: "range \<sigma> \<subseteq> mtopology closure_of S"
     then have "\<exists>y \<in> S. d (\<sigma> n) y < inverse(Suc n)" for n
       by (simp add: metric_closure_of image_subset_iff) (metis inverse_Suc of_nat_Suc)
     then obtain \<tau> where \<tau>: "\<And>n. \<tau> n \<in> S \<and> d (\<sigma> n) (\<tau> n) < inverse(Suc n)"
       by metis
     then have "range \<tau> \<subseteq> S"
       by blast
     moreover
     have *: "\<forall>T. T \<subseteq> S \<and> infinite T \<longrightarrow> mtopology closure_of S \<inter> mtopology derived_set_of T \<noteq> {}"
       using "\<section>"(1) derived_set_of_mono derived_set_of_subset_closure_of by fastforce
     moreover have "S \<subseteq> mtopology closure_of S"
       by (simp add: \<open>S \<subseteq> M\<close> closure_of_subset)
     ultimately obtain l r where lr:
       "l \<in> mtopology closure_of S" "strict_mono r" "limitin mtopology (\<tau> \<circ> r) l sequentially"
       using Bolzano_Weierstrass_property \<open>S \<subseteq> M\<close> by metis
     then have "l \<in> M"
       using limitin_mspace by blast
     have dr_less: "d ((\<sigma> \<circ> r) n) ((\<tau> \<circ> r) n) < inverse(Suc n)" for n
     proof -
       have "d ((\<sigma> \<circ> r) n) ((\<tau> \<circ> r) n) < inverse(Suc (r n))"
         using \<tau> by auto
       also have "... \<le> inverse(Suc n)"
         using lr strict_mono_imp_increasing by auto
       finally show ?thesis .
     qed
     have "limitin mtopology (\<sigma> \<circ> r) l sequentially"
       unfolding limitin_metric
     proof (intro conjI strip)
       show "l \<in> M"
         using limitin_mspace lr by blast
       fix \<epsilon> :: real
       assume "\<epsilon> > 0"
       then have "\<forall>\<^sub>F n in sequentially. (\<tau> \<circ> r) n \<in> M \<and> d ((\<tau> \<circ> r) n) l < \<epsilon>/2"
         using lr half_gt_zero limitin_metric by blast 
       moreover have "\<forall>\<^sub>F n in sequentially. inverse (real (Suc n)) < \<epsilon>/2"
         using Archimedean_eventually_inverse \<open>0 < \<epsilon>\<close> half_gt_zero by blast
       then have "\<forall>\<^sub>F n in sequentially. d ((\<sigma> \<circ> r) n) ((\<tau> \<circ> r) n) < \<epsilon>/2"
         by eventually_elim (smt (verit, del_insts) dr_less)
       ultimately have "\<forall>\<^sub>F n in sequentially. d ((\<sigma> \<circ> r) n) l < \<epsilon>/2 + \<epsilon>/2"
         by eventually_elim (smt (verit) triangle \<open>l \<in> M\<close> MSM \<sigma> comp_apply order_trans range_subsetD)      
       then show "\<forall>\<^sub>F n in sequentially. (\<sigma> \<circ> r) n \<in> M \<and> d ((\<sigma> \<circ> r) n) l < \<epsilon>"
         apply eventually_elim
         using \<open>mtopology closure_of S \<subseteq> M\<close> \<sigma> by auto
     qed
     with lr show "\<exists>l r. l \<in> mtopology closure_of S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially"
       by blast
   qed
   then show "?rhs \<Longrightarrow> ?lhs"
     by (metis Int_subset_iff closure_of_restrict inf_le1 topspace_mtopology)
 qed
 
 end
 
 lemma (in discrete_metric) mtotally_bounded_discrete_metric:
    "disc.mtotally_bounded S \<longleftrightarrow> finite S \<and> S \<subseteq> M" (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
   proof
     show "finite S"
       by (metis (no_types) L closure_of_subset_Int compactin_discrete_topology disc.mtotally_bounded_eq_compact_closure_of
           disc.topspace_mtopology discrete_metric.mcomplete_discrete_metric inf.absorb_iff2 mtopology_discrete_metric finite_subset)
     show "S \<subseteq> M"
       by (simp add: L disc.mtotally_bounded_imp_subset)
   qed
 qed (simp add: disc.finite_imp_mtotally_bounded)
 
 
 context Metric_space
 begin
 
 lemma derived_set_of_infinite_openin_metric:
    "mtopology derived_set_of S =
     {x \<in> M. \<forall>U. x \<in> U \<and> openin mtopology U \<longrightarrow> infinite(S \<inter> U)}"
   by (simp add: derived_set_of_infinite_openin Hausdorff_space_mtopology)
 
 lemma derived_set_of_infinite_1: 
   assumes "infinite (S \<inter> mball x \<epsilon>)" 
   shows "infinite (S \<inter> mcball x \<epsilon>)"
   by (meson Int_mono assms finite_subset mball_subset_mcball subset_refl)
 
 lemma derived_set_of_infinite_2:
   assumes "openin mtopology U" "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> infinite (S \<inter> mcball x \<epsilon>)" and "x \<in> U"
   shows "infinite (S \<inter> U)"
   by (metis assms openin_mtopology_mcball finite_Int inf.absorb_iff2 inf_assoc)
 
 lemma derived_set_of_infinite_mball:
   "mtopology derived_set_of S = {x \<in> M. \<forall>e>0. infinite(S \<inter> mball x e)}"
   unfolding derived_set_of_infinite_openin_metric
   by (meson centre_in_mball_iff openin_mball derived_set_of_infinite_1 derived_set_of_infinite_2)
 
 lemma derived_set_of_infinite_mcball:
   "mtopology derived_set_of S = {x \<in> M. \<forall>e>0. infinite(S \<inter> mcball x e)}"
   unfolding derived_set_of_infinite_openin_metric
   by (meson centre_in_mball_iff openin_mball derived_set_of_infinite_1 derived_set_of_infinite_2)
 
 end
 
 subsection\<open>Continuous functions on metric spaces\<close>
 
 context Metric_space
 begin
 
 lemma continuous_map_to_metric:
    "continuous_map X mtopology f \<longleftrightarrow>
     (\<forall>x \<in> topspace X. \<forall>\<epsilon>>0. \<exists>U. openin X U \<and> x \<in> U \<and> (\<forall>y\<in>U. f y \<in> mball (f x) \<epsilon>))"
    (is "?lhs=?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding continuous_map_eq_topcontinuous_at topcontinuous_at_def
     by (metis centre_in_mball_iff openin_mball topspace_mtopology)
 next
   assume R: ?rhs
   then have "\<forall>x\<in>topspace X. f x \<in> M"
     by (meson gt_ex in_mball)
   moreover 
   have "\<And>x V. \<lbrakk>x \<in> topspace X; openin mtopology V; f x \<in> V\<rbrakk> \<Longrightarrow> \<exists>U. openin X U \<and> x \<in> U \<and> (\<forall>y\<in>U. f y \<in> V)"
     unfolding openin_mtopology by (metis Int_iff R inf.orderE)
   ultimately
   show ?lhs
     by (simp add: continuous_map_eq_topcontinuous_at topcontinuous_at_def)
 qed 
 
 lemma continuous_map_from_metric:
    "continuous_map mtopology X f \<longleftrightarrow>
     f ` M \<subseteq> topspace X \<and>
     (\<forall>a \<in> M. \<forall>U. openin X U \<and> f a \<in> U \<longrightarrow> (\<exists>r>0. \<forall>x. x \<in> M \<and> d a x < r \<longrightarrow> f x \<in> U))"
 proof (cases "f ` M \<subseteq> topspace X")
   case True
   then show ?thesis
     by (fastforce simp: continuous_map openin_mtopology subset_eq)
 next
   case False
   then show ?thesis
     by (simp add: continuous_map_eq_image_closure_subset_gen)
 qed
 
 text \<open>An abstract formulation, since the limits do not have to be sequential\<close>
 lemma continuous_map_uniform_limit:
   assumes contf: "\<forall>\<^sub>F \<xi> in F. continuous_map X mtopology (f \<xi>)"
     and dfg: "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> \<forall>\<^sub>F \<xi> in F. \<forall>x \<in> topspace X. g x \<in> M \<and> d (f \<xi> x) (g x) < \<epsilon>"
     and nontriv: "\<not> trivial_limit F"
   shows "continuous_map X mtopology g"
   unfolding continuous_map_to_metric
 proof (intro strip)
   fix x and \<epsilon>::real
   assume "x \<in> topspace X" and "\<epsilon> > 0"
   then obtain \<xi> where k: "continuous_map X mtopology (f \<xi>)" 
     and gM: "\<forall>x \<in> topspace X. g x \<in> M" 
     and third: "\<forall>x \<in> topspace X. d (f \<xi> x) (g x) < \<epsilon>/3"
     using eventually_conj [OF contf] contf dfg [of "\<epsilon>/3"] eventually_happens' [OF nontriv]
     by (smt (verit, ccfv_SIG) zero_less_divide_iff)
   then obtain U where U: "openin X U" "x \<in> U" and Uthird: "\<forall>y\<in>U. d (f \<xi> y) (f \<xi> x) < \<epsilon>/3"
     unfolding continuous_map_to_metric
     by (metis \<open>0 < \<epsilon>\<close> \<open>x \<in> topspace X\<close> commute divide_pos_pos in_mball zero_less_numeral)
   have f_inM: "f \<xi> y \<in> M" if "y\<in>U" for y
     using U k openin_subset that by (fastforce simp: continuous_map_def)
   have "d (g y) (g x) < \<epsilon>" if "y\<in>U" for y
   proof -
     have "g y \<in> M"
       using U gM openin_subset that by blast
     have "d (g y) (g x) \<le> d (g y) (f \<xi> x) + d (f \<xi> x) (g x)"
       by (simp add: U \<open>g y \<in> M\<close> \<open>x \<in> topspace X\<close> f_inM gM triangle)
     also have "\<dots> \<le> d (g y) (f \<xi> y) + d (f \<xi> y) (f \<xi> x) + d (f \<xi> x) (g x)"
       by (simp add: U \<open>g y \<in> M\<close> commute f_inM that triangle')
     also have "\<dots> < \<epsilon>/3 + \<epsilon>/3 + \<epsilon>/3"
       by (smt (verit) U(1) Uthird \<open>x \<in> topspace X\<close> commute openin_subset subsetD that third)
     finally show ?thesis by simp
   qed
   with U gM show "\<exists>U. openin X U \<and> x \<in> U \<and> (\<forall>y\<in>U. g y \<in> mball (g x) \<epsilon>)"
     by (metis commute in_mball in_mono openin_subset)
 qed
 
 
 lemma continuous_map_uniform_limit_alt:
   assumes contf: "\<forall>\<^sub>F \<xi> in F. continuous_map X mtopology (f \<xi>)"
     and gim: "g ` (topspace X) \<subseteq> M"
     and dfg: "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> \<forall>\<^sub>F \<xi> in F. \<forall>x \<in> topspace X. d (f \<xi> x) (g x) < \<epsilon>"
     and nontriv: "\<not> trivial_limit F"
   shows "continuous_map X mtopology g"
 proof (rule continuous_map_uniform_limit [OF contf])
   fix \<epsilon> :: real
   assume "\<epsilon> > 0"
   with gim dfg show "\<forall>\<^sub>F \<xi> in F. \<forall>x\<in>topspace X. g x \<in> M \<and> d (f \<xi> x) (g x) < \<epsilon>"
     by (simp add: image_subset_iff)
 qed (use nontriv in auto)
 
 
 lemma continuous_map_uniformly_Cauchy_limit:
   assumes "mcomplete"
   assumes contf: "\<forall>\<^sub>F n in sequentially. continuous_map X mtopology (f n)"
     and Cauchy': "\<And>\<epsilon>. \<epsilon> > 0 \<Longrightarrow> \<exists>N. \<forall>m n x. N \<le> m \<longrightarrow> N \<le> n \<longrightarrow> x \<in> topspace X \<longrightarrow> d (f m x) (f n x) < \<epsilon>"
   obtains g where
     "continuous_map X mtopology g"
     "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>topspace X. d (f n x) (g x) < \<epsilon>"
 proof -
   have "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>l. limitin mtopology (\<lambda>n. f n x) l sequentially"
     using \<open>mcomplete\<close> [unfolded mcomplete, rule_format] assms
     by (smt (verit) contf continuous_map_def eventually_mono topspace_mtopology)
   then obtain g where g: "\<And>x. x \<in> topspace X \<Longrightarrow> limitin mtopology (\<lambda>n. f n x) (g x) sequentially"
     by metis
   show thesis
   proof
     show "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>topspace X. d (f n x) (g x) < \<epsilon>"
       if "\<epsilon> > 0" for \<epsilon> :: real
     proof -
       obtain N where N: "\<And>m n x. \<lbrakk>N \<le> m; N \<le> n; x \<in> topspace X\<rbrakk> \<Longrightarrow> d (f m x) (f n x) < \<epsilon>/2"
         by (meson Cauchy' \<open>0 < \<epsilon>\<close> half_gt_zero)
       obtain P where P: "\<And>n x. \<lbrakk>n \<ge> P; x \<in> topspace X\<rbrakk> \<Longrightarrow> f n x \<in> M"
         using contf by (auto simp: eventually_sequentially continuous_map_def)
       show ?thesis
       proof (intro eventually_sequentiallyI strip)
         fix n x
         assume "max N P \<le> n" and x: "x \<in> topspace X"
         obtain L where "g x \<in> M" and L: "\<forall>n\<ge>L. f n x \<in> M \<and> d (f n x) (g x) < \<epsilon>/2"
           using g [OF x] \<open>\<epsilon> > 0\<close> unfolding limitin_metric
           by (metis (no_types, lifting) eventually_sequentially half_gt_zero)
         define n' where "n' \<equiv> Max{L,N,P}"
         have L': "\<forall>m \<ge> n'. f m x \<in> M \<and> d (f m x) (g x) < \<epsilon>/2"
           using L by (simp add: n'_def)
         moreover
         have "d (f n x) (f n' x) < \<epsilon>/2"
           using N [of n n' x] \<open>max N P \<le> n\<close> n'_def x by fastforce
         ultimately have "d (f n x) (g x) < \<epsilon>/2 + \<epsilon>/2"
           by (smt (verit, ccfv_SIG) P \<open>g x \<in> M\<close> \<open>max N P \<le> n\<close> le_refl max.bounded_iff mdist_zero triangle' x)
         then show "d (f n x) (g x) < \<epsilon>" by simp
       qed
     qed
     then show "continuous_map X mtopology g"
       by (smt (verit, del_insts) eventually_mono g limitin_mspace trivial_limit_sequentially continuous_map_uniform_limit [OF contf])
   qed
 qed
 
 lemma metric_continuous_map:
   assumes "Metric_space M' d'"
   shows
    "continuous_map mtopology (Metric_space.mtopology M' d') f \<longleftrightarrow>
     f ` M \<subseteq> M' \<and> (\<forall>a \<in> M. \<forall>\<epsilon>>0. \<exists>\<delta>>0.  (\<forall>x. x \<in> M \<and> d a x < \<delta> \<longrightarrow> d' (f a) (f x) < \<epsilon>))"
    (is "?lhs = ?rhs")
 proof -
   interpret M': Metric_space M' d'
     by (simp add: assms)
   show ?thesis
   proof
     assume L: ?lhs
     show ?rhs
     proof (intro conjI strip)
       show "f ` M \<subseteq> M'"
         using L by (auto simp: continuous_map_def)
       fix a and \<epsilon> :: real
       assume "a \<in> M" and "\<epsilon> > 0"
       then have "openin mtopology {x \<in> M. f x \<in> M'.mball (f a) \<epsilon>}" "f a \<in> M'"
         using L unfolding continuous_map_def by fastforce+
       then obtain \<delta> where "\<delta> > 0" "mball a \<delta> \<subseteq> {x \<in> M. f x \<in> M' \<and> d' (f a) (f x) < \<epsilon>}"
         using \<open>0 < \<epsilon>\<close> \<open>a \<in> M\<close> openin_mtopology by auto
       then show "\<exists>\<delta>>0. \<forall>x. x \<in> M \<and> d a x < \<delta> \<longrightarrow> d' (f a) (f x) < \<epsilon>"
         using \<open>a \<in> M\<close> in_mball by blast
     qed
   next
     assume R: ?rhs    
     show ?lhs
       unfolding continuous_map_def
     proof (intro conjI strip)
       fix U
       assume "openin M'.mtopology U"
       then show "openin mtopology {x \<in> topspace mtopology. f x \<in> U}"
         apply (simp add: continuous_map_def openin_mtopology M'.openin_mtopology subset_iff)
         by (metis R image_subset_iff)
     qed (use R in auto)
   qed
 qed
 
 end (*Metric_space*)
 
 
 subsection \<open>Completely metrizable spaces\<close>
 
 text \<open>These spaces are topologically complete\<close>
 
 definition completely_metrizable_space where
  "completely_metrizable_space X \<equiv> 
      \<exists>M d. Metric_space M d \<and> Metric_space.mcomplete M d \<and> X = Metric_space.mtopology M d"
 
 lemma empty_completely_metrizable_space: 
   "topspace X = {} \<Longrightarrow> completely_metrizable_space X"
   unfolding completely_metrizable_space_def subtopology_eq_discrete_topology_empty [symmetric]
   by (metis Metric_space.mcomplete_empty_mspace discrete_metric.mtopology_discrete_metric metric_M_dd)
 
 lemma completely_metrizable_imp_metrizable_space:
    "completely_metrizable_space X \<Longrightarrow> metrizable_space X"
   using completely_metrizable_space_def metrizable_space_def by auto
 
 lemma (in Metric_space) completely_metrizable_space_mtopology:
    "mcomplete \<Longrightarrow> completely_metrizable_space mtopology"
   using Metric_space_axioms completely_metrizable_space_def by blast
 
 lemma completely_metrizable_space_discrete_topology:
    "completely_metrizable_space (discrete_topology U)"
   unfolding completely_metrizable_space_def
   by (metis discrete_metric.mcomplete_discrete_metric discrete_metric.mtopology_discrete_metric metric_M_dd)
 
 lemma completely_metrizable_space_euclideanreal:
     "completely_metrizable_space euclideanreal"
   by (metis Met_TC.mtopology_is_euclideanreal Met_TC.completely_metrizable_space_mtopology euclidean_metric)
 
 lemma completely_metrizable_space_closedin:
   assumes X: "completely_metrizable_space X" and S: "closedin X S"
   shows "completely_metrizable_space(subtopology X S)"
 proof -
   obtain M d where "Metric_space M d" and comp: "Metric_space.mcomplete M d" 
                 and Xeq: "X = Metric_space.mtopology M d"
     using assms completely_metrizable_space_def by blast
   then interpret Metric_space M d
     by blast
   show ?thesis
     unfolding completely_metrizable_space_def
   proof (intro conjI exI)
     show "Metric_space S d"
       using S Xeq closedin_subset subspace by force
     have sub: "Submetric_axioms M S"
       by (metis S Xeq closedin_metric Submetric_axioms_def)
     then show "Metric_space.mcomplete S d"
       using S Submetric.closedin_mcomplete_imp_mcomplete Submetric_def Xeq comp by blast
     show "subtopology X S = Metric_space.mtopology S d"
       by (metis Metric_space_axioms Xeq sub Submetric.intro Submetric.mtopology_submetric)
   qed
 qed
 
 lemma homeomorphic_completely_metrizable_space_aux:
   assumes homXY: "X homeomorphic_space Y" and X: "completely_metrizable_space X"
   shows "completely_metrizable_space Y"
 proof -
   obtain f g where hmf: "homeomorphic_map X Y f" and hmg: "homeomorphic_map Y X g"
     and fg: "(\<forall>x \<in> topspace X. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
     and fim: "f ` (topspace X) = topspace Y" and gim: "g ` (topspace Y) = topspace X"
     by (smt (verit, best) homXY homeomorphic_imp_surjective_map homeomorphic_maps_map homeomorphic_space_def)
   obtain M d where Md: "Metric_space M d" "Metric_space.mcomplete M d" and Xeq: "X = Metric_space.mtopology M d"
     using X by (auto simp: completely_metrizable_space_def)
   then interpret MX: Metric_space M d by metis
   define D where "D \<equiv> \<lambda>x y. d (g x) (g y)"
   have "Metric_space (topspace Y) D"
   proof
     show "(D x y = 0) \<longleftrightarrow> (x = y)" if "x \<in> topspace Y" "y \<in> topspace Y" for x y
       unfolding D_def
       by (metis that MX.topspace_mtopology MX.zero Xeq fg gim imageI)
     show "D x z \<le> D x y +D y z"
       if "x \<in> topspace Y" "y \<in> topspace Y" "z \<in> topspace Y" for x y z
       using that MX.triangle Xeq gim by (auto simp: D_def)
   qed (auto simp: D_def MX.commute)
   then interpret MY: Metric_space "topspace Y" "\<lambda>x y. D x y" by metis
   show ?thesis
     unfolding completely_metrizable_space_def
   proof (intro exI conjI)
     show "Metric_space (topspace Y) D"
       using MY.Metric_space_axioms by blast
     have gball: "g ` MY.mball y r = MX.mball (g y) r" if "y \<in> topspace Y" for y r
       using that MX.topspace_mtopology Xeq gim
       unfolding MX.mball_def MY.mball_def by (auto simp: subset_iff image_iff D_def)
     have "\<exists>r>0. MY.mball y r \<subseteq> S" if "openin Y S" and "y \<in> S" for S y
     proof -
       have "openin X (g`S)"
         using hmg homeomorphic_map_openness_eq that by auto
       then obtain r where "r>0" "MX.mball (g y) r \<subseteq> g`S"
         using MX.openin_mtopology Xeq \<open>y \<in> S\<close> by auto
       then show ?thesis
         by (smt (verit, ccfv_SIG) MY.in_mball gball fg image_iff in_mono openin_subset subsetI that(1))
     qed
     moreover have "openin Y S"
       if "S \<subseteq> topspace Y" and "\<And>y. y \<in> S \<Longrightarrow> \<exists>r>0. MY.mball y r \<subseteq> S" for S
     proof -
       have "\<And>x. x \<in> g`S \<Longrightarrow> \<exists>r>0. MX.mball x r \<subseteq> g`S"
         by (smt (verit) gball imageE image_mono subset_iff that)
       then have "openin X (g`S)"
         using MX.openin_mtopology Xeq gim that(1) by auto
       then show ?thesis
         using hmg homeomorphic_map_openness_eq that(1) by blast
     qed
     ultimately show Yeq: "Y = MY.mtopology"
       unfolding topology_eq MY.openin_mtopology by (metis openin_subset)
 
     show "MY.mcomplete"
       unfolding MY.mcomplete_def
     proof (intro strip)
       fix \<sigma>
       assume \<sigma>: "MY.MCauchy \<sigma>"
       have "MX.MCauchy (g \<circ> \<sigma>)"
         unfolding MX.MCauchy_def 
       proof (intro conjI strip)
         show "range (g \<circ> \<sigma>) \<subseteq> M"
           using MY.MCauchy_def Xeq \<sigma> gim by auto
         fix \<epsilon> :: real
         assume "\<epsilon> > 0"
         then obtain N where "\<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> D (\<sigma> n) (\<sigma> n') < \<epsilon>"
           using MY.MCauchy_def \<sigma> by presburger
         then show "\<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d ((g \<circ> \<sigma>) n) ((g \<circ> \<sigma>) n') < \<epsilon>"
           by (auto simp: o_def D_def)
       qed
       then obtain x where x: "limitin MX.mtopology (g \<circ> \<sigma>) x sequentially" "x \<in> topspace X"
         using MX.limitin_mspace MX.topspace_mtopology Md Xeq unfolding MX.mcomplete_def
         by blast
       with x have "limitin MY.mtopology (f \<circ> (g \<circ> \<sigma>)) (f x) sequentially"
         by (metis Xeq Yeq continuous_map_limit hmf homeomorphic_imp_continuous_map)
       moreover have "f \<circ> (g \<circ> \<sigma>) = \<sigma>"
         using \<open>MY.MCauchy \<sigma>\<close>  by (force simp add: fg MY.MCauchy_def subset_iff)
       ultimately have "limitin MY.mtopology \<sigma> (f x) sequentially" by simp
       then show "\<exists>y. limitin MY.mtopology \<sigma> y sequentially"
         by blast 
     qed
   qed
 qed
 
 lemma homeomorphic_completely_metrizable_space:
    "X homeomorphic_space Y
         \<Longrightarrow> completely_metrizable_space X \<longleftrightarrow> completely_metrizable_space Y"
   by (meson homeomorphic_completely_metrizable_space_aux homeomorphic_space_sym)
 
 lemma completely_metrizable_space_retraction_map_image:
   assumes r: "retraction_map X Y r" and X: "completely_metrizable_space X"
   shows "completely_metrizable_space Y"
 proof -
   obtain s where s: "retraction_maps X Y r s"
     using r retraction_map_def by blast
   then have "subtopology X (s ` topspace Y) homeomorphic_space Y"
     using retraction_maps_section_image2 by blast
   then show ?thesis
     by (metis X retract_of_space_imp_closedin retraction_maps_section_image1 
         homeomorphic_completely_metrizable_space completely_metrizable_space_closedin 
         completely_metrizable_imp_metrizable_space metrizable_imp_Hausdorff_space s)
 qed
 
 
 
 subsection \<open>Product metric\<close>
 
 text\<open>For the nicest fit with the main Euclidean theories, we choose the Euclidean product, 
 though other definitions of the product work.\<close>
 
 
 definition "prod_dist \<equiv> \<lambda>d1 d2 (x,y) (x',y'). sqrt(d1 x x' ^ 2 + d2 y y' ^ 2)"
 
 locale Metric_space12 = M1: Metric_space M1 d1 + M2: Metric_space M2 d2 for M1 d1 M2 d2
 
 lemma (in Metric_space12) prod_metric: "Metric_space (M1 \<times> M2) (prod_dist d1 d2)"
 proof
   fix x y z
   assume xyz: "x \<in> M1 \<times> M2" "y \<in> M1 \<times> M2" "z \<in> M1 \<times> M2"
   have "sqrt ((d1 x1 z1)\<^sup>2 + (d2 x2 z2)\<^sup>2) \<le> sqrt ((d1 x1 y1)\<^sup>2 + (d2 x2 y2)\<^sup>2) + sqrt ((d1 y1 z1)\<^sup>2 + (d2 y2 z2)\<^sup>2)"
       (is "sqrt ?L \<le> ?R")
     if "x = (x1, x2)" "y = (y1, y2)" "z = (z1, z2)"
     for x1 x2 y1 y2 z1 z2
   proof -
     have tri: "d1 x1 z1 \<le> d1 x1 y1 + d1 y1 z1" "d2 x2 z2 \<le> d2 x2 y2 + d2 y2 z2"
       using that xyz M1.triangle [of x1 y1 z1] M2.triangle [of x2 y2 z2] by auto
     show ?thesis
     proof (rule real_le_lsqrt)
       have "?L \<le> (d1 x1 y1 + d1 y1 z1)\<^sup>2 + (d2 x2 y2 + d2 y2 z2)\<^sup>2"
         using tri by (smt (verit) M1.nonneg M2.nonneg power_mono)
       also have "... \<le> ?R\<^sup>2"
         by (metis real_sqrt_sum_squares_triangle_ineq sqrt_le_D)
       finally show "?L \<le> ?R\<^sup>2" .
     qed auto
   qed
   then show "prod_dist d1 d2 x z \<le> prod_dist d1 d2 x y + prod_dist d1 d2 y z"
     by (simp add: prod_dist_def case_prod_unfold)
 qed (auto simp: M1.commute M2.commute case_prod_unfold prod_dist_def)
 
 sublocale Metric_space12 \<subseteq> Prod_metric: Metric_space "M1\<times>M2" "prod_dist d1 d2" 
   by (simp add: prod_metric)
 
 text \<open>For easy reference to theorems outside of the locale\<close>
 lemma Metric_space12_mspace_mdist:
   "Metric_space12 (mspace m1) (mdist m1) (mspace m2) (mdist m2)"
   by (simp add: Metric_space12_def Metric_space_mspace_mdist)
 
 definition prod_metric where
  "prod_metric \<equiv> \<lambda>m1 m2. metric (mspace m1 \<times> mspace m2, prod_dist (mdist m1) (mdist m2))"
 
 lemma submetric_prod_metric:
    "submetric (prod_metric m1 m2) (S \<times> T) = prod_metric (submetric m1 S) (submetric m2 T)"
   apply (simp add: prod_metric_def)
   by (simp add: submetric_def Metric_space.mspace_metric Metric_space.mdist_metric Metric_space12.prod_metric Metric_space12_def Metric_space_mspace_mdist Times_Int_Times)
 
 lemma mspace_prod_metric [simp]:"
   mspace (prod_metric m1 m2) = mspace m1 \<times> mspace m2"
   by (simp add: prod_metric_def Metric_space.mspace_metric Metric_space12.prod_metric Metric_space12_mspace_mdist)
 
 lemma mdist_prod_metric [simp]: 
   "mdist (prod_metric m1 m2) = prod_dist (mdist m1) (mdist m2)"
   by (metis Metric_space.mdist_metric Metric_space12.prod_metric Metric_space12_mspace_mdist prod_metric_def)
 
-context Metric_space12 
+lemma prod_dist_dist [simp]: "prod_dist dist dist = dist"
+  by (simp add: prod_dist_def dist_prod_def fun_eq_iff)
+
+lemma prod_metric_euclidean [simp]:
+  "prod_metric euclidean_metric euclidean_metric = euclidean_metric"
+  by (simp add: prod_metric_def euclidean_metric_def)
+
+context Metric_space12
 begin
 
 lemma component_le_prod_metric:
    "d1 x1 x2 \<le> prod_dist d1 d2 (x1,y1) (x2,y2)" "d2 y1 y2 \<le> prod_dist d1 d2 (x1,y1) (x2,y2)"
   by (auto simp: prod_dist_def)
 
 lemma prod_metric_le_components:
   "\<lbrakk>x1 \<in> M1; y1 \<in> M1; x2 \<in> M2; y2 \<in> M2\<rbrakk>
     \<Longrightarrow> prod_dist d1 d2 (x1,x2) (y1,y2) \<le> d1 x1 y1 + d2 x2 y2"
   by (auto simp: prod_dist_def sqrt_sum_squares_le_sum)
 
 lemma mball_prod_metric_subset:
    "Prod_metric.mball (x,y) r \<subseteq> M1.mball x r \<times> M2.mball y r"
   by clarsimp (smt (verit, best) component_le_prod_metric)
 
 lemma mcball_prod_metric_subset:
    "Prod_metric.mcball (x,y) r \<subseteq> M1.mcball x r \<times> M2.mcball y r"
   by clarsimp (smt (verit, best) component_le_prod_metric)
 
 lemma mball_subset_prod_metric:
    "M1.mball x1 r1 \<times> M2.mball x2 r2 \<subseteq> Prod_metric.mball (x1,x2) (r1 + r2)"
   using prod_metric_le_components by force
 
 lemma mcball_subset_prod_metric:
    "M1.mcball x1 r1 \<times> M2.mcball x2 r2 \<subseteq> Prod_metric.mcball (x1,x2) (r1 + r2)"
   using prod_metric_le_components by force
 
 lemma mtopology_prod_metric:
   "Prod_metric.mtopology = prod_topology M1.mtopology M2.mtopology"
   unfolding prod_topology_def
 proof (rule topology_base_unique [symmetric])
   fix U
   assume "U \<in> {S \<times> T |S T. openin M1.mtopology S \<and> openin M2.mtopology T}"
   then obtain S T where Ueq: "U = S \<times> T"
     and S: "openin M1.mtopology S" and T: "openin M2.mtopology T"
     by auto
   have "S \<subseteq> M1"
     using M1.openin_mtopology S by auto
   have "T \<subseteq> M2"
     using M2.openin_mtopology T by auto
   show "openin Prod_metric.mtopology U"
     unfolding Prod_metric.openin_mtopology
   proof (intro conjI strip)
     show "U \<subseteq> M1 \<times> M2"
       using Ueq by (simp add: Sigma_mono \<open>S \<subseteq> M1\<close> \<open>T \<subseteq> M2\<close>)
     fix z
     assume "z \<in> U"
     then obtain x1 x2 where "x1 \<in> S" "x2 \<in> T" and zeq: "z = (x1,x2)"
       using Ueq by blast
     obtain r1 where "r1>0" and r1: "M1.mball x1 r1 \<subseteq> S"
       by (meson M1.openin_mtopology \<open>openin M1.mtopology S\<close> \<open>x1 \<in> S\<close>)
     obtain r2 where "r2>0" and r2: "M2.mball x2 r2 \<subseteq> T"
       by (meson M2.openin_mtopology \<open>openin M2.mtopology T\<close> \<open>x2 \<in> T\<close>)
     have "Prod_metric.mball (x1,x2) (min r1 r2) \<subseteq> U"
     proof (rule order_trans [OF mball_prod_metric_subset])
       show "M1.mball x1 (min r1 r2) \<times> M2.mball x2 (min r1 r2) \<subseteq> U"
         using Ueq r1 r2 by force
     qed
     then show "\<exists>r>0. Prod_metric.mball z r \<subseteq> U"
       by (smt (verit, del_insts) zeq \<open>0 < r1\<close> \<open>0 < r2\<close>)
   qed
 next
   fix U z
   assume "openin Prod_metric.mtopology U" and "z \<in> U"
   then have "U \<subseteq> M1 \<times> M2"
     by (simp add: Prod_metric.openin_mtopology)
   then obtain x y where "x \<in> M1" "y \<in> M2" and zeq: "z = (x,y)"
     using \<open>z \<in> U\<close> by blast
   obtain r where "r>0" and r: "Prod_metric.mball (x,y) r \<subseteq> U"
     by (metis Prod_metric.openin_mtopology \<open>openin Prod_metric.mtopology U\<close> \<open>z \<in> U\<close> zeq)
   define B1 where "B1 \<equiv> M1.mball x (r/2)"
   define B2 where "B2 \<equiv> M2.mball y (r/2)"
   have "openin M1.mtopology B1" "openin M2.mtopology B2"
     by (simp_all add: B1_def B2_def)
   moreover have "(x,y) \<in> B1 \<times> B2"
     using \<open>r > 0\<close> by (simp add: \<open>x \<in> M1\<close> \<open>y \<in> M2\<close> B1_def B2_def)
   moreover have "B1 \<times> B2 \<subseteq> U"
     using r prod_metric_le_components by (force simp add: B1_def B2_def)
   ultimately show "\<exists>B. B \<in> {S \<times> T |S T. openin M1.mtopology S \<and> openin M2.mtopology T} \<and> z \<in> B \<and> B \<subseteq> U"
     by (auto simp: zeq)
 qed
 
 lemma MCauchy_prod_metric:
    "Prod_metric.MCauchy \<sigma> \<longleftrightarrow> M1.MCauchy (fst \<circ> \<sigma>) \<and> M2.MCauchy (snd \<circ> \<sigma>)"
    (is "?lhs \<longleftrightarrow> ?rhs")
 proof safe
   assume L: ?lhs
   then have "range \<sigma> \<subseteq> M1 \<times> M2"
     using Prod_metric.MCauchy_def by blast
   then have 1: "range (fst \<circ> \<sigma>) \<subseteq> M1" and 2: "range (snd \<circ> \<sigma>) \<subseteq> M2"
     by auto
   have N1: "\<exists>N. \<forall>n\<ge>N. \<forall>n'\<ge>N. d1 (fst (\<sigma> n)) (fst (\<sigma> n')) < \<epsilon>" 
     and N2: "\<exists>N. \<forall>n\<ge>N. \<forall>n'\<ge>N. d2 (snd (\<sigma> n)) (snd (\<sigma> n')) < \<epsilon>" if "\<epsilon>>0" for \<epsilon> :: real
     using that L unfolding Prod_metric.MCauchy_def
     by (smt (verit, del_insts) add.commute add_less_imp_less_left add_right_mono 
         component_le_prod_metric prod.collapse)+
   show "M1.MCauchy (fst \<circ> \<sigma>)"
     using 1 N1 M1.MCauchy_def by auto
   have "\<exists>N. \<forall>n\<ge>N. \<forall>n'\<ge>N. d2 (snd (\<sigma> n)) (snd (\<sigma> n')) < \<epsilon>" if "\<epsilon>>0" for \<epsilon> :: real
     using that L unfolding Prod_metric.MCauchy_def
     by (smt (verit, del_insts) add.commute add_less_imp_less_left add_right_mono 
         component_le_prod_metric prod.collapse)
   show "M2.MCauchy (snd \<circ> \<sigma>)"
     using 2 N2 M2.MCauchy_def by auto
 next
   assume M1: "M1.MCauchy (fst \<circ> \<sigma>)" and M2: "M2.MCauchy (snd \<circ> \<sigma>)"
   then have subM12: "range (fst \<circ> \<sigma>) \<subseteq> M1" "range (snd \<circ> \<sigma>) \<subseteq> M2"
     using M1.MCauchy_def M2.MCauchy_def by blast+
   show ?lhs
     unfolding Prod_metric.MCauchy_def
   proof (intro conjI strip)
     show "range \<sigma> \<subseteq> M1 \<times> M2"
       using subM12 by (smt (verit, best) SigmaI image_subset_iff o_apply prod.collapse) 
     fix \<epsilon> :: real
     assume "\<epsilon> > 0"
     obtain N1 where N1: "\<And>n n'. N1 \<le> n \<Longrightarrow> N1 \<le> n' \<Longrightarrow> d1 ((fst \<circ> \<sigma>) n) ((fst \<circ> \<sigma>) n') < \<epsilon>/2"
       by (meson M1.MCauchy_def \<open>0 < \<epsilon>\<close> M1 zero_less_divide_iff zero_less_numeral)
     obtain N2 where N2: "\<And>n n'. N2 \<le> n \<Longrightarrow> N2 \<le> n' \<Longrightarrow> d2 ((snd \<circ> \<sigma>) n) ((snd \<circ> \<sigma>) n') < \<epsilon>/2"
       by (meson M2.MCauchy_def \<open>0 < \<epsilon>\<close> M2 zero_less_divide_iff zero_less_numeral)
     have "prod_dist d1 d2 (\<sigma> n) (\<sigma> n') < \<epsilon>"
       if "N1 \<le> n" and "N2 \<le> n" and "N1 \<le> n'" and "N2 \<le> n'" for n n'
     proof -
       obtain a b a' b' where \<sigma>: "\<sigma> n = (a,b)" "\<sigma> n' = (a',b')"
         by fastforce+
       have "prod_dist d1 d2 (a,b) (a',b') \<le> d1 a a' + d2 b b'"
         by (metis \<open>range \<sigma> \<subseteq> M1 \<times> M2\<close> \<sigma> mem_Sigma_iff prod_metric_le_components range_subsetD)
       also have "\<dots> < \<epsilon>/2 + \<epsilon>/2"
         using N1 N2 \<sigma> that by fastforce
       finally show ?thesis
         by (simp add: \<sigma>)
     qed
     then show "\<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> prod_dist d1 d2 (\<sigma> n) (\<sigma> n') < \<epsilon>"
       by (metis order.trans linorder_le_cases)
   qed
 qed
 
 
 lemma mcomplete_prod_metric:
   "Prod_metric.mcomplete \<longleftrightarrow> M1 = {} \<or> M2 = {} \<or> M1.mcomplete \<and> M2.mcomplete"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "M1 = {} \<or> M2 = {}")
   case False
   then obtain x y where "x \<in> M1" "y \<in> M2"
     by blast
   have "M1.mcomplete \<and> M2.mcomplete \<Longrightarrow> Prod_metric.mcomplete"
     by (simp add: Prod_metric.mcomplete_def M1.mcomplete_def M2.mcomplete_def 
         mtopology_prod_metric MCauchy_prod_metric limitin_pairwise)
   moreover
   { assume L: "Prod_metric.mcomplete"
     have "M1.mcomplete"
       unfolding M1.mcomplete_def
     proof (intro strip)
       fix \<sigma>
       assume "M1.MCauchy \<sigma>"
       then have "Prod_metric.MCauchy (\<lambda>n. (\<sigma> n, y))"
         using \<open>y \<in> M2\<close> by (simp add: M1.MCauchy_def M2.MCauchy_def MCauchy_prod_metric)
       then obtain z where "limitin Prod_metric.mtopology (\<lambda>n. (\<sigma> n, y)) z sequentially"
         using L Prod_metric.mcomplete_def by blast
       then show "\<exists>x. limitin M1.mtopology \<sigma> x sequentially"
         by (auto simp: Prod_metric.mcomplete_def M1.mcomplete_def 
              mtopology_prod_metric limitin_pairwise o_def)
     qed
   }
   moreover
   { assume L: "Prod_metric.mcomplete"
     have "M2.mcomplete"
       unfolding M2.mcomplete_def
     proof (intro strip)
       fix \<sigma>
       assume "M2.MCauchy \<sigma>"
       then have "Prod_metric.MCauchy (\<lambda>n. (x, \<sigma> n))"
         using \<open>x \<in> M1\<close> by (simp add: M2.MCauchy_def M1.MCauchy_def MCauchy_prod_metric)
       then obtain z where "limitin Prod_metric.mtopology (\<lambda>n. (x, \<sigma> n)) z sequentially"
         using L Prod_metric.mcomplete_def by blast
       then show "\<exists>x. limitin M2.mtopology \<sigma> x sequentially"
         by (auto simp: Prod_metric.mcomplete_def M2.mcomplete_def 
              mtopology_prod_metric limitin_pairwise o_def)
     qed
   }
   ultimately show ?thesis
     using False by blast 
 qed auto
 
 lemma mbounded_prod_metric:
    "Prod_metric.mbounded U \<longleftrightarrow> M1.mbounded  (fst ` U) \<and> M2.mbounded (snd ` U)"
 proof -
   have "(\<exists>B. U \<subseteq> Prod_metric.mcball (x,y) B) 
     \<longleftrightarrow> ((\<exists>B. (fst ` U) \<subseteq> M1.mcball x B) \<and> (\<exists>B. (snd ` U) \<subseteq> M2.mcball y B))" (is "?lhs \<longleftrightarrow> ?rhs")
     for x y
   proof safe
     fix B
     assume "U \<subseteq> Prod_metric.mcball (x, y) B"
     then have "(fst ` U) \<subseteq> M1.mcball x B" "(snd ` U) \<subseteq> M2.mcball y B"
       using mcball_prod_metric_subset by fastforce+
     then show "\<exists>B. (fst ` U) \<subseteq> M1.mcball x B" "\<exists>B. (snd ` U) \<subseteq> M2.mcball y B"
       by auto
   next
     fix B1 B2
     assume "(fst ` U) \<subseteq> M1.mcball x B1" "(snd ` U) \<subseteq> M2.mcball y B2"
     then have "fst ` U \<times> snd ` U \<subseteq>  M1.mcball x B1 \<times> M2.mcball y B2"
       by blast
     also have "\<dots> \<subseteq> Prod_metric.mcball (x, y) (B1+B2)"
       by (intro mcball_subset_prod_metric)
     finally show "\<exists>B. U \<subseteq> Prod_metric.mcball (x, y) B"
       by (metis subsetD subsetI subset_fst_snd)
   qed
   then show ?thesis
     by (simp add: M1.mbounded_def M2.mbounded_def Prod_metric.mbounded_def)
 qed 
 
 lemma mbounded_Times:
    "Prod_metric.mbounded (S \<times> T) \<longleftrightarrow> S = {} \<or> T = {} \<or> M1.mbounded S \<and> M2.mbounded T"
   by (auto simp: mbounded_prod_metric)
 
 
 lemma mtotally_bounded_Times:
    "Prod_metric.mtotally_bounded (S \<times> T) \<longleftrightarrow>
     S = {} \<or> T = {} \<or> M1.mtotally_bounded S \<and> M2.mtotally_bounded T"
     (is "?lhs \<longleftrightarrow> _")
 proof (cases "S = {} \<or> T = {}")
   case False
   then obtain x y where "x \<in> S" "y \<in> T"
     by auto
   have "M1.mtotally_bounded S" if L: ?lhs
     unfolding M1.mtotally_bounded_sequentially
   proof (intro conjI strip)
     show "S \<subseteq> M1"
       using Prod_metric.mtotally_bounded_imp_subset \<open>y \<in> T\<close> that by blast
     fix \<sigma> :: "nat \<Rightarrow> 'a"
     assume "range \<sigma> \<subseteq> S"
     with L obtain r where "strict_mono r" "Prod_metric.MCauchy ((\<lambda>n. (\<sigma> n,y)) \<circ> r)"
       unfolding Prod_metric.mtotally_bounded_sequentially
       by (smt (verit) SigmaI \<open>y \<in> T\<close> image_subset_iff)
     then have "M1.MCauchy (fst \<circ> (\<lambda>n. (\<sigma> n,y)) \<circ> r)"
       by (simp add: MCauchy_prod_metric o_def)
     with \<open>strict_mono r\<close> show "\<exists>r. strict_mono r \<and> M1.MCauchy (\<sigma> \<circ> r)"
       by (auto simp add: o_def)
   qed
   moreover
   have "M2.mtotally_bounded T" if L: ?lhs
     unfolding M2.mtotally_bounded_sequentially
   proof (intro conjI strip)
     show "T \<subseteq> M2"
       using Prod_metric.mtotally_bounded_imp_subset \<open>x \<in> S\<close> that by blast
     fix \<sigma> :: "nat \<Rightarrow> 'b"
     assume "range \<sigma> \<subseteq> T"
     with L obtain r where "strict_mono r" "Prod_metric.MCauchy ((\<lambda>n. (x,\<sigma> n)) \<circ> r)"
       unfolding Prod_metric.mtotally_bounded_sequentially
       by (smt (verit) SigmaI \<open>x \<in> S\<close> image_subset_iff)
     then have "M2.MCauchy (snd \<circ> (\<lambda>n. (x,\<sigma> n)) \<circ> r)"
       by (simp add: MCauchy_prod_metric o_def)
     with \<open>strict_mono r\<close> show "\<exists>r. strict_mono r \<and> M2.MCauchy (\<sigma> \<circ> r)"
       by (auto simp add: o_def)
   qed
   moreover have ?lhs if 1: "M1.mtotally_bounded S" and 2: "M2.mtotally_bounded T"
     unfolding Prod_metric.mtotally_bounded_sequentially
   proof (intro conjI strip)
     show "S \<times> T \<subseteq> M1 \<times> M2"
       using that 
       by (auto simp: M1.mtotally_bounded_sequentially M2.mtotally_bounded_sequentially)
     fix \<sigma> :: "nat \<Rightarrow> 'a \<times> 'b"
     assume \<sigma>: "range \<sigma> \<subseteq> S \<times> T"
     with 1 obtain r1 where r1: "strict_mono r1" "M1.MCauchy (fst \<circ> \<sigma> \<circ> r1)"
       apply (clarsimp simp: M1.mtotally_bounded_sequentially image_subset_iff)
       by (metis SigmaE comp_eq_dest_lhs fst_conv)
     from \<sigma> 2 obtain r2 where r2: "strict_mono r2" "M2.MCauchy (snd \<circ> \<sigma> \<circ> r1 \<circ> r2)"
       apply (clarsimp simp: M2.mtotally_bounded_sequentially image_subset_iff)
       by (smt (verit, best) comp_apply mem_Sigma_iff prod.collapse)
     then have "M1.MCauchy (fst \<circ> \<sigma> \<circ> r1 \<circ> r2)"
       by (simp add: M1.MCauchy_subsequence r1)
     with r2 have "Prod_metric.MCauchy (\<sigma> \<circ> (r1 \<circ> r2))"
       by (simp add: MCauchy_prod_metric o_def)
     then show "\<exists>r. strict_mono r \<and> Prod_metric.MCauchy (\<sigma> \<circ> r)"
       using r1 r2 strict_mono_o by blast
   qed
   ultimately show ?thesis
     using False by blast
 qed auto
 
 lemma mtotally_bounded_prod_metric:
    "Prod_metric.mtotally_bounded U \<longleftrightarrow>
     M1.mtotally_bounded (fst ` U) \<and> M2.mtotally_bounded (snd ` U)" (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume L: ?lhs
   then have "U \<subseteq> M1 \<times> M2" 
     and *: "\<And>\<sigma>. range \<sigma> \<subseteq> U \<Longrightarrow> \<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> Prod_metric.MCauchy (\<sigma>\<circ>r)"
     by (simp_all add: Prod_metric.mtotally_bounded_sequentially)
   show ?rhs
     unfolding M1.mtotally_bounded_sequentially M2.mtotally_bounded_sequentially
   proof (intro conjI strip)
     show "fst ` U \<subseteq> M1" "snd ` U \<subseteq> M2"
       using \<open>U \<subseteq> M1 \<times> M2\<close> by auto
   next
     fix \<sigma> :: "nat \<Rightarrow> 'a"
     assume "range \<sigma> \<subseteq> fst ` U"
     then obtain \<zeta> where \<zeta>: "\<And>n. \<sigma> n = fst (\<zeta> n) \<and> \<zeta> n \<in> U"
       unfolding image_subset_iff image_iff by (meson UNIV_I)
     then obtain r where "strict_mono r \<and> Prod_metric.MCauchy (\<zeta>\<circ>r)"
       by (metis "*" image_subset_iff)
     with \<zeta> show "\<exists>r. strict_mono r \<and> M1.MCauchy (\<sigma> \<circ> r)"
       by (auto simp: MCauchy_prod_metric o_def)
   next
     fix \<sigma>:: "nat \<Rightarrow> 'b"
     assume "range \<sigma> \<subseteq> snd ` U"
     then obtain \<zeta> where \<zeta>: "\<And>n. \<sigma> n = snd (\<zeta> n) \<and> \<zeta> n \<in> U"
       unfolding image_subset_iff image_iff by (meson UNIV_I)
     then obtain r where "strict_mono r \<and> Prod_metric.MCauchy (\<zeta>\<circ>r)"
       by (metis "*" image_subset_iff)
     with \<zeta> show "\<exists>r. strict_mono r \<and> M2.MCauchy (\<sigma> \<circ> r)"
       by (auto simp: MCauchy_prod_metric o_def)
   qed
 next
   assume ?rhs
   then have "Prod_metric.mtotally_bounded ((fst ` U) \<times> (snd ` U))"
     by (simp add: mtotally_bounded_Times)
   then show ?lhs
     by (metis Prod_metric.mtotally_bounded_subset subset_fst_snd)
 qed
 
 end
 
 
 lemma metrizable_space_prod_topology:
    "metrizable_space (prod_topology X Y) \<longleftrightarrow>
     topspace(prod_topology X Y) = {} \<or> metrizable_space X \<and> metrizable_space Y"
    (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "topspace(prod_topology X Y) = {}")
   case False
   then obtain x y where "x \<in> topspace X" "y \<in> topspace Y"
     by auto
   show ?thesis
   proof
     show "?rhs \<Longrightarrow> ?lhs"
       unfolding metrizable_space_def
       using Metric_space12.mtopology_prod_metric
       by (metis False Metric_space12.prod_metric Metric_space12_def) 
   next
     assume L: ?lhs 
     have "metrizable_space (subtopology (prod_topology X Y) (topspace X \<times> {y}))"
       "metrizable_space (subtopology (prod_topology X Y) ({x} \<times> topspace Y))"
       using L metrizable_space_subtopology by auto
     moreover
     have "(subtopology (prod_topology X Y) (topspace X \<times> {y})) homeomorphic_space X"
       by (metis \<open>y \<in> topspace Y\<close> homeomorphic_space_prod_topology_sing1 homeomorphic_space_sym prod_topology_subtopology(2))
     moreover
     have "(subtopology (prod_topology X Y) ({x} \<times> topspace Y)) homeomorphic_space Y"
       by (metis \<open>x \<in> topspace X\<close> homeomorphic_space_prod_topology_sing2 homeomorphic_space_sym prod_topology_subtopology(1))
     ultimately show ?rhs
       by (simp add: homeomorphic_metrizable_space)
   qed
 qed (simp add: empty_metrizable_space)
 
 
 lemma completely_metrizable_space_prod_topology:
    "completely_metrizable_space (prod_topology X Y) \<longleftrightarrow>
     topspace(prod_topology X Y) = {} \<or>
     completely_metrizable_space X \<and> completely_metrizable_space Y"
    (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "topspace(prod_topology X Y) = {}")
   case False
   then obtain x y where "x \<in> topspace X" "y \<in> topspace Y"
     by auto
   show ?thesis
   proof
     show "?rhs \<Longrightarrow> ?lhs"
       unfolding completely_metrizable_space_def
       by (metis False Metric_space12.mtopology_prod_metric Metric_space12.mcomplete_prod_metric
           Metric_space12.prod_metric Metric_space12_def)
   next
     assume L: ?lhs 
     then have "Hausdorff_space (prod_topology X Y)"
       by (simp add: completely_metrizable_imp_metrizable_space metrizable_imp_Hausdorff_space)
     then have H: "Hausdorff_space X \<and> Hausdorff_space Y"
       using False Hausdorff_space_prod_topology by blast
     then have "closedin (prod_topology X Y) (topspace X \<times> {y}) \<and> closedin (prod_topology X Y) ({x} \<times> topspace Y)"
       using \<open>x \<in> topspace X\<close> \<open>y \<in> topspace Y\<close>
       by (auto simp: closedin_Hausdorff_sing_eq closedin_prod_Times_iff)
     with L have "completely_metrizable_space(subtopology (prod_topology X Y) (topspace X \<times> {y}))
                \<and> completely_metrizable_space(subtopology (prod_topology X Y) ({x} \<times> topspace Y))"
       by (simp add: completely_metrizable_space_closedin)
     moreover
     have "(subtopology (prod_topology X Y) (topspace X \<times> {y})) homeomorphic_space X"
       by (metis \<open>y \<in> topspace Y\<close> homeomorphic_space_prod_topology_sing1 homeomorphic_space_sym prod_topology_subtopology(2))
     moreover
     have "(subtopology (prod_topology X Y) ({x} \<times> topspace Y)) homeomorphic_space Y"
       by (metis \<open>x \<in> topspace X\<close> homeomorphic_space_prod_topology_sing2 homeomorphic_space_sym prod_topology_subtopology(1))
     ultimately show ?rhs
       by (simp add: homeomorphic_completely_metrizable_space)
   qed
 qed (simp add: empty_completely_metrizable_space)
 
 
+subsection \<open>The "atin-within" filter for topologies\<close>
+
+(*FIXME: replace original definition of atin to be an abbreviation, like at / at_within
+    ("atin (_) (_)/ within (_)" [1000, 60] 60)*)
+definition atin_within :: "['a topology, 'a, 'a set] \<Rightarrow> 'a filter"
+  where "atin_within X a S = inf (nhdsin X a) (principal (topspace X \<inter> S - {a}))"
+
+lemma atin_within_UNIV [simp]:
+  shows "atin_within X a UNIV = atin X a"
+  by (simp add: atin_def atin_within_def)
+
+lemma eventually_atin_subtopology:
+  assumes "a \<in> topspace X"
+  shows "eventually P (atin (subtopology X S) a) \<longleftrightarrow> 
+    (a \<in> S \<longrightarrow> (\<exists>U. openin (subtopology X S) U \<and> a \<in> U \<and> (\<forall>x\<in>U - {a}. P x)))"
+  using assms by (simp add: eventually_atin)
+
+lemma eventually_atin_within:
+  "eventually P (atin_within X a S) \<longleftrightarrow> a \<notin> topspace X \<or> (\<exists>T. openin X T \<and> a \<in> T \<and> (\<forall>x\<in>T. x \<in> S \<and> x \<noteq> a \<longrightarrow> P x))"
+proof (cases "a \<in> topspace X")
+  case True
+  hence "eventually P (atin_within X a S) \<longleftrightarrow> 
+         (\<exists>T. openin X T \<and> a \<in> T \<and>
+          (\<forall>x\<in>T. x \<in> topspace X \<and> x \<in> S \<and> x \<noteq> a \<longrightarrow> P x))"
+    by (simp add: atin_within_def eventually_inf_principal eventually_nhdsin)
+  also have "\<dots> \<longleftrightarrow> (\<exists>T. openin X T \<and> a \<in> T \<and> (\<forall>x\<in>T. x \<in> S \<and> x \<noteq> a \<longrightarrow> P x))"
+    using openin_subset by (intro ex_cong) auto
+  finally show ?thesis by (simp add: True)
+qed (simp add: atin_within_def)
+
+lemma atin_subtopology_within:
+  assumes "a \<in> S"
+  shows "atin (subtopology X S) a = atin_within X a S"
+proof -
+  have "eventually P (atin (subtopology X S) a) \<longleftrightarrow> eventually P (atin_within X a S)" for P
+    unfolding eventually_atin eventually_atin_within openin_subtopology
+    using assms by auto
+  then show ?thesis
+    by (meson le_filter_def order.eq_iff)
+qed
+
+lemma limit_continuous_map_within:
+   "\<lbrakk>continuous_map (subtopology X S) Y f; a \<in> S; a \<in> topspace X\<rbrakk>
+    \<Longrightarrow> limitin Y f (f a) (atin_within X a S)"
+  by (metis Int_iff atin_subtopology_within continuous_map_atin topspace_subtopology)
+
+lemma atin_subtopology_within_if:
+  shows "atin (subtopology X S) a = (if a \<in> S then atin_within X a S else bot)"
+  by (simp add: atin_subtopology_within)
+
+lemma trivial_limit_atpointof_within:
+   "trivial_limit(atin_within X a S) \<longleftrightarrow>
+        (a \<notin> X derived_set_of S)"
+  by (auto simp: trivial_limit_def eventually_atin_within in_derived_set_of)
+
+lemma derived_set_of_trivial_limit:
+   "a \<in> X derived_set_of S \<longleftrightarrow> \<not> trivial_limit(atin_within X a S)"
+  by (simp add: trivial_limit_atpointof_within)
+
+    
+subsection\<open>More sequential characterizations in a metric space\<close>
+
+context Metric_space
+begin
+  
+definition decreasing_dist :: "(nat \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> bool"
+    where "decreasing_dist \<sigma> x \<equiv> (\<forall>m n. m < n \<longrightarrow> d (\<sigma> n) x < d (\<sigma> m) x)"
+
+lemma decreasing_dist_imp_inj: "decreasing_dist \<sigma> a \<Longrightarrow> inj \<sigma>"
+  by (metis decreasing_dist_def dual_order.irrefl linorder_inj_onI')
+
+lemma eventually_atin_within_metric:
+   "eventually P (atin_within mtopology a S) \<longleftrightarrow>
+    (a \<in> M \<longrightarrow> (\<exists>\<delta>>0. \<forall>x. x \<in> M \<and> x \<in> S \<and> 0 < d x a \<and> d x a < \<delta> \<longrightarrow> P x))" (is "?lhs=?rhs")
+proof
+  assume ?lhs then show ?rhs
+unfolding eventually_atin_within openin_mtopology subset_iff
+  by (metis commute in_mball mdist_zero order_less_irrefl topspace_mtopology)
+next
+  assume R: ?rhs 
+  show ?lhs
+  proof (cases "a \<in> M")
+    case True
+    then obtain \<delta> where "\<delta> > 0" and \<delta>: "\<And>x. \<lbrakk>x \<in> M; x \<in> S; 0 < d x a; d x a < \<delta>\<rbrakk> \<Longrightarrow> P x"
+      using R by blast
+    then have "openin mtopology (mball a \<delta>) \<and> (\<forall>x \<in> mball a \<delta>. x \<in> S \<and> x \<noteq> a \<longrightarrow> P x)"
+      by (simp add: commute openin_mball)
+    then show ?thesis
+      by (metis True \<open>0 < \<delta>\<close> centre_in_mball_iff eventually_atin_within) 
+  next
+    case False
+    with R show ?thesis
+      by (simp add: eventually_atin_within)
+  qed
+qed
+
+
+lemma eventually_atin_within_A:
+  assumes 
+    "(\<And>\<sigma>. \<lbrakk>range \<sigma> \<subseteq> (S \<inter> M) - {a}; decreasing_dist \<sigma> a;
+          inj \<sigma>; limitin mtopology \<sigma> a sequentially\<rbrakk>
+      \<Longrightarrow> eventually (\<lambda>n. P (\<sigma> n)) sequentially)"
+  shows "eventually P (atin_within mtopology a S)"
+proof -
+  have False if SP: "\<And>\<delta>. \<delta>>0 \<Longrightarrow> \<exists>x \<in> M-{a}. d x a < \<delta> \<and> x \<in> S \<and> \<not> P x" and "a \<in> M"
+  proof -
+    define \<Phi> where "\<Phi> \<equiv> \<lambda>n x. x \<in> M-{a} \<and> d x a < inverse (Suc n) \<and> x \<in> S \<and> \<not> P x"
+    obtain \<sigma> where \<sigma>: "\<And>n. \<Phi> n (\<sigma> n)" and dless: "\<And>n. d (\<sigma>(Suc n)) a < d (\<sigma> n) a"
+    proof -
+      obtain x0 where x0: "\<Phi> 0 x0"
+        using SP [OF zero_less_one] by (force simp: \<Phi>_def)
+      have "\<exists>y. \<Phi> (Suc n) y \<and> d y a < d x a" if "\<Phi> n x" for n x
+        using SP [of "min (inverse (Suc (Suc n))) (d x a)"] \<open>a \<in> M\<close> that
+        by (auto simp: \<Phi>_def)
+      then obtain f where f: "\<And>n x. \<Phi> n x \<Longrightarrow> \<Phi> (Suc n) (f n x) \<and> d (f n x) a < d x a" 
+        by metis
+      show thesis
+        proof
+          show "\<Phi> n (rec_nat x0 f n)" for n
+            by (induction n) (auto simp: x0 dest: f)
+          with f show "d (rec_nat x0 f (Suc n)) a < d (rec_nat x0 f n) a" for n
+            by auto 
+        qed
+    qed
+    have 1: "range \<sigma> \<subseteq> (S \<inter> M) - {a}"
+      using \<sigma> by (auto simp: \<Phi>_def)
+    have "d (\<sigma>(Suc (m+n))) a < d (\<sigma> n) a" for m n
+      by (induction m) (auto intro: order_less_trans dless)
+    then have 2: "decreasing_dist \<sigma> a"
+      unfolding decreasing_dist_def by (metis add.commute less_imp_Suc_add)
+    have "\<forall>\<^sub>F xa in sequentially. d (\<sigma> xa) a < \<epsilon>" if "\<epsilon> > 0" for \<epsilon>
+    proof -
+      obtain N where "inverse (Suc N) < \<epsilon>"
+        using \<open>\<epsilon> > 0\<close> reals_Archimedean by blast
+      with \<sigma> 2 show ?thesis
+        unfolding decreasing_dist_def by (smt (verit, best) \<Phi>_def eventually_at_top_dense)
+    qed
+    then have 4: "limitin mtopology \<sigma> a sequentially"
+      using \<sigma> \<open>a \<in> M\<close> by (simp add: \<Phi>_def limitin_metric)
+    show False
+      using 2 assms [OF 1 _ decreasing_dist_imp_inj 4] \<sigma> by (force simp: \<Phi>_def)
+  qed
+  then show ?thesis
+    by (fastforce simp: eventually_atin_within_metric)
+qed
+
+
+lemma eventually_atin_within_B:
+  assumes ev: "eventually P (atin_within mtopology a S)" 
+    and ran: "range \<sigma> \<subseteq> (S \<inter> M) - {a}"
+    and lim: "limitin mtopology \<sigma> a sequentially"
+  shows "eventually (\<lambda>n. P (\<sigma> n)) sequentially"
+proof -
+  have "a \<in> M"
+    using lim limitin_mspace by auto
+  with ev obtain \<delta> where "0 < \<delta>" 
+    and \<delta>: "\<And>\<sigma>. \<lbrakk>\<sigma> \<in> M; \<sigma> \<in> S; 0 < d \<sigma> a; d \<sigma> a < \<delta>\<rbrakk> \<Longrightarrow> P \<sigma>"
+    by (auto simp: eventually_atin_within_metric)
+  then have *: "\<And>n. \<sigma> n \<in> M \<and> d (\<sigma> n) a < \<delta> \<Longrightarrow> P (\<sigma> n)"
+    using \<open>a \<in> M\<close> ran by auto
+  have "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M \<and> d (\<sigma> n) a < \<delta>"
+    using lim \<open>0 < \<delta>\<close> by (auto simp: limitin_metric)
+  then show ?thesis
+    by (simp add: "*" eventually_mono)
+qed
+
+lemma eventually_atin_within_sequentially:
+     "eventually P (atin_within mtopology a S) \<longleftrightarrow>
+        (\<forall>\<sigma>. range \<sigma> \<subseteq> (S \<inter> M) - {a} \<and>
+            limitin mtopology \<sigma> a sequentially
+            \<longrightarrow> eventually (\<lambda>n. P(\<sigma> n)) sequentially)"
+  by (metis eventually_atin_within_A eventually_atin_within_B)
+
+lemma eventually_atin_within_sequentially_inj:
+     "eventually P (atin_within mtopology a S) \<longleftrightarrow>
+        (\<forall>\<sigma>. range \<sigma> \<subseteq> (S \<inter> M) - {a} \<and> inj \<sigma> \<and>
+            limitin mtopology \<sigma> a sequentially
+            \<longrightarrow> eventually (\<lambda>n. P(\<sigma> n)) sequentially)"
+  by (metis eventually_atin_within_A eventually_atin_within_B)
+
+lemma eventually_atin_within_sequentially_decreasing:
+     "eventually P (atin_within mtopology a S) \<longleftrightarrow>
+        (\<forall>\<sigma>. range \<sigma> \<subseteq> (S \<inter> M) - {a} \<and> decreasing_dist \<sigma> a \<and>
+            limitin mtopology \<sigma> a sequentially
+            \<longrightarrow> eventually (\<lambda>n. P(\<sigma> n)) sequentially)"
+  by (metis eventually_atin_within_A eventually_atin_within_B)
+
+
+lemma eventually_atin_sequentially:
+   "eventually P (atin mtopology a) \<longleftrightarrow>
+    (\<forall>\<sigma>. range \<sigma> \<subseteq> M - {a} \<and> limitin mtopology \<sigma> a sequentially
+         \<longrightarrow> eventually (\<lambda>n. P(\<sigma> n)) sequentially)"
+  using eventually_atin_within_sequentially [where S=UNIV] by simp
+
+lemma eventually_atin_sequentially_inj:
+   "eventually P (atin mtopology a) \<longleftrightarrow>
+    (\<forall>\<sigma>. range \<sigma> \<subseteq> M - {a} \<and> inj \<sigma> \<and>
+        limitin mtopology \<sigma> a sequentially
+        \<longrightarrow> eventually (\<lambda>n. P(\<sigma> n)) sequentially)"
+  using eventually_atin_within_sequentially_inj [where S=UNIV] by simp
+
+lemma eventually_atin_sequentially_decreasing:
+   "eventually P (atin mtopology a) \<longleftrightarrow>
+    (\<forall>\<sigma>. range \<sigma> \<subseteq> M - {a} \<and> decreasing_dist \<sigma> a \<and>
+         limitin mtopology \<sigma> a sequentially
+        \<longrightarrow> eventually (\<lambda>n. P(\<sigma> n)) sequentially)"
+  using eventually_atin_within_sequentially_decreasing [where S=UNIV] by simp
 
 end
 
+context Metric_space12
+begin
+
+lemma limit_atin_sequentially_within:
+  "limitin M2.mtopology f l (atin_within M1.mtopology a S) \<longleftrightarrow>
+     l \<in> M2 \<and>
+     (\<forall>\<sigma>. range \<sigma> \<subseteq> S \<inter> M1 - {a} \<and>
+          limitin M1.mtopology \<sigma> a sequentially
+          \<longrightarrow> limitin M2.mtopology (f \<circ> \<sigma>) l sequentially)"
+    by (auto simp: M1.eventually_atin_within_sequentially limitin_def)
+
+lemma limit_atin_sequentially_within_inj:
+  "limitin M2.mtopology f l (atin_within M1.mtopology a S) \<longleftrightarrow>
+     l \<in> M2 \<and>
+     (\<forall>\<sigma>. range \<sigma> \<subseteq> S \<inter> M1 - {a} \<and> inj \<sigma> \<and>
+          limitin M1.mtopology \<sigma> a sequentially
+          \<longrightarrow> limitin M2.mtopology (f \<circ> \<sigma>) l sequentially)"
+    by (auto simp: M1.eventually_atin_within_sequentially_inj limitin_def)
+
+lemma limit_atin_sequentially_within_decreasing:
+  "limitin M2.mtopology f l (atin_within M1.mtopology a S) \<longleftrightarrow>
+     l \<in> M2 \<and>
+     (\<forall>\<sigma>. range \<sigma> \<subseteq> S \<inter> M1 - {a} \<and> M1.decreasing_dist \<sigma> a \<and> 
+          limitin M1.mtopology \<sigma> a sequentially
+          \<longrightarrow> limitin M2.mtopology (f \<circ> \<sigma>) l sequentially)"
+    by (auto simp: M1.eventually_atin_within_sequentially_decreasing limitin_def)
+
+lemma limit_atin_sequentially:
+   "limitin M2.mtopology f l (atin M1.mtopology a) \<longleftrightarrow>
+        l \<in> M2 \<and>
+        (\<forall>\<sigma>. range \<sigma> \<subseteq> M1 - {a} \<and>
+            limitin M1.mtopology \<sigma> a sequentially
+            \<longrightarrow> limitin M2.mtopology (f \<circ> \<sigma>) l sequentially)"
+  using limit_atin_sequentially_within [where S=UNIV] by simp
+
+lemma limit_atin_sequentially_inj:
+   "limitin M2.mtopology f l (atin M1.mtopology a) \<longleftrightarrow>
+        l \<in> M2 \<and>
+        (\<forall>\<sigma>. range \<sigma> \<subseteq> M1 - {a} \<and> inj \<sigma> \<and>
+            limitin M1.mtopology \<sigma> a sequentially
+            \<longrightarrow> limitin M2.mtopology (f \<circ> \<sigma>) l sequentially)"
+  using limit_atin_sequentially_within_inj [where S=UNIV] by simp
+
+lemma limit_atin_sequentially_decreasing:
+  "limitin M2.mtopology f l (atin M1.mtopology a) \<longleftrightarrow>
+     l \<in> M2 \<and>
+     (\<forall>\<sigma>. range \<sigma> \<subseteq> M1 - {a} \<and> M1.decreasing_dist \<sigma> a \<and> 
+          limitin M1.mtopology \<sigma> a sequentially
+          \<longrightarrow> limitin M2.mtopology (f \<circ> \<sigma>) l sequentially)"
+  using limit_atin_sequentially_within_decreasing [where S=UNIV] by simp
+
+end
+
+text \<open>An experiment: same result as within the locale, but using metric space variables\<close>
+lemma limit_atin_sequentially_within:
+  "limitin (mtopology_of m2) f l (atin_within (mtopology_of m1) a S) \<longleftrightarrow>
+     l \<in> mspace m2 \<and>
+     (\<forall>\<sigma>. range \<sigma> \<subseteq> S \<inter> mspace m1 - {a} \<and>
+          limitin (mtopology_of m1) \<sigma> a sequentially
+          \<longrightarrow> limitin (mtopology_of m2) (f \<circ> \<sigma>) l sequentially)"
+  using Metric_space12.limit_atin_sequentially_within [OF Metric_space12_mspace_mdist]
+  by (metis mtopology_of_def)
+
+
+context Metric_space
+begin
+
+lemma atin_within_imp_M:
+   "atin_within mtopology x S \<noteq> bot \<Longrightarrow> x \<in> M"
+  by (metis derived_set_of_trivial_limit in_derived_set_of topspace_mtopology)
+
+lemma atin_within_sequentially_sequence:
+  assumes "atin_within mtopology x S \<noteq> bot"
+  obtains \<sigma> where "range \<sigma> \<subseteq> S \<inter> M - {x}" 
+          "decreasing_dist \<sigma> x" "inj \<sigma>" "limitin mtopology \<sigma> x sequentially"
+  by (metis eventually_atin_within_A eventually_False assms)
+
+lemma derived_set_of_sequentially:
+  "mtopology derived_set_of S =
+   {x \<in> M. \<exists>\<sigma>. range \<sigma> \<subseteq> S \<inter> M - {x} \<and> limitin mtopology \<sigma> x sequentially}"
+proof -
+  have False
+    if "range \<sigma> \<subseteq> S \<inter> M - {x}"
+      and "limitin mtopology \<sigma> x sequentially"
+      and "atin_within mtopology x S = bot"
+    for x \<sigma>
+  proof -
+    have "\<forall>\<^sub>F n in sequentially. P (\<sigma> n)" for P
+      using that by (metis eventually_atin_within_B eventually_bot)
+    then show False
+      by (meson eventually_False_sequentially eventually_mono)
+  qed
+  then show ?thesis
+    using derived_set_of_trivial_limit 
+    by (fastforce elim!: atin_within_sequentially_sequence intro: atin_within_imp_M)
+qed
+
+lemma derived_set_of_sequentially_alt:
+  "mtopology derived_set_of S =
+   {x. \<exists>\<sigma>. range \<sigma> \<subseteq> S - {x} \<and> limitin mtopology \<sigma> x sequentially}"
+proof -
+  have *: "\<exists>\<sigma>. range \<sigma> \<subseteq> S \<inter> M - {x} \<and> limitin mtopology \<sigma> x sequentially"
+    if \<sigma>: "range \<sigma> \<subseteq> S - {x}" and lim: "limitin mtopology \<sigma> x sequentially" for x \<sigma>
+  proof -
+    obtain N where "\<forall>n\<ge>N. \<sigma> n \<in> M \<and> d (\<sigma> n) x < 1"
+      using lim limit_metric_sequentially by fastforce
+    with \<sigma> obtain a where a:"a \<in> S \<inter> M - {x}" by auto
+    show ?thesis
+    proof (intro conjI exI)
+      show "range (\<lambda>n. if \<sigma> n \<in> M then \<sigma> n else a) \<subseteq> S \<inter> M - {x}"
+        using a \<sigma> by fastforce
+      show "limitin mtopology (\<lambda>n. if \<sigma> n \<in> M then \<sigma> n else a) x sequentially"
+        using lim limit_metric_sequentially by fastforce
+    qed
+  qed
+  show ?thesis
+    by (auto simp: limitin_mspace derived_set_of_sequentially intro!: *)
+qed
+
+lemma derived_set_of_sequentially_inj:
+   "mtopology derived_set_of S =
+    {x \<in> M. \<exists>\<sigma>. range \<sigma> \<subseteq> S \<inter> M - {x} \<and> inj \<sigma> \<and> limitin mtopology \<sigma> x sequentially}"
+proof -
+  have False
+    if "x \<in> M" and "range \<sigma> \<subseteq> S \<inter> M - {x}"
+      and "limitin mtopology \<sigma> x sequentially"
+      and "atin_within mtopology x S = bot"
+    for x \<sigma>
+  proof -
+    have "\<forall>\<^sub>F n in sequentially. P (\<sigma> n)" for P
+      using that derived_set_of_sequentially_alt derived_set_of_trivial_limit by fastforce
+    then show False
+      by (meson eventually_False_sequentially eventually_mono)
+  qed
+  then show ?thesis
+    using derived_set_of_trivial_limit 
+    by (fastforce elim!: atin_within_sequentially_sequence intro: atin_within_imp_M)
+qed
+
+
+lemma derived_set_of_sequentially_inj_alt:
+   "mtopology derived_set_of S =
+    {x. \<exists>\<sigma>. range \<sigma> \<subseteq> S - {x} \<and> inj \<sigma> \<and> limitin mtopology \<sigma> x sequentially}"
+proof -
+  have "\<exists>\<sigma>. range \<sigma> \<subseteq> S - {x} \<and> inj \<sigma> \<and> limitin mtopology \<sigma> x sequentially"
+    if "atin_within mtopology x S \<noteq> bot" for x
+    by (metis Diff_empty Int_subset_iff atin_within_sequentially_sequence subset_Diff_insert that)
+  moreover have False
+    if "range (\<lambda>x. \<sigma> (x::nat)) \<subseteq> S - {x}"
+      and "limitin mtopology \<sigma> x sequentially"
+      and "atin_within mtopology x S = bot"
+    for x \<sigma>
+  proof -
+    have "\<forall>\<^sub>F n in sequentially. P (\<sigma> n)" for P
+      using that derived_set_of_sequentially_alt derived_set_of_trivial_limit by fastforce
+    then show False
+      by (meson eventually_False_sequentially eventually_mono)
+  qed
+  ultimately show ?thesis
+    using derived_set_of_trivial_limit by (fastforce intro: atin_within_imp_M)
+qed
+
+lemma derived_set_of_sequentially_decreasing:
+   "mtopology derived_set_of S =
+    {x \<in> M. \<exists>\<sigma>. range \<sigma> \<subseteq> S - {x} \<and> decreasing_dist \<sigma> x \<and> limitin mtopology \<sigma> x sequentially}"
+proof -
+  have "\<exists>\<sigma>. range \<sigma> \<subseteq> S - {x} \<and> decreasing_dist \<sigma> x \<and> limitin mtopology \<sigma> x sequentially"
+    if "atin_within mtopology x S \<noteq> bot" for x
+    by (metis Diff_empty atin_within_sequentially_sequence le_infE subset_Diff_insert that)
+  moreover have False
+    if "x \<in> M" and "range \<sigma> \<subseteq> S - {x}"
+      and "limitin mtopology \<sigma> x sequentially"
+      and "atin_within mtopology x S = bot"
+    for x \<sigma>
+  proof -
+    have "\<forall>\<^sub>F n in sequentially. P (\<sigma> n)" for P
+      using that derived_set_of_sequentially_alt derived_set_of_trivial_limit by fastforce
+    then show False
+      by (meson eventually_False_sequentially eventually_mono)
+  qed
+  ultimately show ?thesis
+    using derived_set_of_trivial_limit by (fastforce intro: atin_within_imp_M)
+qed
+
+lemma derived_set_of_sequentially_decreasing_alt:
+   "mtopology derived_set_of S =
+    {x. \<exists>\<sigma>. range \<sigma> \<subseteq> S - {x} \<and> decreasing_dist \<sigma> x \<and> limitin mtopology \<sigma> x sequentially}"
+  using derived_set_of_sequentially_alt derived_set_of_sequentially_decreasing by auto
+
+lemma closure_of_sequentially:
+   "mtopology closure_of S = 
+    {x \<in> M. \<exists>\<sigma>. range \<sigma> \<subseteq> S \<inter> M \<and> limitin mtopology \<sigma> x sequentially}"
+  by (auto simp: closure_of derived_set_of_sequentially)
+
+end (*Metric_space*)
+    
+
+subsection \<open>Three strong notions of continuity for metric spaces\<close>
+
+subsubsection \<open>Lipschitz continuity\<close>
+
+definition Lipschitz_continuous_map 
+  where "Lipschitz_continuous_map \<equiv> 
+      \<lambda>m1 m2 f. f ` mspace m1 \<subseteq> mspace m2 \<and>
+        (\<exists>B. \<forall>x \<in> mspace m1. \<forall>y \<in> mspace m1. mdist m2 (f x) (f y) \<le> B * mdist m1 x y)"
+
+lemma Lipschitz_continuous_map_image: 
+  "Lipschitz_continuous_map m1 m2 f \<Longrightarrow> f ` mspace m1 \<subseteq> mspace m2"
+  by (simp add: Lipschitz_continuous_map_def)
+
+lemma Lipschitz_continuous_map_pos:
+   "Lipschitz_continuous_map m1 m2 f \<longleftrightarrow>
+    f ` mspace m1 \<subseteq> mspace m2 \<and>
+        (\<exists>B>0. \<forall>x \<in> mspace m1. \<forall>y \<in> mspace m1. mdist m2 (f x) (f y) \<le> B * mdist m1 x y)"
+proof -
+  have "B * mdist m1 x y \<le> (\<bar>B\<bar> + 1) * mdist m1 x y" "\<bar>B\<bar> + 1 > 0" for x y B
+    by (auto simp add: mult_right_mono)
+  then show ?thesis
+    unfolding Lipschitz_continuous_map_def by (meson dual_order.trans)
+qed
+
+
+lemma Lipschitz_continuous_map_eq:
+  assumes "Lipschitz_continuous_map m1 m2 f" "\<And>x. x \<in> mspace m1 \<Longrightarrow> f x = g x"
+  shows "Lipschitz_continuous_map m1 m2 g"
+  using Lipschitz_continuous_map_def assms
+  by (metis (no_types, opaque_lifting) image_subset_iff)
+
+lemma Lipschitz_continuous_map_from_submetric:
+  assumes "Lipschitz_continuous_map m1 m2 f"
+  shows "Lipschitz_continuous_map (submetric m1 S) m2 f"
+  unfolding Lipschitz_continuous_map_def 
+proof
+  show "f ` mspace (submetric m1 S) \<subseteq> mspace m2"
+    using Lipschitz_continuous_map_pos assms by fastforce
+qed (use assms in \<open>fastforce simp: Lipschitz_continuous_map_def\<close>)
+
+lemma Lipschitz_continuous_map_from_submetric_mono:
+   "\<lbrakk>Lipschitz_continuous_map (submetric m1 T) m2 f; S \<subseteq> T\<rbrakk>
+           \<Longrightarrow> Lipschitz_continuous_map (submetric m1 S) m2 f"
+  by (metis Lipschitz_continuous_map_from_submetric inf.absorb_iff2 submetric_submetric)
+
+lemma Lipschitz_continuous_map_into_submetric:
+   "Lipschitz_continuous_map m1 (submetric m2 S) f \<longleftrightarrow>
+        f ` mspace m1 \<subseteq> S \<and> Lipschitz_continuous_map m1 m2 f"
+  by (auto simp: Lipschitz_continuous_map_def)
+
+lemma Lipschitz_continuous_map_const:
+  "Lipschitz_continuous_map m1 m2 (\<lambda>x. c) \<longleftrightarrow>
+        mspace m1 = {} \<or> c \<in> mspace m2"
+  unfolding Lipschitz_continuous_map_def image_subset_iff
+  by (metis all_not_in_conv mdist_nonneg mdist_zero mult_1)
+
+lemma Lipschitz_continuous_map_id:
+   "Lipschitz_continuous_map m1 m1 (\<lambda>x. x)"
+  by (metis Lipschitz_continuous_map_def image_ident mult_1 order_refl)
+
+lemma Lipschitz_continuous_map_compose:
+  assumes f: "Lipschitz_continuous_map m1 m2 f" and g: "Lipschitz_continuous_map m2 m3 g"
+  shows "Lipschitz_continuous_map m1 m3 (g \<circ> f)"
+  unfolding Lipschitz_continuous_map_def image_subset_iff
+proof
+  show "\<forall>x\<in>mspace m1. (g \<circ> f) x \<in> mspace m3"
+    by (metis Lipschitz_continuous_map_def assms comp_apply image_subset_iff)
+  obtain B where B: "\<forall>x\<in>mspace m1. \<forall>y\<in>mspace m1. mdist m2 (f x) (f y) \<le> B * mdist m1 x y"
+    using assms unfolding Lipschitz_continuous_map_def by presburger
+  obtain C where "C>0" and C: "\<forall>x\<in>mspace m2. \<forall>y\<in>mspace m2. mdist m3 (g x) (g y) \<le> C * mdist m2 x y"
+    using assms unfolding Lipschitz_continuous_map_pos by metis
+  show "\<exists>B. \<forall>x\<in>mspace m1. \<forall>y\<in>mspace m1. mdist m3 ((g \<circ> f) x) ((g \<circ> f) y) \<le> B * mdist m1 x y"
+    apply (rule_tac x="C*B" in exI)
+  proof clarify
+    fix x y
+    assume \<section>: "x \<in> mspace m1" "y \<in> mspace m1"
+    then have "mdist m3 ((g \<circ> f) x) ((g \<circ> f) y) \<le> C * mdist m2 (f x) (f y)"
+      by (metis C Lipschitz_continuous_map_def f comp_apply image_subset_iff)
+    also have "\<dots> \<le> C * B * mdist m1 x y"
+      by (simp add: "\<section>" B \<open>0 < C\<close>)
+    finally show "mdist m3 ((g \<circ> f) x) ((g \<circ> f) y) \<le> C * B * mdist m1 x y" .
+  qed
+qed
+
+subsubsection \<open>Uniform continuity\<close>
+
+definition uniformly_continuous_map 
+  where "uniformly_continuous_map \<equiv> 
+      \<lambda>m1 m2 f. f ` mspace m1 \<subseteq> mspace m2 \<and>
+        (\<forall>\<epsilon>>0. \<exists>\<delta>>0. \<forall>x \<in> mspace m1. \<forall>y \<in> mspace m1. 
+                           mdist m1 y x < \<delta> \<longrightarrow> mdist m2 (f y) (f x) < \<epsilon>)"
+
+lemma uniformly_continuous_map_image: 
+  "uniformly_continuous_map m1 m2 f \<Longrightarrow> f ` mspace m1 \<subseteq> mspace m2"
+  by (simp add: uniformly_continuous_map_def)
+
+lemma ucmap_A:
+  assumes "uniformly_continuous_map m1 m2 f"
+  and "(\<lambda>n. mdist m1 (\<rho> n) (\<sigma> n)) \<longlonglongrightarrow> 0"
+    and "range \<rho> \<subseteq> mspace m1" "range \<sigma> \<subseteq> mspace m1"
+  shows "(\<lambda>n. mdist m2 (f (\<rho> n)) (f (\<sigma> n))) \<longlonglongrightarrow> 0"
+  using assms
+  unfolding uniformly_continuous_map_def image_subset_iff tendsto_iff
+  apply clarsimp
+  by (metis (mono_tags, lifting) eventually_sequentially)
+
+lemma ucmap_B:
+  assumes \<section>: "\<And>\<rho> \<sigma>. \<lbrakk>range \<rho> \<subseteq> mspace m1; range \<sigma> \<subseteq> mspace m1;
+              (\<lambda>n. mdist m1 (\<rho> n) (\<sigma> n)) \<longlonglongrightarrow> 0\<rbrakk>
+              \<Longrightarrow> (\<lambda>n. mdist m2 (f (\<rho> n)) (f (\<sigma> n))) \<longlonglongrightarrow> 0"
+    and "0 < \<epsilon>"
+    and \<rho>: "range \<rho> \<subseteq> mspace m1"
+    and \<sigma>: "range \<sigma> \<subseteq> mspace m1"
+    and "(\<lambda>n. mdist m1 (\<rho> n) (\<sigma> n)) \<longlonglongrightarrow> 0"
+  shows "\<exists>n. mdist m2 (f (\<rho> (n::nat))) (f (\<sigma> n)) < \<epsilon>"
+  using \<section> [OF \<rho> \<sigma>] assms by (meson LIMSEQ_le_const linorder_not_less)
+
+lemma ucmap_C: 
+  assumes \<section>: "\<And>\<rho> \<sigma> \<epsilon>. \<lbrakk>\<epsilon> > 0; range \<rho> \<subseteq> mspace m1; range \<sigma> \<subseteq> mspace m1;
+                       ((\<lambda>n. mdist m1 (\<rho> n) (\<sigma> n)) \<longlonglongrightarrow> 0)\<rbrakk>
+                      \<Longrightarrow> \<exists>n. mdist m2 (f (\<rho> n)) (f (\<sigma> n)) < \<epsilon>"
+    and fim: "f ` mspace m1 \<subseteq> mspace m2"
+  shows "uniformly_continuous_map m1 m2 f"
+proof -
+  {assume "\<not> (\<forall>\<epsilon>>0. \<exists>\<delta>>0. \<forall>x\<in>mspace m1. \<forall>y\<in>mspace m1. mdist m1 y x < \<delta> \<longrightarrow> mdist m2 (f y) (f x) < \<epsilon>)" 
+    then obtain \<epsilon> where "\<epsilon> > 0" 
+      and "\<And>n. \<exists>x\<in>mspace m1. \<exists>y\<in>mspace m1. mdist m1 y x < inverse(Suc n) \<and> mdist m2 (f y) (f x) \<ge> \<epsilon>"
+      by (meson inverse_Suc linorder_not_le)
+    then obtain \<rho> \<sigma> where space: "range \<rho> \<subseteq> mspace m1" "range \<sigma> \<subseteq> mspace m1"
+         and dist: "\<And>n. mdist m1 (\<sigma> n) (\<rho> n) < inverse(Suc n) \<and> mdist m2 (f(\<sigma> n)) (f(\<rho> n)) \<ge> \<epsilon>"
+      by (metis image_subset_iff)
+    have False 
+      using \<section> [OF \<open>\<epsilon> > 0\<close> space] dist Lim_null_comparison
+      by (smt (verit) LIMSEQ_norm_0 inverse_eq_divide mdist_commute mdist_nonneg real_norm_def)
+  }
+  moreover
+  have "t \<in> mspace m2" if "t \<in> f ` mspace m1" for t
+    using fim that by blast
+  ultimately show ?thesis
+    by (fastforce simp: uniformly_continuous_map_def)
+qed
+
+lemma uniformly_continuous_map_sequentially:
+  "uniformly_continuous_map m1 m2 f \<longleftrightarrow>
+    f ` mspace m1 \<subseteq> mspace m2 \<and>
+    (\<forall>\<rho> \<sigma>. range \<rho> \<subseteq> mspace m1 \<and> range \<sigma> \<subseteq> mspace m1 \<and> (\<lambda>n. mdist m1 (\<rho> n) (\<sigma> n)) \<longlonglongrightarrow> 0
+          \<longrightarrow> (\<lambda>n. mdist m2 (f (\<rho> n)) (f (\<sigma> n))) \<longlonglongrightarrow> 0)"
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (simp add: ucmap_A uniformly_continuous_map_image)
+  show "?rhs \<Longrightarrow> ?lhs"
+    by (intro ucmap_B ucmap_C) auto
+qed
+
+
+lemma uniformly_continuous_map_sequentially_alt:
+    "uniformly_continuous_map m1 m2 f \<longleftrightarrow>
+      f ` mspace m1 \<subseteq> mspace m2 \<and>
+      (\<forall>\<epsilon>>0. \<forall>\<rho> \<sigma>. range \<rho> \<subseteq> mspace m1 \<and> range \<sigma> \<subseteq> mspace m1 \<and>
+            ((\<lambda>n. mdist m1 (\<rho> n) (\<sigma> n)) \<longlonglongrightarrow> 0)
+            \<longrightarrow> (\<exists>n. mdist m2 (f (\<rho> n)) (f (\<sigma> n)) < \<epsilon>))"
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    using uniformly_continuous_map_image by (intro conjI strip ucmap_B | force simp: ucmap_A)+
+  show "?rhs \<Longrightarrow> ?lhs"
+    by (intro ucmap_C) auto
+qed
+
+
+lemma uniformly_continuous_map_eq:
+   "\<lbrakk>\<And>x. x \<in> mspace m1 \<Longrightarrow> f x = g x; uniformly_continuous_map m1 m2 f\<rbrakk>
+      \<Longrightarrow> uniformly_continuous_map m1 m2 g"
+  by (simp add: uniformly_continuous_map_def)
+
+lemma uniformly_continuous_map_from_submetric:
+  assumes "uniformly_continuous_map m1 m2 f"
+  shows "uniformly_continuous_map (submetric m1 S) m2 f"
+  unfolding uniformly_continuous_map_def 
+proof
+  show "f ` mspace (submetric m1 S) \<subseteq> mspace m2"
+    using assms by (auto simp: uniformly_continuous_map_def)
+qed (use assms in \<open>force simp: uniformly_continuous_map_def\<close>)
+
+lemma uniformly_continuous_map_from_submetric_mono:
+   "\<lbrakk>uniformly_continuous_map (submetric m1 T) m2 f; S \<subseteq> T\<rbrakk>
+           \<Longrightarrow> uniformly_continuous_map (submetric m1 S) m2 f"
+  by (metis uniformly_continuous_map_from_submetric inf.absorb_iff2 submetric_submetric)
+
+lemma uniformly_continuous_map_into_submetric:
+   "uniformly_continuous_map m1 (submetric m2 S) f \<longleftrightarrow>
+        f ` mspace m1 \<subseteq> S \<and> uniformly_continuous_map m1 m2 f"
+  by (auto simp: uniformly_continuous_map_def)
+
+lemma uniformly_continuous_map_const:
+  "uniformly_continuous_map m1 m2 (\<lambda>x. c) \<longleftrightarrow>
+        mspace m1 = {} \<or> c \<in> mspace m2"
+  unfolding uniformly_continuous_map_def image_subset_iff
+  by (metis empty_iff equals0I mdist_zero)
+
+lemma uniformly_continuous_map_id [simp]:
+   "uniformly_continuous_map m1 m1 (\<lambda>x. x)"
+  by (metis image_ident order_refl uniformly_continuous_map_def)
+
+lemma uniformly_continuous_map_compose:
+  assumes f: "uniformly_continuous_map m1 m2 f" and g: "uniformly_continuous_map m2 m3 g"
+  shows "uniformly_continuous_map m1 m3 (g \<circ> f)"
+  by (smt (verit, ccfv_threshold) comp_apply f g image_subset_iff uniformly_continuous_map_def)
+
+lemma uniformly_continuous_map_real_const [simp]:
+   "uniformly_continuous_map m euclidean_metric (\<lambda>x. c)"
+  by (simp add: euclidean_metric_def uniformly_continuous_map_const)
+
+text \<open>Equivalence between "abstract" and "type class" notions\<close>
+lemma uniformly_continuous_map_euclidean [simp]:
+  "uniformly_continuous_map (submetric euclidean_metric S) euclidean_metric f
+     = uniformly_continuous_on S f"
+  by (auto simp add: uniformly_continuous_map_def uniformly_continuous_on_def)
+
+subsubsection \<open>Cauchy continuity\<close>
+
+definition Cauchy_continuous_map where
+ "Cauchy_continuous_map \<equiv>
+  \<lambda>m1 m2 f. \<forall>\<sigma>. Metric_space.MCauchy (mspace m1) (mdist m1) \<sigma> 
+            \<longrightarrow> Metric_space.MCauchy (mspace m2) (mdist m2) (f \<circ> \<sigma>)"
+
+lemma Cauchy_continuous_map_euclidean [simp]:
+  "Cauchy_continuous_map (submetric euclidean_metric S) euclidean_metric f
+     = Cauchy_continuous_on S f"
+  by (auto simp add: Cauchy_continuous_map_def Cauchy_continuous_on_def Cauchy_def Met_TC.subspace Metric_space.MCauchy_def)
+
+lemma Cauchy_continuous_map_image:
+  assumes "Cauchy_continuous_map m1 m2 f"
+  shows "f ` mspace m1 \<subseteq> mspace m2"
+proof clarsimp
+  fix x
+  assume "x \<in> mspace m1"
+  then have "Metric_space.MCauchy (mspace m1) (mdist m1) (\<lambda>n. x)"
+    by (simp add: Metric_space.MCauchy_const Metric_space_mspace_mdist)
+  then have "Metric_space.MCauchy (mspace m2) (mdist m2) (f \<circ> (\<lambda>n. x))"
+    by (meson Cauchy_continuous_map_def assms)
+  then show "f x \<in> mspace m2"
+    by (simp add: Metric_space.MCauchy_def [OF Metric_space_mspace_mdist])
+qed
+
+
+lemma Cauchy_continuous_map_eq:
+   "\<lbrakk>\<And>x. x \<in> mspace m1 \<Longrightarrow> f x = g x; Cauchy_continuous_map m1 m2 f\<rbrakk>
+      \<Longrightarrow> Cauchy_continuous_map m1 m2 g"
+  by (simp add: image_subset_iff Cauchy_continuous_map_def Metric_space.MCauchy_def [OF Metric_space_mspace_mdist])
+
+lemma Cauchy_continuous_map_from_submetric:
+  assumes "Cauchy_continuous_map m1 m2 f"
+  shows "Cauchy_continuous_map (submetric m1 S) m2 f"
+  using assms
+  by (simp add: image_subset_iff Cauchy_continuous_map_def Metric_space.MCauchy_def [OF Metric_space_mspace_mdist])
+
+lemma Cauchy_continuous_map_from_submetric_mono:
+   "\<lbrakk>Cauchy_continuous_map (submetric m1 T) m2 f; S \<subseteq> T\<rbrakk>
+           \<Longrightarrow> Cauchy_continuous_map (submetric m1 S) m2 f"
+  by (metis Cauchy_continuous_map_from_submetric inf.absorb_iff2 submetric_submetric)
+
+lemma Cauchy_continuous_map_into_submetric:
+   "Cauchy_continuous_map m1 (submetric m2 S) f \<longleftrightarrow>
+   f ` mspace m1 \<subseteq> S \<and> Cauchy_continuous_map m1 m2 f"  (is "?lhs \<longleftrightarrow> ?rhs")
+proof -
+  have "?lhs \<Longrightarrow> Cauchy_continuous_map m1 m2 f"
+    by (simp add: Cauchy_continuous_map_def Metric_space.MCauchy_def [OF Metric_space_mspace_mdist])
+  moreover have "?rhs \<Longrightarrow> ?lhs"
+    by (bestsimp simp add: Cauchy_continuous_map_def  Metric_space.MCauchy_def [OF Metric_space_mspace_mdist])
+  ultimately show ?thesis
+    by (metis Cauchy_continuous_map_image le_inf_iff mspace_submetric)
+qed
+
+lemma Cauchy_continuous_map_const [simp]:
+  "Cauchy_continuous_map m1 m2 (\<lambda>x. c) \<longleftrightarrow> mspace m1 = {} \<or> c \<in> mspace m2"
+proof -
+   have "mspace m1 = {} \<Longrightarrow> Cauchy_continuous_map m1 m2 (\<lambda>x. c)"
+    by (simp add: Cauchy_continuous_map_def Metric_space.MCauchy_def Metric_space_mspace_mdist)
+  moreover have "c \<in> mspace m2 \<Longrightarrow> Cauchy_continuous_map m1 m2 (\<lambda>x. c)"
+    by (simp add: Cauchy_continuous_map_def o_def Metric_space.MCauchy_const [OF Metric_space_mspace_mdist])
+  ultimately show ?thesis
+    using Cauchy_continuous_map_image by blast
+qed
+
+lemma Cauchy_continuous_map_id [simp]:
+   "Cauchy_continuous_map m1 m1 (\<lambda>x. x)"
+  by (simp add: Cauchy_continuous_map_def o_def)
+
+lemma Cauchy_continuous_map_compose:
+  assumes f: "Cauchy_continuous_map m1 m2 f" and g: "Cauchy_continuous_map m2 m3 g"
+  shows "Cauchy_continuous_map m1 m3 (g \<circ> f)"
+  by (metis (no_types, lifting) Cauchy_continuous_map_def f fun.map_comp g)
+
+lemma Lipschitz_imp_uniformly_continuous_map:
+  assumes "Lipschitz_continuous_map m1 m2 f"
+  shows "uniformly_continuous_map m1 m2 f"
+  proof -
+  have "f ` mspace m1 \<subseteq> mspace m2"
+    by (simp add: Lipschitz_continuous_map_image assms)
+  moreover have "\<exists>\<delta>>0. \<forall>x\<in>mspace m1. \<forall>y\<in>mspace m1. mdist m1 y x < \<delta> \<longrightarrow> mdist m2 (f y) (f x) < \<epsilon>"
+    if "\<epsilon> > 0" for \<epsilon>
+  proof -
+    obtain B where "\<forall>x\<in>mspace m1. \<forall>y\<in>mspace m1. mdist m2 (f x) (f y) \<le> B * mdist m1 x y"
+             and "B>0"
+      using that assms by (force simp add: Lipschitz_continuous_map_pos)
+    then have "\<forall>x\<in>mspace m1. \<forall>y\<in>mspace m1. mdist m1 y x < \<epsilon>/B \<longrightarrow> mdist m2 (f y) (f x) < \<epsilon>"
+      by (smt (verit, ccfv_SIG) less_divide_eq mdist_nonneg mult.commute that zero_less_divide_iff)
+    with \<open>B>0\<close> show ?thesis
+      by (metis divide_pos_pos that)
+  qed
+  ultimately show ?thesis
+    by (auto simp: uniformly_continuous_map_def)
+qed
+
+lemma uniformly_imp_Cauchy_continuous_map:
+   "uniformly_continuous_map m1 m2 f \<Longrightarrow> Cauchy_continuous_map m1 m2 f"
+  unfolding uniformly_continuous_map_def Cauchy_continuous_map_def
+  apply (simp add: image_subset_iff o_def Metric_space.MCauchy_def [OF Metric_space_mspace_mdist])
+  by meson
+
+lemma locally_Cauchy_continuous_map:
+  assumes "\<epsilon> > 0"
+    and \<section>: "\<And>x. x \<in> mspace m1 \<Longrightarrow> Cauchy_continuous_map (submetric m1 (mball_of m1 x \<epsilon>)) m2 f"
+  shows "Cauchy_continuous_map m1 m2 f"
+  unfolding Cauchy_continuous_map_def
+proof (intro strip)
+  interpret M1: Metric_space "mspace m1" "mdist m1"
+    by (simp add: Metric_space_mspace_mdist)
+  interpret M2: Metric_space "mspace m2" "mdist m2"
+    by (simp add: Metric_space_mspace_mdist)
+  fix \<sigma>
+  assume \<sigma>: "M1.MCauchy \<sigma>"
+  with \<open>\<epsilon> > 0\<close> obtain N where N: "\<And>n n'. \<lbrakk>n\<ge>N; n'\<ge>N\<rbrakk> \<Longrightarrow> mdist m1 (\<sigma> n) (\<sigma> n') < \<epsilon>"
+    using M1.MCauchy_def by fastforce
+  then have "M1.mball (\<sigma> N) \<epsilon> \<subseteq> mspace m1"
+    by (auto simp: image_subset_iff M1.mball_def)
+  then interpret MS1: Metric_space "mball_of m1 (\<sigma> N) \<epsilon> \<inter> mspace m1" "mdist m1"
+    by (simp add: M1.subspace)
+  show "M2.MCauchy (f \<circ> \<sigma>)"
+  proof (rule M2.MCauchy_offset)
+    have "M1.MCauchy (\<sigma> \<circ> (+) N)"
+      by (simp add: M1.MCauchy_imp_MCauchy_suffix \<sigma>)
+    moreover have "range (\<sigma> \<circ> (+) N) \<subseteq> M1.mball (\<sigma> N) \<epsilon>"
+      using N [OF order_refl] M1.MCauchy_def \<sigma> by fastforce
+    ultimately have "MS1.MCauchy (\<sigma> \<circ> (+) N)"
+      unfolding M1.MCauchy_def MS1.MCauchy_def by (simp add: mball_of_def)
+    moreover have "\<sigma> N \<in> mspace m1"
+      using M1.MCauchy_def \<sigma> by auto
+    ultimately show "M2.MCauchy (f \<circ> \<sigma> \<circ> (+) N)"
+      unfolding comp_assoc
+      by (metis "\<section>" Cauchy_continuous_map_def mdist_submetric mspace_submetric)
+  next
+    fix n
+    have "\<sigma> n \<in> mspace m1"
+      by (meson Metric_space.MCauchy_def Metric_space_mspace_mdist \<sigma> range_subsetD)
+    then have "\<sigma> n \<in> mball_of m1 (\<sigma> n) \<epsilon>"
+      by (simp add: Metric_space.centre_in_mball_iff Metric_space_mspace_mdist assms(1) mball_of_def)
+    then show "(f \<circ> \<sigma>) n \<in> mspace m2"
+      using Cauchy_continuous_map_image [OF \<section> [of "\<sigma> n"]] \<open>\<sigma> n \<in> mspace m1\<close> by auto
+  qed
+qed
+
+context Metric_space12
+begin
+
+lemma Cauchy_continuous_imp_continuous_map:
+  assumes "Cauchy_continuous_map (metric (M1,d1)) (metric (M2,d2)) f"
+  shows "continuous_map M1.mtopology M2.mtopology f"
+proof (clarsimp simp: continuous_map_atin)
+  fix x
+  assume "x \<in> M1"
+  show "limitin M2.mtopology f (f x) (atin M1.mtopology x)"
+    unfolding limit_atin_sequentially
+  proof (intro conjI strip)
+    show "f x \<in> M2"
+      using Cauchy_continuous_map_image \<open>x \<in> M1\<close> assms by fastforce
+    fix \<sigma>
+    assume "range \<sigma> \<subseteq> M1 - {x} \<and> limitin M1.mtopology \<sigma> x sequentially"
+    then have "M1.MCauchy (\<lambda>n. if even n then \<sigma> (n div 2) else x)"
+      by (force simp add: M1.MCauchy_interleaving)
+    then have "M2.MCauchy (f \<circ> (\<lambda>n. if even n then \<sigma> (n div 2) else x))"
+      using assms by (simp add: Cauchy_continuous_map_def)
+    then show "limitin M2.mtopology (f \<circ> \<sigma>) (f x) sequentially"
+      using M2.MCauchy_interleaving [of "f \<circ> \<sigma>" "f x"]
+      by (simp add: o_def if_distrib cong: if_cong)
+  qed
+qed
+
+lemma continuous_imp_Cauchy_continuous_map:
+  assumes "M1.mcomplete"
+    and f: "continuous_map M1.mtopology M2.mtopology f"
+  shows "Cauchy_continuous_map (metric (M1,d1)) (metric (M2,d2)) f"
+  unfolding Cauchy_continuous_map_def
+proof clarsimp
+  fix \<sigma>
+  assume \<sigma>: "M1.MCauchy \<sigma>"
+  then obtain y where y: "limitin M1.mtopology \<sigma> y sequentially"
+    using M1.mcomplete_def assms by blast
+  have "range (f \<circ> \<sigma>) \<subseteq> M2"
+    using \<sigma> f by (simp add: M2.subspace M1.MCauchy_def M1.metric_continuous_map image_subset_iff)
+  then show "M2.MCauchy (f \<circ> \<sigma>)"
+    using continuous_map_limit [OF f y] M2.convergent_imp_MCauchy
+    by blast
+qed
+
+end
+
+text \<open>The same outside the locale\<close>
+lemma Cauchy_continuous_imp_continuous_map:
+  assumes "Cauchy_continuous_map m1 m2 f"
+  shows "continuous_map (mtopology_of m1) (mtopology_of m2) f"
+  using assms Metric_space12.Cauchy_continuous_imp_continuous_map [OF Metric_space12_mspace_mdist]
+  by (auto simp add: mtopology_of_def)
+
+lemma continuous_imp_Cauchy_continuous_map:
+  assumes "Metric_space.mcomplete (mspace m1) (mdist m1)"
+    and "continuous_map (mtopology_of m1) (mtopology_of m2) f"
+  shows "Cauchy_continuous_map m1 m2 f"
+  using assms Metric_space12.continuous_imp_Cauchy_continuous_map [OF Metric_space12_mspace_mdist]
+  by (auto simp add: mtopology_of_def)
+
+lemma uniformly_continuous_imp_continuous_map:
+   "uniformly_continuous_map m1 m2 f
+        \<Longrightarrow> continuous_map (mtopology_of m1) (mtopology_of m2) f"
+  by (simp add: Cauchy_continuous_imp_continuous_map uniformly_imp_Cauchy_continuous_map)
+
+lemma Lipschitz_continuous_imp_continuous_map:
+   "Lipschitz_continuous_map m1 m2 f
+     \<Longrightarrow> continuous_map (mtopology_of m1) (mtopology_of m2) f"
+  by (simp add: Lipschitz_imp_uniformly_continuous_map uniformly_continuous_imp_continuous_map)
+
+lemma Lipschitz_imp_Cauchy_continuous_map:
+   "Lipschitz_continuous_map m1 m2 f
+        \<Longrightarrow> Cauchy_continuous_map m1 m2 f"
+  by (simp add: Lipschitz_imp_uniformly_continuous_map uniformly_imp_Cauchy_continuous_map)
+
+lemma Cauchy_imp_uniformly_continuous_map:
+  assumes f: "Cauchy_continuous_map m1 m2 f"
+    and tbo: "Metric_space.mtotally_bounded (mspace m1) (mdist m1) (mspace m1)"
+  shows "uniformly_continuous_map m1 m2 f"
+  unfolding uniformly_continuous_map_sequentially_alt imp_conjL
+proof (intro conjI strip)
+  show "f ` mspace m1 \<subseteq> mspace m2"
+    by (simp add: Cauchy_continuous_map_image f)
+  interpret M1: Metric_space "mspace m1" "mdist m1"
+    by (simp add: Metric_space_mspace_mdist)
+  interpret M2: Metric_space "mspace m2" "mdist m2"
+    by (simp add: Metric_space_mspace_mdist)
+  fix \<epsilon> :: real and \<rho> \<sigma> 
+  assume "\<epsilon> > 0"
+    and \<rho>: "range \<rho> \<subseteq> mspace m1"
+    and \<sigma>: "range \<sigma> \<subseteq> mspace m1"
+    and 0: "(\<lambda>n. mdist m1 (\<rho> n) (\<sigma> n)) \<longlonglongrightarrow> 0"
+  then obtain r1 where "strict_mono r1" and r1: "M1.MCauchy (\<rho> \<circ> r1)"
+    using M1.mtotally_bounded_sequentially tbo by meson
+  then obtain r2 where "strict_mono r2" and r2: "M1.MCauchy (\<sigma> \<circ> r1 \<circ> r2)"
+    by (metis M1.mtotally_bounded_sequentially tbo \<sigma> image_comp image_subset_iff range_subsetD)
+  define r where "r \<equiv> r1 \<circ> r2"
+  have r: "strict_mono r"
+    by (simp add: r_def \<open>strict_mono r1\<close> \<open>strict_mono r2\<close> strict_mono_o)
+  define \<eta> where "\<eta> \<equiv> \<lambda>n. if even n then (\<rho> \<circ> r) (n div 2) else (\<sigma> \<circ> r) (n div 2)"
+  have "M1.MCauchy \<eta>"
+    unfolding \<eta>_def M1.MCauchy_interleaving_gen
+  proof (intro conjI)
+    show "M1.MCauchy (\<rho> \<circ> r)"
+      by (simp add: M1.MCauchy_subsequence \<open>strict_mono r2\<close> fun.map_comp r1 r_def)
+    show "M1.MCauchy (\<sigma> \<circ> r)"
+      by (simp add: fun.map_comp r2 r_def)
+    show "(\<lambda>n. mdist m1 ((\<rho> \<circ> r) n) ((\<sigma> \<circ> r) n)) \<longlonglongrightarrow> 0"
+      using LIMSEQ_subseq_LIMSEQ [OF 0 r] by (simp add: o_def)
+  qed
+  then have "Metric_space.MCauchy (mspace m2) (mdist m2) (f \<circ> \<eta>)"
+    by (meson Cauchy_continuous_map_def f)
+  then have "(\<lambda>n. mdist m2 (f (\<rho> (r n))) (f (\<sigma> (r n)))) \<longlonglongrightarrow> 0"
+    using M2.MCauchy_interleaving_gen [of "f \<circ> \<rho> \<circ> r" "f \<circ> \<sigma> \<circ> r"]
+    by (simp add: \<eta>_def o_def if_distrib cong: if_cong)
+  then show "\<exists>n. mdist m2 (f (\<rho> n)) (f (\<sigma> n)) < \<epsilon>"
+    by (meson LIMSEQ_le_const \<open>0 < \<epsilon>\<close> linorder_not_le)
+qed
+
+lemma continuous_imp_uniformly_continuous_map:
+   "compact_space (mtopology_of m1) \<and>
+        continuous_map (mtopology_of m1) (mtopology_of m2) f
+        \<Longrightarrow> uniformly_continuous_map m1 m2 f"
+  by (simp add: Cauchy_imp_uniformly_continuous_map continuous_imp_Cauchy_continuous_map
+                Metric_space.compact_space_eq_mcomplete_mtotally_bounded
+                Metric_space_mspace_mdist mtopology_of_def)
+
+lemma continuous_eq_Cauchy_continuous_map:
+   "Metric_space.mcomplete (mspace m1) (mdist m1) \<Longrightarrow> 
+    continuous_map (mtopology_of m1) (mtopology_of m2) f \<longleftrightarrow> Cauchy_continuous_map m1 m2 f"
+  using Cauchy_continuous_imp_continuous_map continuous_imp_Cauchy_continuous_map by blast
+
+lemma continuous_eq_uniformly_continuous_map:
+   "compact_space (mtopology_of m1) 
+    \<Longrightarrow> continuous_map (mtopology_of m1) (mtopology_of m2) f \<longleftrightarrow>
+        uniformly_continuous_map m1 m2 f"
+  using continuous_imp_uniformly_continuous_map uniformly_continuous_imp_continuous_map by blast
+
+lemma Cauchy_eq_uniformly_continuous_map:
+   "Metric_space.mtotally_bounded (mspace m1) (mdist m1) (mspace m1)
+    \<Longrightarrow> Cauchy_continuous_map m1 m2 f \<longleftrightarrow> uniformly_continuous_map m1 m2 f"
+  using Cauchy_imp_uniformly_continuous_map uniformly_imp_Cauchy_continuous_map by blast
+
+lemma Lipschitz_continuous_map_projections:
+  "Lipschitz_continuous_map (prod_metric m1 m2) m1 fst"
+  "Lipschitz_continuous_map (prod_metric m1 m2) m2 snd"
+  by (simp add: Lipschitz_continuous_map_def prod_dist_def; 
+      metis mult_numeral_1 real_sqrt_sum_squares_ge1 real_sqrt_sum_squares_ge2)+
+
+lemma Lipschitz_continuous_map_pairwise:
+   "Lipschitz_continuous_map m (prod_metric m1 m2) f \<longleftrightarrow>
+    Lipschitz_continuous_map m m1 (fst \<circ> f) \<and> Lipschitz_continuous_map m m2 (snd \<circ> f)"
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof 
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (simp add: Lipschitz_continuous_map_compose Lipschitz_continuous_map_projections)
+  have "Lipschitz_continuous_map m (prod_metric m1 m2) (\<lambda>x. (f1 x, f2 x))"
+    if f1: "Lipschitz_continuous_map m m1 f1" and f2: "Lipschitz_continuous_map m m2 f2" for f1 f2
+  proof -
+    obtain B1 where "B1 > 0" 
+      and B1: "\<And>x y. \<lbrakk>x \<in> mspace m; y \<in> mspace m\<rbrakk> \<Longrightarrow> mdist m1 (f1 x) (f1 y) \<le> B1 * mdist m x y"
+      by (meson Lipschitz_continuous_map_pos f1)
+    obtain B2 where "B2 > 0" 
+      and B2: "\<And>x y. \<lbrakk>x \<in> mspace m; y \<in> mspace m\<rbrakk> \<Longrightarrow> mdist m2 (f2 x) (f2 y) \<le> B2 * mdist m x y"
+      by (meson Lipschitz_continuous_map_pos f2)
+    show ?thesis
+      unfolding Lipschitz_continuous_map_pos
+    proof (intro exI conjI strip)
+      have f1im: "f1 ` mspace m \<subseteq> mspace m1"
+        by (simp add: Lipschitz_continuous_map_image f1)
+      moreover have f2im: "f2 ` mspace m \<subseteq> mspace m2"
+        by (simp add: Lipschitz_continuous_map_image f2)
+      ultimately show "(\<lambda>x. (f1 x, f2 x)) ` mspace m \<subseteq> mspace (prod_metric m1 m2)"
+        by auto
+      show "B1+B2 > 0"
+        using \<open>0 < B1\<close> \<open>0 < B2\<close> by linarith
+      fix x y
+      assume xy: "x \<in> mspace m" "y \<in> mspace m"
+      with f1im f2im have "mdist (prod_metric m1 m2) (f1 x, f2 x) (f1 y, f2 y) \<le> mdist m1 (f1 x) (f1 y) + mdist m2 (f2 x) (f2 y)"
+        unfolding mdist_prod_metric
+        by (intro Metric_space12.prod_metric_le_components [OF Metric_space12_mspace_mdist]) auto
+      also have "... \<le> (B1+B2) * mdist m x y"
+        using B1 [OF xy] B2 [OF xy] by (simp add: vector_space_over_itself.scale_left_distrib) 
+      finally show "mdist (prod_metric m1 m2) (f1 x, f2 x) (f1 y, f2 y) \<le> (B1+B2) * mdist m x y" .
+    qed
+  qed
+  then show "?rhs \<Longrightarrow> ?lhs"
+    by force
+qed
+
+lemma uniformly_continuous_map_pairwise:
+   "uniformly_continuous_map m (prod_metric m1 m2) f \<longleftrightarrow> 
+    uniformly_continuous_map m m1 (fst \<circ> f) \<and> uniformly_continuous_map m m2 (snd \<circ> f)"
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof 
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (simp add: Lipschitz_continuous_map_projections Lipschitz_imp_uniformly_continuous_map uniformly_continuous_map_compose)
+  have "uniformly_continuous_map m (prod_metric m1 m2) (\<lambda>x. (f1 x, f2 x))"
+    if f1: "uniformly_continuous_map m m1 f1" and f2: "uniformly_continuous_map m m2 f2" for f1 f2
+  proof -
+    show ?thesis
+      unfolding uniformly_continuous_map_def
+    proof (intro conjI strip)
+      have f1im: "f1 ` mspace m \<subseteq> mspace m1"
+        by (simp add: uniformly_continuous_map_image f1)
+      moreover have f2im: "f2 ` mspace m \<subseteq> mspace m2"
+        by (simp add: uniformly_continuous_map_image f2)
+      ultimately show "(\<lambda>x. (f1 x, f2 x)) ` mspace m \<subseteq> mspace (prod_metric m1 m2)"
+        by auto
+      fix \<epsilon>:: real
+      assume "\<epsilon> > 0"
+      obtain \<delta>1 where "\<delta>1>0" 
+        and \<delta>1: "\<And>x y. \<lbrakk>x \<in> mspace m; y \<in> mspace m; mdist m y x < \<delta>1\<rbrakk> \<Longrightarrow> mdist m1 (f1 y) (f1 x) < \<epsilon>/2"
+        by (metis \<open>0 < \<epsilon>\<close> f1 half_gt_zero uniformly_continuous_map_def)
+      obtain \<delta>2 where "\<delta>2>0" 
+        and \<delta>2: "\<And>x y. \<lbrakk>x \<in> mspace m; y \<in> mspace m; mdist m y x < \<delta>2\<rbrakk> \<Longrightarrow> mdist m2 (f2 y) (f2 x) < \<epsilon>/2"
+        by (metis \<open>0 < \<epsilon>\<close> f2 half_gt_zero uniformly_continuous_map_def)
+      show "\<exists>\<delta>>0. \<forall>x\<in>mspace m. \<forall>y\<in>mspace m. mdist m y x < \<delta> \<longrightarrow> mdist (prod_metric m1 m2) (f1 y, f2 y) (f1 x, f2 x) < \<epsilon>"
+      proof (intro exI conjI strip)
+        show "min \<delta>1 \<delta>2>0"
+          using \<open>0 < \<delta>1\<close> \<open>0 < \<delta>2\<close> by auto
+        fix x y
+        assume xy: "x \<in> mspace m" "y \<in> mspace m" and d: "mdist m y x < min \<delta>1 \<delta>2"
+        have *: "mdist m1 (f1 y) (f1 x) < \<epsilon>/2" "mdist m2 (f2 y) (f2 x) < \<epsilon>/2"
+          using \<delta>1 \<delta>2 d xy by auto
+        have "mdist (prod_metric m1 m2) (f1 y, f2 y) (f1 x, f2 x) \<le> mdist m1 (f1 y) (f1 x) + mdist m2 (f2 y) (f2 x)"
+          unfolding mdist_prod_metric using f1im f2im xy
+          by (intro Metric_space12.prod_metric_le_components [OF Metric_space12_mspace_mdist]) auto
+        also have "... < \<epsilon>/2 + \<epsilon>/2"
+          using * by simp
+        finally show "mdist (prod_metric m1 m2) (f1 y, f2 y) (f1 x, f2 x) < \<epsilon>"
+          by simp
+      qed
+    qed
+  qed
+  then show "?rhs \<Longrightarrow> ?lhs"
+    by force
+qed
+
+lemma Cauchy_continuous_map_pairwise:
+   "Cauchy_continuous_map m (prod_metric m1 m2) f \<longleftrightarrow> Cauchy_continuous_map m m1 (fst \<circ> f) \<and> Cauchy_continuous_map m m2 (snd \<circ> f)"
+  by (auto simp: Cauchy_continuous_map_def Metric_space12.MCauchy_prod_metric[OF Metric_space12_mspace_mdist] comp_assoc)
+
+lemma Lipschitz_continuous_map_paired:
+   "Lipschitz_continuous_map m (prod_metric m1 m2) (\<lambda>x. (f x, g x)) \<longleftrightarrow>
+        Lipschitz_continuous_map m m1 f \<and> Lipschitz_continuous_map m m2 g"
+  by (simp add: Lipschitz_continuous_map_pairwise o_def)
+
+lemma uniformly_continuous_map_paired:
+   "uniformly_continuous_map m (prod_metric m1 m2) (\<lambda>x. (f x, g x)) \<longleftrightarrow>
+        uniformly_continuous_map m m1 f \<and> uniformly_continuous_map m m2 g"
+  by (simp add: uniformly_continuous_map_pairwise o_def)
+
+lemma Cauchy_continuous_map_paired:
+   "Cauchy_continuous_map m (prod_metric m1 m2) (\<lambda>x. (f x, g x)) \<longleftrightarrow>
+        Cauchy_continuous_map m m1 f \<and> Cauchy_continuous_map m m2 g"
+  by (simp add: Cauchy_continuous_map_pairwise o_def)
+
+lemma mbounded_Lipschitz_continuous_image:
+  assumes f: "Lipschitz_continuous_map m1 m2 f" and S: "Metric_space.mbounded (mspace m1) (mdist m1) S"
+  shows "Metric_space.mbounded (mspace m2) (mdist m2) (f`S)"
+proof -
+  obtain B where fim: "f ` mspace m1 \<subseteq> mspace m2"
+    and "B>0" and B: "\<And>x y. \<lbrakk>x \<in> mspace m1; y \<in> mspace m1\<rbrakk> \<Longrightarrow> mdist m2 (f x) (f y) \<le> B * mdist m1 x y"
+    by (meson Lipschitz_continuous_map_pos f)
+  show ?thesis
+    unfolding Metric_space.mbounded_alt_pos [OF Metric_space_mspace_mdist]
+  proof
+    obtain C where "S \<subseteq> mspace m1" and "C>0" and C: "\<And>x y. \<lbrakk>x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> mdist m1 x y \<le> C"
+      using S by (auto simp: Metric_space.mbounded_alt_pos [OF Metric_space_mspace_mdist])
+    show "f ` S \<subseteq> mspace m2"
+      using fim \<open>S \<subseteq> mspace m1\<close> by blast
+    have "\<And>x y. \<lbrakk>x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> mdist m2 (f x) (f y) \<le> B * C"
+      by (smt (verit) B C \<open>0 < B\<close> \<open>S \<subseteq> mspace m1\<close> mdist_nonneg mult_mono subsetD)
+    moreover have "B*C > 0"
+      by (simp add: \<open>0 < B\<close> \<open>0 < C\<close>)
+    ultimately show "\<exists>B>0. \<forall>x\<in>f ` S. \<forall>y\<in>f ` S. mdist m2 x y \<le> B"
+      by auto
+  qed
+qed
+
+lemma mtotally_bounded_Cauchy_continuous_image:
+  assumes f: "Cauchy_continuous_map m1 m2 f" and S: "Metric_space.mtotally_bounded (mspace m1) (mdist m1) S"
+  shows "Metric_space.mtotally_bounded (mspace m2) (mdist m2) (f ` S)"
+  unfolding Metric_space.mtotally_bounded_sequentially[OF Metric_space_mspace_mdist]
+proof (intro conjI strip)
+  have "S \<subseteq> mspace m1"
+    using S by (simp add: Metric_space.mtotally_bounded_sequentially[OF Metric_space_mspace_mdist])
+  then show "f ` S \<subseteq> mspace m2"
+    using Cauchy_continuous_map_image f by blast
+  fix \<sigma> :: "nat \<Rightarrow> 'b"
+  assume "range \<sigma> \<subseteq> f ` S"
+  then have "\<forall>n. \<exists>x. \<sigma> n = f x \<and> x \<in> S"
+    by (meson imageE range_subsetD)
+  then obtain \<rho> where \<rho>: "\<And>n. \<sigma> n = f (\<rho> n)" "range \<rho> \<subseteq> S"
+    by (metis image_subset_iff)
+  then have "\<sigma> = f \<circ> \<rho>"
+    by fastforce
+  obtain r where "strict_mono r" "Metric_space.MCauchy (mspace m1) (mdist m1) (\<rho> \<circ> r)"
+    by (meson \<rho> S Metric_space.mtotally_bounded_sequentially[OF Metric_space_mspace_mdist])
+  then have "Metric_space.MCauchy (mspace m2) (mdist m2) (f \<circ> \<rho> \<circ> r)"
+    using f unfolding Cauchy_continuous_map_def by (metis fun.map_comp)
+  then show "\<exists>r. strict_mono r \<and> Metric_space.MCauchy (mspace m2) (mdist m2) (\<sigma> \<circ> r)"
+    using \<open>\<sigma> = f \<circ> \<rho>\<close> \<open>strict_mono r\<close> by blast
+qed
+
+lemma Lipschitz_coefficient_pos:
+  assumes "x \<in> mspace m" "y \<in> mspace m" "f x \<noteq> f y" 
+    and "f ` mspace m \<subseteq> mspace m2" 
+    and "\<And>x y. \<lbrakk>x \<in> mspace m; y \<in> mspace m\<rbrakk>
+            \<Longrightarrow> mdist m2 (f x) (f y) \<le> k * mdist m x y"
+  shows  "0 < k"
+  using assms by (smt (verit, best) image_subset_iff mdist_nonneg mdist_zero mult_nonpos_nonneg)
+
+lemma Lipschitz_continuous_map_metric:
+   "Lipschitz_continuous_map (prod_metric m m) euclidean_metric (\<lambda>(x,y). mdist m x y)"
+proof -
+  have "\<And>x y x' y'. \<lbrakk>x \<in> mspace m; y \<in> mspace m; x' \<in> mspace m; y' \<in> mspace m\<rbrakk>
+       \<Longrightarrow> \<bar>mdist m x y - mdist m x' y'\<bar> \<le> 2 * sqrt ((mdist m x x')\<^sup>2 + (mdist m y y')\<^sup>2)"
+    by (smt (verit, del_insts) mdist_commute mdist_triangle real_sqrt_sum_squares_ge2)
+  then show ?thesis
+    by (fastforce simp add: Lipschitz_continuous_map_def prod_dist_def dist_real_def)
+qed
+
+lemma Lipschitz_continuous_map_mdist:
+  assumes f: "Lipschitz_continuous_map m m' f" 
+    and g: "Lipschitz_continuous_map m m' g"
+  shows "Lipschitz_continuous_map m euclidean_metric (\<lambda>x. mdist m' (f x) (g x))"
+    (is "Lipschitz_continuous_map m _ ?h")
+proof -
+  have eq: "?h = ((\<lambda>(x,y). mdist m' x y) \<circ> (\<lambda>x. (f x,g x)))"
+    by force
+  show ?thesis
+    unfolding eq
+  proof (rule Lipschitz_continuous_map_compose)
+    show "Lipschitz_continuous_map m (prod_metric m' m') (\<lambda>x. (f x, g x))"
+      by (simp add: Lipschitz_continuous_map_paired f g)
+    show "Lipschitz_continuous_map (prod_metric m' m') euclidean_metric (\<lambda>(x,y). mdist m' x y)"
+      by (simp add: Lipschitz_continuous_map_metric)
+  qed
+qed
+
+lemma uniformly_continuous_map_mdist:
+  assumes f: "uniformly_continuous_map m m' f" 
+    and g: "uniformly_continuous_map m m' g"
+  shows "uniformly_continuous_map m euclidean_metric (\<lambda>x. mdist m' (f x) (g x))"
+    (is "uniformly_continuous_map m _ ?h")
+proof -
+  have eq: "?h = ((\<lambda>(x,y). mdist m' x y) \<circ> (\<lambda>x. (f x,g x)))"
+    by force
+  show ?thesis
+    unfolding eq
+  proof (rule uniformly_continuous_map_compose)
+    show "uniformly_continuous_map m (prod_metric m' m') (\<lambda>x. (f x, g x))"
+      by (simp add: uniformly_continuous_map_paired f g)
+    show "uniformly_continuous_map (prod_metric m' m') euclidean_metric (\<lambda>(x,y). mdist m' x y)"
+      by (simp add: Lipschitz_continuous_map_metric Lipschitz_imp_uniformly_continuous_map)
+  qed
+qed
+
+lemma Cauchy_continuous_map_mdist:
+  assumes f: "Cauchy_continuous_map m m' f" 
+    and g: "Cauchy_continuous_map m m' g"
+  shows "Cauchy_continuous_map m euclidean_metric (\<lambda>x. mdist m' (f x) (g x))"
+    (is "Cauchy_continuous_map m _ ?h")
+proof -
+  have eq: "?h = ((\<lambda>(x,y). mdist m' x y) \<circ> (\<lambda>x. (f x,g x)))"
+    by force
+  show ?thesis
+    unfolding eq
+  proof (rule Cauchy_continuous_map_compose)
+    show "Cauchy_continuous_map m (prod_metric m' m') (\<lambda>x. (f x, g x))"
+      by (simp add: Cauchy_continuous_map_paired f g)
+    show "Cauchy_continuous_map (prod_metric m' m') euclidean_metric (\<lambda>(x,y). mdist m' x y)"
+      by (simp add: Lipschitz_continuous_map_metric Lipschitz_imp_Cauchy_continuous_map)
+  qed
+qed
+
+lemma mtopology_of_prod_metric [simp]:
+    "mtopology_of (prod_metric m1 m2) = prod_topology (mtopology_of m1) (mtopology_of m2)"
+  by (simp add: mtopology_of_def Metric_space12.mtopology_prod_metric[OF Metric_space12_mspace_mdist])
+
+lemma continuous_map_metric:
+   "continuous_map (prod_topology (mtopology_of m) (mtopology_of m)) euclidean
+      (\<lambda>(x,y). mdist m x y)"
+  using Lipschitz_continuous_imp_continuous_map [OF Lipschitz_continuous_map_metric]
+  by auto
+
+lemma continuous_map_mdist_alt:
+  assumes "continuous_map X (prod_topology (mtopology_of m) (mtopology_of m)) f"
+  shows "continuous_map X euclidean (\<lambda>x. case_prod (mdist m) (f x))"
+    (is "continuous_map _ _ ?h")
+proof -
+  have eq: "?h = case_prod (mdist m) \<circ> f"
+    by force
+  show ?thesis
+    unfolding eq
+    using assms continuous_map_compose continuous_map_metric by blast
+qed
+
+lemma continuous_map_mdist:
+  assumes f: "continuous_map X (mtopology_of m) f" 
+      and g: "continuous_map X (mtopology_of m) g"
+  shows "continuous_map X euclidean (\<lambda>x. mdist m (f x) (g x))"
+    (is "continuous_map X _ ?h")
+proof -
+  have eq: "?h = ((\<lambda>(x,y). mdist m x y) \<circ> (\<lambda>x. (f x,g x)))"
+    by force
+  show ?thesis
+    unfolding eq
+  proof (rule continuous_map_compose)
+    show "continuous_map X (prod_topology (mtopology_of m) (mtopology_of m)) (\<lambda>x. (f x, g x))"
+      by (simp add: continuous_map_paired f g)
+  qed (simp add: continuous_map_metric)
+qed
+
+lemma continuous_on_mdist:
+   "a \<in> mspace m \<Longrightarrow> continuous_map (mtopology_of m) euclidean (mdist m a)"
+  by (simp add: continuous_map_mdist)
+
+subsection \<open>Isometries\<close>
+
+lemma (in Metric_space12) isometry_imp_embedding_map:
+  assumes fim: "f ` M1 \<subseteq> M2" and d: "\<And>x y. \<lbrakk>x \<in> M1; y \<in> M1\<rbrakk> \<Longrightarrow> d2 (f x) (f y) = d1 x y"
+  shows "embedding_map M1.mtopology M2.mtopology f"
+proof -
+  have "inj_on f M1"
+    by (metis M1.zero d inj_onI)
+  then obtain g where g: "\<And>x. x \<in> M1 \<Longrightarrow> g (f x) = x"
+    by (metis inv_into_f_f)
+  have "homeomorphic_maps M1.mtopology (subtopology M2.mtopology (f ` topspace M1.mtopology)) f g"
+    unfolding homeomorphic_maps_def
+  proof (intro conjI; clarsimp)
+    show "continuous_map M1.mtopology (subtopology M2.mtopology (f ` M1)) f"
+      by (metis M1.metric_continuous_map M1.topspace_mtopology M2.Metric_space_axioms continuous_map_into_subtopology d fim order_refl)
+    have "Lipschitz_continuous_map (submetric (metric(M2,d2)) (f ` M1)) (metric(M1,d1)) g"
+      unfolding Lipschitz_continuous_map_def
+    proof (intro conjI exI strip; simp)
+      show "d1 (g x) (g y) \<le> 1 * d2 x y" if "x \<in> f ` M1 \<and> x \<in> M2" and "y \<in> f ` M1 \<and> y \<in> M2" for x y
+        using that d g by force
+    qed (use g in auto)
+    then have "continuous_map (mtopology_of (submetric (metric(M2,d2)) (f ` M1))) M1.mtopology g"
+      using Lipschitz_continuous_imp_continuous_map by force
+    moreover have "mtopology_of (submetric (metric(M2,d2)) (f ` M1)) = subtopology M2.mtopology (f ` M1)"
+      by (simp add: mtopology_of_submetric)
+    ultimately show "continuous_map (subtopology M2.mtopology (f ` M1)) M1.mtopology g"
+       by simp
+  qed (use g in auto)
+  then show ?thesis
+    by (auto simp: embedding_map_def homeomorphic_map_maps)
+qed
+
+lemma (in Metric_space12) isometry_imp_homeomorphic_map:
+  assumes fim: "f ` M1 = M2" and d: "\<And>x y. \<lbrakk>x \<in> M1; y \<in> M1\<rbrakk> \<Longrightarrow> d2 (f x) (f y) = d1 x y"
+  shows "homeomorphic_map M1.mtopology M2.mtopology f"
+  by (metis M1.topspace_mtopology M2.subtopology_mspace d embedding_map_def fim isometry_imp_embedding_map subsetI)
+
+end
+
diff --git a/src/HOL/Analysis/Elementary_Metric_Spaces.thy b/src/HOL/Analysis/Elementary_Metric_Spaces.thy
--- a/src/HOL/Analysis/Elementary_Metric_Spaces.thy
+++ b/src/HOL/Analysis/Elementary_Metric_Spaces.thy
@@ -1,3212 +1,3271 @@
 (*  Author:     L C Paulson, University of Cambridge
     Author:     Amine Chaieb, University of Cambridge
     Author:     Robert Himmelmann, TU Muenchen
     Author:     Brian Huffman, Portland State University
 *)
 
 section \<open>Elementary Metric Spaces\<close>
 
 theory Elementary_Metric_Spaces
   imports
     Abstract_Topology_2
     Metric_Arith
 begin
 
 subsection \<open>Open and closed balls\<close>
 
 definition\<^marker>\<open>tag important\<close> ball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set"
   where "ball x e = {y. dist x y < e}"
 
 definition\<^marker>\<open>tag important\<close> cball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set"
   where "cball x e = {y. dist x y \<le> e}"
 
 definition\<^marker>\<open>tag important\<close> sphere :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set"
   where "sphere x e = {y. dist x y = e}"
 
 lemma mem_ball [simp, metric_unfold]: "y \<in> ball x e \<longleftrightarrow> dist x y < e"
   by (simp add: ball_def)
 
 lemma mem_cball [simp, metric_unfold]: "y \<in> cball x e \<longleftrightarrow> dist x y \<le> e"
   by (simp add: cball_def)
 
 lemma mem_sphere [simp]: "y \<in> sphere x e \<longleftrightarrow> dist x y = e"
   by (simp add: sphere_def)
 
 lemma ball_trivial [simp]: "ball x 0 = {}"
   by auto
 
 lemma cball_trivial [simp]: "cball x 0 = {x}"
   by auto
 
 lemma sphere_trivial [simp]: "sphere x 0 = {x}"
   by auto
 
 lemma disjoint_ballI: "dist x y \<ge> r+s \<Longrightarrow> ball x r \<inter> ball y s = {}"
   using dist_triangle_less_add not_le by fastforce
 
 lemma disjoint_cballI: "dist x y > r + s \<Longrightarrow> cball x r \<inter> cball y s = {}"
   by (metis add_mono disjoint_iff_not_equal dist_triangle2 dual_order.trans leD mem_cball)
 
 lemma sphere_empty [simp]: "r < 0 \<Longrightarrow> sphere a r = {}"
   for a :: "'a::metric_space"
   by auto
 
 lemma centre_in_ball [simp]: "x \<in> ball x e \<longleftrightarrow> 0 < e"
   by simp
 
 lemma centre_in_cball [simp]: "x \<in> cball x e \<longleftrightarrow> 0 \<le> e"
   by simp
 
 lemma ball_subset_cball [simp, intro]: "ball x e \<subseteq> cball x e"
   by (simp add: subset_eq)
 
 lemma mem_ball_imp_mem_cball: "x \<in> ball y e \<Longrightarrow> x \<in> cball y e"
   by auto
 
 lemma sphere_cball [simp,intro]: "sphere z r \<subseteq> cball z r"
   by force
 
 lemma cball_diff_sphere: "cball a r - sphere a r = ball a r"
   by auto
 
 lemma subset_ball[intro]: "d \<le> e \<Longrightarrow> ball x d \<subseteq> ball x e"
   by auto
 
 lemma subset_cball[intro]: "d \<le> e \<Longrightarrow> cball x d \<subseteq> cball x e"
   by auto
 
 lemma mem_ball_leI: "x \<in> ball y e \<Longrightarrow> e \<le> f \<Longrightarrow> x \<in> ball y f"
   by auto
 
 lemma mem_cball_leI: "x \<in> cball y e \<Longrightarrow> e \<le> f \<Longrightarrow> x \<in> cball y f"
   by auto
 
 lemma cball_trans: "y \<in> cball z b \<Longrightarrow> x \<in> cball y a \<Longrightarrow> x \<in> cball z (b + a)"
   by metric
 
 lemma ball_max_Un: "ball a (max r s) = ball a r \<union> ball a s"
   by auto
 
 lemma ball_min_Int: "ball a (min r s) = ball a r \<inter> ball a s"
   by auto
 
 lemma cball_max_Un: "cball a (max r s) = cball a r \<union> cball a s"
   by auto
 
 lemma cball_min_Int: "cball a (min r s) = cball a r \<inter> cball a s"
   by auto
 
 lemma cball_diff_eq_sphere: "cball a r - ball a r =  sphere a r"
   by auto
 
 lemma open_ball [intro, simp]: "open (ball x e)"
 proof -
   have "open (dist x -` {..<e})"
     by (intro open_vimage open_lessThan continuous_intros)
   also have "dist x -` {..<e} = ball x e"
     by auto
   finally show ?thesis .
 qed
 
 lemma open_contains_ball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. ball x e \<subseteq> S)"
   by (simp add: open_dist subset_eq Ball_def dist_commute)
 
 lemma openI [intro?]: "(\<And>x. x\<in>S \<Longrightarrow> \<exists>e>0. ball x e \<subseteq> S) \<Longrightarrow> open S"
   by (auto simp: open_contains_ball)
 
 lemma openE[elim?]:
   assumes "open S" "x\<in>S"
   obtains e where "e>0" "ball x e \<subseteq> S"
   using assms unfolding open_contains_ball by auto
 
 lemma open_contains_ball_eq: "open S \<Longrightarrow> x\<in>S \<longleftrightarrow> (\<exists>e>0. ball x e \<subseteq> S)"
   by (metis open_contains_ball subset_eq centre_in_ball)
 
 lemma ball_eq_empty[simp]: "ball x e = {} \<longleftrightarrow> e \<le> 0"
   unfolding mem_ball set_eq_iff
   by (simp add: not_less) metric
 
 lemma ball_empty: "e \<le> 0 \<Longrightarrow> ball x e = {}" 
   by simp
 
 lemma closed_cball [iff]: "closed (cball x e)"
 proof -
   have "closed (dist x -` {..e})"
     by (intro closed_vimage closed_atMost continuous_intros)
   also have "dist x -` {..e} = cball x e"
     by auto
   finally show ?thesis .
 qed
 
 lemma open_contains_cball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0.  cball x e \<subseteq> S)"
 proof -
   {
     fix x and e::real
     assume "x\<in>S" "e>0" "ball x e \<subseteq> S"
     then have "\<exists>d>0. cball x d \<subseteq> S"
       unfolding subset_eq by (rule_tac x="e/2" in exI, auto)
   }
   moreover
   {
     fix x and e::real
     assume "x\<in>S" "e>0" "cball x e \<subseteq> S"
     then have "\<exists>d>0. ball x d \<subseteq> S"
       using mem_ball_imp_mem_cball by blast
   }
   ultimately show ?thesis
     unfolding open_contains_ball by auto
 qed
 
 lemma open_contains_cball_eq: "open S \<Longrightarrow> (\<forall>x. x \<in> S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S))"
   by (metis open_contains_cball subset_eq order_less_imp_le centre_in_cball)
 
 lemma eventually_nhds_ball: "d > 0 \<Longrightarrow> eventually (\<lambda>x. x \<in> ball z d) (nhds z)"
   by (rule eventually_nhds_in_open) simp_all
 
 lemma eventually_at_ball: "d > 0 \<Longrightarrow> eventually (\<lambda>t. t \<in> ball z d \<and> t \<in> A) (at z within A)"
   unfolding eventually_at by (intro exI[of _ d]) (simp_all add: dist_commute)
 
 lemma eventually_at_ball': "d > 0 \<Longrightarrow> eventually (\<lambda>t. t \<in> ball z d \<and> t \<noteq> z \<and> t \<in> A) (at z within A)"
   unfolding eventually_at by (intro exI[of _ d]) (simp_all add: dist_commute)
 
 lemma at_within_ball: "e > 0 \<Longrightarrow> dist x y < e \<Longrightarrow> at y within ball x e = at y"
   by (subst at_within_open) auto
 
 lemma atLeastAtMost_eq_cball:
   fixes a b::real
   shows "{a .. b} = cball ((a + b)/2) ((b - a)/2)"
   by (auto simp: dist_real_def field_simps)
 
 lemma cball_eq_atLeastAtMost:
   fixes a b::real
   shows "cball a b = {a - b .. a + b}"
   by (auto simp: dist_real_def)
 
 lemma greaterThanLessThan_eq_ball:
   fixes a b::real
   shows "{a <..< b} = ball ((a + b)/2) ((b - a)/2)"
   by (auto simp: dist_real_def field_simps)
 
 lemma ball_eq_greaterThanLessThan:
   fixes a b::real
   shows "ball a b = {a - b <..< a + b}"
   by (auto simp: dist_real_def)
 
 lemma interior_ball [simp]: "interior (ball x e) = ball x e"
   by (simp add: interior_open)
 
 lemma cball_eq_empty [simp]: "cball x e = {} \<longleftrightarrow> e < 0"
   by (smt (verit, best) Diff_empty ball_eq_empty cball_diff_sphere centre_in_ball centre_in_cball sphere_empty)
 
 lemma cball_empty [simp]: "e < 0 \<Longrightarrow> cball x e = {}"
   by simp
 
 lemma cball_sing:
   fixes x :: "'a::metric_space"
   shows "e = 0 \<Longrightarrow> cball x e = {x}"
   by simp
 
 lemma ball_divide_subset: "d \<ge> 1 \<Longrightarrow> ball x (e/d) \<subseteq> ball x e"
   by (metis ball_eq_empty div_by_1 frac_le linear subset_ball zero_less_one)
 
 lemma ball_divide_subset_numeral: "ball x (e / numeral w) \<subseteq> ball x e"
   using ball_divide_subset one_le_numeral by blast
 
 lemma cball_divide_subset: "d \<ge> 1 \<Longrightarrow> cball x (e/d) \<subseteq> cball x e"
   by (smt (verit, best) cball_empty div_by_1 frac_le subset_cball zero_le_divide_iff)
 
 lemma cball_divide_subset_numeral: "cball x (e / numeral w) \<subseteq> cball x e"
   using cball_divide_subset one_le_numeral by blast
 
 lemma cball_scale:
   assumes "a \<noteq> 0"
   shows   "(\<lambda>x. a *\<^sub>R x) ` cball c r = cball (a *\<^sub>R c :: 'a :: real_normed_vector) (\<bar>a\<bar> * r)"
 proof -
   have 1: "(\<lambda>x. a *\<^sub>R x) ` cball c r \<subseteq> cball (a *\<^sub>R c) (\<bar>a\<bar> * r)" if "a \<noteq> 0" for a r and c :: 'a
   proof safe
     fix x
     assume x: "x \<in> cball c r"
     have "dist (a *\<^sub>R c) (a *\<^sub>R x) = norm (a *\<^sub>R c - a *\<^sub>R x)"
       by (auto simp: dist_norm)
     also have "a *\<^sub>R c - a *\<^sub>R x = a *\<^sub>R (c - x)"
       by (simp add: algebra_simps)
     finally show "a *\<^sub>R x \<in> cball (a *\<^sub>R c) (\<bar>a\<bar> * r)"
       using that x by (auto simp: dist_norm)
   qed
 
   have "cball (a *\<^sub>R c) (\<bar>a\<bar> * r) = (\<lambda>x. a *\<^sub>R x) ` (\<lambda>x. inverse a *\<^sub>R x) ` cball (a *\<^sub>R c) (\<bar>a\<bar> * r)"
     unfolding image_image using assms by simp
   also have "\<dots> \<subseteq> (\<lambda>x. a *\<^sub>R x) ` cball (inverse a *\<^sub>R (a *\<^sub>R c)) (\<bar>inverse a\<bar> * (\<bar>a\<bar> * r))"
     using assms by (intro image_mono 1) auto
   also have "\<dots> = (\<lambda>x. a *\<^sub>R x) ` cball c r"
     using assms by (simp add: algebra_simps)
   finally have "cball (a *\<^sub>R c) (\<bar>a\<bar> * r) \<subseteq> (\<lambda>x. a *\<^sub>R x) ` cball c r" .
   moreover from assms have "(\<lambda>x. a *\<^sub>R x) ` cball c r \<subseteq> cball (a *\<^sub>R c) (\<bar>a\<bar> * r)"
     by (intro 1) auto
   ultimately show ?thesis by blast
 qed
 
 lemma ball_scale:
   assumes "a \<noteq> 0"
   shows   "(\<lambda>x. a *\<^sub>R x) ` ball c r = ball (a *\<^sub>R c :: 'a :: real_normed_vector) (\<bar>a\<bar> * r)"
 proof -
   have 1: "(\<lambda>x. a *\<^sub>R x) ` ball c r \<subseteq> ball (a *\<^sub>R c) (\<bar>a\<bar> * r)" if "a \<noteq> 0" for a r and c :: 'a
   proof safe
     fix x
     assume x: "x \<in> ball c r"
     have "dist (a *\<^sub>R c) (a *\<^sub>R x) = norm (a *\<^sub>R c - a *\<^sub>R x)"
       by (auto simp: dist_norm)
     also have "a *\<^sub>R c - a *\<^sub>R x = a *\<^sub>R (c - x)"
       by (simp add: algebra_simps)
     finally show "a *\<^sub>R x \<in> ball (a *\<^sub>R c) (\<bar>a\<bar> * r)"
       using that x by (auto simp: dist_norm)
   qed
 
   have "ball (a *\<^sub>R c) (\<bar>a\<bar> * r) = (\<lambda>x. a *\<^sub>R x) ` (\<lambda>x. inverse a *\<^sub>R x) ` ball (a *\<^sub>R c) (\<bar>a\<bar> * r)"
     unfolding image_image using assms by simp
   also have "\<dots> \<subseteq> (\<lambda>x. a *\<^sub>R x) ` ball (inverse a *\<^sub>R (a *\<^sub>R c)) (\<bar>inverse a\<bar> * (\<bar>a\<bar> * r))"
     using assms by (intro image_mono 1) auto
   also have "\<dots> = (\<lambda>x. a *\<^sub>R x) ` ball c r"
     using assms by (simp add: algebra_simps)
   finally have "ball (a *\<^sub>R c) (\<bar>a\<bar> * r) \<subseteq> (\<lambda>x. a *\<^sub>R x) ` ball c r" .
   moreover from assms have "(\<lambda>x. a *\<^sub>R x) ` ball c r \<subseteq> ball (a *\<^sub>R c) (\<bar>a\<bar> * r)"
     by (intro 1) auto
   ultimately show ?thesis by blast
 qed
 
 lemma frequently_atE:
   fixes x :: "'a :: metric_space"
   assumes "frequently P (at x within s)"
   shows   "\<exists>f. filterlim f (at x within s) sequentially \<and> (\<forall>n. P (f n))"
 proof -
   have "\<exists>y. y \<in> s \<inter> (ball x (1 / real (Suc n)) - {x}) \<and> P y" for n
   proof -
     have "\<exists>z\<in>s. z \<noteq> x \<and> dist z x < (1 / real (Suc n)) \<and> P z"
       by (metis assms divide_pos_pos frequently_at of_nat_0_less_iff zero_less_Suc zero_less_one)
     then show ?thesis
       by (auto simp: dist_commute conj_commute)
   qed
   then obtain f where f: "\<And>n. f n \<in> s \<inter> (ball x (1 / real (Suc n)) - {x}) \<and> P (f n)"
     by metis
   have "filterlim f (nhds x) sequentially"
     unfolding tendsto_iff
   proof clarify
     fix e :: real
     assume e: "e > 0"
     then obtain n where n: "Suc n > 1 / e"
       by (meson le_nat_floor lessI not_le)
     have "dist (f k) x < e" if "k \<ge> n" for k
     proof -
       have "dist (f k) x < 1 / real (Suc k)"
         using f[of k] by (auto simp: dist_commute)
       also have "\<dots> \<le> 1 / real (Suc n)"
         using that by (intro divide_left_mono) auto
       also have "\<dots> < e"
         using n e by (simp add: field_simps)
       finally show ?thesis .
     qed
     thus "\<forall>\<^sub>F k in sequentially. dist (f k) x < e"
       unfolding eventually_at_top_linorder by blast
   qed
   moreover have "f n \<noteq> x" for n
     using f[of n] by auto
   ultimately have "filterlim f (at x within s) sequentially"
     using f by (auto simp: filterlim_at)
   with f show ?thesis
     by blast
 qed
 
 subsection \<open>Limit Points\<close>
 
 lemma islimpt_approachable:
   fixes x :: "'a::metric_space"
   shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e)"
   unfolding islimpt_iff_eventually eventually_at by fast
 
 lemma islimpt_approachable_le: "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> S. x' \<noteq> x \<and> dist x' x \<le> e)"
   for x :: "'a::metric_space"
   unfolding islimpt_approachable
   using approachable_lt_le2 [where f="\<lambda>y. dist y x" and P="\<lambda>y. y \<notin> S \<or> y = x" and Q="\<lambda>x. True"]
   by auto
 
 lemma limpt_of_limpts: "x islimpt {y. y islimpt S} \<Longrightarrow> x islimpt S"
   for x :: "'a::metric_space"
   by (metis islimpt_def islimpt_eq_acc_point mem_Collect_eq)
 
 lemma closed_limpts:  "closed {x::'a::metric_space. x islimpt S}"
   using closed_limpt limpt_of_limpts by blast
 
 lemma limpt_of_closure: "x islimpt closure S \<longleftrightarrow> x islimpt S"
   for x :: "'a::metric_space"
   by (auto simp: closure_def islimpt_Un dest: limpt_of_limpts)
 
 lemma islimpt_eq_infinite_ball: "x islimpt S \<longleftrightarrow> (\<forall>e>0. infinite(S \<inter> ball x e))"
   unfolding islimpt_eq_acc_point
   by (metis open_ball Int_commute Int_mono finite_subset open_contains_ball_eq subset_eq)
 
 lemma islimpt_eq_infinite_cball: "x islimpt S \<longleftrightarrow> (\<forall>e>0. infinite(S \<inter> cball x e))"
   unfolding islimpt_eq_infinite_ball
   by (metis open_ball ball_subset_cball centre_in_ball finite_Int inf.absorb_iff2 inf_assoc open_contains_cball_eq)
 
 
 subsection \<open>Perfect Metric Spaces\<close>
 
 lemma perfect_choose_dist: "0 < r \<Longrightarrow> \<exists>a. a \<noteq> x \<and> dist a x < r"
   for x :: "'a::{perfect_space,metric_space}"
   using islimpt_UNIV [of x] by (simp add: islimpt_approachable)
 
 lemma cball_eq_sing:
   fixes x :: "'a::{metric_space,perfect_space}"
   shows "cball x e = {x} \<longleftrightarrow> e = 0"
   by (smt (verit, best) open_ball ball_eq_empty ball_subset_cball cball_empty cball_trivial 
       not_open_singleton subset_singleton_iff)
 
 
 subsection \<open>Finite and discrete\<close>
 
 lemma finite_ball_include:
   fixes a :: "'a::metric_space"
   assumes "finite S" 
   shows "\<exists>e>0. S \<subseteq> ball a e"
   using assms
 proof induction
   case (insert x S)
   then obtain e0 where "e0>0" and e0:"S \<subseteq> ball a e0" by auto
   define e where "e = max e0 (2 * dist a x)"
   have "e>0" unfolding e_def using \<open>e0>0\<close> by auto
   moreover have "insert x S \<subseteq> ball a e"
     using e0 \<open>e>0\<close> unfolding e_def by auto
   ultimately show ?case by auto
 qed (auto intro: zero_less_one)
 
 lemma finite_set_avoid:
   fixes a :: "'a::metric_space"
   assumes "finite S"
   shows "\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<longrightarrow> d \<le> dist a x"
   using assms
 proof induction
   case (insert x S)
   then obtain d where "d > 0" and d: "\<forall>x\<in>S. x \<noteq> a \<longrightarrow> d \<le> dist a x"
     by blast
   show ?case
     by (smt (verit, del_insts) dist_pos_lt insert.IH insert_iff)
 qed (auto intro: zero_less_one)
 
 lemma discrete_imp_closed:
   fixes S :: "'a::metric_space set"
   assumes e: "0 < e"
     and d: "\<forall>x \<in> S. \<forall>y \<in> S. dist y x < e \<longrightarrow> y = x"
   shows "closed S"
 proof -
   have False if C: "\<And>e. e>0 \<Longrightarrow> \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e" for x
   proof -
     from e have e2: "e/2 > 0" by arith
     from C[OF e2] obtain y where y: "y \<in> S" "y \<noteq> x" "dist y x < e/2"
       by blast
     from e2 y(2) have mp: "min (e/2) (dist x y) > 0"
       by simp
     from d y C[OF mp] show ?thesis
       by metric
   qed
   then show ?thesis
     by (metis islimpt_approachable closed_limpt [where 'a='a])
 qed
 
 lemma discrete_imp_not_islimpt:
   assumes e: "0 < e"
     and d: "\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> dist y x < e \<Longrightarrow> y = x"
   shows "\<not> x islimpt S"
 proof
   assume "x islimpt S"
   hence "x islimpt S - {x}"
     by (meson islimpt_punctured)
   moreover from assms have "closed (S - {x})"
     by (intro discrete_imp_closed) auto
   ultimately show False
     unfolding closed_limpt by blast
 qed
   
 
 subsection \<open>Interior\<close>
 
 lemma mem_interior: "x \<in> interior S \<longleftrightarrow> (\<exists>e>0. ball x e \<subseteq> S)"
   using open_contains_ball_eq [where S="interior S"]
   by (simp add: open_subset_interior)
 
 lemma mem_interior_cball: "x \<in> interior S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S)"
   by (meson ball_subset_cball interior_subset mem_interior open_contains_cball open_interior
       subset_trans)
 
 lemma ball_iff_cball: "(\<exists>r>0. ball x r \<subseteq> U) \<longleftrightarrow> (\<exists>r>0. cball x r \<subseteq> U)"
   by (meson mem_interior mem_interior_cball)
 
 
 subsection \<open>Frontier\<close>
 
 lemma frontier_straddle:
   fixes a :: "'a::metric_space"
   shows "a \<in> frontier S \<longleftrightarrow> (\<forall>e>0. (\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e))"
   unfolding frontier_def closure_interior
   by (auto simp: mem_interior subset_eq ball_def)
 
 
 subsection \<open>Limits\<close>
 
 proposition Lim: "(f \<longlongrightarrow> l) net \<longleftrightarrow> trivial_limit net \<or> (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) net)"
   by (auto simp: tendsto_iff trivial_limit_eq)
 
 text \<open>Show that they yield usual definitions in the various cases.\<close>
 
 proposition Lim_within_le: "(f \<longlongrightarrow> l)(at a within S) \<longleftrightarrow>
     (\<forall>e>0. \<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a \<le> d \<longrightarrow> dist (f x) l < e)"
   by (auto simp: tendsto_iff eventually_at_le)
 
 proposition Lim_within: "(f \<longlongrightarrow> l) (at a within S) \<longleftrightarrow>
     (\<forall>e >0. \<exists>d>0. \<forall>x \<in> S. 0 < dist x a \<and> dist x a  < d \<longrightarrow> dist (f x) l < e)"
   by (auto simp: tendsto_iff eventually_at)
 
 corollary Lim_withinI [intro?]:
   assumes "\<And>e. e > 0 \<Longrightarrow> \<exists>d>0. \<forall>x \<in> S. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l \<le> e"
   shows "(f \<longlongrightarrow> l) (at a within S)"
   unfolding Lim_within by (smt (verit, ccfv_SIG) assms zero_less_dist_iff)
 
 proposition Lim_at: "(f \<longlongrightarrow> l) (at a) \<longleftrightarrow>
     (\<forall>e >0. \<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d  \<longrightarrow> dist (f x) l < e)"
   by (auto simp: tendsto_iff eventually_at)
 
 lemma Lim_transform_within_set:
   fixes a :: "'a::metric_space" and l :: "'b::metric_space"
   shows "\<lbrakk>(f \<longlongrightarrow> l) (at a within S); eventually (\<lambda>x. x \<in> S \<longleftrightarrow> x \<in> T) (at a)\<rbrakk>
          \<Longrightarrow> (f \<longlongrightarrow> l) (at a within T)"
   by (simp add: eventually_at Lim_within) (smt (verit, best))
 
 text \<open>Another limit point characterization.\<close>
 
 lemma limpt_sequential_inj:
   fixes x :: "'a::metric_space"
   shows "x islimpt S \<longleftrightarrow>
          (\<exists>f. (\<forall>n::nat. f n \<in> S - {x}) \<and> inj f \<and> (f \<longlongrightarrow> x) sequentially)"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
     by (force simp: islimpt_approachable)
   then obtain y where y: "\<And>e. e>0 \<Longrightarrow> y e \<in> S \<and> y e \<noteq> x \<and> dist (y e) x < e"
     by metis
   define f where "f \<equiv> rec_nat (y 1) (\<lambda>n fn. y (min (inverse(2 ^ (Suc n))) (dist fn x)))"
   have [simp]: "f 0 = y 1"
             and fSuc: "f(Suc n) = y (min (inverse(2 ^ (Suc n))) (dist (f n) x))" for n
     by (simp_all add: f_def)
   have f: "f n \<in> S \<and> (f n \<noteq> x) \<and> dist (f n) x < inverse(2 ^ n)" for n
   proof (induction n)
     case 0 show ?case
       by (simp add: y)
   next
     case (Suc n) then show ?case
       by (smt (verit, best) fSuc dist_pos_lt inverse_positive_iff_positive y zero_less_power)
   qed
   show ?rhs
   proof (intro exI conjI allI)
     show "\<And>n. f n \<in> S - {x}"
       using f by blast
     have "dist (f n) x < dist (f m) x" if "m < n" for m n
     using that
     proof (induction n)
       case 0 then show ?case by simp
     next
       case (Suc n)
       then consider "m < n" | "m = n" using less_Suc_eq by blast
       then show ?case
       proof cases
         assume "m < n"
         have "dist (f(Suc n)) x = dist (y (min (inverse(2 ^ (Suc n))) (dist (f n) x))) x"
           by (simp add: fSuc)
         also have "\<dots> < dist (f n) x"
           by (metis dist_pos_lt f min.strict_order_iff min_less_iff_conj y)
         also have "\<dots> < dist (f m) x"
           using Suc.IH \<open>m < n\<close> by blast
         finally show ?thesis .
       next
         assume "m = n" then show ?case
           by (smt (verit, best) dist_pos_lt f fSuc y)
       qed
     qed
     then show "inj f"
       by (metis less_irrefl linorder_injI)
     have "\<And>e n. \<lbrakk>0 < e; nat \<lceil>1 / e\<rceil> \<le> n\<rbrakk> \<Longrightarrow> dist (f n) x < e"
       apply (rule less_trans [OF f [THEN conjunct2, THEN conjunct2]])
       by (simp add: divide_simps order_le_less_trans)
     then show "f \<longlonglongrightarrow> x"
       using lim_sequentially by blast
   qed
 next
   assume ?rhs
   then show ?lhs
     by (fastforce simp add: islimpt_approachable lim_sequentially)
 qed
 
 lemma Lim_dist_ubound:
   assumes "\<not>(trivial_limit net)"
     and "(f \<longlongrightarrow> l) net"
     and "eventually (\<lambda>x. dist a (f x) \<le> e) net"
   shows "dist a l \<le> e"
   using assms by (fast intro: tendsto_le tendsto_intros)
 
 
 subsection \<open>Continuity\<close>
 
 text\<open>Derive the epsilon-delta forms, which we often use as "definitions"\<close>
 
 proposition continuous_within_eps_delta:
   "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. \<forall>x'\<in> s.  dist x' x < d --> dist (f x') (f x) < e)"
   unfolding continuous_within and Lim_within  by fastforce
 
 corollary continuous_at_eps_delta:
   "continuous (at x) f \<longleftrightarrow> (\<forall>e > 0. \<exists>d > 0. \<forall>x'. dist x' x < d \<longrightarrow> dist (f x') (f x) < e)"
   using continuous_within_eps_delta [of x UNIV f] by simp
 
 lemma continuous_at_right_real_increasing:
   fixes f :: "real \<Rightarrow> real"
   assumes nondecF: "\<And>x y. x \<le> y \<Longrightarrow> f x \<le> f y"
   shows "continuous (at_right a) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. f (a + d) - f a < e)"
   apply (simp add: greaterThan_def dist_real_def continuous_within Lim_within_le)
   apply (intro all_cong ex_cong)
   by (smt (verit, best) nondecF)
 
 lemma continuous_at_left_real_increasing:
   assumes nondecF: "\<And> x y. x \<le> y \<Longrightarrow> f x \<le> ((f y) :: real)"
   shows "(continuous (at_left (a :: real)) f) \<longleftrightarrow> (\<forall>e > 0. \<exists>delta > 0. f a - f (a - delta) < e)"
   apply (simp add: lessThan_def dist_real_def continuous_within Lim_within_le)
   apply (intro all_cong ex_cong)
   by (smt (verit) nondecF)
 
 text\<open>Versions in terms of open balls.\<close>
 
 lemma continuous_within_ball:
   "continuous (at x within S) f \<longleftrightarrow>
     (\<forall>e > 0. \<exists>d > 0. f ` (ball x d \<inter> S) \<subseteq> ball (f x) e)"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   {
     fix e :: real
     assume "e > 0"
     then obtain d where "d>0" and d: "\<forall>y\<in>S. 0 < dist y x \<and> dist y x < d \<longrightarrow> dist (f y) (f x) < e"
       using \<open>?lhs\<close>[unfolded continuous_within Lim_within] by auto
     { fix y
       assume "y \<in> f ` (ball x d \<inter> S)" then have "y \<in> ball (f x) e"
         using d \<open>e > 0\<close> by (auto simp: dist_commute)
     }
     then have "\<exists>d>0. f ` (ball x d \<inter> S) \<subseteq> ball (f x) e"
       using \<open>d > 0\<close> by blast
   }
   then show ?rhs by auto
 next
   assume ?rhs
   then show ?lhs
     apply (simp add: continuous_within Lim_within ball_def subset_eq)
     by (metis (mono_tags, lifting) Int_iff dist_commute mem_Collect_eq)
 qed
 
 lemma continuous_at_ball:
   "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. f ` (ball x d) \<subseteq> ball (f x) e)"
   apply (simp add: continuous_at Lim_at subset_eq Ball_def Bex_def image_iff)
   by (smt (verit, ccfv_threshold) dist_commute dist_self)
 
 
 text\<open>Define setwise continuity in terms of limits within the set.\<close>
 
 lemma continuous_on_iff:
   "continuous_on s f \<longleftrightarrow>
     (\<forall>x\<in>s. \<forall>e>0. \<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e)"
   unfolding continuous_on_def Lim_within
   by (metis dist_pos_lt dist_self)
 
 lemma continuous_within_E:
   assumes "continuous (at x within S) f" "e>0"
   obtains d where "d>0"  "\<And>x'. \<lbrakk>x'\<in> S; dist x' x \<le> d\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e"
   using assms unfolding continuous_within_eps_delta
   by (metis dense order_le_less_trans)
 
 lemma continuous_onI [intro?]:
   assumes "\<And>x e. \<lbrakk>e > 0; x \<in> S\<rbrakk> \<Longrightarrow> \<exists>d>0. \<forall>x'\<in>S. dist x' x < d \<longrightarrow> dist (f x') (f x) \<le> e"
   shows "continuous_on S f"
 apply (simp add: continuous_on_iff, clarify)
 apply (rule ex_forward [OF assms [OF half_gt_zero]], auto)
 done
 
 text\<open>Some simple consequential lemmas.\<close>
 
 lemma continuous_onE:
     assumes "continuous_on s f" "x\<in>s" "e>0"
     obtains d where "d>0"  "\<And>x'. \<lbrakk>x' \<in> s; dist x' x \<le> d\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e"
   using assms
   unfolding continuous_on_iff by (metis dense order_le_less_trans)
 
 text\<open>The usual transformation theorems.\<close>
 
 lemma continuous_transform_within:
   fixes f g :: "'a::metric_space \<Rightarrow> 'b::topological_space"
   assumes "continuous (at x within s) f"
     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 "continuous (at x within s) g"
   using assms
   unfolding continuous_within by (force intro: Lim_transform_within)
 
 
 subsection \<open>Closure and Limit Characterization\<close>
 
 lemma closure_approachable:
   fixes S :: "'a::metric_space set"
   shows "x \<in> closure S \<longleftrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x < e)"
   using dist_self by (force simp: closure_def islimpt_approachable)
 
 lemma closure_approachable_le:
   fixes S :: "'a::metric_space set"
   shows "x \<in> closure S \<longleftrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x \<le> e)"
   unfolding closure_approachable
   using dense by force
 
 lemma closure_approachableD:
   assumes "x \<in> closure S" "e>0"
   shows "\<exists>y\<in>S. dist x y < e"
   using assms unfolding closure_approachable by (auto simp: dist_commute)
 
 lemma closed_approachable:
   fixes S :: "'a::metric_space set"
   shows "closed S \<Longrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x < e) \<longleftrightarrow> x \<in> S"
   by (metis closure_closed closure_approachable)
 
 lemma closure_contains_Inf:
   fixes S :: "real set"
   assumes "S \<noteq> {}" "bdd_below S"
   shows "Inf S \<in> closure S"
 proof -
   have *: "\<forall>x\<in>S. Inf S \<le> x"
     using cInf_lower[of _ S] assms by metis
   { fix e :: real
     assume "e > 0"
     then have "Inf S < Inf S + e" by simp
     with assms obtain x where "x \<in> S" "x < Inf S + e"
       using cInf_lessD by blast
     with * have "\<exists>x\<in>S. dist x (Inf S) < e"
       using dist_real_def by force
   }
   then show ?thesis unfolding closure_approachable by auto
 qed
 
 lemma closure_contains_Sup:
   fixes S :: "real set"
   assumes "S \<noteq> {}" "bdd_above S"
   shows "Sup S \<in> closure S"
 proof -
   have *: "\<forall>x\<in>S. x \<le> Sup S"
     using cSup_upper[of _ S] assms by metis
   {
     fix e :: real
     assume "e > 0"
     then have "Sup S - e < Sup S" by simp
     with assms obtain x where "x \<in> S" "Sup S - e < x"
       using less_cSupE by blast
     with * have "\<exists>x\<in>S. dist x (Sup S) < e"
       using dist_real_def by force
   }
   then show ?thesis unfolding closure_approachable by auto
 qed
 
 lemma not_trivial_limit_within_ball:
   "\<not> trivial_limit (at x within S) \<longleftrightarrow> (\<forall>e>0. S \<inter> ball x e - {x} \<noteq> {})"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   show ?rhs if ?lhs
   proof -
     { fix e :: real
       assume "e > 0"
       then obtain y where "y \<in> S - {x}" and "dist y x < e"
         using \<open>?lhs\<close> not_trivial_limit_within[of x S] closure_approachable[of x "S - {x}"]
         by auto
       then have "y \<in> S \<inter> ball x e - {x}"
         unfolding ball_def by (simp add: dist_commute)
       then have "S \<inter> ball x e - {x} \<noteq> {}" by blast
     }
     then show ?thesis by auto
   qed
   show ?lhs if ?rhs
   proof -
     { fix e :: real
       assume "e > 0"
       then obtain y where "y \<in> S \<inter> ball x e - {x}"
         using \<open>?rhs\<close> by blast
       then have "y \<in> S - {x}" and "dist y x < e"
         unfolding ball_def by (simp_all add: dist_commute)
       then have "\<exists>y \<in> S - {x}. dist y x < e"
         by auto
     }
     then show ?thesis
       using not_trivial_limit_within[of x S] closure_approachable[of x "S - {x}"]
       by auto
   qed
 qed
 
 
 subsection \<open>Boundedness\<close>
 
   (* FIXME: This has to be unified with BSEQ!! *)
 definition\<^marker>\<open>tag important\<close> (in metric_space) bounded :: "'a set \<Rightarrow> bool"
   where "bounded S \<longleftrightarrow> (\<exists>x e. \<forall>y\<in>S. dist x y \<le> e)"
 
 lemma bounded_subset_cball: "bounded S \<longleftrightarrow> (\<exists>e x. S \<subseteq> cball x e \<and> 0 \<le> e)"
   unfolding bounded_def subset_eq  by auto (meson order_trans zero_le_dist)
 
 lemma bounded_any_center: "bounded S \<longleftrightarrow> (\<exists>e. \<forall>y\<in>S. dist a y \<le> e)"
   unfolding bounded_def
   by auto (metis add.commute add_le_cancel_right dist_commute dist_triangle_le)
 
 lemma bounded_iff: "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. norm x \<le> a)"
   unfolding bounded_any_center [where a=0]
   by (simp add: dist_norm)
 
 lemma bdd_above_norm: "bdd_above (norm ` X) \<longleftrightarrow> bounded X"
   by (simp add: bounded_iff bdd_above_def)
 
 lemma bounded_norm_comp: "bounded ((\<lambda>x. norm (f x)) ` S) = bounded (f ` S)"
   by (simp add: bounded_iff)
 
 lemma boundedI:
   assumes "\<And>x. x \<in> S \<Longrightarrow> norm x \<le> B"
   shows "bounded S"
   using assms bounded_iff by blast
 
 lemma bounded_empty [simp]: "bounded {}"
   by (simp add: bounded_def)
 
 lemma bounded_subset: "bounded T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> bounded S"
   by (metis bounded_def subset_eq)
 
 lemma bounded_interior[intro]: "bounded S \<Longrightarrow> bounded(interior S)"
   by (metis bounded_subset interior_subset)
 
 lemma bounded_closure[intro]:
   assumes "bounded S"
   shows "bounded (closure S)"
 proof -
   from assms obtain x and a where a: "\<forall>y\<in>S. dist x y \<le> a"
     unfolding bounded_def by auto
   { fix y
     assume "y \<in> closure S"
     then obtain f where f: "\<forall>n. f n \<in> S"  "(f \<longlongrightarrow> y) sequentially"
       unfolding closure_sequential by auto
     have "\<forall>n. f n \<in> S \<longrightarrow> dist x (f n) \<le> a" using a by simp
     then have "eventually (\<lambda>n. dist x (f n) \<le> a) sequentially"
       by (simp add: f(1))
     then have "dist x y \<le> a"
       using Lim_dist_ubound f(2) trivial_limit_sequentially by blast
   }
   then show ?thesis
     unfolding bounded_def by auto
 qed
 
 lemma bounded_closure_image: "bounded (f ` closure S) \<Longrightarrow> bounded (f ` S)"
   by (simp add: bounded_subset closure_subset image_mono)
 
 lemma bounded_cball[simp,intro]: "bounded (cball x e)"
   unfolding bounded_def  using mem_cball by blast
 
 lemma bounded_ball[simp,intro]: "bounded (ball x e)"
   by (metis ball_subset_cball bounded_cball bounded_subset)
 
 lemma bounded_Un[simp]: "bounded (S \<union> T) \<longleftrightarrow> bounded S \<and> bounded T"
   by (auto simp: bounded_def) (metis Un_iff bounded_any_center le_max_iff_disj)
 
 lemma bounded_Union[intro]: "finite F \<Longrightarrow> \<forall>S\<in>F. bounded S \<Longrightarrow> bounded (\<Union>F)"
   by (induct rule: finite_induct[of F]) auto
 
 lemma bounded_UN [intro]: "finite A \<Longrightarrow> \<forall>x\<in>A. bounded (B x) \<Longrightarrow> bounded (\<Union>x\<in>A. B x)"
   by auto
 
 lemma bounded_insert [simp]: "bounded (insert x S) \<longleftrightarrow> bounded S"
 proof -
   have "\<forall>y\<in>{x}. dist x y \<le> 0"
     by simp
   then have "bounded {x}"
     unfolding bounded_def by fast
   then show ?thesis
     by (metis insert_is_Un bounded_Un)
 qed
 
 lemma bounded_subset_ballI: "S \<subseteq> ball x r \<Longrightarrow> bounded S"
   by (meson bounded_ball bounded_subset)
 
 lemma bounded_subset_ballD:
   assumes "bounded S" shows "\<exists>r. 0 < r \<and> S \<subseteq> ball x r"
 proof -
   obtain e::real and y where "S \<subseteq> cball y e" "0 \<le> e"
     using assms by (auto simp: bounded_subset_cball)
   then show ?thesis
     by (intro exI[where x="dist x y + e + 1"]) metric
 qed
 
 lemma finite_imp_bounded [intro]: "finite S \<Longrightarrow> bounded S"
   by (induct set: finite) simp_all
 
 lemma bounded_Int[intro]: "bounded S \<or> bounded T \<Longrightarrow> bounded (S \<inter> T)"
   by (metis Int_lower1 Int_lower2 bounded_subset)
 
 lemma bounded_diff[intro]: "bounded S \<Longrightarrow> bounded (S - T)"
   by (metis Diff_subset bounded_subset)
 
 lemma bounded_dist_comp:
   assumes "bounded (f ` S)" "bounded (g ` S)"
   shows "bounded ((\<lambda>x. dist (f x) (g x)) ` S)"
 proof -
   from assms obtain M1 M2 where *: "dist (f x) undefined \<le> M1" "dist undefined (g x) \<le> M2" if "x \<in> S" for x
     by (auto simp: bounded_any_center[of _ undefined] dist_commute)
   have "dist (f x) (g x) \<le> M1 + M2" if "x \<in> S" for x
     using *[OF that]
     by metric
   then show ?thesis
     by (auto intro!: boundedI)
 qed
 
 lemma bounded_Times:
   assumes "bounded s" "bounded t"
   shows "bounded (s \<times> t)"
 proof -
   obtain x y a b where "\<forall>z\<in>s. dist x z \<le> a" "\<forall>z\<in>t. dist y z \<le> b"
     using assms [unfolded bounded_def] by auto
   then have "\<forall>z\<in>s \<times> t. dist (x, y) z \<le> sqrt (a\<^sup>2 + b\<^sup>2)"
     by (auto simp: dist_Pair_Pair real_sqrt_le_mono add_mono power_mono)
   then show ?thesis unfolding bounded_any_center [where a="(x, y)"] by auto
 qed
 
 
 subsection \<open>Compactness\<close>
 
 lemma compact_imp_bounded:
   assumes "compact U"
   shows "bounded U"
 proof -
   have "compact U" "\<forall>x\<in>U. open (ball x 1)" "U \<subseteq> (\<Union>x\<in>U. ball x 1)"
     using assms by auto
   then obtain D where D: "D \<subseteq> U" "finite D" "U \<subseteq> (\<Union>x\<in>D. ball x 1)"
     by (metis compactE_image)
   from \<open>finite D\<close> have "bounded (\<Union>x\<in>D. ball x 1)"
     by (simp add: bounded_UN)
   then show "bounded U" using \<open>U \<subseteq> (\<Union>x\<in>D. ball x 1)\<close>
     by (rule bounded_subset)
 qed
 
 lemma continuous_on_compact_bound:
   assumes "compact A" "continuous_on A f"
   obtains B where "B \<ge> 0" "\<And>x. x \<in> A \<Longrightarrow> norm (f x) \<le> B"
 proof -
   have "compact (f ` A)" by (metis assms compact_continuous_image)
   then obtain B where "\<forall>x\<in>A. norm (f x) \<le> B"
     by (auto dest!: compact_imp_bounded simp: bounded_iff)
   hence "max B 0 \<ge> 0" and "\<forall>x\<in>A. norm (f x) \<le> max B 0" by auto
   thus ?thesis using that by blast
 qed
 
 lemma closure_Int_ball_not_empty:
   assumes "S \<subseteq> closure T" "x \<in> S" "r > 0"
   shows "T \<inter> ball x r \<noteq> {}"
   using assms centre_in_ball closure_iff_nhds_not_empty by blast
 
 lemma compact_sup_maxdistance:
   fixes S :: "'a::metric_space set"
   assumes "compact S"
     and "S \<noteq> {}"
   shows "\<exists>x\<in>S. \<exists>y\<in>S. \<forall>u\<in>S. \<forall>v\<in>S. dist u v \<le> dist x y"
 proof -
   have "compact (S \<times> S)"
     using \<open>compact S\<close> by (intro compact_Times)
   moreover have "S \<times> S \<noteq> {}"
     using \<open>S \<noteq> {}\<close> by auto
   moreover have "continuous_on (S \<times> S) (\<lambda>x. dist (fst x) (snd x))"
     by (intro continuous_at_imp_continuous_on ballI continuous_intros)
   ultimately show ?thesis
     using continuous_attains_sup[of "S \<times> S" "\<lambda>x. dist (fst x) (snd x)"] by auto
 qed
 
 text \<open>
   If \<open>A\<close> is a compact subset of an open set \<open>B\<close> in a metric space, then there exists an \<open>\<epsilon> > 0\<close>
   such that the Minkowski sum of \<open>A\<close> with an open ball of radius \<open>\<epsilon>\<close> is also a subset of \<open>B\<close>.
 \<close>
 lemma compact_subset_open_imp_ball_epsilon_subset:
   assumes "compact A" "open B" "A \<subseteq> B"
   obtains e where "e > 0"  "(\<Union>x\<in>A. ball x e) \<subseteq> B"
 proof -
   have "\<forall>x\<in>A. \<exists>e. e > 0 \<and> ball x e \<subseteq> B"
     using assms unfolding open_contains_ball by blast
   then obtain e where e: "\<And>x. x \<in> A \<Longrightarrow> e x > 0" "\<And>x. x \<in> A \<Longrightarrow> ball x (e x) \<subseteq> B"
     by metis
   define C where "C = e ` A"
   obtain X where X: "X \<subseteq> A" "finite X" "A \<subseteq> (\<Union>c\<in>X. ball c (e c / 2))"
     using assms(1)
   proof (rule compactE_image)
     show "open (ball x (e x / 2))" if "x \<in> A" for x
       by simp
     show "A \<subseteq> (\<Union>c\<in>A. ball c (e c / 2))"
       using e by auto
   qed auto
 
   define e' where "e' = Min (insert 1 ((\<lambda>x. e x / 2) ` X))"
   have "e' > 0"
     unfolding e'_def using e X by (subst Min_gr_iff) auto
   have e': "e' \<le> e x / 2" if "x \<in> X" for x
     using that X unfolding e'_def by (intro Min.coboundedI) auto
 
   show ?thesis
   proof 
     show "e' > 0"
       by fact
   next
     show "(\<Union>x\<in>A. ball x e') \<subseteq> B"
     proof clarify
       fix x y assume xy: "x \<in> A" "y \<in> ball x e'"
       from xy(1) X obtain z where z: "z \<in> X" "x \<in> ball z (e z / 2)"
         by auto
       have "dist y z \<le> dist x y + dist z x"
         by (metis dist_commute dist_triangle)
       also have "dist z x < e z / 2"
         using xy z by auto
       also have "dist x y < e'"
         using xy by auto
       also have "\<dots> \<le> e z / 2"
         using z by (intro e') auto
       finally have "y \<in> ball z (e z)"
         by (simp add: dist_commute)
       also have "\<dots> \<subseteq> B"
         using z X by (intro e) auto
       finally show "y \<in> B" .
     qed
   qed
 qed
 
 lemma compact_subset_open_imp_cball_epsilon_subset:
   assumes "compact A" "open B" "A \<subseteq> B"
   obtains e where "e > 0"  "(\<Union>x\<in>A. cball x e) \<subseteq> B"
 proof -
   obtain e where "e > 0" and e: "(\<Union>x\<in>A. ball x e) \<subseteq> B"
     using compact_subset_open_imp_ball_epsilon_subset [OF assms] by blast
   then have "(\<Union>x\<in>A. cball x (e / 2)) \<subseteq> (\<Union>x\<in>A. ball x e)"
     by auto
   with \<open>0 < e\<close> that show ?thesis
     by (metis e half_gt_zero_iff order_trans)
 qed
 
 subsubsection\<open>Totally bounded\<close>
 
-lemma cauchy_def: "Cauchy S \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m n. m \<ge> N \<and> n \<ge> N \<longrightarrow> dist (S m) (S n) < e)"
-  unfolding Cauchy_def by metis
-
 proposition seq_compact_imp_totally_bounded:
   assumes "seq_compact S"
   shows "\<forall>e>0. \<exists>k. finite k \<and> k \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>k. ball x e)"
 proof -
   { fix e::real assume "e > 0" assume *: "\<And>k. finite k \<Longrightarrow> k \<subseteq> S \<Longrightarrow> \<not> S \<subseteq> (\<Union>x\<in>k. ball x e)"
     let ?Q = "\<lambda>x n r. r \<in> S \<and> (\<forall>m < (n::nat). \<not> (dist (x m) r < e))"
     have "\<exists>x. \<forall>n::nat. ?Q x n (x n)"
     proof (rule dependent_wellorder_choice)
       fix n x assume "\<And>y. y < n \<Longrightarrow> ?Q x y (x y)"
       then have "\<not> S \<subseteq> (\<Union>x\<in>x ` {0..<n}. ball x e)"
         using *[of "x ` {0 ..< n}"] by (auto simp: subset_eq)
       then obtain z where z:"z\<in>S" "z \<notin> (\<Union>x\<in>x ` {0..<n}. ball x e)"
         unfolding subset_eq by auto
       show "\<exists>r. ?Q x n r"
         using z by auto
     qed simp
     then obtain x where "\<forall>n::nat. x n \<in> S" and x:"\<And>n m. m < n \<Longrightarrow> \<not> (dist (x m) (x n) < e)"
       by blast
     then obtain l r where "l \<in> S" and r:"strict_mono  r" and "((x \<circ> r) \<longlongrightarrow> l) sequentially"
       using assms by (metis seq_compact_def)
     then have "Cauchy (x \<circ> r)"
       using LIMSEQ_imp_Cauchy by auto
     then obtain N::nat where "\<And>m n. N \<le> m \<Longrightarrow> N \<le> n \<Longrightarrow> dist ((x \<circ> r) m) ((x \<circ> r) n) < e"
-      unfolding cauchy_def using \<open>e > 0\<close> by blast
+      unfolding Cauchy_def using \<open>e > 0\<close> by blast
     then have False
       using x[of "r N" "r (N+1)"] r by (auto simp: strict_mono_def) }
   then show ?thesis
     by metis
 qed
 
 subsubsection\<open>Heine-Borel theorem\<close>
 
 proposition seq_compact_imp_Heine_Borel:
   fixes S :: "'a :: metric_space set"
   assumes "seq_compact S"
   shows "compact S"
 proof -
   from seq_compact_imp_totally_bounded[OF \<open>seq_compact S\<close>]
   obtain f where f: "\<forall>e>0. finite (f e) \<and> f e \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>f e. ball x e)"
     unfolding choice_iff' ..
   define K where "K = (\<lambda>(x, r). ball x r) ` ((\<Union>e \<in> \<rat> \<inter> {0 <..}. f e) \<times> \<rat>)"
   have "countably_compact S"
     using \<open>seq_compact S\<close> by (rule seq_compact_imp_countably_compact)
   then show "compact S"
   proof (rule countably_compact_imp_compact)
     show "countable K"
       unfolding K_def using f
       by (auto intro: countable_finite countable_subset countable_rat
                intro!: countable_image countable_SIGMA countable_UN)
     show "\<forall>b\<in>K. open b" by (auto simp: K_def)
   next
     fix T x
     assume T: "open T" "x \<in> T" and x: "x \<in> S"
     from openE[OF T] obtain e where "0 < e" "ball x e \<subseteq> T"
       by auto
     then have "0 < e/2" "ball x (e/2) \<subseteq> T"
       by auto
     from Rats_dense_in_real[OF \<open>0 < e/2\<close>] obtain r where "r \<in> \<rat>" "0 < r" "r < e/2"
       by auto
     from f[rule_format, of r] \<open>0 < r\<close> \<open>x \<in> S\<close> obtain k where "k \<in> f r" "x \<in> ball k r"
       by auto
     from \<open>r \<in> \<rat>\<close> \<open>0 < r\<close> \<open>k \<in> f r\<close> have "ball k r \<in> K"
       by (auto simp: K_def)
     then show "\<exists>b\<in>K. x \<in> b \<and> b \<inter> S \<subseteq> T"
     proof (rule bexI[rotated], safe)
       fix y
       assume "y \<in> ball k r"
       with \<open>r < e/2\<close> \<open>x \<in> ball k r\<close> have "dist x y < e"
         by (intro dist_triangle_half_r [of k _ e]) (auto simp: dist_commute)
       with \<open>ball x e \<subseteq> T\<close> show "y \<in> T"
         by auto
     next
       show "x \<in> ball k r" by fact
     qed
   qed
 qed
 
 proposition compact_eq_seq_compact_metric:
   "compact (S :: 'a::metric_space set) \<longleftrightarrow> seq_compact S"
   using compact_imp_seq_compact seq_compact_imp_Heine_Borel by blast
 
 proposition compact_def: \<comment> \<open>this is the definition of compactness in HOL Light\<close>
   "compact (S :: 'a::metric_space set) \<longleftrightarrow>
    (\<forall>f. (\<forall>n. f n \<in> S) \<longrightarrow> (\<exists>l\<in>S. \<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> l))"
   unfolding compact_eq_seq_compact_metric seq_compact_def by auto
 
 subsubsection \<open>Complete the chain of compactness variants\<close>
 
 proposition compact_eq_Bolzano_Weierstrass:
   fixes S :: "'a::metric_space set"
   shows "compact S \<longleftrightarrow> (\<forall>T. infinite T \<and> T \<subseteq> S \<longrightarrow> (\<exists>x \<in> S. x islimpt T))"
   using Bolzano_Weierstrass_imp_seq_compact Heine_Borel_imp_Bolzano_Weierstrass compact_eq_seq_compact_metric 
   by blast
 
 proposition Bolzano_Weierstrass_imp_bounded:
   "(\<And>T. \<lbrakk>infinite T; T \<subseteq> S\<rbrakk> \<Longrightarrow> (\<exists>x \<in> S. x islimpt T)) \<Longrightarrow> bounded S"
   using compact_imp_bounded unfolding compact_eq_Bolzano_Weierstrass by metis
 
 
 subsection \<open>Banach fixed point theorem\<close>
   
 theorem banach_fix:\<comment> \<open>TODO: rename to \<open>Banach_fix\<close>\<close>
   assumes s: "complete s" "s \<noteq> {}"
     and c: "0 \<le> c" "c < 1"
     and f: "f ` s \<subseteq> s"
     and lipschitz: "\<forall>x\<in>s. \<forall>y\<in>s. dist (f x) (f y) \<le> c * dist x y"
   shows "\<exists>!x\<in>s. f x = x"
 proof -
   from c have "1 - c > 0" by simp
 
   from s(2) obtain z0 where z0: "z0 \<in> s" by blast
   define z where "z n = (f ^^ n) z0" for n
   with f z0 have z_in_s: "z n \<in> s" for n :: nat
     by (induct n) auto
   define d where "d = dist (z 0) (z 1)"
 
   have fzn: "f (z n) = z (Suc n)" for n
     by (simp add: z_def)
   have cf_z: "dist (z n) (z (Suc n)) \<le> (c ^ n) * d" for n :: nat
   proof (induct n)
     case 0
     then show ?case
       by (simp add: d_def)
   next
     case (Suc m)
     with \<open>0 \<le> c\<close> have "c * dist (z m) (z (Suc m)) \<le> c ^ Suc m * d"
       using mult_left_mono[of "dist (z m) (z (Suc m))" "c ^ m * d" c] by simp
     then show ?case
       using lipschitz[THEN bspec[where x="z m"], OF z_in_s, THEN bspec[where x="z (Suc m)"], OF z_in_s]
       by (simp add: fzn mult_le_cancel_left)
   qed
 
   have cf_z2: "(1 - c) * dist (z m) (z (m + n)) \<le> (c ^ m) * d * (1 - c ^ n)" for n m :: nat
   proof (induct n)
     case 0
     show ?case by simp
   next
     case (Suc k)
     from c have "(1 - c) * dist (z m) (z (m + Suc k)) \<le>
         (1 - c) * (dist (z m) (z (m + k)) + dist (z (m + k)) (z (Suc (m + k))))"
       by (simp add: dist_triangle)
     also from c cf_z[of "m + k"] have "\<dots> \<le> (1 - c) * (dist (z m) (z (m + k)) + c ^ (m + k) * d)"
       by simp
     also from Suc have "\<dots> \<le> c ^ m * d * (1 - c ^ k) + (1 - c) * c ^ (m + k) * d"
       by (simp add: field_simps)
     also have "\<dots> = (c ^ m) * (d * (1 - c ^ k) + (1 - c) * c ^ k * d)"
       by (simp add: power_add field_simps)
     also from c have "\<dots> \<le> (c ^ m) * d * (1 - c ^ Suc k)"
       by (simp add: field_simps)
     finally show ?case by simp
   qed
 
   have "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (z m) (z n) < e" if "e > 0" for e
   proof (cases "d = 0")
     case True
     from \<open>1 - c > 0\<close> have "(1 - c) * x \<le> 0 \<longleftrightarrow> x \<le> 0" for x
       by (simp add: mult_le_0_iff)
     with c cf_z2[of 0] True have "z n = z0" for n
       by (simp add: z_def)
     with \<open>e > 0\<close> show ?thesis by simp
   next
     case False
     with zero_le_dist[of "z 0" "z 1"] have "d > 0"
       by (metis d_def less_le)
     with \<open>1 - c > 0\<close> \<open>e > 0\<close> have "0 < e * (1 - c) / d"
       by simp
     with c obtain N where N: "c ^ N < e * (1 - c) / d"
       using real_arch_pow_inv[of "e * (1 - c) / d" c] by auto
     have *: "dist (z m) (z n) < e" if "m > n" and as: "m \<ge> N" "n \<ge> N" for m n :: nat
     proof -
       from c \<open>n \<ge> N\<close> have *: "c ^ n \<le> c ^ N"
         using power_decreasing[OF \<open>n\<ge>N\<close>, of c] by simp
       from c \<open>m > n\<close> have "1 - c ^ (m - n) > 0"
         using power_strict_mono[of c 1 "m - n"] by simp
       with \<open>d > 0\<close> \<open>0 < 1 - c\<close> have **: "d * (1 - c ^ (m - n)) / (1 - c) > 0"
         by simp
       from cf_z2[of n "m - n"] \<open>m > n\<close>
       have "dist (z m) (z n) \<le> c ^ n * d * (1 - c ^ (m - n)) / (1 - c)"
         by (simp add: pos_le_divide_eq[OF \<open>1 - c > 0\<close>] mult.commute dist_commute)
       also have "\<dots> \<le> c ^ N * d * (1 - c ^ (m - n)) / (1 - c)"
         using mult_right_mono[OF * order_less_imp_le[OF **]]
         by (simp add: mult.assoc)
       also have "\<dots> < (e * (1 - c) / d) * d * (1 - c ^ (m - n)) / (1 - c)"
         using mult_strict_right_mono[OF N **] by (auto simp: mult.assoc)
       also from c \<open>d > 0\<close> \<open>1 - c > 0\<close> have "\<dots> = e * (1 - c ^ (m - n))"
         by simp
       also from c \<open>1 - c ^ (m - n) > 0\<close> \<open>e > 0\<close> have "\<dots> \<le> e"
         using mult_right_le_one_le[of e "1 - c ^ (m - n)"] by auto
       finally show ?thesis by simp
     qed
     have "dist (z n) (z m) < e" if "N \<le> m" "N \<le> n" for m n :: nat
     proof (cases "n = m")
       case True
       with \<open>e > 0\<close> show ?thesis by simp
     next
       case False
       with *[of n m] *[of m n] and that show ?thesis
         by (auto simp: dist_commute nat_neq_iff)
     qed
     then show ?thesis by auto
   qed
   then have "Cauchy z"
-    by (simp add: cauchy_def)
+    by (metis metric_CauchyI)
   then obtain x where "x\<in>s" and x:"(z \<longlongrightarrow> x) sequentially"
     using s(1)[unfolded compact_def complete_def, THEN spec[where x=z]] and z_in_s by auto
 
   define e where "e = dist (f x) x"
   have "e = 0"
   proof (rule ccontr)
     assume "e \<noteq> 0"
     then have "e > 0"
       unfolding e_def using zero_le_dist[of "f x" x]
       by (metis dist_eq_0_iff dist_nz e_def)
     then obtain N where N:"\<forall>n\<ge>N. dist (z n) x < e/2"
       using x[unfolded lim_sequentially, THEN spec[where x="e/2"]] by auto
     then have N':"dist (z N) x < e/2" by auto
     have *: "c * dist (z N) x \<le> dist (z N) x"
       unfolding mult_le_cancel_right2
       using zero_le_dist[of "z N" x] and c
       by (metis dist_eq_0_iff dist_nz order_less_asym less_le)
     have "dist (f (z N)) (f x) \<le> c * dist (z N) x"
       using lipschitz[THEN bspec[where x="z N"], THEN bspec[where x=x]]
       using z_in_s[of N] \<open>x\<in>s\<close>
       using c
       by auto
     also have "\<dots> < e/2"
       using N' and c using * by auto
     finally show False
       unfolding fzn
       using N[THEN spec[where x="Suc N"]] and dist_triangle_half_r[of "z (Suc N)" "f x" e x]
       unfolding e_def
       by auto
   qed
   then have "f x = x" by (auto simp: e_def)
   moreover have "y = x" if "f y = y" "y \<in> s" for y
   proof -
     from \<open>x \<in> s\<close> \<open>f x = x\<close> that have "dist x y \<le> c * dist x y"
       using lipschitz[THEN bspec[where x=x], THEN bspec[where x=y]] by simp
     with c and zero_le_dist[of x y] have "dist x y = 0"
       by (simp add: mult_le_cancel_right1)
     then show ?thesis by simp
   qed
   ultimately show ?thesis
     using \<open>x\<in>s\<close> by blast
 qed
 
 
 subsection \<open>Edelstein fixed point theorem\<close>
 
 theorem Edelstein_fix:
   fixes S :: "'a::metric_space set"
   assumes S: "compact S" "S \<noteq> {}"
     and gs: "(g ` S) \<subseteq> S"
     and dist: "\<forall>x\<in>S. \<forall>y\<in>S. x \<noteq> y \<longrightarrow> dist (g x) (g y) < dist x y"
   shows "\<exists>!x\<in>S. g x = x"
 proof -
   let ?D = "(\<lambda>x. (x, x)) ` S"
   have D: "compact ?D" "?D \<noteq> {}"
     by (rule compact_continuous_image)
        (auto intro!: S continuous_Pair continuous_ident simp: continuous_on_eq_continuous_within)
 
   have "\<And>x y e. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> 0 < e \<Longrightarrow> dist y x < e \<Longrightarrow> dist (g y) (g x) < e"
     using dist by fastforce
   then have "continuous_on S g"
     by (auto simp: continuous_on_iff)
   then have cont: "continuous_on ?D (\<lambda>x. dist ((g \<circ> fst) x) (snd x))"
     unfolding continuous_on_eq_continuous_within
     by (intro continuous_dist ballI continuous_within_compose)
        (auto intro!: continuous_fst continuous_snd continuous_ident simp: image_image)
 
   obtain a where "a \<in> S" and le: "\<And>x. x \<in> S \<Longrightarrow> dist (g a) a \<le> dist (g x) x"
     using continuous_attains_inf[OF D cont] by auto
 
   have "g a = a"
   proof (rule ccontr)
     assume "g a \<noteq> a"
     with \<open>a \<in> S\<close> gs have "dist (g (g a)) (g a) < dist (g a) a"
       by (intro dist[rule_format]) auto
     moreover have "dist (g a) a \<le> dist (g (g a)) (g a)"
       using \<open>a \<in> S\<close> gs by (intro le) auto
     ultimately show False by auto
   qed
   moreover have "\<And>x. x \<in> S \<Longrightarrow> g x = x \<Longrightarrow> x = a"
     using dist[THEN bspec[where x=a]] \<open>g a = a\<close> and \<open>a\<in>S\<close> by auto
   ultimately show "\<exists>!x\<in>S. g x = x"
     using \<open>a \<in> S\<close> by blast
 qed
 
 subsection \<open>The diameter of a set\<close>
 
 definition\<^marker>\<open>tag important\<close> diameter :: "'a::metric_space set \<Rightarrow> real" where
   "diameter S = (if S = {} then 0 else SUP (x,y)\<in>S\<times>S. dist x y)"
 
 lemma diameter_empty [simp]: "diameter{} = 0"
   by (auto simp: diameter_def)
 
 lemma diameter_singleton [simp]: "diameter{x} = 0"
   by (auto simp: diameter_def)
 
 lemma diameter_le:
   assumes "S \<noteq> {} \<or> 0 \<le> d"
     and no: "\<And>x y. \<lbrakk>x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> norm(x - y) \<le> d"
   shows "diameter S \<le> d"
   using assms
   by (auto simp: dist_norm diameter_def intro: cSUP_least)
 
 lemma diameter_bounded_bound:
   fixes S :: "'a :: metric_space set"
   assumes S: "bounded S" "x \<in> S" "y \<in> S"
   shows "dist x y \<le> diameter S"
 proof -
   from S obtain z d where z: "\<And>x. x \<in> S \<Longrightarrow> dist z x \<le> d"
     unfolding bounded_def by auto
   have "bdd_above (case_prod dist ` (S\<times>S))"
   proof (intro bdd_aboveI, safe)
     fix a b
     assume "a \<in> S" "b \<in> S"
     with z[of a] z[of b] dist_triangle[of a b z]
     show "dist a b \<le> 2 * d"
       by (simp add: dist_commute)
   qed
   moreover have "(x,y) \<in> S\<times>S" using S by auto
   ultimately have "dist x y \<le> (SUP (x,y)\<in>S\<times>S. dist x y)"
     by (rule cSUP_upper2) simp
   with \<open>x \<in> S\<close> show ?thesis
     by (auto simp: diameter_def)
 qed
 
 lemma diameter_lower_bounded:
   fixes S :: "'a :: metric_space set"
   assumes S: "bounded S"
     and d: "0 < d" "d < diameter S"
   shows "\<exists>x\<in>S. \<exists>y\<in>S. d < dist x y"
 proof (rule ccontr)
   assume contr: "\<not> ?thesis"
   moreover have "S \<noteq> {}"
     using d by (auto simp: diameter_def)
   ultimately have "diameter S \<le> d"
     by (auto simp: not_less diameter_def intro!: cSUP_least)
   with \<open>d < diameter S\<close> show False by auto
 qed
 
 lemma diameter_bounded:
   assumes "bounded S"
   shows "\<forall>x\<in>S. \<forall>y\<in>S. dist x y \<le> diameter S"
     and "\<forall>d>0. d < diameter S \<longrightarrow> (\<exists>x\<in>S. \<exists>y\<in>S. dist x y > d)"
   using diameter_bounded_bound[of S] diameter_lower_bounded[of S] assms
   by auto
 
 lemma bounded_two_points: "bounded S \<longleftrightarrow> (\<exists>e. \<forall>x\<in>S. \<forall>y\<in>S. dist x y \<le> e)"
   by (meson bounded_def diameter_bounded(1))
 
 lemma diameter_compact_attained:
   assumes "compact S"
     and "S \<noteq> {}"
   shows "\<exists>x\<in>S. \<exists>y\<in>S. dist x y = diameter S"
 proof -
   have b: "bounded S" using assms(1)
     by (rule compact_imp_bounded)
   then obtain x y where xys: "x\<in>S" "y\<in>S"
     and xy: "\<forall>u\<in>S. \<forall>v\<in>S. dist u v \<le> dist x y"
     using compact_sup_maxdistance[OF assms] by auto
   then have "diameter S \<le> dist x y"
     unfolding diameter_def by (force intro!: cSUP_least)
   then show ?thesis
     by (metis b diameter_bounded_bound order_antisym xys)
 qed
 
 lemma diameter_ge_0:
   assumes "bounded S"  shows "0 \<le> diameter S"
   by (metis all_not_in_conv assms diameter_bounded_bound diameter_empty dist_self order_refl)
 
 lemma diameter_subset:
   assumes "S \<subseteq> T" "bounded T"
   shows "diameter S \<le> diameter T"
 proof (cases "S = {} \<or> T = {}")
   case True
   with assms show ?thesis
     by (force simp: diameter_ge_0)
 next
   case False
   then have "bdd_above ((\<lambda>x. case x of (x, xa) \<Rightarrow> dist x xa) ` (T \<times> T))"
     using \<open>bounded T\<close> diameter_bounded_bound by (force simp: bdd_above_def)
   with False \<open>S \<subseteq> T\<close> show ?thesis
     apply (simp add: diameter_def)
     apply (rule cSUP_subset_mono, auto)
     done
 qed
 
 lemma diameter_closure:
   assumes "bounded S"
   shows "diameter(closure S) = diameter S"
 proof (rule order_antisym)
   have "False" if d_less_d: "diameter S < diameter (closure S)"
   proof -
     define d where "d = diameter(closure S) - diameter(S)"
     have "d > 0"
       using that by (simp add: d_def)
     then have dle: "diameter(closure(S)) - d / 2 < diameter(closure(S))"
       by simp
     have dd: "diameter (closure S) - d / 2 = (diameter(closure(S)) + diameter(S)) / 2"
       by (simp add: d_def field_split_simps)
      have bocl: "bounded (closure S)"
       using assms by blast
     moreover have "0 \<le> diameter S"
       using assms diameter_ge_0 by blast
     ultimately obtain x y where "x \<in> closure S" "y \<in> closure S" and xy: "diameter(closure(S)) - d / 2 < dist x y"
       by (smt (verit) dle d_less_d d_def dd diameter_lower_bounded)
     then obtain x' y' where x'y': "x' \<in> S" "dist x' x < d/4" "y' \<in> S" "dist y' y < d/4"
       by (metis \<open>0 < d\<close> zero_less_divide_iff zero_less_numeral closure_approachable)
     then have "dist x' y' \<le> diameter S"
       using assms diameter_bounded_bound by blast
     with x'y' have "dist x y \<le> d / 4 + diameter S + d / 4"
       by (meson add_mono dist_triangle dist_triangle3 less_eq_real_def order_trans)
     then show ?thesis
       using xy d_def by linarith
   qed
   then show "diameter (closure S) \<le> diameter S"
     by fastforce
   next
     show "diameter S \<le> diameter (closure S)"
       by (simp add: assms bounded_closure closure_subset diameter_subset)
 qed
 
 proposition Lebesgue_number_lemma:
   assumes "compact S" "\<C> \<noteq> {}" "S \<subseteq> \<Union>\<C>" and ope: "\<And>B. B \<in> \<C> \<Longrightarrow> open B"
   obtains \<delta> where "0 < \<delta>" "\<And>T. \<lbrakk>T \<subseteq> S; diameter T < \<delta>\<rbrakk> \<Longrightarrow> \<exists>B \<in> \<C>. T \<subseteq> B"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (metis \<open>\<C> \<noteq> {}\<close> zero_less_one empty_subsetI equals0I subset_trans that)
 next
   case False
   { fix x assume "x \<in> S"
     then obtain C where C: "x \<in> C" "C \<in> \<C>"
       using \<open>S \<subseteq> \<Union>\<C>\<close> by blast
     then obtain r where r: "r>0" "ball x (2*r) \<subseteq> C"
       by (metis mult.commute mult_2_right not_le ope openE field_sum_of_halves zero_le_numeral zero_less_mult_iff)
     then have "\<exists>r C. r > 0 \<and> ball x (2*r) \<subseteq> C \<and> C \<in> \<C>"
       using C by blast
   }
   then obtain r where r: "\<And>x. x \<in> S \<Longrightarrow> r x > 0 \<and> (\<exists>C \<in> \<C>. ball x (2*r x) \<subseteq> C)"
     by metis
   then have "S \<subseteq> (\<Union>x \<in> S. ball x (r x))"
     by auto
   then obtain \<T> where "finite \<T>" "S \<subseteq> \<Union>\<T>" and \<T>: "\<T> \<subseteq> (\<lambda>x. ball x (r x)) ` S"
     by (rule compactE [OF \<open>compact S\<close>]) auto
   then obtain S0 where "S0 \<subseteq> S" "finite S0" and S0: "\<T> = (\<lambda>x. ball x (r x)) ` S0"
     by (meson finite_subset_image)
   then have "S0 \<noteq> {}"
     using False \<open>S \<subseteq> \<Union>\<T>\<close> by auto
   define \<delta> where "\<delta> = Inf (r ` S0)"
   have "\<delta> > 0"
     using \<open>finite S0\<close> \<open>S0 \<subseteq> S\<close> \<open>S0 \<noteq> {}\<close> r by (auto simp: \<delta>_def finite_less_Inf_iff)
   show ?thesis
   proof
     show "0 < \<delta>"
       by (simp add: \<open>0 < \<delta>\<close>)
     show "\<exists>B \<in> \<C>. T \<subseteq> B" if "T \<subseteq> S" and dia: "diameter T < \<delta>" for T
     proof (cases "T = {}")
       case True
       then show ?thesis
         using \<open>\<C> \<noteq> {}\<close> by blast
     next
       case False
       then obtain y where "y \<in> T" by blast
       then have "y \<in> S"
         using \<open>T \<subseteq> S\<close> by auto
       then obtain x where "x \<in> S0" and x: "y \<in> ball x (r x)"
         using \<open>S \<subseteq> \<Union>\<T>\<close> S0 that by blast
       have "ball y \<delta> \<subseteq> ball y (r x)"
         by (metis \<delta>_def \<open>S0 \<noteq> {}\<close> \<open>finite S0\<close> \<open>x \<in> S0\<close> empty_is_image finite_imageI finite_less_Inf_iff imageI less_irrefl not_le subset_ball)
       also have "... \<subseteq> ball x (2*r x)"
         using x by metric
       finally obtain C where "C \<in> \<C>" "ball y \<delta> \<subseteq> C"
         by (meson r \<open>S0 \<subseteq> S\<close> \<open>x \<in> S0\<close> dual_order.trans subsetCE)
       have "bounded T"
         using \<open>compact S\<close> bounded_subset compact_imp_bounded \<open>T \<subseteq> S\<close> by blast
       then have "T \<subseteq> ball y \<delta>"
         using \<open>y \<in> T\<close> dia diameter_bounded_bound by fastforce
       then show ?thesis
         by (meson \<open>C \<in> \<C>\<close> \<open>ball y \<delta> \<subseteq> C\<close> subset_eq)
     qed
   qed
 qed
 
 
 subsection \<open>Metric spaces with the Heine-Borel property\<close>
 
 text \<open>
   A metric space (or topological vector space) is said to have the
   Heine-Borel property if every closed and bounded subset is compact.
 \<close>
 
 class heine_borel = metric_space +
   assumes bounded_imp_convergent_subsequence:
     "bounded (range f) \<Longrightarrow> \<exists>l r. strict_mono (r::nat\<Rightarrow>nat) \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially"
 
 proposition bounded_closed_imp_seq_compact:
   fixes S::"'a::heine_borel set"
   assumes "bounded S"
     and "closed S"
   shows "seq_compact S"
 proof (unfold seq_compact_def, clarify)
   fix f :: "nat \<Rightarrow> 'a"
   assume f: "\<forall>n. f n \<in> S"
   with \<open>bounded S\<close> have "bounded (range f)"
     by (auto intro: bounded_subset)
   obtain l r where r: "strict_mono (r :: nat \<Rightarrow> nat)" and l: "((f \<circ> r) \<longlongrightarrow> l) sequentially"
     using bounded_imp_convergent_subsequence [OF \<open>bounded (range f)\<close>] by auto
   from f have fr: "\<forall>n. (f \<circ> r) n \<in> S"
     by simp
   have "l \<in> S" using \<open>closed S\<close> fr l
     by (rule closed_sequentially)
   show "\<exists>l\<in>S. \<exists>r. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially"
     using \<open>l \<in> S\<close> r l by blast
 qed
 
 lemma compact_eq_bounded_closed:
   fixes S :: "'a::heine_borel set"
   shows "compact S \<longleftrightarrow> bounded S \<and> closed S"
   using bounded_closed_imp_seq_compact compact_eq_seq_compact_metric compact_imp_bounded compact_imp_closed 
   by auto
 
 lemma bounded_infinite_imp_islimpt:
   fixes S :: "'a::heine_borel set"
   assumes "T \<subseteq> S" "bounded S" "infinite T"
   obtains x where "x islimpt S" 
   by (meson assms closed_limpt compact_eq_Bolzano_Weierstrass compact_eq_bounded_closed islimpt_subset) 
 
 lemma compact_Inter:
   fixes \<F> :: "'a :: heine_borel set set"
   assumes com: "\<And>S. S \<in> \<F> \<Longrightarrow> compact S" and "\<F> \<noteq> {}"
   shows "compact(\<Inter> \<F>)"
   using assms
   by (meson Inf_lower all_not_in_conv bounded_subset closed_Inter compact_eq_bounded_closed)
 
 lemma compact_closure [simp]:
   fixes S :: "'a::heine_borel set"
   shows "compact(closure S) \<longleftrightarrow> bounded S"
 by (meson bounded_closure bounded_subset closed_closure closure_subset compact_eq_bounded_closed)
 
 instance\<^marker>\<open>tag important\<close> real :: heine_borel
 proof
   fix f :: "nat \<Rightarrow> real"
   assume f: "bounded (range f)"
   obtain r :: "nat \<Rightarrow> nat" where r: "strict_mono r" "monoseq (f \<circ> r)"
     unfolding comp_def by (metis seq_monosub)
   then have "Bseq (f \<circ> r)"
     unfolding Bseq_eq_bounded by (metis f BseqI' bounded_iff comp_apply rangeI)
   with r show "\<exists>l r. strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> l"
     using Bseq_monoseq_convergent[of "f \<circ> r"] by (auto simp: convergent_def)
 qed
 
 lemma compact_lemma_general:
   fixes f :: "nat \<Rightarrow> 'a"
   fixes proj::"'a \<Rightarrow> 'b \<Rightarrow> 'c::heine_borel" (infixl "proj" 60)
   fixes unproj:: "('b \<Rightarrow> 'c) \<Rightarrow> 'a"
   assumes finite_basis: "finite basis"
   assumes bounded_proj: "\<And>k. k \<in> basis \<Longrightarrow> bounded ((\<lambda>x. x proj k) ` range f)"
   assumes proj_unproj: "\<And>e k. k \<in> basis \<Longrightarrow> (unproj e) proj k = e k"
   assumes unproj_proj: "\<And>x. unproj (\<lambda>k. x proj k) = x"
   shows "\<forall>d\<subseteq>basis. \<exists>l::'a. \<exists> r::nat\<Rightarrow>nat.
     strict_mono r \<and> (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) proj i) (l proj i) < e) sequentially)"
 proof safe
   fix d :: "'b set"
   assume d: "d \<subseteq> basis"
   with finite_basis have "finite d"
     by (blast intro: finite_subset)
   from this d show "\<exists>l::'a. \<exists>r::nat\<Rightarrow>nat. strict_mono r \<and>
     (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) proj i) (l proj i) < e) sequentially)"
   proof (induct d)
     case empty
     then show ?case
       unfolding strict_mono_def by auto
   next
     case (insert k d)
     have k[intro]: "k \<in> basis"
       using insert by auto
     have s': "bounded ((\<lambda>x. x proj k) ` range f)"
       using k
       by (rule bounded_proj)
     obtain l1::"'a" and r1 where r1: "strict_mono r1"
       and lr1: "\<forall>e > 0. \<forall>\<^sub>F n in sequentially. \<forall>i\<in>d. dist (f (r1 n) proj i) (l1 proj i) < e"
       using insert by auto
     have f': "\<forall>n. f (r1 n) proj k \<in> (\<lambda>x. x proj k) ` range f"
       by simp
     have "bounded (range (\<lambda>i. f (r1 i) proj k))"
       by (metis (lifting) bounded_subset f' image_subsetI s')
     then obtain l2 r2 where r2: "strict_mono r2" and lr2: "(\<lambda>i. f (r1 (r2 i)) proj k) \<longlonglongrightarrow> l2"
       using bounded_imp_convergent_subsequence[of "\<lambda>i. f (r1 i) proj k"]
       by (auto simp: o_def)
     define r where "r = r1 \<circ> r2"
     have r: "strict_mono r"
       using r1 and r2 unfolding r_def o_def strict_mono_def by auto
     moreover
     define l where "l = unproj (\<lambda>i. if i = k then l2 else l1 proj i)"
     { fix e::real
       assume "e > 0"
       from lr1 \<open>e > 0\<close> have N1: "\<forall>\<^sub>F n in sequentially. \<forall>i\<in>d. dist (f (r1 n) proj i) (l1 proj i) < e"
         by blast
       from lr2 \<open>e > 0\<close> have N2: "\<forall>\<^sub>F n in sequentially. dist (f (r1 (r2 n)) proj k) l2 < e"
         by (rule tendstoD)
       from r2 N1 have N1': "\<forall>\<^sub>F n in sequentially. \<forall>i\<in>d. dist (f (r1 (r2 n)) proj i) (l1 proj i) < e"
         by (rule eventually_subseq)
       have "\<forall>\<^sub>F n in sequentially. \<forall>i\<in>insert k d. dist (f (r n) proj i) (l proj i) < e"
         using N1' N2
         by eventually_elim (use insert.prems in \<open>auto simp: l_def r_def o_def proj_unproj\<close>)
     }
     ultimately show ?case by auto
   qed
 qed
 
 lemma bounded_fst: "bounded s \<Longrightarrow> bounded (fst ` s)"
   unfolding bounded_def
   by (metis (erased, opaque_lifting) dist_fst_le image_iff order_trans)
 
 lemma bounded_snd: "bounded s \<Longrightarrow> bounded (snd ` s)"
   unfolding bounded_def
   by (metis (no_types, opaque_lifting) dist_snd_le image_iff order.trans)
 
 instance\<^marker>\<open>tag important\<close> prod :: (heine_borel, heine_borel) heine_borel
 proof
   fix f :: "nat \<Rightarrow> 'a \<times> 'b"
   assume f: "bounded (range f)"
   then have "bounded (fst ` range f)"
     by (rule bounded_fst)
   then have s1: "bounded (range (fst \<circ> f))"
     by (simp add: image_comp)
   obtain l1 r1 where r1: "strict_mono r1" and l1: "(\<lambda>n. fst (f (r1 n))) \<longlonglongrightarrow> l1"
     using bounded_imp_convergent_subsequence [OF s1] unfolding o_def by fast
   from f have s2: "bounded (range (snd \<circ> f \<circ> r1))"
     by (auto simp: image_comp intro: bounded_snd bounded_subset)
   obtain l2 r2 where r2: "strict_mono r2" and l2: "(\<lambda>n. snd (f (r1 (r2 n)))) \<longlonglongrightarrow> l2"
     using bounded_imp_convergent_subsequence [OF s2]
     unfolding o_def by fast
   have l1': "((\<lambda>n. fst (f (r1 (r2 n)))) \<longlongrightarrow> l1) sequentially"
     using LIMSEQ_subseq_LIMSEQ [OF l1 r2] unfolding o_def .
   have l: "((f \<circ> (r1 \<circ> r2)) \<longlongrightarrow> (l1, l2)) sequentially"
     using tendsto_Pair [OF l1' l2] unfolding o_def by simp
   have r: "strict_mono (r1 \<circ> r2)"
     using r1 r2 unfolding strict_mono_def by simp
   show "\<exists>l r. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially"
     using l r by fast
 qed
 
 
 subsection \<open>Completeness\<close>
 
 proposition (in metric_space) completeI:
   assumes "\<And>f. \<forall>n. f n \<in> s \<Longrightarrow> Cauchy f \<Longrightarrow> \<exists>l\<in>s. f \<longlonglongrightarrow> l"
   shows "complete s"
   using assms unfolding complete_def by fast
 
 proposition (in metric_space) completeE:
   assumes "complete s" and "\<forall>n. f n \<in> s" and "Cauchy f"
   obtains l where "l \<in> s" and "f \<longlonglongrightarrow> l"
   using assms unfolding complete_def by fast
 
 (* TODO: generalize to uniform spaces *)
 lemma compact_imp_complete:
   fixes s :: "'a::metric_space set"
   assumes "compact s"
   shows "complete s"
 proof -
   {
     fix f
     assume as: "(\<forall>n::nat. f n \<in> s)" "Cauchy f"
     from as(1) obtain l r where lr: "l\<in>s" "strict_mono r" "(f \<circ> r) \<longlonglongrightarrow> l"
       using assms unfolding compact_def by blast
 
     note lr' = seq_suble [OF lr(2)]
     {
       fix e :: real
       assume "e > 0"
       from as(2) obtain N where N:"\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (f m) (f n) < e/2"
-        unfolding cauchy_def using \<open>e > 0\<close> by (meson half_gt_zero)
+        unfolding Cauchy_def using \<open>e > 0\<close> by (meson half_gt_zero)
       then obtain M where M:"\<forall>n\<ge>M. dist ((f \<circ> r) n) l < e/2"
         by (metis dist_self lim_sequentially lr(3))
       {
         fix n :: nat
         assume n: "n \<ge> max N M"
         have "dist ((f \<circ> r) n) l < e/2"
           using n M by auto
         moreover have "r n \<ge> N"
           using lr'[of n] n by auto
         then have "dist (f n) ((f \<circ> r) n) < e/2"
           using N and n by auto
         ultimately have "dist (f n) l < e" using n M
           by metric
       }
       then have "\<exists>N. \<forall>n\<ge>N. dist (f n) l < e" by blast
     }
     then have "\<exists>l\<in>s. (f \<longlongrightarrow> l) sequentially" using \<open>l\<in>s\<close>
       unfolding lim_sequentially by auto
   }
   then show ?thesis unfolding complete_def by auto
 qed
 
 proposition compact_eq_totally_bounded:
   "compact s \<longleftrightarrow> complete s \<and> (\<forall>e>0. \<exists>k. finite k \<and> s \<subseteq> (\<Union>x\<in>k. ball x e))"
     (is "_ \<longleftrightarrow> ?rhs")
 proof
   assume assms: "?rhs"
   then obtain k where k: "\<And>e. 0 < e \<Longrightarrow> finite (k e)" "\<And>e. 0 < e \<Longrightarrow> s \<subseteq> (\<Union>x\<in>k e. ball x e)"
     by (auto simp: choice_iff')
 
   show "compact s"
   proof cases
     assume "s = {}"
     then show "compact s" by (simp add: compact_def)
   next
     assume "s \<noteq> {}"
     show ?thesis
       unfolding compact_def
     proof safe
       fix f :: "nat \<Rightarrow> 'a"
       assume f: "\<forall>n. f n \<in> s"
 
       define e where "e n = 1 / (2 * Suc n)" for n
       then have [simp]: "\<And>n. 0 < e n" by auto
       define B where "B n U = (SOME b. infinite {n. f n \<in> b} \<and> (\<exists>x. b \<subseteq> ball x (e n) \<inter> U))" for n U
       {
         fix n U
         assume "infinite {n. f n \<in> U}"
         then have "\<exists>b\<in>k (e n). infinite {i\<in>{n. f n \<in> U}. f i \<in> ball b (e n)}"
           using k f by (intro pigeonhole_infinite_rel) (auto simp: subset_eq)
         then obtain a where
           "a \<in> k (e n)"
           "infinite {i \<in> {n. f n \<in> U}. f i \<in> ball a (e n)}" ..
         then have "\<exists>b. infinite {i. f i \<in> b} \<and> (\<exists>x. b \<subseteq> ball x (e n) \<inter> U)"
           by (intro exI[of _ "ball a (e n) \<inter> U"] exI[of _ a]) (auto simp: ac_simps)
         from someI_ex[OF this]
         have "infinite {i. f i \<in> B n U}" "\<exists>x. B n U \<subseteq> ball x (e n) \<inter> U"
           unfolding B_def by auto
       }
       note B = this
 
       define F where "F = rec_nat (B 0 UNIV) B"
       {
         fix n
         have "infinite {i. f i \<in> F n}"
           by (induct n) (auto simp: F_def B)
       }
       then have F: "\<And>n. \<exists>x. F (Suc n) \<subseteq> ball x (e n) \<inter> F n"
         using B by (simp add: F_def)
       then have F_dec: "\<And>m n. m \<le> n \<Longrightarrow> F n \<subseteq> F m"
         using decseq_SucI[of F] by (auto simp: decseq_def)
 
       obtain sel where sel: "\<And>k i. i < sel k i" "\<And>k i. f (sel k i) \<in> F k"
       proof (atomize_elim, unfold all_conj_distrib[symmetric], intro choice allI)
         fix k i
         have "infinite ({n. f n \<in> F k} - {.. i})"
           using \<open>infinite {n. f n \<in> F k}\<close> by auto
         from infinite_imp_nonempty[OF this]
         show "\<exists>x>i. f x \<in> F k"
           by (simp add: set_eq_iff not_le conj_commute)
       qed
 
       define t where "t = rec_nat (sel 0 0) (\<lambda>n i. sel (Suc n) i)"
       have "strict_mono t"
         unfolding strict_mono_Suc_iff by (simp add: t_def sel)
       moreover have "\<forall>i. (f \<circ> t) i \<in> s"
         using f by auto
       moreover
       have t: "(f \<circ> t) n \<in> F n" for n
         by (cases n) (simp_all add: t_def sel)
 
       have "Cauchy (f \<circ> t)"
       proof (safe intro!: metric_CauchyI exI elim!: nat_approx_posE)
         fix r :: real and N n m
         assume "1 / Suc N < r" "Suc N \<le> n" "Suc N \<le> m"
         then have "(f \<circ> t) n \<in> F (Suc N)" "(f \<circ> t) m \<in> F (Suc N)" "2 * e N < r"
           using F_dec t by (auto simp: e_def field_simps)
         with F[of N] obtain x where "dist x ((f \<circ> t) n) < e N" "dist x ((f \<circ> t) m) < e N"
           by (auto simp: subset_eq)
         with \<open>2 * e N < r\<close> show "dist ((f \<circ> t) m) ((f \<circ> t) n) < r"
           by metric
       qed
 
       ultimately show "\<exists>l\<in>s. \<exists>r. strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> l"
         using assms unfolding complete_def by blast
     qed
   qed
 qed (metis compact_imp_complete compact_imp_seq_compact seq_compact_imp_totally_bounded)
 
 lemma cauchy_imp_bounded:
   assumes "Cauchy s"
   shows "bounded (range s)"
 proof -
   from assms obtain N :: nat where "\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < 1"
-    unfolding cauchy_def by force
+    by (meson Cauchy_def zero_less_one)
   then have N:"\<forall>n. N \<le> n \<longrightarrow> dist (s N) (s n) < 1" by auto
   moreover
   have "bounded (s ` {0..N})"
     using finite_imp_bounded[of "s ` {1..N}"] by auto
   then obtain a where a:"\<forall>x\<in>s ` {0..N}. dist (s N) x \<le> a"
     unfolding bounded_any_center [where a="s N"] by auto
   ultimately show "?thesis"
     unfolding bounded_any_center [where a="s N"]
     apply (rule_tac x="max a 1" in exI, auto)
     apply (erule_tac x=y in allE)
     apply (erule_tac x=y in ballE, auto)
     done
 qed
 
 instance heine_borel < complete_space
 proof
   fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
   then show "convergent f"
     unfolding convergent_def
     using Cauchy_converges_subseq cauchy_imp_bounded bounded_imp_convergent_subsequence by blast
 qed
 
 lemma complete_UNIV: "complete (UNIV :: ('a::complete_space) set)"
 proof (rule completeI)
   fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
   then show "\<exists>l\<in>UNIV. f \<longlonglongrightarrow> l" 
     using Cauchy_convergent convergent_def by blast
 qed
 
 lemma complete_imp_closed:
   fixes S :: "'a::metric_space set"
   shows "complete S \<Longrightarrow> closed S"
   by (metis LIMSEQ_imp_Cauchy LIMSEQ_unique closed_sequential_limits completeE)
 
 lemma complete_Int_closed:
   fixes S :: "'a::metric_space set"
   assumes "complete S" and "closed t"
   shows "complete (S \<inter> t)"
   by (metis Int_iff assms closed_sequentially completeE completeI)
 
 lemma complete_closed_subset:
   fixes S :: "'a::metric_space set"
   assumes "closed S" and "S \<subseteq> t" and "complete t"
   shows "complete S"
   using assms complete_Int_closed [of t S] by (simp add: Int_absorb1)
 
 lemma complete_eq_closed:
   fixes S :: "('a::complete_space) set"
   shows "complete S \<longleftrightarrow> closed S"
 proof
   assume "closed S" then show "complete S"
     using subset_UNIV complete_UNIV by (rule complete_closed_subset)
 next
   assume "complete S" then show "closed S"
     by (rule complete_imp_closed)
 qed
 
 lemma convergent_eq_Cauchy:
   fixes S :: "nat \<Rightarrow> 'a::complete_space"
   shows "(\<exists>l. (S \<longlongrightarrow> l) sequentially) \<longleftrightarrow> Cauchy S"
   unfolding Cauchy_convergent_iff convergent_def ..
 
 lemma convergent_imp_bounded:
   fixes S :: "nat \<Rightarrow> 'a::metric_space"
   shows "(S \<longlongrightarrow> l) sequentially \<Longrightarrow> bounded (range S)"
   by (intro cauchy_imp_bounded LIMSEQ_imp_Cauchy)
 
 lemma frontier_subset_compact:
   fixes S :: "'a::heine_borel set"
   shows "compact S \<Longrightarrow> frontier S \<subseteq> S"
   using frontier_subset_closed compact_eq_bounded_closed
   by blast
 
-lemma continuous_closed_imp_Cauchy_continuous:
-  fixes S :: "('a::complete_space) set"
-  shows "\<lbrakk>continuous_on S f; closed S; Cauchy \<sigma>; \<And>n. (\<sigma> n) \<in> S\<rbrakk> \<Longrightarrow> Cauchy(f \<circ> \<sigma>)"
-  by (meson LIMSEQ_imp_Cauchy completeE complete_eq_closed continuous_on_sequentially)
-
 lemma banach_fix_type:
   fixes f::"'a::complete_space\<Rightarrow>'a"
   assumes c:"0 \<le> c" "c < 1"
       and lipschitz:"\<forall>x. \<forall>y. dist (f x) (f y) \<le> c * dist x y"
   shows "\<exists>!x. (f x = x)"
   using assms banach_fix[OF complete_UNIV UNIV_not_empty assms(1,2) subset_UNIV, of f]
   by auto
 
+subsection \<open>Cauchy continuity\<close>
+
+definition Cauchy_continuous_on where
+  "Cauchy_continuous_on \<equiv> \<lambda>S f. \<forall>\<sigma>. Cauchy \<sigma> \<longrightarrow> range \<sigma> \<subseteq> S \<longrightarrow> Cauchy (f \<circ> \<sigma>)"
+
+lemma continuous_closed_imp_Cauchy_continuous:
+  fixes S :: "('a::complete_space) set"
+  shows "\<lbrakk>continuous_on S f; closed S\<rbrakk> \<Longrightarrow> Cauchy_continuous_on S f"
+  unfolding Cauchy_continuous_on_def
+  by (metis LIMSEQ_imp_Cauchy completeE complete_eq_closed continuous_on_sequentially range_subsetD)
+
+lemma uniformly_continuous_imp_Cauchy_continuous:
+  fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+  shows "uniformly_continuous_on S f \<Longrightarrow> Cauchy_continuous_on S f"
+  by (simp add: uniformly_continuous_on_def Cauchy_continuous_on_def Cauchy_def image_subset_iff) metis
+
+lemma Cauchy_continuous_on_imp_continuous:
+  fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+  assumes "Cauchy_continuous_on S f"
+  shows "continuous_on S f"
+proof -
+  have False if x: "\<forall>n. \<exists>x'\<in>S. dist x' x < inverse(Suc n) \<and> \<not> dist (f x') (f x) < \<epsilon>" "\<epsilon>>0" "x \<in> S" for x and \<epsilon>::real
+  proof -
+    obtain \<rho> where \<rho>: "\<forall>n. \<rho> n \<in> S" and dx: "\<forall>n. dist (\<rho> n) x < inverse(Suc n)" and dfx: "\<forall>n. \<not> dist (f (\<rho> n)) (f x) < \<epsilon>"
+      using x by metis
+    define \<sigma> where "\<sigma> \<equiv> \<lambda>n. if even n then \<rho> n else x"
+    with \<rho> \<open>x \<in> S\<close> have "range \<sigma> \<subseteq> S"
+      by auto
+    have "\<sigma> \<longlonglongrightarrow> x"
+      unfolding tendsto_iff
+    proof (intro strip)
+      fix e :: real
+      assume "e>0"
+      then obtain N where "inverse (Suc N) < e"
+        using reals_Archimedean by blast
+      then have "\<forall>n. N \<le> n \<longrightarrow> dist (\<rho> n) x < e"
+        by (smt (verit, ccfv_SIG) dx inverse_Suc inverse_less_iff_less inverse_positive_iff_positive of_nat_Suc of_nat_mono)
+      with \<open>e>0\<close> show "\<forall>\<^sub>F n in sequentially. dist (\<sigma> n) x < e"
+        by (auto simp add: eventually_sequentially \<sigma>_def)
+    qed
+    then have "Cauchy \<sigma>"
+      by (intro LIMSEQ_imp_Cauchy)
+    then have Cf: "Cauchy (f \<circ> \<sigma>)"
+      by (meson Cauchy_continuous_on_def \<open>range \<sigma> \<subseteq> S\<close> assms)
+    have "(f \<circ> \<sigma>) \<longlonglongrightarrow> f x"
+      unfolding tendsto_iff 
+    proof (intro strip)
+      fix e :: real
+      assume "e>0"
+      then obtain N where N: "\<forall>m\<ge>N. \<forall>n\<ge>N. dist ((f \<circ> \<sigma>) m) ((f \<circ> \<sigma>) n) < e"
+        using Cf unfolding Cauchy_def by presburger
+      moreover have "(f \<circ> \<sigma>) (Suc(N+N)) = f x"
+        by (simp add: \<sigma>_def)
+      ultimately have "\<forall>n\<ge>N. dist ((f \<circ> \<sigma>) n) (f x) < e"
+        by (metis add_Suc le_add2)
+      then show "\<forall>\<^sub>F n in sequentially. dist ((f \<circ> \<sigma>) n) (f x) < e"
+        using eventually_sequentially by blast
+    qed
+    moreover have "\<And>n. \<not> dist (f (\<sigma> (2*n))) (f x) < \<epsilon>"
+      using dfx by (simp add: \<sigma>_def)
+    ultimately show False
+      using \<open>\<epsilon>>0\<close> by (fastforce simp: mult_2 nat_le_iff_add tendsto_iff eventually_sequentially)
+  qed
+  then show ?thesis
+    unfolding continuous_on_iff by (meson inverse_Suc)
+qed
+
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open> Finite intersection property\<close>
 
 text\<open>Also developed in HOL's toplogical spaces theory, but the Heine-Borel type class isn't available there.\<close>
 
 lemma closed_imp_fip:
   fixes S :: "'a::heine_borel set"
   assumes "closed S"
       and T: "T \<in> \<F>" "bounded T"
       and clof: "\<And>T. T \<in> \<F> \<Longrightarrow> closed T"
       and "\<And>\<F>'. \<lbrakk>finite \<F>'; \<F>' \<subseteq> \<F>\<rbrakk> \<Longrightarrow> S \<inter> \<Inter>\<F>' \<noteq> {}"
     shows "S \<inter> \<Inter>\<F> \<noteq> {}"
 proof -
   have "compact (S \<inter> T)"
     using \<open>closed S\<close> clof compact_eq_bounded_closed T by blast
   then have "(S \<inter> T) \<inter> \<Inter>\<F> \<noteq> {}"
     by (smt (verit, best) Inf_insert Int_assoc assms compact_imp_fip finite_insert insert_subset)
   then show ?thesis by blast
 qed
 
 lemma closed_imp_fip_compact:
   fixes S :: "'a::heine_borel set"
   shows
    "\<lbrakk>closed S; \<And>T. T \<in> \<F> \<Longrightarrow> compact T;
      \<And>\<F>'. \<lbrakk>finite \<F>'; \<F>' \<subseteq> \<F>\<rbrakk> \<Longrightarrow> S \<inter> \<Inter>\<F>' \<noteq> {}\<rbrakk>
         \<Longrightarrow> S \<inter> \<Inter>\<F> \<noteq> {}"
   by (metis closed_imp_fip compact_eq_bounded_closed equals0I finite.emptyI order.refl)
 
 lemma closed_fip_Heine_Borel:
   fixes \<F> :: "'a::heine_borel set set"
   assumes "T \<in> \<F>" "bounded T"
       and "\<And>T. T \<in> \<F> \<Longrightarrow> closed T"
       and "\<And>\<F>'. \<lbrakk>finite \<F>'; \<F>' \<subseteq> \<F>\<rbrakk> \<Longrightarrow> \<Inter>\<F>' \<noteq> {}"
     shows "\<Inter>\<F> \<noteq> {}"
   using closed_imp_fip [OF closed_UNIV] assms by auto
 
 lemma compact_fip_Heine_Borel:
   fixes \<F> :: "'a::heine_borel set set"
   assumes clof: "\<And>T. T \<in> \<F> \<Longrightarrow> compact T"
       and none: "\<And>\<F>'. \<lbrakk>finite \<F>'; \<F>' \<subseteq> \<F>\<rbrakk> \<Longrightarrow> \<Inter>\<F>' \<noteq> {}"
     shows "\<Inter>\<F> \<noteq> {}"
   by (metis InterI clof closed_fip_Heine_Borel compact_eq_bounded_closed equals0D none)
 
 lemma compact_sequence_with_limit:
   fixes f :: "nat \<Rightarrow> 'a::heine_borel"
   shows "f \<longlonglongrightarrow> l \<Longrightarrow> compact (insert l (range f))"
   by (simp add: closed_limpt compact_eq_bounded_closed convergent_imp_bounded islimpt_insert sequence_unique_limpt)
 
 
 subsection \<open>Properties of Balls and Spheres\<close>
 
 lemma compact_cball[simp]:
   fixes x :: "'a::heine_borel"
   shows "compact (cball x e)"
   using compact_eq_bounded_closed bounded_cball closed_cball by blast
 
 lemma compact_frontier_bounded[intro]:
   fixes S :: "'a::heine_borel set"
   shows "bounded S \<Longrightarrow> compact (frontier S)"
   unfolding frontier_def
   using compact_eq_bounded_closed by blast
 
 lemma compact_frontier[intro]:
   fixes S :: "'a::heine_borel set"
   shows "compact S \<Longrightarrow> compact (frontier S)"
   using compact_eq_bounded_closed compact_frontier_bounded by blast
 
 lemma no_limpt_imp_countable:
   assumes "\<And>z. \<not>z islimpt (X :: 'a :: {real_normed_vector, heine_borel} set)"
   shows   "countable X"
 proof -
   have "countable (\<Union>n. cball 0 (real n) \<inter> X)"
   proof (intro countable_UN[OF _ countable_finite])
     fix n :: nat
     show "finite (cball 0 (real n) \<inter> X)"
       using assms by (intro finite_not_islimpt_in_compact) auto
   qed auto
   also have "(\<Union>n. cball 0 (real n)) = (UNIV :: 'a set)"
   proof safe
     fix z :: 'a
     have "norm z \<ge> 0"
       by simp
     hence "real (nat \<lceil>norm z\<rceil>) \<ge> norm z"
       by linarith
     thus "z \<in> (\<Union>n. cball 0 (real n))"
       by auto
   qed auto
   hence "(\<Union>n. cball 0 (real n) \<inter> X) = X"
     by blast
   finally show "countable X" .
 qed
 
 
 subsection \<open>Distance from a Set\<close>
 
 lemma distance_attains_sup:
   assumes "compact s" "s \<noteq> {}"
   shows "\<exists>x\<in>s. \<forall>y\<in>s. dist a y \<le> dist a x"
 proof (rule continuous_attains_sup [OF assms])
   {
     fix x
     assume "x\<in>s"
     have "(dist a \<longlongrightarrow> dist a x) (at x within s)"
       by (intro tendsto_dist tendsto_const tendsto_ident_at)
   }
   then show "continuous_on s (dist a)"
     unfolding continuous_on ..
 qed
 
 text \<open>For \emph{minimal} distance, we only need closure, not compactness.\<close>
 
 lemma distance_attains_inf:
   fixes a :: "'a::heine_borel"
   assumes "closed s" and "s \<noteq> {}"
   obtains x where "x\<in>s" "\<And>y. y \<in> s \<Longrightarrow> dist a x \<le> dist a y"
 proof -
   from assms obtain b where "b \<in> s" by auto
   let ?B = "s \<inter> cball a (dist b a)"
   have "?B \<noteq> {}" using \<open>b \<in> s\<close>
     by (auto simp: dist_commute)
   moreover have "continuous_on ?B (dist a)"
     by (auto intro!: continuous_at_imp_continuous_on continuous_dist continuous_ident continuous_const)
   moreover have "compact ?B"
     by (intro closed_Int_compact \<open>closed s\<close> compact_cball)
   ultimately obtain x where "x \<in> ?B" "\<forall>y\<in>?B. dist a x \<le> dist a y"
     by (metis continuous_attains_inf)
   with that show ?thesis by fastforce
 qed
 
 
 subsection \<open>Infimum Distance\<close>
 
 definition\<^marker>\<open>tag important\<close> "infdist x A = (if A = {} then 0 else INF a\<in>A. dist x a)"
 
 lemma bdd_below_image_dist[intro, simp]: "bdd_below (dist x ` A)"
   by (auto intro!: zero_le_dist)
 
 lemma infdist_notempty: "A \<noteq> {} \<Longrightarrow> infdist x A = (INF a\<in>A. dist x a)"
   by (simp add: infdist_def)
 
 lemma infdist_nonneg: "0 \<le> infdist x A"
   by (auto simp: infdist_def intro: cINF_greatest)
 
 lemma infdist_le: "a \<in> A \<Longrightarrow> infdist x A \<le> dist x a"
   by (auto intro: cINF_lower simp add: infdist_def)
 
 lemma infdist_le2: "a \<in> A \<Longrightarrow> dist x a \<le> d \<Longrightarrow> infdist x A \<le> d"
   by (auto intro!: cINF_lower2 simp add: infdist_def)
 
 lemma infdist_zero[simp]: "a \<in> A \<Longrightarrow> infdist a A = 0"
   by (auto intro!: antisym infdist_nonneg infdist_le2)
 
 lemma infdist_Un_min:
   assumes "A \<noteq> {}" "B \<noteq> {}"
   shows "infdist x (A \<union> B) = min (infdist x A) (infdist x B)"
 using assms by (simp add: infdist_def cINF_union inf_real_def)
 
 lemma infdist_triangle: "infdist x A \<le> infdist y A + dist x y"
 proof (cases "A = {}")
   case True
   then show ?thesis by (simp add: infdist_def)
 next
   case False
   then obtain a where "a \<in> A" by auto
   have "infdist x A \<le> Inf {dist x y + dist y a |a. a \<in> A}"
   proof (rule cInf_greatest)
     from \<open>A \<noteq> {}\<close> show "{dist x y + dist y a |a. a \<in> A} \<noteq> {}"
       by simp
     fix d
     assume "d \<in> {dist x y + dist y a |a. a \<in> A}"
     then obtain a where d: "d = dist x y + dist y a" "a \<in> A"
       by auto
     show "infdist x A \<le> d"
       unfolding infdist_notempty[OF \<open>A \<noteq> {}\<close>]
     proof (rule cINF_lower2)
       show "a \<in> A" by fact
       show "dist x a \<le> d"
         unfolding d by (rule dist_triangle)
     qed simp
   qed
   also have "\<dots> = dist x y + infdist y A"
   proof (rule cInf_eq, safe)
     fix a
     assume "a \<in> A"
     then show "dist x y + infdist y A \<le> dist x y + dist y a"
       by (auto intro: infdist_le)
   next
     fix i
     assume inf: "\<And>d. d \<in> {dist x y + dist y a |a. a \<in> A} \<Longrightarrow> i \<le> d"
     then have "i - dist x y \<le> infdist y A"
       unfolding infdist_notempty[OF \<open>A \<noteq> {}\<close>] using \<open>a \<in> A\<close>
       by (intro cINF_greatest) (auto simp: field_simps)
     then show "i \<le> dist x y + infdist y A"
       by simp
   qed
   finally show ?thesis by simp
 qed
 
 lemma infdist_triangle_abs: "\<bar>infdist x A - infdist y A\<bar> \<le> dist x y"
   by (metis (full_types) abs_diff_le_iff diff_le_eq dist_commute infdist_triangle)
 
 lemma in_closure_iff_infdist_zero:
   assumes "A \<noteq> {}"
   shows "x \<in> closure A \<longleftrightarrow> infdist x A = 0"
 proof
   assume "x \<in> closure A"
   show "infdist x A = 0"
   proof (rule ccontr)
     assume "infdist x A \<noteq> 0"
     with infdist_nonneg[of x A] have "infdist x A > 0"
       by auto
     then have "ball x (infdist x A) \<inter> closure A = {}"
       by (smt (verit, best) \<open>x \<in> closure A\<close> closure_approachableD infdist_le)
     then have "x \<notin> closure A"
       by (metis \<open>0 < infdist x A\<close> centre_in_ball disjoint_iff_not_equal)
     then show False using \<open>x \<in> closure A\<close> by simp
   qed
 next
   assume x: "infdist x A = 0"
   then obtain a where "a \<in> A"
     by atomize_elim (metis all_not_in_conv assms)
   have False if "e > 0" "\<not> (\<exists>y\<in>A. dist y x < e)" for e
   proof -
     have "infdist x A \<ge> e" using \<open>a \<in> A\<close>
       unfolding infdist_def using that
       by (force simp: dist_commute intro: cINF_greatest)
     with x \<open>e > 0\<close> show False by auto
   qed
   then show "x \<in> closure A"
     using closure_approachable by blast
 qed
 
 lemma in_closed_iff_infdist_zero:
   assumes "closed A" "A \<noteq> {}"
   shows "x \<in> A \<longleftrightarrow> infdist x A = 0"
 proof -
   have "x \<in> closure A \<longleftrightarrow> infdist x A = 0"
     by (simp add: \<open>A \<noteq> {}\<close> in_closure_iff_infdist_zero)
   with assms show ?thesis by simp
 qed
 
 lemma infdist_pos_not_in_closed:
   assumes "closed S" "S \<noteq> {}" "x \<notin> S"
   shows "infdist x S > 0"
   by (smt (verit, best) assms in_closed_iff_infdist_zero infdist_nonneg)
 
 lemma
   infdist_attains_inf:
   fixes X::"'a::heine_borel set"
   assumes "closed X"
   assumes "X \<noteq> {}"
   obtains x where "x \<in> X" "infdist y X = dist y x"
 proof -
   have "bdd_below (dist y ` X)"
     by auto
   from distance_attains_inf[OF assms, of y]
   obtain x where "x \<in> X" "\<And>z. z \<in> X \<Longrightarrow> dist y x \<le> dist y z" by auto
   then have "infdist y X = dist y x"
     by (metis antisym assms(2) cINF_greatest infdist_def infdist_le)
   with \<open>x \<in> X\<close> show ?thesis ..
 qed
 
 
 text \<open>Every metric space is a T4 space:\<close>
 
 instance metric_space \<subseteq> t4_space
 proof
   fix S T::"'a set" assume H: "closed S" "closed T" "S \<inter> T = {}"
   consider "S = {}" | "T = {}" | "S \<noteq> {} \<and> T \<noteq> {}" by auto
   then show "\<exists>U V. open U \<and> open V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> U \<inter> V = {}"
   proof (cases)
     case 1 then show ?thesis by blast
   next
     case 2 then show ?thesis by blast
   next
     case 3
     define U where "U = (\<Union>x\<in>S. ball x ((infdist x T)/2))"
     have A: "open U" unfolding U_def by auto
     have "infdist x T > 0" if "x \<in> S" for x
       using H that 3 by (auto intro!: infdist_pos_not_in_closed)
     then have B: "S \<subseteq> U" unfolding U_def by auto
     define V where "V = (\<Union>x\<in>T. ball x ((infdist x S)/2))"
     have C: "open V" unfolding V_def by auto
     have "infdist x S > 0" if "x \<in> T" for x
       using H that 3 by (auto intro!: infdist_pos_not_in_closed)
     then have D: "T \<subseteq> V" unfolding V_def by auto
 
     have "(ball x ((infdist x T)/2)) \<inter> (ball y ((infdist y S)/2)) = {}" if "x \<in> S" "y \<in> T" for x y
     proof auto
       fix z assume H: "dist x z * 2 < infdist x T" "dist y z * 2 < infdist y S"
       have "2 * dist x y \<le> 2 * dist x z + 2 * dist y z"
         by metric
       also have "... < infdist x T + infdist y S"
         using H by auto
       finally have "dist x y < infdist x T \<or> dist x y < infdist y S"
         by auto
       then show False
         using infdist_le[OF \<open>x \<in> S\<close>, of y] infdist_le[OF \<open>y \<in> T\<close>, of x] by (auto simp add: dist_commute)
     qed
     then have E: "U \<inter> V = {}"
       unfolding U_def V_def by auto
     show ?thesis
       using A B C D E by blast
   qed
 qed
 
 lemma tendsto_infdist [tendsto_intros]:
   assumes f: "(f \<longlongrightarrow> l) F"
   shows "((\<lambda>x. infdist (f x) A) \<longlongrightarrow> infdist l A) F"
 proof (rule tendstoI)
   fix e ::real
   assume "e > 0"
   from tendstoD[OF f this]
   show "eventually (\<lambda>x. dist (infdist (f x) A) (infdist l A) < e) F"
   proof (eventually_elim)
     fix x
     from infdist_triangle[of l A "f x"] infdist_triangle[of "f x" A l]
     have "dist (infdist (f x) A) (infdist l A) \<le> dist (f x) l"
       by (simp add: dist_commute dist_real_def)
     also assume "dist (f x) l < e"
     finally show "dist (infdist (f x) A) (infdist l A) < e" .
   qed
 qed
 
 lemma continuous_infdist[continuous_intros]:
   assumes "continuous F f"
   shows "continuous F (\<lambda>x. infdist (f x) A)"
   using assms unfolding continuous_def by (rule tendsto_infdist)
 
 lemma continuous_on_infdist [continuous_intros]:
   assumes "continuous_on S f"
   shows "continuous_on S (\<lambda>x. infdist (f x) A)"
 using assms unfolding continuous_on by (auto intro: tendsto_infdist)
 
 lemma compact_infdist_le:
   fixes A::"'a::heine_borel set"
   assumes "A \<noteq> {}"
   assumes "compact A"
   assumes "e > 0"
   shows "compact {x. infdist x A \<le> e}"
 proof -
   from continuous_closed_vimage[of "{0..e}" "\<lambda>x. infdist x A"]
     continuous_infdist[OF continuous_ident, of _ UNIV A]
   have "closed {x. infdist x A \<le> e}" by (auto simp: vimage_def infdist_nonneg)
   moreover
   from assms obtain x0 b where b: "\<And>x. x \<in> A \<Longrightarrow> dist x0 x \<le> b" "closed A"
     by (auto simp: compact_eq_bounded_closed bounded_def)
   {
     fix y
     assume "infdist y A \<le> e"
     moreover
     from infdist_attains_inf[OF \<open>closed A\<close> \<open>A \<noteq> {}\<close>, of y]
     obtain z where "z \<in> A" "infdist y A = dist y z" by blast
     ultimately
     have "dist x0 y \<le> b + e" using b by metric
   } then
   have "bounded {x. infdist x A \<le> e}"
     by (auto simp: bounded_any_center[where a=x0] intro!: exI[where x="b + e"])
   ultimately show "compact {x. infdist x A \<le> e}"
     by (simp add: compact_eq_bounded_closed)
 qed
 
 
 subsection \<open>Separation between Points and Sets\<close>
 
 proposition separate_point_closed:
   fixes S :: "'a::heine_borel set"
   assumes "closed S" and "a \<notin> S"
   shows "\<exists>d>0. \<forall>x\<in>S. d \<le> dist a x"
   by (metis assms distance_attains_inf empty_iff gt_ex zero_less_dist_iff)
 
 proposition separate_compact_closed:
   fixes S T :: "'a::heine_borel set"
   assumes "compact S"
     and T: "closed T" "S \<inter> T = {}"
   shows "\<exists>d>0. \<forall>x\<in>S. \<forall>y\<in>T. d \<le> dist x y"
 proof cases
   assume "S \<noteq> {} \<and> T \<noteq> {}"
   then have "S \<noteq> {}" "T \<noteq> {}" by auto
   let ?inf = "\<lambda>x. infdist x T"
   have "continuous_on S ?inf"
     by (auto intro!: continuous_at_imp_continuous_on continuous_infdist continuous_ident)
   then obtain x where x: "x \<in> S" "\<forall>y\<in>S. ?inf x \<le> ?inf y"
     using continuous_attains_inf[OF \<open>compact S\<close> \<open>S \<noteq> {}\<close>] by auto
   then have "0 < ?inf x"
     using T \<open>T \<noteq> {}\<close> in_closed_iff_infdist_zero by (auto simp: less_le infdist_nonneg)
   moreover have "\<forall>x'\<in>S. \<forall>y\<in>T. ?inf x \<le> dist x' y"
     using x by (auto intro: order_trans infdist_le)
   ultimately show ?thesis by auto
 qed (auto intro!: exI[of _ 1])
 
 proposition separate_closed_compact:
   fixes S T :: "'a::heine_borel set"
   assumes S: "closed S"
     and T: "compact T"
     and dis: "S \<inter> T = {}"
   shows "\<exists>d>0. \<forall>x\<in>S. \<forall>y\<in>T. d \<le> dist x y"
   by (metis separate_compact_closed[OF T S] dis dist_commute inf_commute)
 
 proposition compact_in_open_separated:
   fixes A::"'a::heine_borel set"
   assumes A: "A \<noteq> {}" "compact A"
   assumes "open B"
   assumes "A \<subseteq> B"
   obtains e where "e > 0" "{x. infdist x A \<le> e} \<subseteq> B"
 proof atomize_elim
   have "closed (- B)" "compact A" "- B \<inter> A = {}"
     using assms by (auto simp: open_Diff compact_eq_bounded_closed)
   from separate_closed_compact[OF this]
   obtain d'::real where d': "d'>0" "\<And>x y. x \<notin> B \<Longrightarrow> y \<in> A \<Longrightarrow> d' \<le> dist x y"
     by auto
   define d where "d = d' / 2"
   hence "d>0" "d < d'" using d' by auto
   with d' have d: "\<And>x y. x \<notin> B \<Longrightarrow> y \<in> A \<Longrightarrow> d < dist x y"
     by force
   show "\<exists>e>0. {x. infdist x A \<le> e} \<subseteq> B"
   proof (rule ccontr)
     assume "\<nexists>e. 0 < e \<and> {x. infdist x A \<le> e} \<subseteq> B"
     with \<open>d > 0\<close> obtain x where x: "infdist x A \<le> d" "x \<notin> B"
       by auto
     then show False
       by (metis A compact_eq_bounded_closed infdist_attains_inf x d linorder_not_less)
   qed
 qed
 
 
 subsection \<open>Uniform Continuity\<close>
 
 lemma uniformly_continuous_onE:
   assumes "uniformly_continuous_on s f" "0 < e"
   obtains d where "d>0" "\<And>x x'. \<lbrakk>x\<in>s; x'\<in>s; dist x' x < d\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e"
   using assms
   by (auto simp: uniformly_continuous_on_def)
 
 lemma uniformly_continuous_on_sequentially:
   "uniformly_continuous_on s f \<longleftrightarrow> (\<forall>x y. (\<forall>n. x n \<in> s) \<and> (\<forall>n. y n \<in> s) \<and>
     (\<lambda>n. dist (x n) (y n)) \<longlonglongrightarrow> 0 \<longrightarrow> (\<lambda>n. dist (f(x n)) (f(y n))) \<longlonglongrightarrow> 0)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   {
     fix x y
     assume x: "\<forall>n. x n \<in> s"
       and y: "\<forall>n. y n \<in> s"
       and xy: "((\<lambda>n. dist (x n) (y n)) \<longlongrightarrow> 0) sequentially"
     {
       fix e :: real
       assume "e > 0"
       then obtain d where "d > 0" and d: "\<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e"
         by (metis \<open>?lhs\<close> uniformly_continuous_onE)
       obtain N where N: "\<forall>n\<ge>N. dist (x n) (y n) < d"
         using xy[unfolded lim_sequentially dist_norm] and \<open>d>0\<close> by auto
       then have "\<exists>N. \<forall>n\<ge>N. dist (f (x n)) (f (y n)) < e"
         using d x y by blast
     }
     then have "((\<lambda>n. dist (f(x n)) (f(y n))) \<longlongrightarrow> 0) sequentially"
       unfolding lim_sequentially and dist_real_def by auto
   }
   then show ?rhs by auto
 next
   assume ?rhs
   {
     assume "\<not> ?lhs"
     then obtain e where "e > 0" "\<forall>d>0. \<exists>x\<in>s. \<exists>x'\<in>s. dist x' x < d \<and> \<not> dist (f x') (f x) < e"
       unfolding uniformly_continuous_on_def by auto
     then obtain fa where fa:
       "\<forall>x. 0 < x \<longrightarrow> fst (fa x) \<in> s \<and> snd (fa x) \<in> s \<and> dist (fst (fa x)) (snd (fa x)) < x \<and> \<not> dist (f (fst (fa x))) (f (snd (fa x))) < e"
       using choice[of "\<lambda>d x. d>0 \<longrightarrow> fst x \<in> s \<and> snd x \<in> s \<and> dist (snd x) (fst x) < d \<and> \<not> dist (f (snd x)) (f (fst x)) < e"]
       by (auto simp: Bex_def dist_commute)
     define x where "x n = fst (fa (inverse (real n + 1)))" for n
     define y where "y n = snd (fa (inverse (real n + 1)))" for n
     have xyn: "\<forall>n. x n \<in> s \<and> y n \<in> s"
       and xy0: "\<forall>n. dist (x n) (y n) < inverse (real n + 1)"
       and fxy:"\<forall>n. \<not> dist (f (x n)) (f (y n)) < e"
       unfolding x_def and y_def using fa
       by auto
     {
       fix e :: real
       assume "e > 0"
       then obtain N :: nat where "N \<noteq> 0" and N: "0 < inverse (real N) \<and> inverse (real N) < e"
         unfolding real_arch_inverse[of e] by auto
       then have "\<exists>N. \<forall>n\<ge>N. dist (x n) (y n) < e"
         by (smt (verit, ccfv_SIG) inverse_le_imp_le nat_le_real_less of_nat_le_0_iff xy0) 
     }
     then have "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (f (x n)) (f (y n)) < e"
       using \<open>?rhs\<close>[THEN spec[where x=x], THEN spec[where x=y]] and xyn
       unfolding lim_sequentially dist_real_def by auto
     then have False using fxy and \<open>e>0\<close> by auto
   }
   then show ?lhs
     unfolding uniformly_continuous_on_def by blast
 qed
 
 
 subsection \<open>Continuity on a Compact Domain Implies Uniform Continuity\<close>
 
 text\<open>From the proof of the Heine-Borel theorem: Lemma 2 in section 3.7, page 69 of
 J. C. Burkill and H. Burkill. A Second Course in Mathematical Analysis (CUP, 2002)\<close>
 
 lemma Heine_Borel_lemma:
   assumes "compact S" and Ssub: "S \<subseteq> \<Union>\<G>" and opn: "\<And>G. G \<in> \<G> \<Longrightarrow> open G"
   obtains e where "0 < e" "\<And>x. x \<in> S \<Longrightarrow> \<exists>G \<in> \<G>. ball x e \<subseteq> G"
 proof -
   have False if neg: "\<And>e. 0 < e \<Longrightarrow> \<exists>x \<in> S. \<forall>G \<in> \<G>. \<not> ball x e \<subseteq> G"
   proof -
     have "\<exists>x \<in> S. \<forall>G \<in> \<G>. \<not> ball x (1 / Suc n) \<subseteq> G" for n
       using neg by simp
     then obtain f where "\<And>n. f n \<in> S" and fG: "\<And>G n. G \<in> \<G> \<Longrightarrow> \<not> ball (f n) (1 / Suc n) \<subseteq> G"
       by metis
     then obtain l r where "l \<in> S" "strict_mono r" and to_l: "(f \<circ> r) \<longlonglongrightarrow> l"
       using \<open>compact S\<close> compact_def that by metis
     then obtain G where "l \<in> G" "G \<in> \<G>"
       using Ssub by auto
     then obtain e where "0 < e" and e: "\<And>z. dist z l < e \<Longrightarrow> z \<in> G"
       using opn open_dist by blast
     obtain N1 where N1: "\<And>n. n \<ge> N1 \<Longrightarrow> dist (f (r n)) l < e/2"
       using to_l apply (simp add: lim_sequentially)
       using \<open>0 < e\<close> half_gt_zero that by blast
     obtain N2 where N2: "of_nat N2 > 2/e"
       using reals_Archimedean2 by blast
     obtain x where "x \<in> ball (f (r (max N1 N2))) (1 / real (Suc (r (max N1 N2))))" and "x \<notin> G"
       using fG [OF \<open>G \<in> \<G>\<close>, of "r (max N1 N2)"] by blast
     then have "dist (f (r (max N1 N2))) x < 1 / real (Suc (r (max N1 N2)))"
       by simp
     also have "... \<le> 1 / real (Suc (max N1 N2))"
       by (meson Suc_le_mono \<open>strict_mono r\<close> inverse_of_nat_le nat.discI seq_suble)
     also have "... \<le> 1 / real (Suc N2)"
       by (simp add: field_simps)
     also have "... < e/2"
       using N2 \<open>0 < e\<close> by (simp add: field_simps)
     finally have "dist (f (r (max N1 N2))) x < e/2" .
     moreover have "dist (f (r (max N1 N2))) l < e/2"
       using N1 max.cobounded1 by blast
     ultimately have "dist x l < e"
       by metric
     then show ?thesis
       using e \<open>x \<notin> G\<close> by blast
   qed
   then show ?thesis
     by (meson that)
 qed
 
 lemma compact_uniformly_equicontinuous:
   assumes "compact S"
       and cont: "\<And>x e. \<lbrakk>x \<in> S; 0 < e\<rbrakk>
                         \<Longrightarrow> \<exists>d. 0 < d \<and>
                                 (\<forall>f \<in> \<F>. \<forall>x' \<in> S. dist x' x < d \<longrightarrow> dist (f x') (f x) < e)"
       and "0 < e"
   obtains d where "0 < d"
                   "\<And>f x x'. \<lbrakk>f \<in> \<F>; x \<in> S; x' \<in> S; dist x' x < d\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e"
 proof -
   obtain d where d_pos: "\<And>x e. \<lbrakk>x \<in> S; 0 < e\<rbrakk> \<Longrightarrow> 0 < d x e"
      and d_dist : "\<And>x x' e f. \<lbrakk>dist x' x < d x e; x \<in> S; x' \<in> S; 0 < e; f \<in> \<F>\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e"
     using cont by metis
   let ?\<G> = "((\<lambda>x. ball x (d x (e/2))) ` S)"
   have Ssub: "S \<subseteq> \<Union> ?\<G>"
     using \<open>0 < e\<close> d_pos by auto
   then obtain k where "0 < k" and k: "\<And>x. x \<in> S \<Longrightarrow> \<exists>G \<in> ?\<G>. ball x k \<subseteq> G"
     by (rule Heine_Borel_lemma [OF \<open>compact S\<close>]) auto
   moreover have "dist (f v) (f u) < e" if "f \<in> \<F>" "u \<in> S" "v \<in> S" "dist v u < k" for f u v
   proof -
     obtain G where "G \<in> ?\<G>" "u \<in> G" "v \<in> G"
       using k that
       by (metis \<open>dist v u < k\<close> \<open>u \<in> S\<close> \<open>0 < k\<close> centre_in_ball subsetD dist_commute mem_ball)
     then obtain w where w: "dist w u < d w (e/2)" "dist w v < d w (e/2)" "w \<in> S"
       by auto
     with that d_dist have "dist (f w) (f v) < e/2"
       by (metis \<open>0 < e\<close> dist_commute half_gt_zero)
     moreover
     have "dist (f w) (f u) < e/2"
       using that d_dist w by (metis \<open>0 < e\<close> dist_commute divide_pos_pos zero_less_numeral)
     ultimately show ?thesis
       using dist_triangle_half_r by blast
   qed
   ultimately show ?thesis using that by blast
 qed
 
 corollary compact_uniformly_continuous:
   fixes f :: "'a :: metric_space \<Rightarrow> 'b :: metric_space"
   assumes f: "continuous_on S f" and S: "compact S"
   shows "uniformly_continuous_on S f"
   using f
     unfolding continuous_on_iff uniformly_continuous_on_def
     by (force intro: compact_uniformly_equicontinuous [OF S, of "{f}"])
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open> Theorems relating continuity and uniform continuity to closures\<close>
 
 lemma continuous_on_closure:
    "continuous_on (closure S) f \<longleftrightarrow>
     (\<forall>x e. x \<in> closure S \<and> 0 < e
            \<longrightarrow> (\<exists>d. 0 < d \<and> (\<forall>y. y \<in> S \<and> dist y x < d \<longrightarrow> dist (f y) (f x) < e)))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     unfolding continuous_on_iff  by (metis Un_iff closure_def)
 next
   assume R [rule_format]: ?rhs
   show ?lhs
   proof
     fix x and e::real
     assume "0 < e" and x: "x \<in> closure S"
     obtain \<delta>::real where "\<delta> > 0"
                    and \<delta>: "\<And>y. \<lbrakk>y \<in> S; dist y x < \<delta>\<rbrakk> \<Longrightarrow> dist (f y) (f x) < e/2"
       using R [of x "e/2"] \<open>0 < e\<close> x by auto
     have "dist (f y) (f x) \<le> e" if y: "y \<in> closure S" and dyx: "dist y x < \<delta>/2" for y
     proof -
       obtain \<delta>'::real where "\<delta>' > 0"
                       and \<delta>': "\<And>z. \<lbrakk>z \<in> S; dist z y < \<delta>'\<rbrakk> \<Longrightarrow> dist (f z) (f y) < e/2"
         using R [of y "e/2"] \<open>0 < e\<close> y by auto
       obtain z where "z \<in> S" and z: "dist z y < min \<delta>' \<delta> / 2"
         using closure_approachable y
         by (metis \<open>0 < \<delta>'\<close> \<open>0 < \<delta>\<close> divide_pos_pos min_less_iff_conj zero_less_numeral)
       have "dist (f z) (f y) < e/2"
         using \<delta>' [OF \<open>z \<in> S\<close>] z \<open>0 < \<delta>'\<close> by metric
       moreover have "dist (f z) (f x) < e/2"
         using \<delta>[OF \<open>z \<in> S\<close>] z dyx by metric
       ultimately show ?thesis
         by metric
     qed
     then show "\<exists>d>0. \<forall>x'\<in>closure S. dist x' x < d \<longrightarrow> dist (f x') (f x) \<le> e"
       by (rule_tac x="\<delta>/2" in exI) (simp add: \<open>\<delta> > 0\<close>)
   qed
 qed
 
 lemma continuous_on_closure_sequentially:
   fixes f :: "'a::metric_space \<Rightarrow> 'b :: metric_space"
   shows
    "continuous_on (closure S) f \<longleftrightarrow>
     (\<forall>x a. a \<in> closure S \<and> (\<forall>n. x n \<in> S) \<and> x \<longlonglongrightarrow> a \<longrightarrow> (f \<circ> x) \<longlonglongrightarrow> f a)"
    (is "?lhs = ?rhs")
 proof -
   have "continuous_on (closure S) f \<longleftrightarrow>
            (\<forall>x \<in> closure S. continuous (at x within S) f)"
     by (force simp: continuous_on_closure continuous_within_eps_delta)
   also have "... = ?rhs"
     by (force simp: continuous_within_sequentially)
   finally show ?thesis .
 qed
 
 lemma uniformly_continuous_on_closure:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   assumes ucont: "uniformly_continuous_on S f"
       and cont: "continuous_on (closure S) f"
     shows "uniformly_continuous_on (closure S) f"
 unfolding uniformly_continuous_on_def
 proof (intro allI impI)
   fix e::real
   assume "0 < e"
   then obtain d::real
     where "d>0"
       and d: "\<And>x x'. \<lbrakk>x\<in>S; x'\<in>S; dist x' x < d\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e/3"
     using ucont [unfolded uniformly_continuous_on_def, rule_format, of "e/3"] by auto
   show "\<exists>d>0. \<forall>x\<in>closure S. \<forall>x'\<in>closure S. dist x' x < d \<longrightarrow> dist (f x') (f x) < e"
   proof (rule exI [where x="d/3"], clarsimp simp: \<open>d > 0\<close>)
     fix x y
     assume x: "x \<in> closure S" and y: "y \<in> closure S" and dyx: "dist y x * 3 < d"
     obtain d1::real where "d1 > 0"
            and d1: "\<And>w. \<lbrakk>w \<in> closure S; dist w x < d1\<rbrakk> \<Longrightarrow> dist (f w) (f x) < e/3"
       using cont [unfolded continuous_on_iff, rule_format, of "x" "e/3"] \<open>0 < e\<close> x by auto
      obtain x' where "x' \<in> S" and x': "dist x' x < min d1 (d / 3)"
         using closure_approachable [of x S]
         by (metis \<open>0 < d1\<close> \<open>0 < d\<close> divide_pos_pos min_less_iff_conj x zero_less_numeral)
     obtain d2::real where "d2 > 0"
            and d2: "\<forall>w \<in> closure S. dist w y < d2 \<longrightarrow> dist (f w) (f y) < e/3"
       using cont [unfolded continuous_on_iff, rule_format, of "y" "e/3"] \<open>0 < e\<close> y by auto
     obtain y' where "y' \<in> S" and y': "dist y' y < min d2 (d / 3)"
       using closure_approachable [of y S]
       by (metis \<open>0 < d2\<close> \<open>0 < d\<close> divide_pos_pos min_less_iff_conj y zero_less_numeral)
     have "dist x' x < d/3" using x' by auto
     then have "dist x' y' < d"
       using dyx y' by metric
     then have "dist (f x') (f y') < e/3"
       by (rule d [OF \<open>y' \<in> S\<close> \<open>x' \<in> S\<close>])
     moreover have "dist (f x') (f x) < e/3" using \<open>x' \<in> S\<close> closure_subset x' d1
       by (simp add: closure_def)
     moreover have "dist (f y') (f y) < e/3" using \<open>y' \<in> S\<close> closure_subset y' d2
       by (simp add: closure_def)
     ultimately show "dist (f y) (f x) < e" by metric
   qed
 qed
 
 lemma uniformly_continuous_on_extension_at_closure:
   fixes f::"'a::metric_space \<Rightarrow> 'b::complete_space"
   assumes uc: "uniformly_continuous_on X f"
   assumes "x \<in> closure X"
   obtains l where "(f \<longlongrightarrow> l) (at x within X)"
 proof -
   from assms obtain xs where xs: "xs \<longlonglongrightarrow> x" "\<And>n. xs n \<in> X"
     by (auto simp: closure_sequential)
 
   from uniformly_continuous_on_Cauchy[OF uc LIMSEQ_imp_Cauchy, OF xs]
   obtain l where l: "(\<lambda>n. f (xs n)) \<longlonglongrightarrow> l"
     by atomize_elim (simp only: convergent_eq_Cauchy)
 
   have "(f \<longlongrightarrow> l) (at x within X)"
   proof (safe intro!: Lim_within_LIMSEQ)
     fix xs'
     assume "\<forall>n. xs' n \<noteq> x \<and> xs' n \<in> X"
       and xs': "xs' \<longlonglongrightarrow> x"
     then have "xs' n \<noteq> x" "xs' n \<in> X" for n by auto
 
     from uniformly_continuous_on_Cauchy[OF uc LIMSEQ_imp_Cauchy, OF \<open>xs' \<longlonglongrightarrow> x\<close> \<open>xs' _ \<in> X\<close>]
     obtain l' where l': "(\<lambda>n. f (xs' n)) \<longlonglongrightarrow> l'"
       by atomize_elim (simp only: convergent_eq_Cauchy)
 
     show "(\<lambda>n. f (xs' n)) \<longlonglongrightarrow> l"
     proof (rule tendstoI)
       fix e::real assume "e > 0"
       define e' where "e' \<equiv> e/2"
       have "e' > 0" using \<open>e > 0\<close> by (simp add: e'_def)
 
       have "\<forall>\<^sub>F n in sequentially. dist (f (xs n)) l < e'"
         by (simp add: \<open>0 < e'\<close> l tendstoD)
       moreover
       from uc[unfolded uniformly_continuous_on_def, rule_format, OF \<open>e' > 0\<close>]
       obtain d where d: "d > 0" "\<And>x x'. x \<in> X \<Longrightarrow> x' \<in> X \<Longrightarrow> dist x x' < d \<Longrightarrow> dist (f x) (f x') < e'"
         by auto
       have "\<forall>\<^sub>F n in sequentially. dist (xs n) (xs' n) < d"
         by (auto intro!: \<open>0 < d\<close> order_tendstoD tendsto_eq_intros xs xs')
       ultimately
       show "\<forall>\<^sub>F n in sequentially. dist (f (xs' n)) l < e"
       proof eventually_elim
         case (elim n)
         have "dist (f (xs' n)) l \<le> dist (f (xs n)) (f (xs' n)) + dist (f (xs n)) l"
           by metric
         also have "dist (f (xs n)) (f (xs' n)) < e'"
           by (auto intro!: d xs \<open>xs' _ \<in> _\<close> elim)
         also note \<open>dist (f (xs n)) l < e'\<close>
         also have "e' + e' = e" by (simp add: e'_def)
         finally show ?case by simp
       qed
     qed
   qed
   thus ?thesis ..
 qed
 
 lemma uniformly_continuous_on_extension_on_closure:
   fixes f::"'a::metric_space \<Rightarrow> 'b::complete_space"
   assumes uc: "uniformly_continuous_on X f"
   obtains g where "uniformly_continuous_on (closure X) g" "\<And>x. x \<in> X \<Longrightarrow> f x = g x"
     "\<And>Y h x. X \<subseteq> Y \<Longrightarrow> Y \<subseteq> closure X \<Longrightarrow> continuous_on Y h \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> f x = h x) \<Longrightarrow> x \<in> Y \<Longrightarrow> h x = g x"
 proof -
   from uc have cont_f: "continuous_on X f"
     by (simp add: uniformly_continuous_imp_continuous)
   obtain y where y: "(f \<longlongrightarrow> y x) (at x within X)" if "x \<in> closure X" for x
     using uniformly_continuous_on_extension_at_closure[OF assms] by meson
   let ?g = "\<lambda>x. if x \<in> X then f x else y x"
 
   have "uniformly_continuous_on (closure X) ?g"
     unfolding uniformly_continuous_on_def
   proof safe
     fix e::real assume "e > 0"
     define e' where "e' \<equiv> e / 3"
     have "e' > 0" using \<open>e > 0\<close> by (simp add: e'_def)
     from uc[unfolded uniformly_continuous_on_def, rule_format, OF \<open>0 < e'\<close>]
     obtain d where "d > 0" and d: "\<And>x x'. x \<in> X \<Longrightarrow> x' \<in> X \<Longrightarrow> dist x' x < d \<Longrightarrow> dist (f x') (f x) < e'"
       by auto
     define d' where "d' = d / 3"
     have "d' > 0" using \<open>d > 0\<close> by (simp add: d'_def)
     show "\<exists>d>0. \<forall>x\<in>closure X. \<forall>x'\<in>closure X. dist x' x < d \<longrightarrow> dist (?g x') (?g x) < e"
     proof (safe intro!: exI[where x=d'] \<open>d' > 0\<close>)
       fix x x' assume x: "x \<in> closure X" and x': "x' \<in> closure X" and dist: "dist x' x < d'"
       then obtain xs xs' where xs: "xs \<longlonglongrightarrow> x" "\<And>n. xs n \<in> X"
         and xs': "xs' \<longlonglongrightarrow> x'" "\<And>n. xs' n \<in> X"
         by (auto simp: closure_sequential)
       have "\<forall>\<^sub>F n in sequentially. dist (xs' n) x' < d'"
         and "\<forall>\<^sub>F n in sequentially. dist (xs n) x < d'"
         by (auto intro!: \<open>0 < d'\<close> order_tendstoD tendsto_eq_intros xs xs')
       moreover
       have "(\<lambda>x. f (xs x)) \<longlonglongrightarrow> y x" if "x \<in> closure X" "x \<notin> X" "xs \<longlonglongrightarrow> x" "\<And>n. xs n \<in> X" for xs x
         using that not_eventuallyD
         by (force intro!: filterlim_compose[OF y[OF \<open>x \<in> closure X\<close>]] simp: filterlim_at)
       then have "(\<lambda>x. f (xs' x)) \<longlonglongrightarrow> ?g x'" "(\<lambda>x. f (xs x)) \<longlonglongrightarrow> ?g x"
         using x x'
         by (auto intro!: continuous_on_tendsto_compose[OF cont_f] simp: xs' xs)
       then have "\<forall>\<^sub>F n in sequentially. dist (f (xs' n)) (?g x') < e'"
         "\<forall>\<^sub>F n in sequentially. dist (f (xs n)) (?g x) < e'"
         by (auto intro!: \<open>0 < e'\<close> order_tendstoD tendsto_eq_intros)
       ultimately
       have "\<forall>\<^sub>F n in sequentially. dist (?g x') (?g x) < e"
       proof eventually_elim
         case (elim n)
         have "dist (?g x') (?g x) \<le>
           dist (f (xs' n)) (?g x') + dist (f (xs' n)) (f (xs n)) + dist (f (xs n)) (?g x)"
           by (metis add.commute add_le_cancel_left dist_commute dist_triangle dist_triangle_le)
         also
         from \<open>dist (xs' n) x' < d'\<close> \<open>dist x' x < d'\<close> \<open>dist (xs n) x < d'\<close>
         have "dist (xs' n) (xs n) < d" unfolding d'_def by metric
         with \<open>xs _ \<in> X\<close> \<open>xs' _ \<in> X\<close> have "dist (f (xs' n)) (f (xs n)) < e'"
           by (rule d)
         also note \<open>dist (f (xs' n)) (?g x') < e'\<close>
         also note \<open>dist (f (xs n)) (?g x) < e'\<close>
         finally show ?case by (simp add: e'_def)
       qed
       then show "dist (?g x') (?g x) < e" by simp
     qed
   qed
   moreover have "f x = ?g x" if "x \<in> X" for x using that by simp
   moreover
   {
     fix Y h x
     assume Y: "x \<in> Y" "X \<subseteq> Y" "Y \<subseteq> closure X" and cont_h: "continuous_on Y h"
       and extension: "(\<And>x. x \<in> X \<Longrightarrow> f x = h x)"
     {
       assume "x \<notin> X"
       have "x \<in> closure X" using Y by auto
       then obtain xs where xs: "xs \<longlonglongrightarrow> x" "\<And>n. xs n \<in> X"
         by (auto simp: closure_sequential)
       from continuous_on_tendsto_compose[OF cont_h xs(1)] xs(2) Y
       have hx: "(\<lambda>x. f (xs x)) \<longlonglongrightarrow> h x"
         by (auto simp: subsetD extension)
       then have "(\<lambda>x. f (xs x)) \<longlonglongrightarrow> y x"
         using \<open>x \<notin> X\<close> not_eventuallyD xs(2)
         by (force intro!: filterlim_compose[OF y[OF \<open>x \<in> closure X\<close>]] simp: filterlim_at xs)
       with hx have "h x = y x" by (rule LIMSEQ_unique)
     } then
     have "h x = ?g x"
       using extension by auto
   }
   ultimately show ?thesis ..
 qed
 
 lemma bounded_uniformly_continuous_image:
   fixes f :: "'a :: heine_borel \<Rightarrow> 'b :: heine_borel"
   assumes "uniformly_continuous_on S f" "bounded S"
   shows "bounded(f ` S)"
   by (metis (no_types, lifting) assms bounded_closure_image compact_closure compact_continuous_image compact_eq_bounded_closed image_cong uniformly_continuous_imp_continuous uniformly_continuous_on_extension_on_closure)
 
 
 subsection \<open>With Abstract Topology (TODO: move and remove dependency?)\<close>
 
 lemma openin_contains_ball:
     "openin (top_of_set T) S \<longleftrightarrow>
      S \<subseteq> T \<and> (\<forall>x \<in> S. \<exists>e. 0 < e \<and> ball x e \<inter> T \<subseteq> S)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (metis IntD2 Int_commute Int_lower1 Int_mono inf.idem openE openin_open)
 next
   assume ?rhs
   then show ?lhs
     by (smt (verit) open_ball Int_commute Int_iff centre_in_ball in_mono openin_open_Int openin_subopen)
 qed
 
 lemma openin_contains_cball:
    "openin (top_of_set T) S \<longleftrightarrow>
         S \<subseteq> T \<and> (\<forall>x \<in> S. \<exists>e. 0 < e \<and> cball x e \<inter> T \<subseteq> S)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (force simp add: openin_contains_ball intro: exI [where x="_/2"])
 next
   assume ?rhs
   then show ?lhs
     by (force simp add: openin_contains_ball)
 qed
 
 
 subsection \<open>Closed Nest\<close>
 
 text \<open>Bounded closed nest property (proof does not use Heine-Borel)\<close>
 
 lemma bounded_closed_nest:
   fixes S :: "nat \<Rightarrow> ('a::heine_borel) set"
   assumes "\<And>n. closed (S n)"
       and "\<And>n. S n \<noteq> {}"
       and "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
       and "bounded (S 0)"
   obtains a where "\<And>n. a \<in> S n"
 proof -
   from assms(2) obtain x where x: "\<forall>n. x n \<in> S n"
     using choice[of "\<lambda>n x. x \<in> S n"] by auto
   from assms(4,1) have "seq_compact (S 0)"
     by (simp add: bounded_closed_imp_seq_compact)
   then obtain l r where lr: "l \<in> S 0" "strict_mono r" "(x \<circ> r) \<longlonglongrightarrow> l"
     using x and assms(3) unfolding seq_compact_def by blast
   have "\<forall>n. l \<in> S n"
   proof
     fix n :: nat
     have "closed (S n)"
       using assms(1) by simp
     moreover have "\<forall>i. (x \<circ> r) i \<in> S i"
       using x and assms(3) and lr(2) [THEN seq_suble] by auto
     then have "\<forall>i. (x \<circ> r) (i + n) \<in> S n"
       using assms(3) by (fast intro!: le_add2)
     moreover have "(\<lambda>i. (x \<circ> r) (i + n)) \<longlonglongrightarrow> l"
       using lr(3) by (rule LIMSEQ_ignore_initial_segment)
     ultimately show "l \<in> S n"
       by (rule closed_sequentially)
   qed
   then show ?thesis 
     using that by blast
 qed
 
 text \<open>Decreasing case does not even need compactness, just completeness.\<close>
 
 lemma decreasing_closed_nest:
   fixes S :: "nat \<Rightarrow> ('a::complete_space) set"
   assumes "\<And>n. closed (S n)"
           "\<And>n. S n \<noteq> {}"
           "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
           "\<And>e. e>0 \<Longrightarrow> \<exists>n. \<forall>x\<in>S n. \<forall>y\<in>S n. dist x y < e"
   obtains a where "\<And>n. a \<in> S n"
 proof -
   obtain t where t: "\<forall>n. t n \<in> S n"
     by (meson assms(2) equals0I)
   {
     fix e :: real
     assume "e > 0"
     then obtain N where N: "\<forall>x\<in>S N. \<forall>y\<in>S N. dist x y < e"
       using assms(4) by blast
     {
       fix m n :: nat
       assume "N \<le> m \<and> N \<le> n"
       then have "t m \<in> S N" "t n \<in> S N"
         using assms(3) t unfolding  subset_eq t by blast+
       then have "dist (t m) (t n) < e"
         using N by auto
     }
     then have "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (t m) (t n) < e"
       by auto
   }
   then have "Cauchy t"
-    unfolding cauchy_def by auto
+    by (metis metric_CauchyI)
   then obtain l where l:"(t \<longlongrightarrow> l) sequentially"
     using complete_UNIV unfolding complete_def by auto
   { fix n :: nat
     { fix e :: real
       assume "e > 0"
       then obtain N :: nat where N: "\<forall>n\<ge>N. dist (t n) l < e"
         using l[unfolded lim_sequentially] by auto
       have "t (max n N) \<in> S n"
         by (meson assms(3) contra_subsetD max.cobounded1 t)
       then have "\<exists>y\<in>S n. dist y l < e"
         using N max.cobounded2 by blast
     }
     then have "l \<in> S n"
       using closed_approachable[of "S n" l] assms(1) by auto
   }
   then show ?thesis
     using that by blast
 qed
 
 text \<open>Strengthen it to the intersection actually being a singleton.\<close>
 
 lemma decreasing_closed_nest_sing:
   fixes S :: "nat \<Rightarrow> 'a::complete_space set"
   assumes "\<And>n. closed(S n)"
           "\<And>n. S n \<noteq> {}"
           "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
           "\<And>e. e>0 \<Longrightarrow> \<exists>n. \<forall>x \<in> (S n). \<forall> y\<in>(S n). dist x y < e"
   shows "\<exists>a. \<Inter>(range S) = {a}"
 proof -
   obtain a where a: "\<forall>n. a \<in> S n"
     using decreasing_closed_nest[of S] using assms by auto
   { fix b
     assume b: "b \<in> \<Inter>(range S)"
     { fix e :: real
       assume "e > 0"
       then have "dist a b < e"
         using assms(4) and b and a by blast
     }
     then have "dist a b = 0"
       by (metis dist_eq_0_iff dist_nz less_le)
   }
   with a have "\<Inter>(range S) = {a}"
     unfolding image_def by auto
   then show ?thesis ..
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Making a continuous function avoid some value in a neighbourhood\<close>
 
 lemma continuous_within_avoid:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::t1_space"
   assumes "continuous (at x within s) f"
     and "f x \<noteq> a"
   shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e --> f y \<noteq> a"
 proof -
   obtain U where "open U" and "f x \<in> U" and "a \<notin> U"
     using t1_space [OF \<open>f x \<noteq> a\<close>] by fast
   have "(f \<longlongrightarrow> f x) (at x within s)"
     using assms(1) by (simp add: continuous_within)
   then have "eventually (\<lambda>y. f y \<in> U) (at x within s)"
     using \<open>open U\<close> and \<open>f x \<in> U\<close>
     unfolding tendsto_def by fast
   then have "eventually (\<lambda>y. f y \<noteq> a) (at x within s)"
     using \<open>a \<notin> U\<close> by (fast elim: eventually_mono)
   then show ?thesis
     using \<open>f x \<noteq> a\<close> by (auto simp: dist_commute eventually_at)
 qed
 
 lemma continuous_at_avoid:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::t1_space"
   assumes "continuous (at x) f"
     and "f x \<noteq> a"
   shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
   using assms continuous_within_avoid[of x UNIV f a] by simp
 
 lemma continuous_on_avoid:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::t1_space"
   assumes "continuous_on s f"
     and "x \<in> s"
     and "f x \<noteq> a"
   shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e \<longrightarrow> f y \<noteq> a"
   using assms(1)[unfolded continuous_on_eq_continuous_within, THEN bspec[where x=x],
     OF assms(2)] continuous_within_avoid[of x s f a]
   using assms(3)
   by auto
 
 lemma continuous_on_open_avoid:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::t1_space"
   assumes "continuous_on s f"
     and "open s"
     and "x \<in> s"
     and "f x \<noteq> a"
   shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
   using assms(1)[unfolded continuous_on_eq_continuous_at[OF assms(2)], THEN bspec[where x=x], OF assms(3)]
   using continuous_at_avoid[of x f a] assms(4)
   by auto
 
 subsection \<open>Consequences for Real Numbers\<close>
 
 lemma closed_contains_Inf:
   fixes S :: "real set"
   shows "S \<noteq> {} \<Longrightarrow> bdd_below S \<Longrightarrow> closed S \<Longrightarrow> Inf S \<in> S"
   by (metis closure_contains_Inf closure_closed)
 
 lemma closed_subset_contains_Inf:
   fixes A C :: "real set"
   shows "closed C \<Longrightarrow> A \<subseteq> C \<Longrightarrow> A \<noteq> {} \<Longrightarrow> bdd_below A \<Longrightarrow> Inf A \<in> C"
   by (metis closure_contains_Inf closure_minimal subset_eq)
 
 lemma closed_contains_Sup:
   fixes S :: "real set"
   shows "S \<noteq> {} \<Longrightarrow> bdd_above S \<Longrightarrow> closed S \<Longrightarrow> Sup S \<in> S"
   by (subst closure_closed[symmetric], assumption, rule closure_contains_Sup)
 
 lemma closed_subset_contains_Sup:
   fixes A C :: "real set"
   shows "closed C \<Longrightarrow> A \<subseteq> C \<Longrightarrow> A \<noteq> {} \<Longrightarrow> bdd_above A \<Longrightarrow> Sup A \<in> C"
   by (metis closure_contains_Sup closure_minimal subset_eq)
 
 lemma atLeastAtMost_subset_contains_Inf:
   fixes A :: "real set" and a b :: real
   shows "A \<noteq> {} \<Longrightarrow> a \<le> b \<Longrightarrow> A \<subseteq> {a..b} \<Longrightarrow> Inf A \<in> {a..b}"
   by (rule closed_subset_contains_Inf)
      (auto intro: closed_real_atLeastAtMost intro!: bdd_belowI[of A a])
 
 lemma bounded_real: "bounded (S::real set) \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. \<bar>x\<bar> \<le> a)"
   by (simp add: bounded_iff)
 
 lemma bounded_imp_bdd_above: "bounded S \<Longrightarrow> bdd_above (S :: real set)"
   by (auto simp: bounded_def bdd_above_def dist_real_def)
      (metis abs_le_D1 abs_minus_commute diff_le_eq)
 
 lemma bounded_imp_bdd_below: "bounded S \<Longrightarrow> bdd_below (S :: real set)"
   by (auto simp: bounded_def bdd_below_def dist_real_def)
      (metis abs_le_D1 add.commute diff_le_eq)
 
 lemma bounded_has_Sup:
   fixes S :: "real set"
   assumes "bounded S"
     and "S \<noteq> {}"
   shows "\<forall>x\<in>S. x \<le> Sup S"
     and "\<forall>b. (\<forall>x\<in>S. x \<le> b) \<longrightarrow> Sup S \<le> b"
 proof
   show "\<forall>b. (\<forall>x\<in>S. x \<le> b) \<longrightarrow> Sup S \<le> b"
     using assms by (metis cSup_least)
 qed (metis cSup_upper assms(1) bounded_imp_bdd_above)
 
 lemma Sup_insert:
   fixes S :: "real set"
   shows "bounded S \<Longrightarrow> Sup (insert x S) = (if S = {} then x else max x (Sup S))"
   by (auto simp: bounded_imp_bdd_above sup_max cSup_insert_If)
 
 lemma bounded_has_Inf:
   fixes S :: "real set"
   assumes "bounded S"
     and "S \<noteq> {}"
   shows "\<forall>x\<in>S. x \<ge> Inf S"
     and "\<forall>b. (\<forall>x\<in>S. x \<ge> b) \<longrightarrow> Inf S \<ge> b"
 proof
   show "\<forall>b. (\<forall>x\<in>S. x \<ge> b) \<longrightarrow> Inf S \<ge> b"
     using assms by (metis cInf_greatest)
 qed (metis cInf_lower assms(1) bounded_imp_bdd_below)
 
 lemma Inf_insert:
   fixes S :: "real set"
   shows "bounded S \<Longrightarrow> Inf (insert x S) = (if S = {} then x else min x (Inf S))"
   by (auto simp: bounded_imp_bdd_below inf_min cInf_insert_If)
 
 lemma open_real:
   fixes s :: "real set"
   shows "open s \<longleftrightarrow> (\<forall>x \<in> s. \<exists>e>0. \<forall>x'. \<bar>x' - x\<bar> < e --> x' \<in> s)"
   unfolding open_dist dist_norm by simp
 
 lemma islimpt_approachable_real:
   fixes s :: "real set"
   shows "x islimpt s \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> s. x' \<noteq> x \<and> \<bar>x' - x\<bar> < e)"
   unfolding islimpt_approachable dist_norm by simp
 
 lemma closed_real:
   fixes s :: "real set"
   shows "closed s \<longleftrightarrow> (\<forall>x. (\<forall>e>0.  \<exists>x' \<in> s. x' \<noteq> x \<and> \<bar>x' - x\<bar> < e) \<longrightarrow> x \<in> s)"
   unfolding closed_limpt islimpt_approachable dist_norm by simp
 
 lemma continuous_at_real_range:
   fixes f :: "'a::real_normed_vector \<Rightarrow> real"
   shows "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. \<forall>x'. norm(x' - x) < d --> \<bar>f x' - f x\<bar> < e)"
   by (metis (mono_tags, opaque_lifting) LIM_eq continuous_within norm_eq_zero real_norm_def right_minus_eq)
 
 lemma continuous_on_real_range:
   fixes f :: "'a::real_normed_vector \<Rightarrow> real"
   shows "continuous_on s f \<longleftrightarrow>
     (\<forall>x \<in> s. \<forall>e>0. \<exists>d>0. (\<forall>x' \<in> s. norm(x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e))"
   unfolding continuous_on_iff dist_norm by simp
 
 lemma continuous_on_closed_Collect_le:
   fixes f g :: "'a::topological_space \<Rightarrow> real"
   assumes f: "continuous_on s f" and g: "continuous_on s g" and s: "closed s"
   shows "closed {x \<in> s. f x \<le> g x}"
 proof -
   have "closed ((\<lambda>x. g x - f x) -` {0..} \<inter> s)"
     using closed_real_atLeast continuous_on_diff [OF g f]
     by (simp add: continuous_on_closed_vimage [OF s])
   also have "((\<lambda>x. g x - f x) -` {0..} \<inter> s) = {x\<in>s. f x \<le> g x}"
     by auto
   finally show ?thesis .
 qed
 
 lemma continuous_le_on_closure:
   fixes a::real
   assumes f: "continuous_on (closure s) f"
       and x: "x \<in> closure(s)"
       and xlo: "\<And>x. x \<in> s ==> f(x) \<le> a"
     shows "f(x) \<le> a"
   using image_closure_subset [OF f, where T=" {x. x \<le> a}" ] assms
     continuous_on_closed_Collect_le[of "UNIV" "\<lambda>x. x" "\<lambda>x. a"]
   by auto
 
 lemma continuous_ge_on_closure:
   fixes a::real
   assumes f: "continuous_on (closure s) f"
       and x: "x \<in> closure(s)"
       and xlo: "\<And>x. x \<in> s ==> f(x) \<ge> a"
     shows "f(x) \<ge> a"
   using image_closure_subset [OF f, where T=" {x. a \<le> x}"] assms
     continuous_on_closed_Collect_le[of "UNIV" "\<lambda>x. a" "\<lambda>x. x"]
   by auto
 
 
 subsection\<open>The infimum of the distance between two sets\<close>
 
 definition\<^marker>\<open>tag important\<close> setdist :: "'a::metric_space set \<Rightarrow> 'a set \<Rightarrow> real" where
   "setdist s t \<equiv>
        (if s = {} \<or> t = {} then 0
         else Inf {dist x y| x y. x \<in> s \<and> y \<in> t})"
 
 lemma setdist_empty1 [simp]: "setdist {} t = 0"
   by (simp add: setdist_def)
 
 lemma setdist_empty2 [simp]: "setdist t {} = 0"
   by (simp add: setdist_def)
 
 lemma setdist_pos_le [simp]: "0 \<le> setdist s t"
   by (auto simp: setdist_def ex_in_conv [symmetric] intro: cInf_greatest)
 
 lemma le_setdistI:
   assumes "s \<noteq> {}" "t \<noteq> {}" "\<And>x y. \<lbrakk>x \<in> s; y \<in> t\<rbrakk> \<Longrightarrow> d \<le> dist x y"
     shows "d \<le> setdist s t"
   using assms
   by (auto simp: setdist_def Set.ex_in_conv [symmetric] intro: cInf_greatest)
 
 lemma setdist_le_dist: "\<lbrakk>x \<in> s; y \<in> t\<rbrakk> \<Longrightarrow> setdist s t \<le> dist x y"
   unfolding setdist_def
   by (auto intro!: bdd_belowI [where m=0] cInf_lower)
 
 lemma le_setdist_iff:
         "d \<le> setdist S T \<longleftrightarrow>
         (\<forall>x \<in> S. \<forall>y \<in> T. d \<le> dist x y) \<and> (S = {} \<or> T = {} \<longrightarrow> d \<le> 0)"
   by (smt (verit) le_setdistI setdist_def setdist_le_dist)
 
 lemma setdist_ltE:
   assumes "setdist S T < b" "S \<noteq> {}" "T \<noteq> {}"
     obtains x y where "x \<in> S" "y \<in> T" "dist x y < b"
 using assms
 by (auto simp: not_le [symmetric] le_setdist_iff)
 
 lemma setdist_refl: "setdist S S = 0"
   by (metis dist_eq_0_iff ex_in_conv order_antisym setdist_def setdist_le_dist setdist_pos_le)
 
 lemma setdist_sym: "setdist S T = setdist T S"
   by (force simp: setdist_def dist_commute intro!: arg_cong [where f=Inf])
 
 lemma setdist_triangle: "setdist S T \<le> setdist S {a} + setdist {a} T"
 proof (cases "S = {} \<or> T = {}")
   case True then show ?thesis
     using setdist_pos_le by fastforce
 next
   case False
   then have "\<And>x. x \<in> S \<Longrightarrow> setdist S T - dist x a \<le> setdist {a} T"
     using  dist_self dist_triangle3 empty_not_insert le_setdist_iff setdist_le_dist singleton_iff
     by (smt (verit, best) dist_self dist_triangle3 empty_not_insert le_setdist_iff setdist_le_dist singleton_iff)
   then have "setdist S T - setdist {a} T \<le> setdist S {a}"
     using False by (fastforce intro: le_setdistI)
   then show ?thesis
     by (simp add: algebra_simps)
 qed
 
 lemma setdist_singletons [simp]: "setdist {x} {y} = dist x y"
   by (simp add: setdist_def)
 
 lemma setdist_Lipschitz: "\<bar>setdist {x} S - setdist {y} S\<bar> \<le> dist x y"
   apply (subst setdist_singletons [symmetric])
   by (metis abs_diff_le_iff diff_le_eq setdist_triangle setdist_sym)
 
 lemma continuous_at_setdist [continuous_intros]: "continuous (at x) (\<lambda>y. (setdist {y} S))"
   by (force simp: continuous_at_eps_delta dist_real_def intro: le_less_trans [OF setdist_Lipschitz])
 
 lemma continuous_on_setdist [continuous_intros]: "continuous_on T (\<lambda>y. (setdist {y} S))"
   by (metis continuous_at_setdist continuous_at_imp_continuous_on)
 
 lemma uniformly_continuous_on_setdist: "uniformly_continuous_on T (\<lambda>y. (setdist {y} S))"
   by (force simp: uniformly_continuous_on_def dist_real_def intro: le_less_trans [OF setdist_Lipschitz])
 
 lemma setdist_subset_right: "\<lbrakk>T \<noteq> {}; T \<subseteq> u\<rbrakk> \<Longrightarrow> setdist S u \<le> setdist S T"
   by (smt (verit, best) in_mono le_setdist_iff)
 
 lemma setdist_subset_left: "\<lbrakk>S \<noteq> {}; S \<subseteq> T\<rbrakk> \<Longrightarrow> setdist T u \<le> setdist S u"
   by (metis setdist_subset_right setdist_sym)
 
 lemma setdist_closure_1 [simp]: "setdist (closure S) T = setdist S T"
 proof (cases "S = {} \<or> T = {}")
   case True then show ?thesis by force
 next
   case False
   { fix y
     assume "y \<in> T"
     have "continuous_on (closure S) (\<lambda>a. dist a y)"
       by (auto simp: continuous_intros dist_norm)
     then have *: "\<And>x. x \<in> closure S \<Longrightarrow> setdist S T \<le> dist x y"
       by (fast intro: setdist_le_dist \<open>y \<in> T\<close> continuous_ge_on_closure)
   } then
   show ?thesis
     by (metis False antisym closure_eq_empty closure_subset le_setdist_iff setdist_subset_left)
 qed
 
 lemma setdist_closure_2 [simp]: "setdist T (closure S) = setdist T S"
   by (metis setdist_closure_1 setdist_sym)
 
 lemma setdist_eq_0I: "\<lbrakk>x \<in> S; x \<in> T\<rbrakk> \<Longrightarrow> setdist S T = 0"
   by (metis antisym dist_self setdist_le_dist setdist_pos_le)
 
 lemma setdist_unique:
   "\<lbrakk>a \<in> S; b \<in> T; \<And>x y. x \<in> S \<and> y \<in> T ==> dist a b \<le> dist x y\<rbrakk>
    \<Longrightarrow> setdist S T = dist a b"
   by (force simp add: setdist_le_dist le_setdist_iff intro: antisym)
 
 lemma setdist_le_sing: "x \<in> S ==> setdist S T \<le> setdist {x} T"
   using setdist_subset_left by auto
 
 lemma infdist_eq_setdist: "infdist x A = setdist {x} A"
   by (simp add: infdist_def setdist_def Setcompr_eq_image)
 
 lemma setdist_eq_infdist: "setdist A B = (if A = {} then 0 else INF a\<in>A. infdist a B)"
 proof -
   have "Inf {dist x y |x y. x \<in> A \<and> y \<in> B} = (INF x\<in>A. Inf (dist x ` B))"
     if "b \<in> B" "a \<in> A" for a b
   proof (rule order_antisym)
     have "Inf {dist x y |x y. x \<in> A \<and> y \<in> B} \<le> Inf (dist x ` B)"
       if  "b \<in> B" "a \<in> A" "x \<in> A" for x 
     proof -
       have "\<And>b'. b' \<in> B \<Longrightarrow> Inf {dist x y |x y. x \<in> A \<and> y \<in> B} \<le> dist x b'"
         by (metis (mono_tags, lifting) ex_in_conv setdist_def setdist_le_dist that(3))
       then show ?thesis
         by (smt (verit) cINF_greatest ex_in_conv \<open>b \<in> B\<close>)
     qed
     then show "Inf {dist x y |x y. x \<in> A \<and> y \<in> B} \<le> (INF x\<in>A. Inf (dist x ` B))"
       by (metis (mono_tags, lifting) cINF_greatest emptyE that)
   next
     have *: "\<And>x y. \<lbrakk>b \<in> B; a \<in> A; x \<in> A; y \<in> B\<rbrakk> \<Longrightarrow> \<exists>a\<in>A. Inf (dist a ` B) \<le> dist x y"
       by (meson bdd_below_image_dist cINF_lower)
     show "(INF x\<in>A. Inf (dist x ` B)) \<le> Inf {dist x y |x y. x \<in> A \<and> y \<in> B}"
     proof (rule conditionally_complete_lattice_class.cInf_mono)
       show "bdd_below ((\<lambda>x. Inf (dist x ` B)) ` A)"
         by (metis (no_types, lifting) bdd_belowI2 ex_in_conv infdist_def infdist_nonneg that(1))
     qed (use that in \<open>auto simp: *\<close>)
   qed
   then show ?thesis
     by (auto simp: setdist_def infdist_def)
 qed
 
 lemma infdist_mono:
   assumes "A \<subseteq> B" "A \<noteq> {}"
   shows "infdist x B \<le> infdist x A"
   by (simp add: assms infdist_eq_setdist setdist_subset_right)
 
 lemma infdist_singleton [simp]: "infdist x {y} = dist x y"
   by (simp add: infdist_eq_setdist)
 
 proposition setdist_attains_inf:
   assumes "compact B" "B \<noteq> {}"
   obtains y where "y \<in> B" "setdist A B = infdist y A"
 proof (cases "A = {}")
   case True
   then show thesis
     by (metis assms diameter_compact_attained infdist_def setdist_def that)
 next
   case False
   obtain y where "y \<in> B" and min: "\<And>y'. y' \<in> B \<Longrightarrow> infdist y A \<le> infdist y' A"
     by (metis continuous_attains_inf [OF assms continuous_on_infdist] continuous_on_id)
   show thesis
   proof
     have "setdist A B = (INF y\<in>B. infdist y A)"
       by (metis \<open>B \<noteq> {}\<close> setdist_eq_infdist setdist_sym)
     also have "\<dots> = infdist y A"
     proof (rule order_antisym)
       show "(INF y\<in>B. infdist y A) \<le> infdist y A"
         by (meson \<open>y \<in> B\<close> bdd_belowI2 cInf_lower image_eqI infdist_nonneg)
     next
       show "infdist y A \<le> (INF y\<in>B. infdist y A)"
         by (simp add: \<open>B \<noteq> {}\<close> cINF_greatest min)
     qed
     finally show "setdist A B = infdist y A" .
   qed (fact \<open>y \<in> B\<close>)
 qed
 
 end
diff --git a/src/HOL/Analysis/Function_Metric.thy b/src/HOL/Analysis/Function_Metric.thy
--- a/src/HOL/Analysis/Function_Metric.thy
+++ b/src/HOL/Analysis/Function_Metric.thy
@@ -1,386 +1,387 @@
 (*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr with additions from LCP
     License: BSD
 *)
 
 section \<open>Metrics on product spaces\<close>
 
 theory Function_Metric
   imports
     Function_Topology
     Elementary_Metric_Spaces
 begin
 
 text \<open>In general, the product topology is not metrizable, unless the index set is countable.
 When the index set is countable, essentially any (convergent) combination of the metrics on the
 factors will do. We use below the simplest one, based on \<open>L\<^sup>1\<close>, but \<open>L\<^sup>2\<close> would also work,
 for instance.
 
 What is not completely trivial is that the distance thus defined induces the same topology
 as the product topology. This is what we have to prove to show that we have an instance
 of \<^class>\<open>metric_space\<close>.
 
 The proofs below would work verbatim for general countable products of metric spaces. However,
 since distances are only implemented in terms of type classes, we only develop the theory
 for countable products of the same space.\<close>
 
 instantiation "fun" :: (countable, metric_space) metric_space
 begin
 
 definition\<^marker>\<open>tag important\<close> dist_fun_def:
   "dist x y = (\<Sum>n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
 
 definition\<^marker>\<open>tag important\<close> uniformity_fun_def:
   "(uniformity::(('a \<Rightarrow> 'b) \<times> ('a \<Rightarrow> 'b)) filter) = (INF e\<in>{0<..}. principal {(x, y). dist (x::('a\<Rightarrow>'b)) y < e})"
 
 text \<open>Except for the first one, the auxiliary lemmas below are only useful when proving the
 instance: once it is proved, they become trivial consequences of the general theory of metric
 spaces. It would thus be desirable to hide them once the instance is proved, but I do not know how
 to do this.\<close>
 
 lemma dist_fun_le_dist_first_terms:
   "dist x y \<le> 2 * Max {dist (x (from_nat n)) (y (from_nat n))|n. n \<le> N} + (1/2)^N"
 proof -
   have "(\<Sum>n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)
           = (\<Sum>n. (1 / 2) ^ (Suc N) * ((1/2) ^ n * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1))"
     by (rule suminf_cong, simp add: power_add)
   also have "... = (1/2)^(Suc N) * (\<Sum>n. (1 / 2) ^ n * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)"
     apply (rule suminf_mult)
     by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
   also have "... \<le> (1/2)^(Suc N) * (\<Sum>n. (1 / 2) ^ n)"
     apply (simp, rule suminf_le, simp)
     by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
   also have "... = (1/2)^(Suc N) * 2"
     using suminf_geometric[of "1/2"] by auto
   also have "... = (1/2)^N"
     by auto
   finally have *: "(\<Sum>n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1) \<le> (1/2)^N"
     by simp
 
   define M where "M = Max {dist (x (from_nat n)) (y (from_nat n))|n. n \<le> N}"
   have "dist (x (from_nat 0)) (y (from_nat 0)) \<le> M"
     unfolding M_def by (rule Max_ge, auto)
   then have [simp]: "M \<ge> 0" by (meson dual_order.trans zero_le_dist)
   have "dist (x (from_nat n)) (y (from_nat n)) \<le> M" if "n\<le>N" for n
     unfolding M_def apply (rule Max_ge) using that by auto
   then have i: "min (dist (x (from_nat n)) (y (from_nat n))) 1 \<le> M" if "n\<le>N" for n
     using that by force
   have "(\<Sum>n< Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1) \<le>
       (\<Sum>n< Suc N. M * (1 / 2) ^ n)"
     by (rule sum_mono, simp add: i)
   also have "... = M * (\<Sum>n<Suc N. (1 / 2) ^ n)"
     by (rule sum_distrib_left[symmetric])
   also have "... \<le> M * (\<Sum>n. (1 / 2) ^ n)"
     by (rule mult_left_mono, rule sum_le_suminf, auto simp add: summable_geometric_iff)
   also have "... = M * 2"
     using suminf_geometric[of "1/2"] by auto
   finally have **: "(\<Sum>n< Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1) \<le> 2 * M"
     by simp
 
   have "dist x y = (\<Sum>n. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
     unfolding dist_fun_def by simp
   also have "... = (\<Sum>n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)
                   + (\<Sum>n<Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
     apply (rule suminf_split_initial_segment)
     by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
   also have "... \<le> 2 * M + (1/2)^N"
     using * ** by auto
   finally show ?thesis unfolding M_def by simp
 qed
 
 lemma open_fun_contains_ball_aux:
   assumes "open (U::(('a \<Rightarrow> 'b) set))"
           "x \<in> U"
   shows "\<exists>e>0. {y. dist x y < e} \<subseteq> U"
 proof -
   have *: "openin (product_topology (\<lambda>i. euclidean) UNIV) U"
     using open_fun_def assms by auto
   obtain X where H: "Pi\<^sub>E UNIV X \<subseteq> U"
                     "\<And>i. openin euclidean (X i)"
                     "finite {i. X i \<noteq> topspace euclidean}"
                     "x \<in> Pi\<^sub>E UNIV X"
     using product_topology_open_contains_basis[OF * \<open>x \<in> U\<close>] by auto
   define I where "I = {i. X i \<noteq> topspace euclidean}"
   have "finite I" unfolding I_def using H(3) by auto
   {
     fix i
     have "x i \<in> X i" using \<open>x \<in> U\<close> H by auto
     then have "\<exists>e. e>0 \<and> ball (x i) e \<subseteq> X i"
       using \<open>openin euclidean (X i)\<close> open_openin open_contains_ball by blast
     then obtain e where "e>0" "ball (x i) e \<subseteq> X i" by blast
     define f where "f = min e (1/2)"
     have "f>0" "f<1" unfolding f_def using \<open>e>0\<close> by auto
     moreover have "ball (x i) f \<subseteq> X i" unfolding f_def using \<open>ball (x i) e \<subseteq> X i\<close> by auto
     ultimately have "\<exists>f. f > 0 \<and> f < 1 \<and> ball (x i) f \<subseteq> X i" by auto
   } note * = this
   have "\<exists>e. \<forall>i. e i > 0 \<and> e i < 1 \<and> ball (x i) (e i) \<subseteq> X i"
     by (rule choice, auto simp add: *)
   then obtain e where "\<And>i. e i > 0" "\<And>i. e i < 1" "\<And>i. ball (x i) (e i) \<subseteq> X i"
     by blast
   define m where "m = Min {(1/2)^(to_nat i) * e i|i. i \<in> I}"
   have "m > 0" if "I\<noteq>{}"
     unfolding m_def Min_gr_iff using \<open>finite I\<close> \<open>I \<noteq> {}\<close> \<open>\<And>i. e i > 0\<close> by auto
   moreover have "{y. dist x y < m} \<subseteq> U"
   proof (auto)
     fix y assume "dist x y < m"
     have "y i \<in> X i" if "i \<in> I" for i
     proof -
       have *: "summable (\<lambda>n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
         by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
       define n where "n = to_nat i"
       have "(1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1 < m"
         using \<open>dist x y < m\<close> unfolding dist_fun_def using sum_le_suminf[OF *, of "{n}"] by auto
       then have "(1/2)^(to_nat i) * min (dist (x i) (y i)) 1 < m"
         using \<open>n = to_nat i\<close> by auto
       also have "... \<le> (1/2)^(to_nat i) * e i"
         unfolding m_def apply (rule Min_le) using \<open>finite I\<close> \<open>i \<in> I\<close> by auto
       ultimately have "min (dist (x i) (y i)) 1 < e i"
         by (auto simp add: field_split_simps)
       then have "dist (x i) (y i) < e i"
         using \<open>e i < 1\<close> by auto
       then show "y i \<in> X i" using \<open>ball (x i) (e i) \<subseteq> X i\<close> by auto
     qed
     then have "y \<in> Pi\<^sub>E UNIV X" using H(1) unfolding I_def topspace_euclidean by (auto simp add: PiE_iff)
     then show "y \<in> U" using \<open>Pi\<^sub>E UNIV X \<subseteq> U\<close> by auto
   qed
   ultimately have *: "\<exists>m>0. {y. dist x y < m} \<subseteq> U" if "I \<noteq> {}" using that by auto
 
   have "U = UNIV" if "I = {}"
     using that H(1) unfolding I_def topspace_euclidean by (auto simp add: PiE_iff)
   then have "\<exists>m>0. {y. dist x y < m} \<subseteq> U" if "I = {}" using that zero_less_one by blast
   then show "\<exists>m>0. {y. dist x y < m} \<subseteq> U" using * by blast
 qed
 
 lemma ball_fun_contains_open_aux:
   fixes x::"('a \<Rightarrow> 'b)" and e::real
   assumes "e>0"
   shows "\<exists>U. open U \<and> x \<in> U \<and> U \<subseteq> {y. dist x y < e}"
 proof -
   have "\<exists>N::nat. 2^N > 8/e"
     by (simp add: real_arch_pow)
   then obtain N::nat where "2^N > 8/e" by auto
   define f where "f = e/4"
   have [simp]: "e>0" "f > 0" unfolding f_def using assms by auto
   define X::"('a \<Rightarrow> 'b set)" where "X = (\<lambda>i. if (\<exists>n\<le>N. i = from_nat n) then {z. dist (x i) z < f} else UNIV)"
   have "{i. X i \<noteq> UNIV} \<subseteq> from_nat`{0..N}"
     unfolding X_def by auto
   then have "finite {i. X i \<noteq> topspace euclidean}"
     unfolding topspace_euclidean using finite_surj by blast
   have "\<And>i. open (X i)"
     unfolding X_def using metric_space_class.open_ball open_UNIV by auto
   then have "\<And>i. openin euclidean (X i)"
     using open_openin by auto
   define U where "U = Pi\<^sub>E UNIV X"
   have "open U"
     unfolding open_fun_def product_topology_def apply (rule topology_generated_by_Basis)
     unfolding U_def using \<open>\<And>i. openin euclidean (X i)\<close> \<open>finite {i. X i \<noteq> topspace euclidean}\<close>
     by auto
   moreover have "x \<in> U"
     unfolding U_def X_def by (auto simp add: PiE_iff)
   moreover have "dist x y < e" if "y \<in> U" for y
   proof -
     have *: "dist (x (from_nat n)) (y (from_nat n)) \<le> f" if "n \<le> N" for n
       using \<open>y \<in> U\<close> unfolding U_def apply (auto simp add: PiE_iff)
       unfolding X_def using that by (metis less_imp_le mem_Collect_eq)
     have **: "Max {dist (x (from_nat n)) (y (from_nat n))|n. n \<le> N} \<le> f"
       apply (rule Max.boundedI) using * by auto
 
     have "dist x y \<le> 2 * Max {dist (x (from_nat n)) (y (from_nat n))|n. n \<le> N} + (1/2)^N"
       by (rule dist_fun_le_dist_first_terms)
     also have "... \<le> 2 * f + e / 8"
       apply (rule add_mono) using ** \<open>2^N > 8/e\<close> by(auto simp add: field_split_simps)
     also have "... \<le> e/2 + e/8"
       unfolding f_def by auto
     also have "... < e"
       by auto
     finally show "dist x y < e" by simp
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma fun_open_ball_aux:
   fixes U::"('a \<Rightarrow> 'b) set"
   shows "open U \<longleftrightarrow> (\<forall>x\<in>U. \<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> y \<in> U)"
 proof (auto)
   assume "open U"
   fix x assume "x \<in> U"
   then show "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> y \<in> U"
     using open_fun_contains_ball_aux[OF \<open>open U\<close> \<open>x \<in> U\<close>] by auto
 next
   assume H: "\<forall>x\<in>U. \<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> y \<in> U"
   define K where "K = {V. open V \<and> V \<subseteq> U}"
   {
     fix x assume "x \<in> U"
     then obtain e where e: "e>0" "{y. dist x y < e} \<subseteq> U" using H by blast
     then obtain V where V: "open V" "x \<in> V" "V \<subseteq> {y. dist x y < e}"
       using ball_fun_contains_open_aux[OF \<open>e>0\<close>, of x] by auto
     have "V \<in> K"
       unfolding K_def using e(2) V(1) V(3) by auto
     then have "x \<in> (\<Union>K)" using \<open>x \<in> V\<close> by auto
   }
   then have "(\<Union>K) = U"
     unfolding K_def by auto
   moreover have "open (\<Union>K)"
     unfolding K_def by auto
   ultimately show "open U" by simp
 qed
 
 instance proof
   fix x y::"'a \<Rightarrow> 'b" show "(dist x y = 0) = (x = y)"
   proof
     assume "x = y"
     then show "dist x y = 0" unfolding dist_fun_def using \<open>x = y\<close> by auto
   next
     assume "dist x y = 0"
     have *: "summable (\<lambda>n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
       by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
     have "(1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1 = 0" for n
       using \<open>dist x y = 0\<close> unfolding dist_fun_def by (simp add: "*" suminf_eq_zero_iff)
     then have "dist (x (from_nat n)) (y (from_nat n)) = 0" for n
       by (metis div_0 min_def nonzero_mult_div_cancel_left power_eq_0_iff
                 zero_eq_1_divide_iff zero_neq_numeral)
     then have "x (from_nat n) = y (from_nat n)" for n
       by auto
     then have "x i = y i" for i
       by (metis from_nat_to_nat)
     then show "x = y"
       by auto
   qed
 next
   text\<open>The proof of the triangular inequality is trivial, modulo the fact that we are dealing
         with infinite series, hence we should justify the convergence at each step. In this
         respect, the following simplification rule is extremely handy.\<close>
   have [simp]: "summable (\<lambda>n. (1/2)^n * min (dist (u (from_nat n)) (v (from_nat n))) 1)" for u v::"'a \<Rightarrow> 'b"
     by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
   fix x y z::"'a \<Rightarrow> 'b"
   {
     fix n
     have *: "dist (x (from_nat n)) (y (from_nat n)) \<le>
             dist (x (from_nat n)) (z (from_nat n)) + dist (y (from_nat n)) (z (from_nat n))"
       by (simp add: dist_triangle2)
     have "0 \<le> dist (y (from_nat n)) (z (from_nat n))"
       using zero_le_dist by blast
     moreover
     {
       assume "min (dist (y (from_nat n)) (z (from_nat n))) 1 \<noteq> dist (y (from_nat n)) (z (from_nat n))"
       then have "1 \<le> min (dist (x (from_nat n)) (z (from_nat n))) 1 + min (dist (y (from_nat n)) (z (from_nat n))) 1"
         by (metis (no_types) diff_le_eq diff_self min_def zero_le_dist zero_le_one)
     }
     ultimately have "min (dist (x (from_nat n)) (y (from_nat n))) 1 \<le>
             min (dist (x (from_nat n)) (z (from_nat n))) 1 + min (dist (y (from_nat n)) (z (from_nat n))) 1"
       using * by linarith
   } note ineq = this
   have "dist x y = (\<Sum>n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
     unfolding dist_fun_def by simp
   also have "... \<le> (\<Sum>n. (1/2)^n * min (dist (x (from_nat n)) (z (from_nat n))) 1
                         + (1/2)^n * min (dist (y (from_nat n)) (z (from_nat n))) 1)"
     apply (rule suminf_le)
     using ineq apply (metis (no_types, opaque_lifting) add.right_neutral distrib_left
       le_divide_eq_numeral1(1) mult_2_right mult_left_mono zero_le_one zero_le_power)
     by (auto simp add: summable_add)
   also have "... = (\<Sum>n. (1/2)^n * min (dist (x (from_nat n)) (z (from_nat n))) 1)
                   + (\<Sum>n. (1/2)^n * min (dist (y (from_nat n)) (z (from_nat n))) 1)"
     by (rule suminf_add[symmetric], auto)
   also have "... = dist x z + dist y z"
     unfolding dist_fun_def by simp
   finally show "dist x y \<le> dist x z + dist y z"
     by simp
 next
   text\<open>Finally, we show that the topology generated by the distance and the product
         topology coincide. This is essentially contained in Lemma \<open>fun_open_ball_aux\<close>,
         except that the condition to prove is expressed with filters. To deal with this,
         we copy some mumbo jumbo from Lemma \<open>eventually_uniformity_metric\<close> in
         \<^file>\<open>~~/src/HOL/Real_Vector_Spaces.thy\<close>\<close>
   fix U::"('a \<Rightarrow> 'b) set"
   have "eventually P uniformity \<longleftrightarrow> (\<exists>e>0. \<forall>x (y::('a \<Rightarrow> 'b)). dist x y < e \<longrightarrow> P (x, y))" for P
   unfolding uniformity_fun_def apply (subst eventually_INF_base)
     by (auto simp: eventually_principal subset_eq intro: bexI[of _ "min _ _"])
   then show "open U = (\<forall>x\<in>U. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> U)"
     unfolding fun_open_ball_aux by simp
 qed (simp add: uniformity_fun_def)
 
 end
 
 text \<open>Nice properties of spaces are preserved under countable products. In addition
 to first countability, second countability and metrizability, as we have seen above,
 completeness is also preserved, and therefore being Polish.\<close>
 
 instance "fun" :: (countable, complete_space) complete_space
 proof
   fix u::"nat \<Rightarrow> ('a \<Rightarrow> 'b)" assume "Cauchy u"
   have "Cauchy (\<lambda>n. u n i)" for i
-  unfolding cauchy_def proof (intro impI allI)
-    fix e assume "e>(0::real)"
+    unfolding Cauchy_def 
+  proof (intro strip)
+    fix e::real assume "e>0"
     obtain k where "i = from_nat k"
       using from_nat_to_nat[of i] by metis
     have "(1/2)^k * min e 1 > 0" using \<open>e>0\<close> by auto
     then have "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (u m) (u n) < (1/2)^k * min e 1"
-      using \<open>Cauchy u\<close> unfolding cauchy_def by blast
+      using \<open>Cauchy u\<close> by (meson Cauchy_def)
     then obtain N::nat where C: "\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (u m) (u n) < (1/2)^k * min e 1"
       by blast
     have "\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (u m i) (u n i) < e"
     proof (auto)
       fix m n::nat assume "m \<ge> N" "n \<ge> N"
       have "(1/2)^k * min (dist (u m i) (u n i)) 1
               = sum (\<lambda>p. (1/2)^p * min (dist (u m (from_nat p)) (u n (from_nat p))) 1) {k}"
         using \<open>i = from_nat k\<close> by auto
       also have "... \<le> (\<Sum>p. (1/2)^p * min (dist (u m (from_nat p)) (u n (from_nat p))) 1)"
         apply (rule sum_le_suminf)
         by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
       also have "... = dist (u m) (u n)"
         unfolding dist_fun_def by auto
       also have "... < (1/2)^k * min e 1"
         using C \<open>m \<ge> N\<close> \<open>n \<ge> N\<close> by auto
       finally have "min (dist (u m i) (u n i)) 1 < min e 1"
         by (auto simp add: field_split_simps)
       then show "dist (u m i) (u n i) < e" by auto
     qed
-    then show "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (u m i) (u n i) < e"
+    then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (u m i) (u n i) < e"
       by blast
   qed
   then have "\<exists>x. (\<lambda>n. u n i) \<longlonglongrightarrow> x" for i
     using Cauchy_convergent convergent_def by auto
   then have "\<exists>x. \<forall>i. (\<lambda>n. u n i) \<longlonglongrightarrow> x i"
     using choice by force
   then obtain x where *: "\<And>i. (\<lambda>n. u n i) \<longlonglongrightarrow> x i" by blast
   have "u \<longlonglongrightarrow> x"
   proof (rule metric_LIMSEQ_I)
     fix e assume [simp]: "e>(0::real)"
     have i: "\<exists>K. \<forall>n\<ge>K. dist (u n i) (x i) < e/4" for i
       by (rule metric_LIMSEQ_D, auto simp add: *)
     have "\<exists>K. \<forall>i. \<forall>n\<ge>K i. dist (u n i) (x i) < e/4"
       apply (rule choice) using i by auto
     then obtain K where K: "\<And>i n. n \<ge> K i \<Longrightarrow> dist (u n i) (x i) < e/4"
       by blast
 
     have "\<exists>N::nat. 2^N > 4/e"
       by (simp add: real_arch_pow)
     then obtain N::nat where "2^N > 4/e" by auto
     define L where "L = Max {K (from_nat n)|n. n \<le> N}"
     have "dist (u k) x < e" if "k \<ge> L" for k
     proof -
       have *: "dist (u k (from_nat n)) (x (from_nat n)) \<le> e / 4" if "n \<le> N" for n
       proof -
         have "K (from_nat n) \<le> L"
           unfolding L_def apply (rule Max_ge) using \<open>n \<le> N\<close> by auto
         then have "k \<ge> K (from_nat n)" using \<open>k \<ge> L\<close> by auto
         then show ?thesis using K less_imp_le by auto
       qed
       have **: "Max {dist (u k (from_nat n)) (x (from_nat n)) |n. n \<le> N} \<le> e/4"
         apply (rule Max.boundedI) using * by auto
       have "dist (u k) x \<le> 2 * Max {dist (u k (from_nat n)) (x (from_nat n)) |n. n \<le> N} + (1/2)^N"
         using dist_fun_le_dist_first_terms by auto
       also have "... \<le> 2 * e/4 + e/4"
         apply (rule add_mono)
         using ** \<open>2^N > 4/e\<close> less_imp_le by (auto simp add: field_split_simps)
       also have "... < e" by auto
       finally show ?thesis by simp
     qed
     then show "\<exists>L. \<forall>k\<ge>L. dist (u k) x < e" by blast
   qed
   then show "convergent u" using convergent_def by blast
 qed
 
 instance "fun" :: (countable, polish_space) polish_space
   by standard
 
 end
\ No newline at end of file
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,5516 +1,5517 @@
 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
       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"
     using Stone_Weierstrass_polynomial_function_subspace [OF _ contf _ \<open>subspace T\<close>, of "1/2"] 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)"
   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"
     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'"
       using \<open>T \<noteq> {}\<close>  spheremap_lemma3 [OF \<open>bounded T\<close> \<open>convex T\<close> subspace_UNIV, where 'b='a] 
       by (force 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)"
       using spheremap_lemma2 homotopy_eqv_cohomotopic_triviality_null[OF relS] 
       using homotopy_eqv_homotopic_triviality_null_imp [OF relT contf fim]
       by (metis \<open>S' \<subseteq> T'\<close> \<open>subspace S'\<close> \<open>subspace T'\<close> dimST')
     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
       using 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 (auto simp 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
   moreover have "continuous_on (S \<union> \<Union> \<F>) (\<lambda>x. if x \<in> S then f x else g x)"
     by (auto simp: insert closed_Union contf contg  intro: fg continuous_on_cases)
   ultimately show ?case
     by (smt (verit, del_insts) Int_iff UnE complete_lattice_class.Sup_insert feq fim geq gim image_subset_iff)
 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 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))"
           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 clarsimp
         by (smt (verit, ccfv_SIG) IntI face_of_aff_dim_lt face_of_imp_convex [of X] face_of_imp_convex [of Y] 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"
     by (simp add: \<H>_def) (smt (verit) \<open>\<G> \<subseteq> \<F>\<close> DiffE face' face_of_Int_subface in_mono inf.idem)
   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
       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)"
           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
     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"
         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>
 
 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"
       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"
         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))"
       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 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"
       by (metis C \<open>locally connected U\<close> clo closedin_def locally_connected_open_component topspace_euclidean_subtopology)
     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>S \<subseteq> U\<close> \<open>a \<in> C\<close> affine_hull_eq affine_hull_openin assms(2) empty_iff hull_subset le_sup_iff opeUC)
       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})"
     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"
       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"
         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"
         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"
         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)
         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
         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
           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"
       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 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)
         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"])
       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 (metis (no_types, lifting) \<open>locally connected U\<close> clo closedin_def locally_connected_open_component mem_Collect_eq topspace_euclidean_subtopology)
     show "closedin (top_of_set U) (U - UF)"
       unfolding UF_def by (force intro: openin_delete *)
     have "(\<Union>x\<in>F. x - {a x}) \<inter> S = {}" "\<Union> G \<subseteq> U"
       using in_components_subset by (auto simp: F_def G_def)
     moreover have "\<Union> G \<inter> UF = {}"
       using components_nonoverlap by (fastforce simp: F_def G_def UF_def)
     ultimately show "S \<union> \<Union>G = (U - UF) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
       using UF_def \<open>S \<subseteq> U\<close> by auto
   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)"
     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))"
     proof
       show "\<Union> ((\<union>) S ` F) \<inter> (S \<union> \<Union> G \<union> (S \<union> UF)) \<subseteq> S \<union> UF"
         using components_eq [of _ "U-S"]
         by (auto simp add: F_def G_def UF_def disjoint_iff_not_equal)
     qed (use UF_def \<open>C0 \<in> F\<close> in blast)
   qed
   have SUG: "S \<union> \<Union>G \<subseteq> U - K"
     using \<open>S \<subseteq> U\<close> K in_components_subset[of _ "U-S"] by (force simp: G_def disjnt_iff)
   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"
     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> components_eq [of _ "U-S"] by (fastforce simp add: F_def G_def UF_def)
   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 \<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"
       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
         by (simp add: LU_def disjoint_iff) (meson False bounded_cbox bounded_subset subset_iff 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
     have "convex (cbox (- c) c \<inter> T)"
       by (simp add: affine_imp_convex assms(4) convex_Int)
     then show "continuous_on (T - K \<inter> cbox (- (b + One)) (b + One)) (g \<circ> closest_point (cbox (-c) c \<inter> T))"
       using cloTK clo_cT cT_ne
       by (intro continuous_on_compose continuous_on_closest_point continuous_on_subset [OF contg]; force)
     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
       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
     using 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 by (fastforce simp: assms False that dest: dis)
 qed
 
 corollary extend_map_UNIV_to_sphere_cofinite:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   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"
   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"
   using extend_map_UNIV_to_sphere_cofinite [OF aff \<open>0 \<le> r\<close> \<open>compact S\<close> contf fim, of "{}"]
   by (metis Compl_empty_eq dis subset_empty)
 
 
 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 "\<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 have "\<forall>c\<in>components (- S). \<not> bounded c \<Longrightarrow> connected (- S)"
     by (metis "2" assms(1) cobounded_has_bounded_component compact_imp_bounded double_complement)
   with R show ?lhs
     by (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>])
 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
   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 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)"
       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
       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>)
   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)
       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)"
       by (smt (verit) comp_apply inj_on_def \<open>U \<subseteq> S\<close> fim homeomorphism_apply2 homhk image_iff 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, opaque_lifting) 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"
       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"
         by (smt (verit, ccfv_SIG) comp_apply fim inj_on_def homeomorphism_apply2 [OF homkh] image_subset_iff 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"
       by (smt (verit, best) comp_apply inj_on_def fim homeomorphism_apply1 homhk image_subset_iff 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"
   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)"
 proof -
   have "DIM(real) \<le> DIM('a)"
     by simp
   then show ?thesis
     using invariance_of_domain_gen assms continuous_on_subset subset_inj_on by metis
 qed
 
 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)
   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
     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)"
 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 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 (use assms in auto)
 
 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"
     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"
     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
   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
   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
     using False assms homeomorphic_aff_dim_le by blast
   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
     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 by (auto simp: homeomorphic_minimal)
   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
     using False assms homeomorphic_aff_dim_le by blast
   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
     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
+      using uniformly_continuous_imp_Cauchy_continuous \<open>Cauchy \<sigma>\<close> \<sigma> contf
+      unfolding Cauchy_continuous_on_def 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 \<section>: "Arg2pi z \<le> 2 * pi" for z
         by (simp add: Arg2pi order_le_less)
       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])
         by (auto simp: Arg2pi \<section>)
       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])
         by (auto simp: Arg2pi \<section>)
       show "continuous_on ({0..1} \<times> sphere 0 1) j"
         apply (simp add: j_def)
         apply (subst eq)
         apply (rule continuous_on_cases_local)
         using Arg2pi_eq h01
         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 -
   let ?h = "(\<lambda>t. complex_of_real (2 * pi * t) * \<i>)"
   have "homotopic_loops S (f \<circ> exp \<circ> ?h) (f \<circ> exp \<circ> ?h) \<and> homotopic_loops S (g \<circ> exp \<circ> ?h) (g \<circ> exp \<circ> ?h)"
     by (simp add: homotopic_circlemaps_imp_homotopic_loops contf fim contg gim)
   then have "homotopic_loops S (f \<circ> exp \<circ> ?h) (g \<circ> exp \<circ> ?h)"
     using S simply_connected_homotopic_loops by blast
   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)"
   by (metis conth continuous_on_const him hom image_subset_iff)
 
 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"
       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>))"
       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)"
   by (metis simply_connected_eq_homotopic_circlemaps1 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)))"
   by (metis simply_connected_eq_homotopic_circlemaps simply_connected_eq_homotopic_circlemaps2a 
       simply_connected_eq_homotopic_circlemaps3 simply_connected_imp_path_connected)
 
 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 loop_free_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))"
 proof -
   have "DIM('a) - Suc 0 = DIM('b) - Suc 0 \<Longrightarrow> DIM('a) = DIM('b)"
     by (metis DIM_positive Suc_pred)
   then show ?thesis
     by (auto simp: homeomorphic_affine_sets_eq affine_hyperplane assms)
 qed
 
 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 by (auto simp: aff_dim_cball)
     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>])
     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)"
     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}))"
       by (smt (verit, del_insts) SU homeomorphism_def inj_on_def injf gh Diff_iff comp_apply imageE subset_iff)
     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}))"
       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)"
     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}))"
       by (smt (verit, del_insts) SU homeomorphism_def inj_on_def injf jk Diff_iff comp_apply imageE subset_iff)
     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})"
         by (metis Diff_mono SU gh homeomorphism_image2 homeomorphism_of_subsets set_eq_subset)
     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})"
       using homeomorphism_apply1 [OF jk] SU
       by (meson Diff_mono homeomorphism_def homeomorphism_of_subsets jk subset_refl)
     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)"
     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)"
         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
       by (metis DIM_ge_Suc0 One_nat_def Suc_1 not_less_eq_eq numeral_3_eq_3 order_antisym_conv)
   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 "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"
       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
   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"
     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})"
     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::nat 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
             using \<open>j \<noteq> 0 \<close> \<open>j < n\<close> True
             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
             unfolding  seq
             using \<open>j < n\<close> False
             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
     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"
         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 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 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 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 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
           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
       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 
           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 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 "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 twopi where "twopi \<equiv> \<lambda>n. of_real (2 * of_int n * pi) * \<i>"
     define \<V> where "\<V> \<equiv> range (\<lambda>n. (\<lambda>x. x + twopi n) ` (ball(Ln z) 1))"
     have exp_eq': "exp w = exp z \<longleftrightarrow> (\<exists>n::int. w = z + twopi n)" for z w
       by (simp add: exp_eq twopi_def)
     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
       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 UV: "\<Union>\<V> = exp -` exp ` ball (Ln z) 1"
         by (force simp: \<V>_def twopi_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 "2 \<le> cmod (twopi m -twopi n)" if "m \<noteq> n" for m n
       proof -
         have "1 \<le> abs (m - n)"
           using that by linarith
         then have "1 \<le> cmod (of_int m - of_int n) * 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 m - of_int n) * of_real pi"
           using pi_ge_two
            by (intro mult_left_mono) auto
         also have "... \<le> cmod ((of_int m - of_int n) * of_real pi * \<i>)"
           by (simp add: norm_mult)
         also have "... \<le> cmod (of_int m * of_real pi * \<i> - of_int n * of_real pi * \<i>)"
           by (simp add: algebra_simps)
         finally have "1 \<le> cmod (of_int m * of_real pi * \<i> - of_int n * of_real pi * \<i>)" .
         then have "2 * 1 \<le> cmod (2 * (of_int m * of_real pi * \<i> - of_int n * 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 twopi_def)
       qed
       then show "disjoint \<V>"
         unfolding \<V>_def pairwise_def disjnt_iff
         by (smt (verit, best) add.commute add_diff_cancel_left' add_diff_eq dist_commute dist_complex_def dist_triangle imageE mem_ball)
       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 + twopi n) ` (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)"
           using pi_ge_two inj_on_subset [OF inj_on_exp_pi [of "Ln z"]]
           by (simp add: subset_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"
           by (smt (verit) n exp_eq' image_cong image_image)
         have \<gamma>exp: "\<gamma> (exp x) + twopi n = x" if "x \<in> u" for x
         proof -
           have "exp x = exp (x - twopi n)"
             using exp_eq' by auto
           then have "\<gamma> (exp x) = \<gamma> (exp (x - twopi n))"
             by simp
           also have "... = x - twopi 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) + twopi n) = exp x" if "dist (Ln z) x < 1" for x
           by (metis \<gamma>exp exp_eq' imageI mem_ball n that)
         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 + twopi n)"
           by (intro continuous_intros)
         have "homeomorphism u (exp ` ball (Ln z) 1) exp ((\<lambda>x. x + twopi n) \<circ> \<gamma>)"
           unfolding homeomorphism_def
           apply (intro conjI ballI eq1 continuous_on_exp [OF continuous_on_id])
              apply (auto simp: \<gamma>exp exp2n cont n)
            apply (force simp: image_iff homeomorphism_apply1 [OF hom])+
           done
         then show "\<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q" by metis
       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
     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)
     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)"
     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_eq [OF homotopic_with_sphere_times [OF L cont]]
       by (auto simp: divide_inverse norm_inverse)
     with L show ?rhs
       by (simp add: homotopic_with_imp_continuous 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> {}}"
     using lower_hemicontinuous fST clo by blast
   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))"
     by (meson compactE finite_subset_image Elementary_Metric_Spaces.open_ball compactE_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"
       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])
   moreover have "\<And>x. r = dist a x \<Longrightarrow> f x = k (h (f x))"
     by (metis fim hk homeomorphism_def image_subset_iff mem_sphere)
   ultimately have "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. k c)"
     by (auto intro: homotopic_with_eq)
   then show ?thesis
     by (metis that)
 qed
 
 
 subsection\<open>Holomorphic logarithms and square roots\<close>
 
 lemma g_imp_holomorphic_log:
   assumes holf: "f holomorphic_on 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)
   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)"
         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"
       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
 
 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])
   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"
       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"
       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)
       with that show ?thesis
         by (simp add: cos_exp_eq flip: fgeq)
     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 (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"
   by (smt (verit) Borsukian_retraction_gen retract_of_def retraction retraction_def retraction_subset)
 
 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"
   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"
   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 (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 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"
   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)"
   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 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)"
         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)"
         by (metis contg conth continuous_on_diff continuous_on_subset inf_le1 inf_le2)
       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 * contg conth continuous_intros conjI)
        apply (auto simp: algebra_simps fg fh exp_add)
       done
   qed
 qed
 
 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)"
   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 
   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')
       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])
         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 = {}"
       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"
         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))"
         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))"
         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
   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" "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"
     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"
       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"
       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, opaque_lifting) 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"
         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 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> by (simp add: homotopic_constant_maps path_connected_component)
       then show ?thesis
         using c homotopic_with_symD homotopic_with_trans by blast
     qed auto
   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 (simp add: Borsukian_separation_compact closed_subset compact_imp_closed unicoherentD)
 qed
 
 end
diff --git a/src/HOL/Analysis/Lipschitz.thy b/src/HOL/Analysis/Lipschitz.thy
--- a/src/HOL/Analysis/Lipschitz.thy
+++ b/src/HOL/Analysis/Lipschitz.thy
@@ -1,839 +1,850 @@
 (*  Title:      HOL/Analysis/Lipschitz.thy
     Author:     Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
     Author:     Fabian Immler, TU München
 *)
 section \<open>Lipschitz Continuity\<close>
 
 theory Lipschitz
   imports
-    Derivative
+    Derivative Abstract_Metric_Spaces
 begin
 
 definition\<^marker>\<open>tag important\<close> lipschitz_on
   where "lipschitz_on C U f \<longleftrightarrow> (0 \<le> C \<and> (\<forall>x \<in> U. \<forall>y\<in>U. dist (f x) (f y) \<le> C * dist x y))"
 
 bundle lipschitz_syntax begin
 notation\<^marker>\<open>tag important\<close> lipschitz_on ("_-lipschitz'_on" [1000])
 end
 bundle no_lipschitz_syntax begin
 no_notation lipschitz_on ("_-lipschitz'_on" [1000])
 end
 
 unbundle lipschitz_syntax
 
 lemma lipschitz_onI: "L-lipschitz_on X f"
   if "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> dist (f x) (f y) \<le> L * dist x y" "0 \<le> L"
   using that by (auto simp: lipschitz_on_def)
 
 lemma lipschitz_onD:
   "dist (f x) (f y) \<le> L * dist x y"
   if "L-lipschitz_on X f" "x \<in> X" "y \<in> X"
   using that by (auto simp: lipschitz_on_def)
 
 lemma lipschitz_on_nonneg:
   "0 \<le> L" if "L-lipschitz_on X f"
   using that by (auto simp: lipschitz_on_def)
 
 lemma lipschitz_on_normD:
   "norm (f x - f y) \<le> L * norm (x - y)"
   if "lipschitz_on L X f" "x \<in> X" "y \<in> X"
   using lipschitz_onD[OF that]
   by (simp add: dist_norm)
 
 lemma lipschitz_on_mono: "L-lipschitz_on D f" if "M-lipschitz_on E f" "D \<subseteq> E" "M \<le> L"
   using that
   by (force simp: lipschitz_on_def intro: order_trans[OF _ mult_right_mono])
 
 lemmas lipschitz_on_subset = lipschitz_on_mono[OF _ _ order_refl]
   and lipschitz_on_le = lipschitz_on_mono[OF _ order_refl]
 
 lemma lipschitz_on_leI:
   "L-lipschitz_on X f"
   if "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> x \<le> y \<Longrightarrow> dist (f x) (f y) \<le> L * dist x y"
     "0 \<le> L"
   for f::"'a::{linorder_topology, ordered_real_vector, metric_space} \<Rightarrow> 'b::metric_space"
 proof (rule lipschitz_onI)
   fix x y assume xy: "x \<in> X" "y \<in> X"
   consider "y \<le> x" | "x \<le> y"
     by (rule le_cases)
   then show "dist (f x) (f y) \<le> L * dist x y"
   proof cases
     case 1
     then have "dist (f y) (f x) \<le> L * dist y x"
       by (auto intro!: that xy)
     then show ?thesis
       by (simp add: dist_commute)
   qed (auto intro!: that xy)
 qed fact
 
 lemma lipschitz_on_concat:
   fixes a b c::real
   assumes f: "L-lipschitz_on {a .. b} f"
   assumes g: "L-lipschitz_on {b .. c} g"
   assumes fg: "f b = g b"
   shows "lipschitz_on L {a .. c} (\<lambda>x. if x \<le> b then f x else g x)"
     (is "lipschitz_on _ _ ?f")
 proof (rule lipschitz_on_leI)
   fix x y
   assume x: "x \<in> {a..c}" and y: "y \<in> {a..c}" and xy: "x \<le> y"
   consider "x \<le> b \<and> b < y" | "x \<ge> b \<or> y \<le> b" by arith
   then show "dist (?f x) (?f y) \<le> L * dist x y"
   proof cases
     case 1
     have "dist (f x) (g y) \<le> dist (f x) (f b) + dist (g b) (g y)"
       unfolding fg by (rule dist_triangle)
     also have "dist (f x) (f b) \<le> L * dist x b"
       using 1 x
       by (auto intro!: lipschitz_onD[OF f])
     also have "dist (g b) (g y) \<le> L * dist b y"
       using 1 x y
       by (auto intro!: lipschitz_onD[OF g] lipschitz_onD[OF f])
     finally have "dist (f x) (g y) \<le> L * dist x b + L * dist b y"
       by simp
     also have "\<dots> = L * (dist x b + dist b y)"
       by (simp add: algebra_simps)
     also have "dist x b + dist b y = dist x y"
       using 1 x y
       by (auto simp: dist_real_def abs_real_def)
     finally show ?thesis
       using 1 by simp
   next
     case 2
     with lipschitz_onD[OF f, of x y] lipschitz_onD[OF g, of x y] x y xy
     show ?thesis
       by (auto simp: fg)
   qed
 qed (rule lipschitz_on_nonneg[OF f])
 
 lemma lipschitz_on_concat_max:
   fixes a b c::real
   assumes f: "L-lipschitz_on {a .. b} f"
   assumes g: "M-lipschitz_on {b .. c} g"
   assumes fg: "f b = g b"
   shows "(max L M)-lipschitz_on {a .. c} (\<lambda>x. if x \<le> b then f x else g x)"
 proof -
   have "lipschitz_on (max L M) {a .. b} f" "lipschitz_on (max L M) {b .. c} g"
     by (auto intro!: lipschitz_on_mono[OF f order_refl] lipschitz_on_mono[OF g order_refl])
   from lipschitz_on_concat[OF this fg] show ?thesis .
 qed
 
+text \<open>Equivalence between "abstract" and "type class" Lipschitz notions, 
+for all types in the metric space class\<close>
+lemma Lipschitz_map_euclidean [simp]:
+  "Lipschitz_continuous_map euclidean_metric euclidean_metric f
+     \<longleftrightarrow> (\<exists>B. lipschitz_on B UNIV f)"  (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (force simp add: Lipschitz_continuous_map_pos lipschitz_on_def less_le_not_le)
+  show "?rhs \<Longrightarrow> ?lhs"
+  by (metis Lipschitz_continuous_map_def lipschitz_onD mdist_euclidean_metric mspace_euclidean_metric top_greatest)
+qed
 
 subsubsection \<open>Continuity\<close>
 
 proposition lipschitz_on_uniformly_continuous:
   assumes "L-lipschitz_on X f"
   shows "uniformly_continuous_on X f"
   unfolding uniformly_continuous_on_def
 proof safe
   fix e::real
   assume "0 < e"
   from assms have l: "(L+1)-lipschitz_on X f"
     by (rule lipschitz_on_mono) auto
   show "\<exists>d>0. \<forall>x\<in>X. \<forall>x'\<in>X. dist x' x < d \<longrightarrow> dist (f x') (f x) < e"
     using lipschitz_onD[OF l] lipschitz_on_nonneg[OF assms] \<open>0 < e\<close>
     by (force intro!: exI[where x="e/(L + 1)"] simp: field_simps)
 qed
 
 proposition lipschitz_on_continuous_on:
   "continuous_on X f" if "L-lipschitz_on X f"
   by (rule uniformly_continuous_imp_continuous[OF lipschitz_on_uniformly_continuous[OF that]])
 
 lemma lipschitz_on_continuous_within:
   "continuous (at x within X) f" if "L-lipschitz_on X f" "x \<in> X"
   using lipschitz_on_continuous_on[OF that(1)] that(2)
   by (auto simp: continuous_on_eq_continuous_within)
 
 subsubsection \<open>Differentiable functions\<close>
 
 proposition bounded_derivative_imp_lipschitz:
   assumes "\<And>x. x \<in> X \<Longrightarrow> (f has_derivative f' x) (at x within X)"
   assumes convex: "convex X"
   assumes "\<And>x. x \<in> X \<Longrightarrow> onorm (f' x) \<le> C" "0 \<le> C"
   shows "C-lipschitz_on X f"
 proof (rule lipschitz_onI)
   show "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> dist (f x) (f y) \<le> C * dist x y"
     by (auto intro!: assms differentiable_bound[unfolded dist_norm[symmetric], OF convex])
 qed fact
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Structural introduction rules\<close>
 
 named_theorems lipschitz_intros "structural introduction rules for Lipschitz controls"
 
 lemma lipschitz_on_compose [lipschitz_intros]:
   "(D * C)-lipschitz_on U (g o f)"
   if f: "C-lipschitz_on U f" and g: "D-lipschitz_on (f`U) g"
 proof (rule lipschitz_onI)
   show "D* C \<ge> 0" using lipschitz_on_nonneg[OF f] lipschitz_on_nonneg[OF g] by auto
   fix x y assume H: "x \<in> U" "y \<in> U"
   have "dist (g (f x)) (g (f y)) \<le> D * dist (f x) (f y)"
     apply (rule lipschitz_onD[OF g]) using H by auto
   also have "... \<le> D * C * dist x y"
     using mult_left_mono[OF lipschitz_onD(1)[OF f H] lipschitz_on_nonneg[OF g]] by auto
   finally show "dist ((g \<circ> f) x) ((g \<circ> f) y) \<le> D * C* dist x y"
     unfolding comp_def by (auto simp add: mult.commute)
 qed
 
 lemma lipschitz_on_compose2:
   "(D * C)-lipschitz_on U (\<lambda>x. g (f x))"
   if "C-lipschitz_on U f" "D-lipschitz_on (f`U) g"
   using lipschitz_on_compose[OF that] by (simp add: o_def)
 
 lemma lipschitz_on_cong[cong]:
   "C-lipschitz_on U g \<longleftrightarrow> D-lipschitz_on V f"
   if "C = D" "U = V" "\<And>x. x \<in> V \<Longrightarrow> g x = f x"
   using that by (auto simp: lipschitz_on_def)
 
 lemma lipschitz_on_transform:
   "C-lipschitz_on U g"
   if "C-lipschitz_on U f"
     "\<And>x. x \<in> U \<Longrightarrow> g x = f x"
   using that
   by simp
 
 lemma lipschitz_on_empty_iff[simp]: "C-lipschitz_on {} f \<longleftrightarrow> C \<ge> 0"
   by (auto simp: lipschitz_on_def)
 
 lemma lipschitz_on_insert_iff[simp]:
   "C-lipschitz_on (insert y X) f \<longleftrightarrow>
     C-lipschitz_on X f \<and> (\<forall>x \<in> X. dist (f x) (f y) \<le> C * dist x y)"
   by (auto simp: lipschitz_on_def dist_commute)
 
 lemma lipschitz_on_singleton [lipschitz_intros]: "C \<ge> 0 \<Longrightarrow> C-lipschitz_on {x} f"
   and lipschitz_on_empty [lipschitz_intros]: "C \<ge> 0 \<Longrightarrow> C-lipschitz_on {} f"
   by simp_all
 
 lemma lipschitz_on_id [lipschitz_intros]: "1-lipschitz_on U (\<lambda>x. x)"
   by (auto simp: lipschitz_on_def)
 
 lemma lipschitz_on_constant [lipschitz_intros]: "0-lipschitz_on U (\<lambda>x. c)"
   by (auto simp: lipschitz_on_def)
 
 lemma lipschitz_on_add [lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow>'b::real_normed_vector"
   assumes "C-lipschitz_on U f"
     "D-lipschitz_on U g"
   shows "(C+D)-lipschitz_on U (\<lambda>x. f x + g x)"
 proof (rule lipschitz_onI)
   show "C + D \<ge> 0"
     using lipschitz_on_nonneg[OF assms(1)] lipschitz_on_nonneg[OF assms(2)] by auto
   fix x y assume H: "x \<in> U" "y \<in> U"
   have "dist (f x + g x) (f y + g y) \<le> dist (f x) (f y) + dist (g x) (g y)"
     by (simp add: dist_triangle_add)
   also have "... \<le> C * dist x y + D * dist x y"
     using lipschitz_onD(1)[OF assms(1) H] lipschitz_onD(1)[OF assms(2) H] by auto
   finally show "dist (f x + g x) (f y + g y) \<le> (C+D) * dist x y" by (auto simp add: algebra_simps)
 qed
 
 lemma lipschitz_on_cmult [lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow> 'b::real_normed_vector"
   assumes "C-lipschitz_on U f"
   shows "(abs(a) * C)-lipschitz_on U (\<lambda>x. a *\<^sub>R f x)"
 proof (rule lipschitz_onI)
   show "abs(a) * C \<ge> 0" using lipschitz_on_nonneg[OF assms(1)] by auto
   fix x y assume H: "x \<in> U" "y \<in> U"
   have "dist (a *\<^sub>R f x) (a *\<^sub>R f y) = abs(a) * dist (f x) (f y)"
     by (metis dist_norm norm_scaleR real_vector.scale_right_diff_distrib)
   also have "... \<le> abs(a) * C * dist x y"
     using lipschitz_onD(1)[OF assms(1) H] by (simp add: Groups.mult_ac(1) mult_left_mono)
   finally show "dist (a *\<^sub>R f x) (a *\<^sub>R f y) \<le> \<bar>a\<bar> * C * dist x y" by auto
 qed
 
 lemma lipschitz_on_cmult_real [lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow> real"
   assumes "C-lipschitz_on U f"
   shows "(abs(a) * C)-lipschitz_on U (\<lambda>x. a * f x)"
   using lipschitz_on_cmult[OF assms] by auto
 
 lemma lipschitz_on_cmult_nonneg [lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow> 'b::real_normed_vector"
   assumes "C-lipschitz_on U f"
     "a \<ge> 0"
   shows "(a * C)-lipschitz_on U (\<lambda>x. a *\<^sub>R f x)"
   using lipschitz_on_cmult[OF assms(1), of a] assms(2) by auto
 
 lemma lipschitz_on_cmult_real_nonneg [lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow> real"
   assumes "C-lipschitz_on U f"
     "a \<ge> 0"
   shows "(a * C)-lipschitz_on U (\<lambda>x. a * f x)"
   using lipschitz_on_cmult_nonneg[OF assms] by auto
 
 lemma lipschitz_on_cmult_upper [lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow> 'b::real_normed_vector"
   assumes "C-lipschitz_on U f"
     "abs(a) \<le> D"
   shows "(D * C)-lipschitz_on U (\<lambda>x. a *\<^sub>R f x)"
   apply (rule lipschitz_on_mono[OF lipschitz_on_cmult[OF assms(1), of a], of _ "D * C"])
   using assms(2) lipschitz_on_nonneg[OF assms(1)] mult_right_mono by auto
 
 lemma lipschitz_on_cmult_real_upper [lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow> real"
   assumes "C-lipschitz_on U f"
     "abs(a) \<le> D"
   shows "(D * C)-lipschitz_on U (\<lambda>x. a * f x)"
   using lipschitz_on_cmult_upper[OF assms] by auto
 
 lemma lipschitz_on_minus[lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow>'b::real_normed_vector"
   assumes "C-lipschitz_on U f"
   shows "C-lipschitz_on U (\<lambda>x. - f x)"
   by (metis (mono_tags, lifting) assms dist_minus lipschitz_on_def)
 
 lemma lipschitz_on_minus_iff[simp]:
   "L-lipschitz_on X (\<lambda>x. - f x) \<longleftrightarrow> L-lipschitz_on X f"
   "L-lipschitz_on X (- f) \<longleftrightarrow> L-lipschitz_on X f"
   for f::"'a::metric_space \<Rightarrow>'b::real_normed_vector"
   using lipschitz_on_minus[of L X f] lipschitz_on_minus[of L X "-f"]
   by auto
 
 lemma lipschitz_on_diff[lipschitz_intros]:
   fixes f::"'a::metric_space \<Rightarrow>'b::real_normed_vector"
   assumes "C-lipschitz_on U f" "D-lipschitz_on U g"
   shows "(C + D)-lipschitz_on U (\<lambda>x. f x - g x)"
   using lipschitz_on_add[OF assms(1) lipschitz_on_minus[OF assms(2)]] by auto
 
 lemma lipschitz_on_closure [lipschitz_intros]:
   assumes "C-lipschitz_on U f" "continuous_on (closure U) f"
   shows "C-lipschitz_on (closure U) f"
 proof (rule lipschitz_onI)
   show "C \<ge> 0" using lipschitz_on_nonneg[OF assms(1)] by simp
   fix x y assume "x \<in> closure U" "y \<in> closure U"
   obtain u v::"nat \<Rightarrow> 'a" where *: "\<And>n. u n \<in> U" "u \<longlonglongrightarrow> x"
                                    "\<And>n. v n \<in> U" "v \<longlonglongrightarrow> y"
     using \<open>x \<in> closure U\<close> \<open>y \<in> closure U\<close> unfolding closure_sequential by blast
   have a: "(\<lambda>n. f (u n)) \<longlonglongrightarrow> f x"
     using *(1) *(2) \<open>x \<in> closure U\<close> \<open>continuous_on (closure U) f\<close>
     unfolding comp_def continuous_on_closure_sequentially[of U f] by auto
   have b: "(\<lambda>n. f (v n)) \<longlonglongrightarrow> f y"
     using *(3) *(4) \<open>y \<in> closure U\<close> \<open>continuous_on (closure U) f\<close>
     unfolding comp_def continuous_on_closure_sequentially[of U f] by auto
   have l: "(\<lambda>n. C * dist (u n) (v n) - dist (f (u n)) (f (v n))) \<longlonglongrightarrow> C * dist x y - dist (f x) (f y)"
     by (intro tendsto_intros * a b)
   have "C * dist (u n) (v n) - dist (f (u n)) (f (v n)) \<ge> 0" for n
     using lipschitz_onD(1)[OF assms(1) \<open>u n \<in> U\<close> \<open>v n \<in> U\<close>] by simp
   then have "C * dist x y - dist (f x) (f y) \<ge> 0" using LIMSEQ_le_const[OF l, of 0] by auto
   then show "dist (f x) (f y) \<le> C * dist x y" by auto
 qed
 
 lemma lipschitz_on_Pair[lipschitz_intros]:
   assumes f: "L-lipschitz_on A f"
   assumes g: "M-lipschitz_on A g"
   shows "(sqrt (L\<^sup>2 + M\<^sup>2))-lipschitz_on A (\<lambda>a. (f a, g a))"
 proof (rule lipschitz_onI, goal_cases)
   case (1 x y)
   have "dist (f x, g x) (f y, g y) = sqrt ((dist (f x) (f y))\<^sup>2 + (dist (g x) (g y))\<^sup>2)"
     by (auto simp add: dist_Pair_Pair real_le_lsqrt)
   also have "\<dots> \<le> sqrt ((L * dist x y)\<^sup>2 + (M * dist x y)\<^sup>2)"
     by (auto intro!: real_sqrt_le_mono add_mono power_mono 1 lipschitz_onD f g)
   also have "\<dots> \<le> sqrt (L\<^sup>2 + M\<^sup>2) * dist x y"
     by (auto simp: power_mult_distrib ring_distribs[symmetric] real_sqrt_mult)
   finally show ?case .
 qed simp
 
 lemma lipschitz_extend_closure:
   fixes f::"('a::metric_space) \<Rightarrow> ('b::complete_space)"
   assumes "C-lipschitz_on U f"
   shows "\<exists>g. C-lipschitz_on (closure U) g \<and> (\<forall>x\<in>U. g x = f x)"
 proof -
   obtain g where g: "\<And>x. x \<in> U \<Longrightarrow> g x = f x" "uniformly_continuous_on (closure U) g"
     using uniformly_continuous_on_extension_on_closure[OF lipschitz_on_uniformly_continuous[OF assms]] by metis
   have "C-lipschitz_on (closure U) g"
     apply (rule lipschitz_on_closure, rule lipschitz_on_transform[OF assms])
     using g uniformly_continuous_imp_continuous[OF g(2)] by auto
   then show ?thesis using g(1) by auto
 qed
 
 lemma (in bounded_linear) lipschitz_boundE:
   obtains B where "B-lipschitz_on A f"
 proof -
   from nonneg_bounded
   obtain B where B: "B \<ge> 0" "\<And>x. norm (f x) \<le> B * norm x"
     by (auto simp: ac_simps)
   have "B-lipschitz_on A f"
     by (auto intro!: lipschitz_onI B simp: dist_norm diff[symmetric])
   thus ?thesis ..
 qed
 
 
 subsection \<open>Local Lipschitz continuity\<close>
 
 text \<open>Given a function defined on a real interval, it is Lipschitz-continuous if and only if
 it is locally so, as proved in the following lemmas. It is useful especially for
 piecewise-defined functions: if each piece is Lipschitz, then so is the whole function.
 The same goes for functions defined on geodesic spaces, or more generally on geodesic subsets
 in a metric space (for instance convex subsets in a real vector space), and this follows readily
 from the real case, but we will not prove it explicitly.
 
 We give several variations around this statement. This is essentially a connectedness argument.\<close>
 
 lemma locally_lipschitz_imp_lipschitz_aux:
   fixes f::"real \<Rightarrow> ('a::metric_space)"
   assumes "a \<le> b"
           "continuous_on {a..b} f"
           "\<And>x. x \<in> {a..<b} \<Longrightarrow> \<exists>y \<in> {x<..b}. dist (f y) (f x) \<le> M * (y-x)"
   shows "dist (f b) (f a) \<le> M * (b-a)"
 proof -
   define A where "A = {x \<in> {a..b}. dist (f x) (f a) \<le> M * (x-a)}"
   have *: "A = (\<lambda>x. M * (x-a) - dist (f x) (f a))-`{0..} \<inter> {a..b}"
     unfolding A_def by auto
   have "a \<in> A" unfolding A_def using \<open>a \<le> b\<close> by auto
   then have "A \<noteq> {}" by auto
   moreover have "bdd_above A" unfolding A_def by auto
   moreover have "closed A" unfolding * by (rule closed_vimage_Int, auto intro!: continuous_intros assms)
   ultimately have "Sup A \<in> A" by (rule closed_contains_Sup)
   have "Sup A = b"
   proof (rule ccontr)
     assume "Sup A \<noteq> b"
     define x where "x = Sup A"
     have I: "dist (f x) (f a) \<le> M * (x-a)" using \<open>Sup A \<in> A\<close> x_def A_def by auto
     have "x \<in> {a..<b}" unfolding x_def using \<open>Sup A \<in> A\<close> \<open>Sup A \<noteq> b\<close> A_def by auto
     then obtain y where J: "y \<in> {x<..b}" "dist (f y) (f x) \<le> M * (y-x)" using assms(3) by blast
     have "dist (f y) (f a) \<le> dist (f y) (f x) + dist (f x) (f a)" by (rule dist_triangle)
     also have "... \<le> M * (y-x) + M * (x-a)" using I J(2) by auto
     finally have "dist (f y) (f a) \<le> M * (y-a)" by (auto simp add: algebra_simps)
     then have "y \<in> A" unfolding A_def using \<open>y \<in> {x<..b}\<close> \<open>x \<in> {a..<b}\<close> by auto
     then have "y \<le> Sup A" by (rule cSup_upper, auto simp: A_def)
     then show False using \<open>y \<in> {x<..b}\<close> x_def by auto
   qed
   then show ?thesis using \<open>Sup A \<in> A\<close> A_def by auto
 qed
 
 lemma locally_lipschitz_imp_lipschitz:
   fixes f::"real \<Rightarrow> ('a::metric_space)"
   assumes "continuous_on {a..b} f"
           "\<And>x y. x \<in> {a..<b} \<Longrightarrow> y > x \<Longrightarrow> \<exists>z \<in> {x<..y}. dist (f z) (f x) \<le> M * (z-x)"
           "M \<ge> 0"
   shows "lipschitz_on M {a..b} f"
 proof (rule lipschitz_onI[OF _ \<open>M \<ge> 0\<close>])
   have *: "dist (f t) (f s) \<le> M * (t-s)" if "s \<le> t" "s \<in> {a..b}" "t \<in> {a..b}" for s t
   proof (rule locally_lipschitz_imp_lipschitz_aux, simp add: \<open>s \<le> t\<close>)
     show "continuous_on {s..t} f" using continuous_on_subset[OF assms(1)] that by auto
     fix x assume "x \<in> {s..<t}"
     then have "x \<in> {a..<b}" using that by auto
     show "\<exists>z\<in>{x<..t}. dist (f z) (f x) \<le> M * (z - x)"
       using assms(2)[OF \<open>x \<in> {a..<b}\<close>, of t] \<open>x \<in> {s..<t}\<close> by auto
   qed
   fix x y assume "x \<in> {a..b}" "y \<in> {a..b}"
   consider "x \<le> y" | "y \<le> x" by linarith
   then show "dist (f x) (f y) \<le> M * dist x y"
     apply (cases)
     using *[OF _ \<open>x \<in> {a..b}\<close> \<open>y \<in> {a..b}\<close>] *[OF _ \<open>y \<in> {a..b}\<close> \<open>x \<in> {a..b}\<close>]
     by (auto simp add: dist_commute dist_real_def)
 qed
 
 text \<open>We deduce that if a function is Lipschitz on finitely many closed sets on the real line, then
 it is Lipschitz on any interval contained in their union. The difficulty in the proof is to show
 that any point \<open>z\<close> in this interval (except the maximum) has a point arbitrarily close to it on its
 right which is contained in a common initial closed set. Otherwise, we show that there is a small
 interval \<open>(z, T)\<close> which does not intersect any of the initial closed sets, a contradiction.\<close>
 
 proposition lipschitz_on_closed_Union:
   assumes "\<And>i. i \<in> I \<Longrightarrow> lipschitz_on M (U i) f"
           "\<And>i. i \<in> I \<Longrightarrow> closed (U i)"
           "finite I"
           "M \<ge> 0"
           "{u..(v::real)} \<subseteq> (\<Union>i\<in>I. U i)"
   shows "lipschitz_on M {u..v} f"
 proof (rule locally_lipschitz_imp_lipschitz[OF _ _ \<open>M \<ge> 0\<close>])
   have *: "continuous_on (U i) f" if "i \<in> I" for i
     by (rule lipschitz_on_continuous_on[OF assms(1)[OF \<open>i\<in> I\<close>]])
   have "continuous_on (\<Union>i\<in>I. U i) f"
     apply (rule continuous_on_closed_Union) using \<open>finite I\<close> * assms(2) by auto
   then show "continuous_on {u..v} f"
     using \<open>{u..(v::real)} \<subseteq> (\<Union>i\<in>I. U i)\<close> continuous_on_subset by auto
 
   fix z Z assume z: "z \<in> {u..<v}" "z < Z"
   then have "u \<le> v" by auto
   define T where "T = min Z v"
   then have T: "T > z" "T \<le> v" "T \<ge> u" "T \<le> Z" using z by auto
   define A where "A = (\<Union>i\<in> I \<inter> {i. U i \<inter> {z<..T} \<noteq> {}}. U i \<inter> {z..T})"
   have a: "closed A"
     unfolding A_def apply (rule closed_UN) using \<open>finite I\<close> \<open>\<And>i. i \<in> I \<Longrightarrow> closed (U i)\<close> by auto
   have b: "bdd_below A" unfolding A_def using \<open>finite I\<close> by auto
   have "\<exists>i \<in> I. T \<in> U i" using \<open>{u..v} \<subseteq> (\<Union>i\<in>I. U i)\<close> T by auto
   then have c: "T \<in> A" unfolding A_def using T by (auto, fastforce)
   have "Inf A \<ge> z"
     apply (rule cInf_greatest, auto) using c unfolding A_def by auto
   moreover have "Inf A \<le> z"
   proof (rule ccontr)
     assume "\<not>(Inf A \<le> z)"
     then obtain w where w: "w > z" "w < Inf A" by (meson dense not_le_imp_less)
     have "Inf A \<le> T" using a b c by (simp add: cInf_lower)
     then have "w \<le> T" using w by auto
     then have "w \<in> {u..v}" using w \<open>z \<in> {u..<v}\<close> T by auto
     then obtain j where j: "j \<in> I" "w \<in> U j" using \<open>{u..v} \<subseteq> (\<Union>i\<in>I. U i)\<close> by fastforce
     then have "w \<in> U j \<inter> {z..T}" "U j \<inter> {z<..T} \<noteq> {}" using j T w \<open>w \<le> T\<close> by auto
     then have "w \<in> A" unfolding A_def using \<open>j \<in> I\<close> by auto
     then have "Inf A \<le> w" using a b by (simp add: cInf_lower)
     then show False using w by auto
   qed
   ultimately have "Inf A = z" by simp
   moreover have "Inf A \<in> A"
     apply (rule closed_contains_Inf) using a b c by auto
   ultimately have "z \<in> A" by simp
   then obtain i where i: "i \<in> I" "U i \<inter> {z<..T} \<noteq> {}" "z \<in> U i" unfolding A_def by auto
   then obtain t where "t \<in> U i \<inter> {z<..T}" by blast
   then have "dist (f t) (f z) \<le> M * (t - z)"
     using lipschitz_onD(1)[OF assms(1)[of i], of t z] i dist_real_def by auto
   then show "\<exists>t\<in>{z<..Z}. dist (f t) (f z) \<le> M * (t - z)" using \<open>T \<le> Z\<close> \<open>t \<in> U i \<inter> {z<..T}\<close> by auto
 qed
 
 
 subsection \<open>Local Lipschitz continuity (uniform for a family of functions)\<close>
 
 definition\<^marker>\<open>tag important\<close> local_lipschitz::
   "'a::metric_space set \<Rightarrow> 'b::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c::metric_space) \<Rightarrow> bool"
   where
   "local_lipschitz T X f \<equiv> \<forall>x \<in> X. \<forall>t \<in> T.
     \<exists>u>0. \<exists>L. \<forall>t \<in> cball t u \<inter> T. L-lipschitz_on (cball x u \<inter> X) (f t)"
 
 lemma local_lipschitzI:
   assumes "\<And>t x. t \<in> T \<Longrightarrow> x \<in> X \<Longrightarrow> \<exists>u>0. \<exists>L. \<forall>t \<in> cball t u \<inter> T. L-lipschitz_on (cball x u \<inter> X) (f t)"
   shows "local_lipschitz T X f"
   using assms
   unfolding local_lipschitz_def
   by auto
 
 lemma local_lipschitzE:
   assumes local_lipschitz: "local_lipschitz T X f"
   assumes "t \<in> T" "x \<in> X"
   obtains u L where "u > 0" "\<And>s. s \<in> cball t u \<inter> T \<Longrightarrow> L-lipschitz_on (cball x u \<inter> X) (f s)"
   using assms local_lipschitz_def
   by metis
 
 lemma local_lipschitz_continuous_on:
   assumes local_lipschitz: "local_lipschitz T X f"
   assumes "t \<in> T"
   shows "continuous_on X (f t)"
   unfolding continuous_on_def
 proof safe
   fix x assume "x \<in> X"
   from local_lipschitzE[OF local_lipschitz \<open>t \<in> T\<close> \<open>x \<in> X\<close>] obtain u L
     where "0 < u"
     and L: "\<And>s. s \<in> cball t u \<inter> T \<Longrightarrow> L-lipschitz_on (cball x u \<inter> X) (f s)"
     by metis
   have "x \<in> ball x u" using \<open>0 < u\<close> by simp
   from lipschitz_on_continuous_on[OF L]
   have tendsto: "(f t \<longlongrightarrow> f t x) (at x within cball x u \<inter> X)"
     using \<open>0 < u\<close> \<open>x \<in> X\<close> \<open>t \<in> T\<close>
     by (auto simp: continuous_on_def)
   moreover have "\<forall>\<^sub>F xa in at x. (xa \<in> cball x u \<inter> X) = (xa \<in> X)"
     using eventually_at_ball[OF \<open>0 < u\<close>, of x UNIV]
     by eventually_elim auto
   ultimately show "(f t \<longlongrightarrow> f t x) (at x within X)"
     by (rule Lim_transform_within_set)
 qed
 
 lemma
   local_lipschitz_compose1:
   assumes ll: "local_lipschitz (g ` T) X (\<lambda>t. f t)"
   assumes g: "continuous_on T g"
   shows "local_lipschitz T X (\<lambda>t. f (g t))"
 proof (rule local_lipschitzI)
   fix t x
   assume "t \<in> T" "x \<in> X"
   then have "g t \<in> g ` T" by simp
   from local_lipschitzE[OF assms(1) this \<open>x \<in> X\<close>]
   obtain u L where "0 < u" and l: "(\<And>s. s \<in> cball (g t) u \<inter> g ` T \<Longrightarrow> L-lipschitz_on (cball x u \<inter> X) (f s))"
     by auto
   from g[unfolded continuous_on_eq_continuous_within, rule_format, OF \<open>t \<in> T\<close>,
     unfolded continuous_within_eps_delta, rule_format, OF \<open>0 < u\<close>]
   obtain d where d: "d>0" "\<And>x'. x'\<in>T \<Longrightarrow> dist x' t < d \<Longrightarrow> dist (g x') (g t) < u"
     by (auto)
   show "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> T. L-lipschitz_on  (cball x u \<inter> X) (f (g t))"
     using d \<open>0 < u\<close>
     by (fastforce intro: exI[where x="(min d u)/2"] exI[where x=L]
       intro!: less_imp_le[OF d(2)] lipschitz_on_subset[OF l] simp: dist_commute)
 qed
 
 context
   fixes T::"'a::metric_space set" and X f
   assumes local_lipschitz: "local_lipschitz T X f"
 begin
 
 lemma continuous_on_TimesI:
   assumes y: "\<And>x. x \<in> X \<Longrightarrow> continuous_on T (\<lambda>t. f t x)"
   shows "continuous_on (T \<times> X) (\<lambda>(t, x). f t x)"
   unfolding continuous_on_iff
 proof (safe, simp)
   fix a b and e::real
   assume H: "a \<in> T" "b \<in> X" "0 < e"
   hence "0 < e/2" by simp
   from y[unfolded continuous_on_iff, OF \<open>b \<in> X\<close>, rule_format, OF \<open>a \<in> T\<close> \<open>0 < e/2\<close>]
   obtain d where d: "d > 0" "\<And>t. t \<in> T \<Longrightarrow> dist t a < d \<Longrightarrow> dist (f t b) (f a b) < e/2"
     by auto
 
   from \<open>a : T\<close> \<open>b \<in> X\<close>
   obtain u L where u: "0 < u"
     and L: "\<And>t. t \<in> cball a u \<inter> T \<Longrightarrow> L-lipschitz_on  (cball b u \<inter> X) (f t)"
     by (erule local_lipschitzE[OF local_lipschitz])
 
   have "a \<in> cball a u \<inter> T" by (auto simp: \<open>0 < u\<close> \<open>a \<in> T\<close> less_imp_le)
   from lipschitz_on_nonneg[OF L[OF \<open>a \<in> cball _ _ \<inter> _\<close>]] have "0 \<le> L" .
 
   let ?d = "Min {d, u, (e/2/(L + 1))}"
   show "\<exists>d>0. \<forall>x\<in>T. \<forall>y\<in>X. dist (x, y) (a, b) < d \<longrightarrow> dist (f x y) (f a b) < e"
   proof (rule exI[where x = ?d], safe)
     show "0 < ?d"
       using \<open>0 \<le> L\<close> \<open>0 < u\<close> \<open>0 < e\<close> \<open>0 < d\<close>
       by (auto intro!: divide_pos_pos )
     fix x y
     assume "x \<in> T" "y \<in> X"
     assume dist_less: "dist (x, y) (a, b) < ?d"
     have "dist y b \<le> dist (x, y) (a, b)"
       using dist_snd_le[of "(x, y)" "(a, b)"]
       by auto
     also
     note dist_less
     also
     {
       note calculation
       also have "?d \<le> u" by simp
       finally have "dist y b < u" .
     }
     have "?d \<le> e/2/(L + 1)" by simp
     also have "(L + 1) * \<dots> \<le> e / 2"
       using \<open>0 < e\<close> \<open>L \<ge> 0\<close>
       by (auto simp: field_split_simps)
     finally have le1: "(L + 1) * dist y b < e / 2" using \<open>L \<ge> 0\<close> by simp
 
     have "dist x a \<le> dist (x, y) (a, b)"
       using dist_fst_le[of "(x, y)" "(a, b)"]
       by auto
     also note dist_less
     finally have "dist x a < ?d" .
     also have "?d \<le> d" by simp
     finally have "dist x a < d" .
     note \<open>dist x a < ?d\<close>
     also have "?d \<le> u" by simp
     finally have "dist x a < u" .
     then have "x \<in> cball a u \<inter> T"
       using \<open>x \<in> T\<close>
       by (auto simp: dist_commute)
     have "dist (f x y) (f a b) \<le> dist (f x y) (f x b) + dist (f x b) (f a b)"
       by (rule dist_triangle)
     also have "(L + 1)-lipschitz_on (cball b u \<inter> X) (f x)"
       using L[OF \<open>x \<in> cball a u \<inter> T\<close>]
       by (rule lipschitz_on_le) simp
     then have "dist (f x y) (f x b) \<le> (L + 1) * dist y b"
       apply (rule lipschitz_onD)
       subgoal
         using \<open>y \<in> X\<close> \<open>dist y b < u\<close>
         by (simp add: dist_commute)
       subgoal
         using \<open>0 < u\<close> \<open>b \<in> X\<close>
         by simp
       done
     also have "(L + 1) * dist y b \<le> e / 2"
       using le1 \<open>0 \<le> L\<close> by simp
     also have "dist (f x b) (f a b) < e / 2"
       by (rule d; fact)
     also have "e / 2 + e / 2 = e" by simp
     finally show "dist (f x y) (f a b) < e" by simp
   qed
 qed
 
 lemma local_lipschitz_compact_implies_lipschitz:
   assumes "compact X" "compact T"
   assumes cont: "\<And>x. x \<in> X \<Longrightarrow> continuous_on T (\<lambda>t. f t x)"
   obtains L where "\<And>t. t \<in> T \<Longrightarrow> L-lipschitz_on X (f t)"
 proof -
   {
     assume *: "\<And>n::nat. \<not>(\<forall>t\<in>T. n-lipschitz_on X (f t))"
     {
       fix n::nat
       from *[of n] have "\<exists>x y t. t \<in> T \<and> x \<in> X \<and> y \<in> X \<and> dist (f t y) (f t x) > n * dist y x"
         by (force simp: lipschitz_on_def)
     } then obtain t and x y::"nat \<Rightarrow> 'b" where xy: "\<And>n. x n \<in> X" "\<And>n. y n \<in> X"
       and t: "\<And>n. t n \<in> T"
       and d: "\<And>n. dist (f (t n) (y n)) (f (t n) (x n)) > n * dist (y n) (x n)"
       by metis
     from xy assms obtain lx rx where lx': "lx \<in> X" "strict_mono (rx :: nat \<Rightarrow> nat)" "(x o rx) \<longlonglongrightarrow> lx"
       by (metis compact_def)
     with xy have "\<And>n. (y o rx) n \<in> X" by auto
     with assms obtain ly ry where ly': "ly \<in> X" "strict_mono (ry :: nat \<Rightarrow> nat)" "((y o rx) o ry) \<longlonglongrightarrow> ly"
       by (metis compact_def)
     with t have "\<And>n. ((t o rx) o ry) n \<in> T" by simp
     with assms obtain lt rt where lt': "lt \<in> T" "strict_mono (rt :: nat \<Rightarrow> nat)" "(((t o rx) o ry) o rt) \<longlonglongrightarrow> lt"
       by (metis compact_def)
     from lx' ly'
     have lx: "(x o (rx o ry o rt)) \<longlonglongrightarrow> lx" (is "?x \<longlonglongrightarrow> _")
       and ly: "(y o (rx o ry o rt)) \<longlonglongrightarrow> ly" (is "?y \<longlonglongrightarrow> _")
       and lt: "(t o (rx o ry o rt)) \<longlonglongrightarrow> lt" (is "?t \<longlonglongrightarrow> _")
       subgoal by (simp add: LIMSEQ_subseq_LIMSEQ o_assoc lt'(2))
       subgoal by (simp add: LIMSEQ_subseq_LIMSEQ ly'(3) o_assoc lt'(2))
       subgoal by (simp add: o_assoc lt'(3))
       done
     hence "(\<lambda>n. dist (?y n) (?x n)) \<longlonglongrightarrow> dist ly lx"
       by (metis tendsto_dist)
     moreover
     let ?S = "(\<lambda>(t, x). f t x) ` (T \<times> X)"
     have "eventually (\<lambda>n::nat. n > 0) sequentially"
       by (metis eventually_at_top_dense)
     hence "eventually (\<lambda>n. norm (dist (?y n) (?x n)) \<le> norm (\<bar>diameter ?S\<bar> / n) * 1) sequentially"
     proof eventually_elim
       case (elim n)
       have "0 < rx (ry (rt n))" using \<open>0 < n\<close>
         by (metis dual_order.strict_trans1 lt'(2) lx'(2) ly'(2) seq_suble)
       have compact: "compact ?S"
         by (auto intro!: compact_continuous_image continuous_on_subset[OF continuous_on_TimesI]
           compact_Times \<open>compact X\<close> \<open>compact T\<close> cont)
       have "norm (dist (?y n) (?x n)) = dist (?y n) (?x n)" by simp
       also
       from this elim d[of "rx (ry (rt n))"]
       have "\<dots> < dist (f (?t n) (?y n)) (f (?t n) (?x n)) / rx (ry (rt (n)))"
         using lx'(2) ly'(2) lt'(2) \<open>0 < rx _\<close>
         by (auto simp add: field_split_simps strict_mono_def)
       also have "\<dots> \<le> diameter ?S / n"
       proof (rule frac_le)
         show "diameter ?S \<ge> 0"
           using compact compact_imp_bounded diameter_ge_0 by blast
         show "dist (f (?t n) (?y n)) (f (?t n) (?x n)) \<le> diameter ((\<lambda>(t,x). f t x) ` (T \<times> X))"
           by (metis (no_types) compact compact_imp_bounded diameter_bounded_bound image_eqI mem_Sigma_iff o_apply split_conv t xy(1) xy(2))
         show "real n \<le> real (rx (ry (rt n)))"
           by (meson le_trans lt'(2) lx'(2) ly'(2) of_nat_mono strict_mono_imp_increasing)
       qed (use \<open>n > 0\<close> in auto)
       also have "\<dots> \<le> abs (diameter ?S) / n"
         by (auto intro!: divide_right_mono)
       finally show ?case by simp
     qed
     with _ have "(\<lambda>n. dist (?y n) (?x n)) \<longlonglongrightarrow> 0"
       by (rule tendsto_0_le)
         (metis tendsto_divide_0[OF tendsto_const] filterlim_at_top_imp_at_infinity
           filterlim_real_sequentially)
     ultimately have "lx = ly"
       using LIMSEQ_unique by fastforce
     with assms lx' have "lx \<in> X" by auto
     from \<open>lt \<in> T\<close> this obtain u L where L: "u > 0" "\<And>t. t \<in> cball lt u \<inter> T \<Longrightarrow> L-lipschitz_on (cball lx u \<inter> X) (f t)"
       by (erule local_lipschitzE[OF local_lipschitz])
     hence "L \<ge> 0" by (force intro!: lipschitz_on_nonneg \<open>lt \<in> T\<close>)
 
     from L lt ly lx \<open>lx = ly\<close>
     have
       "eventually (\<lambda>n. ?t n \<in> ball lt u) sequentially"
       "eventually (\<lambda>n. ?y n \<in> ball lx u) sequentially"
       "eventually (\<lambda>n. ?x n \<in> ball lx u) sequentially"
       by (auto simp: dist_commute Lim)
     moreover have "eventually (\<lambda>n. n > L) sequentially"
       by (metis filterlim_at_top_dense filterlim_real_sequentially)
     ultimately
     have "eventually (\<lambda>_. False) sequentially"
     proof eventually_elim
       case (elim n)
       hence "dist (f (?t n) (?y n)) (f (?t n) (?x n)) \<le> L * dist (?y n) (?x n)"
         using assms xy t
         unfolding dist_norm[symmetric]
         by (intro lipschitz_onD[OF L(2)]) (auto)
       also have "\<dots> \<le> n * dist (?y n) (?x n)"
         using elim by (intro mult_right_mono) auto
       also have "\<dots> \<le> rx (ry (rt n)) * dist (?y n) (?x n)"
         by (intro mult_right_mono[OF _ zero_le_dist])
            (meson lt'(2) lx'(2) ly'(2) of_nat_le_iff order_trans seq_suble)
       also have "\<dots> < dist (f (?t n) (?y n)) (f (?t n) (?x n))"
         by (auto intro!: d)
       finally show ?case by simp
     qed
     hence False
       by simp
   } then obtain L where "\<And>t. t \<in> T \<Longrightarrow> L-lipschitz_on X (f t)"
     by metis
   thus ?thesis ..
 qed
 
 lemma local_lipschitz_subset:
   assumes "S \<subseteq> T" "Y \<subseteq> X"
   shows "local_lipschitz S Y f"
 proof (rule local_lipschitzI)
   fix t x assume "t \<in> S" "x \<in> Y"
   then have "t \<in> T" "x \<in> X" using assms by auto
   from local_lipschitzE[OF local_lipschitz, OF this]
   obtain u L where u: "0 < u" and L: "\<And>s. s \<in> cball t u \<inter> T \<Longrightarrow> L-lipschitz_on (cball x u \<inter> X) (f s)"
     by blast
   show "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> S. L-lipschitz_on (cball x u \<inter> Y) (f t)"
     using assms
     by (auto intro: exI[where x=u] exI[where x=L]
         intro!: u lipschitz_on_subset[OF _ Int_mono[OF order_refl \<open>Y \<subseteq> X\<close>]] L)
 qed
 
 end
 
 lemma local_lipschitz_minus:
   fixes f::"'a::metric_space \<Rightarrow> 'b::metric_space \<Rightarrow> 'c::real_normed_vector"
   shows "local_lipschitz T X (\<lambda>t x. - f t x) = local_lipschitz T X f"
   by (auto simp: local_lipschitz_def lipschitz_on_minus)
 
 lemma local_lipschitz_PairI:
   assumes f: "local_lipschitz A B (\<lambda>a b. f a b)"
   assumes g: "local_lipschitz A B (\<lambda>a b. g a b)"
   shows "local_lipschitz A B (\<lambda>a b. (f a b, g a b))"
 proof (rule local_lipschitzI)
   fix t x assume "t \<in> A" "x \<in> B"
   from local_lipschitzE[OF f this] local_lipschitzE[OF g this]
   obtain u L v M where "0 < u" "(\<And>s. s \<in> cball t u \<inter> A \<Longrightarrow> L-lipschitz_on (cball x u \<inter> B) (f s))"
     "0 < v" "(\<And>s. s \<in> cball t v \<inter> A \<Longrightarrow> M-lipschitz_on (cball x v \<inter> B) (g s))"
     by metis
   then show "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> A. L-lipschitz_on (cball x u \<inter> B) (\<lambda>b. (f t b, g t b))"
     by (intro exI[where x="min u v"])
       (force intro: lipschitz_on_subset intro!: lipschitz_on_Pair)
 qed
 
 lemma local_lipschitz_constI: "local_lipschitz S T (\<lambda>t x. f t)"
   by (auto simp: intro!: local_lipschitzI lipschitz_on_constant intro: exI[where x=1])
 
 lemma (in bounded_linear) local_lipschitzI:
   shows "local_lipschitz A B (\<lambda>_. f)"
 proof (rule local_lipschitzI, goal_cases)
   case (1 t x)
   from lipschitz_boundE[of "(cball x 1 \<inter> B)"] obtain C where "C-lipschitz_on (cball x 1 \<inter> B) f" by auto
   then show ?case
     by (auto intro: exI[where x=1])
 qed
 
 proposition c1_implies_local_lipschitz:
   fixes T::"real set" and X::"'a::{banach,heine_borel} set"
     and f::"real \<Rightarrow> 'a \<Rightarrow> 'a"
   assumes f': "\<And>t x. t \<in> T \<Longrightarrow> x \<in> X \<Longrightarrow> (f t has_derivative blinfun_apply (f' (t, x))) (at x)"
   assumes cont_f': "continuous_on (T \<times> X) f'"
   assumes "open T"
   assumes "open X"
   shows "local_lipschitz T X f"
 proof (rule local_lipschitzI)
   fix t x
   assume "t \<in> T" "x \<in> X"
   from open_contains_cball[THEN iffD1, OF \<open>open X\<close>, rule_format, OF \<open>x \<in> X\<close>]
   obtain u where u: "u > 0" "cball x u \<subseteq> X" by auto
   moreover
   from open_contains_cball[THEN iffD1, OF \<open>open T\<close>, rule_format, OF \<open>t \<in> T\<close>]
   obtain v where v: "v > 0" "cball t v \<subseteq> T" by auto
   ultimately
   have "compact (cball t v \<times> cball x u)" "cball t v \<times> cball x u \<subseteq> T \<times> X"
     by (auto intro!: compact_Times)
   then have "compact (f' ` (cball t v \<times> cball x u))"
     by (auto intro!: compact_continuous_image continuous_on_subset[OF cont_f'])
   then obtain B where B: "B > 0" "\<And>s y. s \<in> cball t v \<Longrightarrow> y \<in> cball x u \<Longrightarrow> norm (f' (s, y)) \<le> B"
     by (auto dest!: compact_imp_bounded simp: bounded_pos)
 
   have lipschitz: "B-lipschitz_on (cball x (min u v) \<inter> X) (f s)" if s: "s \<in> cball t v" for s
   proof -
     note s
     also note \<open>cball t v \<subseteq> T\<close>
     finally
     have deriv: "\<And>y. y \<in> cball x u \<Longrightarrow> (f s has_derivative blinfun_apply (f' (s, y))) (at y within cball x u)"
       using \<open>_ \<subseteq> X\<close>
       by (auto intro!: has_derivative_at_withinI[OF f'])
     have "norm (f s y - f s z) \<le> B * norm (y - z)"
       if "y \<in> cball x u" "z \<in> cball x u"
       for y z
       using s that
       by (intro differentiable_bound[OF convex_cball deriv])
         (auto intro!: B  simp: norm_blinfun.rep_eq[symmetric])
     then show ?thesis
       using \<open>0 < B\<close>
       by (auto intro!: lipschitz_onI simp: dist_norm)
   qed
   show "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> T. L-lipschitz_on (cball x u \<inter> X) (f t)"
     by (force intro: exI[where x="min u v"] exI[where x=B] intro!: lipschitz simp: u v)
 qed
 
 end
diff --git a/src/HOL/Homology/Invariance_of_Domain.thy b/src/HOL/Homology/Invariance_of_Domain.thy
--- a/src/HOL/Homology/Invariance_of_Domain.thy
+++ b/src/HOL/Homology/Invariance_of_Domain.thy
@@ -1,3032 +1,3033 @@
 section\<open>Invariance of Domain\<close>
 
 theory Invariance_of_Domain
   imports Brouwer_Degree "HOL-Analysis.Continuous_Extension" "HOL-Analysis.Homeomorphism"
 
 begin
 
 subsection\<open>Degree invariance mod 2 for map between pairs\<close>
 
 theorem Borsuk_odd_mapping_degree_step:
   assumes cmf: "continuous_map (nsphere n) (nsphere n) f"
     and f: "\<And>x. x \<in> topspace(nsphere n) \<Longrightarrow> (f \<circ> (\<lambda>x i. -x i)) x = ((\<lambda>x i. -x i) \<circ> f) x"
     and fim: "f ` (topspace(nsphere(n - Suc 0))) \<subseteq> topspace(nsphere(n - Suc 0))"
   shows "even (Brouwer_degree2 n f - Brouwer_degree2 (n - Suc 0) f)"
 proof (cases "n = 0")
   case False
   define neg where "neg \<equiv> \<lambda>x::nat\<Rightarrow>real. \<lambda>i. -x i"
   define upper where "upper \<equiv> \<lambda>n. {x::nat\<Rightarrow>real. x n \<ge> 0}"
   define lower where "lower \<equiv> \<lambda>n. {x::nat\<Rightarrow>real. x n \<le> 0}"
   define equator where "equator \<equiv> \<lambda>n. {x::nat\<Rightarrow>real. x n = 0}"
   define usphere where "usphere \<equiv> \<lambda>n. subtopology (nsphere n) (upper n)"
   define lsphere where "lsphere \<equiv> \<lambda>n. subtopology (nsphere n) (lower n)"
   have [simp]: "neg x i = -x i" for x i
     by (force simp: neg_def)
   have equator_upper: "equator n \<subseteq> upper n"
     by (force simp: equator_def upper_def)
   have upper_usphere: "subtopology (nsphere n) (upper n) = usphere n"
     by (simp add: usphere_def)
   let ?rhgn = "relative_homology_group n (nsphere n)"
   let ?hi_ee = "hom_induced n (nsphere n) (equator n) (nsphere n) (equator n)"
   interpret GE: comm_group "?rhgn (equator n)"
     by simp
   interpret HB: group_hom "?rhgn (equator n)"
                           "homology_group (int n - 1) (subtopology (nsphere n) (equator n))"
                           "hom_boundary n (nsphere n) (equator n)"
     by (simp add: group_hom_axioms_def group_hom_def hom_boundary_hom)
   interpret HIU: group_hom "?rhgn (equator n)"
                            "?rhgn (upper n)"
                            "hom_induced n (nsphere n) (equator n) (nsphere n) (upper n) id"
     by (simp add: group_hom_axioms_def group_hom_def hom_induced_hom)
   have subt_eq: "subtopology (nsphere n) {x. x n = 0} = nsphere (n - Suc 0)"
     by (metis False Suc_pred le_zero_eq not_le subtopology_nsphere_equator)
   then have equ: "subtopology (nsphere n) (equator n) = nsphere(n - Suc 0)"
     "subtopology (lsphere n) (equator n) = nsphere(n - Suc 0)"
     "subtopology (usphere n) (equator n) = nsphere(n - Suc 0)"
     using False by (auto simp: lsphere_def usphere_def equator_def lower_def upper_def subtopology_subtopology simp flip: Collect_conj_eq cong: rev_conj_cong)
   have cmr: "continuous_map (nsphere(n - Suc 0)) (nsphere(n - Suc 0)) f"
     by (metis (no_types, lifting) IntE cmf fim continuous_map_from_subtopology continuous_map_in_subtopology equ(1) image_subset_iff topspace_subtopology)
 
   have "f x n = 0" if "x \<in> topspace (nsphere n)" "x n = 0" for x
   proof -
     have "x \<in> topspace (nsphere (n - Suc 0))"
       by (simp add: that topspace_nsphere_minus1)
     moreover have "topspace (nsphere n) \<inter> {f. f n = 0} = topspace (nsphere (n - Suc 0))"
       by (metis subt_eq topspace_subtopology)
     ultimately show ?thesis
       using cmr continuous_map_def by fastforce
   qed
   then have fimeq: "f ` (topspace (nsphere n) \<inter> equator n) \<subseteq> topspace (nsphere n) \<inter> equator n"
     using fim cmf by (auto simp: equator_def continuous_map_def image_subset_iff)
   have "\<And>k. continuous_map (powertop_real UNIV) euclideanreal (\<lambda>x. - x k)"
     by (metis UNIV_I continuous_map_product_projection continuous_map_minus)
   then have cm_neg: "continuous_map (nsphere m) (nsphere m) neg" for m
     by (force simp: nsphere continuous_map_in_subtopology neg_def continuous_map_componentwise_UNIV intro: continuous_map_from_subtopology)
   then have cm_neg_lu: "continuous_map (lsphere n) (usphere n) neg"
       by (auto simp: lsphere_def usphere_def lower_def upper_def continuous_map_from_subtopology continuous_map_in_subtopology)
   have neg_in_top_iff: "neg x \<in> topspace(nsphere m) \<longleftrightarrow> x \<in> topspace(nsphere m)" for m x
     by (simp add: nsphere_def neg_def topspace_Euclidean_space)
   obtain z where zcarr: "z \<in> carrier (reduced_homology_group (int n - 1) (nsphere (n - Suc 0)))"
     and zeq: "subgroup_generated (reduced_homology_group (int n - 1) (nsphere (n - Suc 0))) {z}
               = reduced_homology_group (int n - 1) (nsphere (n - Suc 0))"
     using cyclic_reduced_homology_group_nsphere [of "int n - 1" "n - Suc 0"] by (auto simp: cyclic_group_def)
   have "hom_boundary n (subtopology (nsphere n) {x. x n \<le> 0}) {x. x n = 0}
       \<in> Group.iso (relative_homology_group n
                      (subtopology (nsphere n) {x. x n \<le> 0}) {x. x n = 0})
                   (reduced_homology_group (int n - 1) (nsphere (n - Suc 0)))"
     using iso_lower_hemisphere_reduced_homology_group [of "int n - 1" "n - Suc 0"] False by simp
   then obtain gp where g: "group_isomorphisms
                           (relative_homology_group n (subtopology (nsphere n) {x. x n \<le> 0}) {x. x n = 0})
                           (reduced_homology_group (int n - 1) (nsphere (n - Suc 0)))
                           (hom_boundary n (subtopology (nsphere n) {x. x n \<le> 0}) {x. x n = 0})
                           gp"
     by (auto simp: group.iso_iff_group_isomorphisms)
   then interpret gp: group_hom "reduced_homology_group (int n - 1) (nsphere (n - Suc 0))"
     "relative_homology_group n (subtopology (nsphere n) {x. x n \<le> 0}) {x. x n = 0}" gp
     by (simp add: group_hom_axioms_def group_hom_def group_isomorphisms_def)
   obtain zp where zpcarr: "zp \<in> carrier(relative_homology_group n (lsphere n) (equator n))"
     and zp_z: "hom_boundary n (lsphere n) (equator n) zp = z"
     and zp_sg: "subgroup_generated (relative_homology_group n (lsphere n) (equator n)) {zp}
                 = relative_homology_group n (lsphere n) (equator n)"
   proof
     show "gp z \<in> carrier (relative_homology_group n (lsphere n) (equator n))"
       "hom_boundary n (lsphere n) (equator n) (gp z) = z"
       using g zcarr by (auto simp: lsphere_def equator_def lower_def group_isomorphisms_def)
     have giso: "gp \<in> Group.iso (reduced_homology_group (int n - 1) (nsphere (n - Suc 0)))
                      (relative_homology_group n (subtopology (nsphere n) {x. x n \<le> 0}) {x. x n = 0})"
       by (metis (mono_tags, lifting) g group_isomorphisms_imp_iso group_isomorphisms_sym)
     show "subgroup_generated (relative_homology_group n (lsphere n) (equator n)) {gp z} =
         relative_homology_group n (lsphere n) (equator n)"
       apply (rule monoid.equality)
       using giso gp.subgroup_generated_by_image [of "{z}"] zcarr
       by (auto simp: lsphere_def equator_def lower_def zeq gp.iso_iff)
   qed
   have hb_iso: "hom_boundary n (subtopology (nsphere n) {x. x n \<ge> 0}) {x. x n = 0}
             \<in> iso (relative_homology_group n (subtopology (nsphere n) {x. x n \<ge> 0}) {x. x n = 0})
                   (reduced_homology_group (int n - 1) (nsphere (n - Suc 0)))"
     using iso_upper_hemisphere_reduced_homology_group [of "int n - 1" "n - Suc 0"] False by simp
   then obtain gn where g: "group_isomorphisms
                           (relative_homology_group n (subtopology (nsphere n) {x. x n \<ge> 0}) {x. x n = 0})
                           (reduced_homology_group (int n - 1) (nsphere (n - Suc 0)))
                           (hom_boundary n (subtopology (nsphere n) {x. x n \<ge> 0}) {x. x n = 0})
                           gn"
     by (auto simp: group.iso_iff_group_isomorphisms)
   then interpret gn: group_hom "reduced_homology_group (int n - 1) (nsphere (n - Suc 0))"
     "relative_homology_group n (subtopology (nsphere n) {x. x n \<ge> 0}) {x. x n = 0}" gn
     by (simp add: group_hom_axioms_def group_hom_def group_isomorphisms_def)
   obtain zn where zncarr: "zn \<in> carrier(relative_homology_group n (usphere n) (equator n))"
     and zn_z: "hom_boundary n (usphere n) (equator n) zn = z"
     and zn_sg: "subgroup_generated (relative_homology_group n (usphere n) (equator n)) {zn}
                  = relative_homology_group n (usphere n) (equator n)"
   proof
     show "gn z \<in> carrier (relative_homology_group n (usphere n) (equator n))"
       "hom_boundary n (usphere n) (equator n) (gn z) = z"
       using g zcarr by (auto simp: usphere_def equator_def upper_def group_isomorphisms_def)
     have giso: "gn \<in> Group.iso (reduced_homology_group (int n - 1) (nsphere (n - Suc 0)))
                      (relative_homology_group n (subtopology (nsphere n) {x. x n \<ge> 0}) {x. x n = 0})"
       by (metis (mono_tags, lifting) g group_isomorphisms_imp_iso group_isomorphisms_sym)
     show "subgroup_generated (relative_homology_group n (usphere n) (equator n)) {gn z} =
         relative_homology_group n (usphere n) (equator n)"
       apply (rule monoid.equality)
       using giso gn.subgroup_generated_by_image [of "{z}"] zcarr
       by (auto simp: usphere_def equator_def upper_def zeq gn.iso_iff)
   qed
   let ?hi_lu = "hom_induced n (lsphere n) (equator n) (nsphere n) (upper n) id"
   interpret gh_lu: group_hom "relative_homology_group n (lsphere n) (equator n)" "?rhgn (upper n)" ?hi_lu
     by (simp add: group_hom_axioms_def group_hom_def hom_induced_hom)
   interpret gh_eef: group_hom "?rhgn (equator n)" "?rhgn (equator n)" "?hi_ee f"
     by (simp add: group_hom_axioms_def group_hom_def hom_induced_hom)
   define wp where "wp \<equiv> ?hi_lu zp"
   then have wpcarr: "wp \<in> carrier(?rhgn (upper n))"
     by (simp add: hom_induced_carrier)
   have "hom_induced n (nsphere n) {} (nsphere n) {x. x n \<ge> 0} id
       \<in> iso (reduced_homology_group n (nsphere n))
             (?rhgn {x. x n \<ge> 0})"
     using iso_reduced_homology_group_upper_hemisphere [of n n n] by auto
   then have "carrier(?rhgn {x. x n \<ge> 0})
           \<subseteq> (hom_induced n (nsphere n) {} (nsphere n) {x. x n \<ge> 0} id)
                          ` carrier(reduced_homology_group n (nsphere n))"
     by (simp add: iso_iff)
   then obtain vp where vpcarr: "vp \<in> carrier(reduced_homology_group n (nsphere n))"
     and eqwp: "hom_induced n (nsphere n) {} (nsphere n) (upper n) id vp = wp"
     using wpcarr by (auto simp: upper_def)
   define wn where "wn \<equiv> hom_induced n (usphere n) (equator n) (nsphere n) (lower n) id zn"
   then have wncarr: "wn \<in> carrier(?rhgn (lower n))"
     by (simp add: hom_induced_carrier)
   have "hom_induced n (nsphere n) {} (nsphere n) {x. x n \<le> 0} id
       \<in> iso (reduced_homology_group n (nsphere n))
             (?rhgn {x. x n \<le> 0})"
     using iso_reduced_homology_group_lower_hemisphere [of n n n] by auto
   then have "carrier(?rhgn {x. x n \<le> 0})
           \<subseteq> (hom_induced n (nsphere n) {} (nsphere n) {x. x n \<le> 0} id)
                          ` carrier(reduced_homology_group n (nsphere n))"
     by (simp add: iso_iff)
   then obtain vn where vpcarr: "vn \<in> carrier(reduced_homology_group n (nsphere n))"
     and eqwp: "hom_induced n (nsphere n) {} (nsphere n) (lower n) id vn = wn"
     using wncarr by (auto simp: lower_def)
   define up where "up \<equiv> hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id zp"
   then have upcarr: "up \<in> carrier(?rhgn (equator n))"
     by (simp add: hom_induced_carrier)
   define un where "un \<equiv> hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id zn"
   then have uncarr: "un \<in> carrier(?rhgn (equator n))"
     by (simp add: hom_induced_carrier)
   have *: "(\<lambda>(x, y).
             hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id x
           \<otimes>\<^bsub>?rhgn (equator n)\<^esub>
             hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id y)
         \<in> Group.iso
             (relative_homology_group n (lsphere n) (equator n) \<times>\<times>
              relative_homology_group n (usphere n) (equator n))
             (?rhgn (equator n))"
   proof (rule conjunct1 [OF exact_sequence_sum_lemma [OF abelian_relative_homology_group]])
     show "hom_induced n (lsphere n) (equator n) (nsphere n) (upper n) id
         \<in> Group.iso (relative_homology_group n (lsphere n) (equator n))
             (?rhgn (upper n))"
       apply (simp add: lsphere_def usphere_def equator_def lower_def upper_def)
       using iso_relative_homology_group_lower_hemisphere by blast
     show "hom_induced n (usphere n) (equator n) (nsphere n) (lower n) id
         \<in> Group.iso (relative_homology_group n (usphere n) (equator n))
             (?rhgn (lower n))"
       apply (simp_all add: lsphere_def usphere_def equator_def lower_def upper_def)
       using iso_relative_homology_group_upper_hemisphere by blast+
     show "exact_seq
          ([?rhgn (lower n),
            ?rhgn (equator n),
            relative_homology_group n (lsphere n) (equator n)],
           [hom_induced n (nsphere n) (equator n) (nsphere n) (lower n) id,
            hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id])"
       unfolding lsphere_def usphere_def equator_def lower_def upper_def
       by (rule homology_exactness_triple_3) force
     show "exact_seq
          ([?rhgn (upper n),
            ?rhgn (equator n),
            relative_homology_group n (usphere n) (equator n)],
           [hom_induced n (nsphere n) (equator n) (nsphere n) (upper n) id,
            hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id])"
       unfolding lsphere_def usphere_def equator_def lower_def upper_def
       by (rule homology_exactness_triple_3) force
   next
     fix x
     assume "x \<in> carrier (relative_homology_group n (lsphere n) (equator n))"
     show "hom_induced n (nsphere n) (equator n) (nsphere n) (upper n) id
          (hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id x) =
         hom_induced n (lsphere n) (equator n) (nsphere n) (upper n) id x"
       by (simp add: hom_induced_compose' subset_iff lsphere_def usphere_def equator_def lower_def upper_def)
   next
     fix x
     assume "x \<in> carrier (relative_homology_group n (usphere n) (equator n))"
     show "hom_induced n (nsphere n) (equator n) (nsphere n) (lower n) id
          (hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id x) =
         hom_induced n (usphere n) (equator n) (nsphere n) (lower n) id x"
       by (simp add: hom_induced_compose' subset_iff lsphere_def usphere_def equator_def lower_def upper_def)
   qed
   then have sb: "carrier (?rhgn (equator n))
              \<subseteq> (\<lambda>(x, y).
             hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id x
           \<otimes>\<^bsub>?rhgn (equator n)\<^esub>
             hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id y)
                ` carrier (relative_homology_group n (lsphere n) (equator n) \<times>\<times>
              relative_homology_group n (usphere n) (equator n))"
     by (simp add: iso_iff)
   obtain a b::int
     where up_ab: "?hi_ee f up
              = up [^]\<^bsub>?rhgn (equator n)\<^esub> a\<otimes>\<^bsub>?rhgn (equator n)\<^esub> un [^]\<^bsub>?rhgn (equator n)\<^esub> b"
   proof -
     have hiupcarr: "?hi_ee f up \<in> carrier(?rhgn (equator n))"
       by (simp add: hom_induced_carrier)
     obtain u v where u: "u \<in> carrier (relative_homology_group n (lsphere n) (equator n))"
       and v: "v \<in> carrier (relative_homology_group n (usphere n) (equator n))"
       and eq: "?hi_ee f up =
                 hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id u
                 \<otimes>\<^bsub>?rhgn (equator n)\<^esub>
                 hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id v"
       using subsetD [OF sb hiupcarr] by auto
     have "u \<in> carrier (subgroup_generated (relative_homology_group n (lsphere n) (equator n)) {zp})"
       by (simp_all add: u zp_sg)
     then obtain a::int where a: "u = zp [^]\<^bsub>relative_homology_group n (lsphere n) (equator n)\<^esub> a"
       by (metis group.carrier_subgroup_generated_by_singleton group_relative_homology_group rangeE zpcarr)
     have ae: "hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id
             (pow (relative_homology_group n (lsphere n) (equator n)) zp a)
           = pow (?rhgn (equator n)) (hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id zp) a"
       by (meson group_hom.hom_int_pow group_hom_axioms_def group_hom_def group_relative_homology_group hom_induced zpcarr)
     have "v \<in> carrier (subgroup_generated (relative_homology_group n (usphere n) (equator n)) {zn})"
       by (simp_all add: v zn_sg)
     then obtain b::int where b: "v = zn [^]\<^bsub>relative_homology_group n (usphere n) (equator n)\<^esub> b"
       by (metis group.carrier_subgroup_generated_by_singleton group_relative_homology_group rangeE zncarr)
     have be: "hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id
            (zn [^]\<^bsub>relative_homology_group n (usphere n) (equator n)\<^esub> b)
         = hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id
            zn [^]\<^bsub>relative_homology_group n (nsphere n) (equator n)\<^esub> b"
       by (meson group_hom.hom_int_pow group_hom_axioms_def group_hom_def group_relative_homology_group hom_induced zncarr)
     show thesis
     proof
       show "?hi_ee f up
          = up [^]\<^bsub>?rhgn (equator n)\<^esub> a \<otimes>\<^bsub>?rhgn (equator n)\<^esub> un [^]\<^bsub>?rhgn (equator n)\<^esub> b"
         using a ae b be eq local.up_def un_def by auto
     qed
   qed
   have "(hom_boundary n (nsphere n) (equator n)
        \<circ> hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id) zp = z"
     using zp_z equ apply (simp add: lsphere_def naturality_hom_induced)
     by (metis hom_boundary_carrier hom_induced_id)
   then have up_z: "hom_boundary n (nsphere n) (equator n) up = z"
     by (simp add: up_def)
   have "(hom_boundary n (nsphere n) (equator n)
        \<circ> hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id) zn = z"
     using zn_z equ apply (simp add: usphere_def naturality_hom_induced)
     by (metis hom_boundary_carrier hom_induced_id)
   then have un_z: "hom_boundary n (nsphere n) (equator n) un = z"
     by (simp add: un_def)
   have Bd_ab: "Brouwer_degree2 (n - Suc 0) f = a + b"
   proof (rule Brouwer_degree2_unique_generator; use False int_ops in simp_all)
     show "continuous_map (nsphere (n - Suc 0)) (nsphere (n - Suc 0)) f"
       using cmr by auto
     show "subgroup_generated (reduced_homology_group (int n - 1) (nsphere (n - Suc 0))) {z} =
         reduced_homology_group (int n - 1) (nsphere (n - Suc 0))"
       using zeq by blast
     have "(hom_induced (int n - 1) (nsphere (n - Suc 0)) {} (nsphere (n - Suc 0)) {} f
            \<circ> hom_boundary n (nsphere n) (equator n)) up
         = (hom_boundary n (nsphere n) (equator n) \<circ>
            ?hi_ee f) up"
       using naturality_hom_induced [OF cmf fimeq, of n, symmetric]
       by (simp add: subtopology_restrict equ fun_eq_iff)
     also have "\<dots> = hom_boundary n (nsphere n) (equator n)
                        (up [^]\<^bsub>relative_homology_group n (nsphere n) (equator n)\<^esub>
                         a \<otimes>\<^bsub>relative_homology_group n (nsphere n) (equator n)\<^esub>
                         un [^]\<^bsub>relative_homology_group n (nsphere n) (equator n)\<^esub> b)"
       by (simp add: o_def up_ab)
     also have "\<dots> = z [^]\<^bsub>reduced_homology_group (int n - 1) (nsphere (n - Suc 0))\<^esub> (a + b)"
       using zcarr
       apply (simp add: HB.hom_int_pow reduced_homology_group_def group.int_pow_subgroup_generated upcarr uncarr)
       by (metis equ(1) group.int_pow_mult group_relative_homology_group hom_boundary_carrier un_z up_z)
   finally show "hom_induced (int n - 1) (nsphere (n - Suc 0)) {} (nsphere (n - Suc 0)) {} f z =
         z [^]\<^bsub>reduced_homology_group (int n - 1) (nsphere (n - Suc 0))\<^esub> (a + b)"
       by (simp add: up_z)
   qed
   define u where "u \<equiv> up \<otimes>\<^bsub>?rhgn (equator n)\<^esub> inv\<^bsub>?rhgn (equator n)\<^esub> un"
   have ucarr: "u \<in> carrier (?rhgn (equator n))"
     by (simp add: u_def uncarr upcarr)
   then have "u [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 n f = u [^]\<^bsub>?rhgn (equator n)\<^esub> (a - b)
              \<longleftrightarrow> (GE.ord u) dvd a - b - Brouwer_degree2 n f"
     by (simp add: GE.int_pow_eq)
   moreover
   have "GE.ord u = 0"
   proof (clarsimp simp add: GE.ord_eq_0 ucarr)
     fix d :: nat
     assume "0 < d"
       and "u [^]\<^bsub>?rhgn (equator n)\<^esub> d = singular_relboundary_set n (nsphere n) (equator n)"
     then have "hom_induced n (nsphere n) (equator n) (nsphere n) (upper n) id u [^]\<^bsub>?rhgn (upper n)\<^esub> d
                = \<one>\<^bsub>?rhgn (upper n)\<^esub>"
       by (metis HIU.hom_one HIU.hom_nat_pow one_relative_homology_group ucarr)
     moreover
     have "?hi_lu
         = hom_induced n (nsphere n) (equator n) (nsphere n) (upper n) id \<circ>
           hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id"
       by (simp add: lsphere_def image_subset_iff equator_upper flip: hom_induced_compose)
     then have p: "wp = hom_induced n (nsphere n) (equator n) (nsphere n) (upper n) id up"
       by (simp add: local.up_def wp_def)
     have n: "hom_induced n (nsphere n) (equator n) (nsphere n) (upper n) id un = \<one>\<^bsub>?rhgn (upper n)\<^esub>"
       using homology_exactness_triple_3 [OF equator_upper, of n "nsphere n"]
       using un_def zncarr by (auto simp: upper_usphere kernel_def)
     have "hom_induced n (nsphere n) (equator n) (nsphere n) (upper n) id u = wp"
       unfolding u_def
       using p n HIU.inv_one HIU.r_one uncarr upcarr by auto
     ultimately have "(wp [^]\<^bsub>?rhgn (upper n)\<^esub> d) = \<one>\<^bsub>?rhgn (upper n)\<^esub>"
       by simp
     moreover have "infinite (carrier (subgroup_generated (?rhgn (upper n)) {wp}))"
     proof -
       have "?rhgn (upper n) \<cong> reduced_homology_group n (nsphere n)"
         unfolding upper_def
         using iso_reduced_homology_group_upper_hemisphere [of n n n]
         by (blast intro: group.iso_sym group_reduced_homology_group is_isoI)
       also have "\<dots> \<cong> integer_group"
         by (simp add: reduced_homology_group_nsphere)
       finally have iso: "?rhgn (upper n) \<cong> integer_group" .
       have "carrier (subgroup_generated (?rhgn (upper n)) {wp}) = carrier (?rhgn (upper n))"
         using gh_lu.subgroup_generated_by_image [of "{zp}"] zpcarr HIU.carrier_subgroup_generated_subset
           gh_lu.iso_iff iso_relative_homology_group_lower_hemisphere zp_sg
         by (auto simp: lower_def lsphere_def upper_def equator_def wp_def)
       then show ?thesis
         using infinite_UNIV_int iso_finite [OF iso] by simp
     qed
     ultimately show False
       using HIU.finite_cyclic_subgroup \<open>0 < d\<close> wpcarr by blast
   qed
   ultimately have iff: "u [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 n f = u [^]\<^bsub>?rhgn (equator n)\<^esub> (a - b)
                    \<longleftrightarrow> Brouwer_degree2 n f = a - b"
     by auto
   have "u [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 n f = ?hi_ee f u"
   proof -
     have ne: "topspace (nsphere n) \<inter> equator n \<noteq> {}"
       by (metis equ(1) nonempty_nsphere topspace_subtopology)
     have eq1: "hom_boundary n (nsphere n) (equator n) u
                = \<one>\<^bsub>reduced_homology_group (int n - 1) (subtopology (nsphere n) (equator n))\<^esub>"
       using one_reduced_homology_group u_def un_z uncarr up_z upcarr by force
     then have uhom: "u \<in> hom_induced n (nsphere n) {} (nsphere n) (equator n) id `
                          carrier (reduced_homology_group (int n) (nsphere n))"
       using homology_exactness_reduced_1 [OF ne, of n] eq1 ucarr by (auto simp: kernel_def)
     then obtain v where vcarr: "v \<in> carrier (reduced_homology_group (int n) (nsphere n))"
                   and ueq: "u = hom_induced n (nsphere n) {} (nsphere n) (equator n) id v"
       by blast
     interpret GH_hi: group_hom "homology_group n (nsphere n)"
                         "?rhgn (equator n)"
                         "hom_induced n (nsphere n) {} (nsphere n) (equator n) id"
       by (simp add: group_hom_axioms_def group_hom_def hom_induced_hom)
     have poweq: "pow (homology_group n (nsphere n)) x i = pow (reduced_homology_group n (nsphere n)) x i"
       for x and i::int
       by (simp add: False un_reduced_homology_group)
     have vcarr': "v \<in> carrier (homology_group n (nsphere n))"
       using carrier_reduced_homology_group_subset vcarr by blast
     have "u [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 n f
           = hom_induced n (nsphere n) {} (nsphere n) (equator n) f v"
       using vcarr vcarr'
       by (simp add: ueq poweq hom_induced_compose' cmf flip: GH_hi.hom_int_pow Brouwer_degree2)
     also have "\<dots> = hom_induced n (nsphere n) (topspace(nsphere n) \<inter> equator n) (nsphere n) (equator n) f
                      (hom_induced n (nsphere n) {} (nsphere n) (topspace(nsphere n) \<inter> equator n) id v)"
       using fimeq by (simp add: hom_induced_compose' cmf)
     also have "\<dots> = ?hi_ee f u"
       by (metis hom_induced inf.left_idem ueq)
     finally show ?thesis .
   qed
   moreover
   interpret gh_een: group_hom "?rhgn (equator n)" "?rhgn (equator n)" "?hi_ee neg"
     by (simp add: group_hom_axioms_def group_hom_def hom_induced_hom)
   have hi_up_eq_un: "?hi_ee neg up = un [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 (n - Suc 0) neg"
   proof -
     have "?hi_ee neg (hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) id zp)
          = hom_induced n (lsphere n) (equator n) (nsphere n) (equator n) (neg \<circ> id) zp"
       by (intro hom_induced_compose') (auto simp: lsphere_def equator_def cm_neg)
     also have "\<dots> = hom_induced n (usphere n) (equator n) (nsphere n) (equator n) id
             (hom_induced n (lsphere n) (equator n) (usphere n) (equator n) neg zp)"
       by (subst hom_induced_compose' [OF cm_neg_lu]) (auto simp: usphere_def equator_def)
     also have "hom_induced n (lsphere n) (equator n) (usphere n) (equator n) neg zp
              = zn [^]\<^bsub>relative_homology_group n (usphere n) (equator n)\<^esub> Brouwer_degree2 (n - Suc 0) neg"
     proof -
       let ?hb = "hom_boundary n (usphere n) (equator n)"
       have eq: "subtopology (nsphere n) {x. x n \<ge> 0} = usphere n \<and> {x. x n = 0} = equator n"
         by (auto simp: usphere_def upper_def equator_def)
       with hb_iso have inj: "inj_on (?hb) (carrier (relative_homology_group n (usphere n) (equator n)))"
         by (simp add: iso_iff)
       interpret hb_hom: group_hom "relative_homology_group n (usphere n) (equator n)"
                                   "reduced_homology_group (int n - 1) (nsphere (n - Suc 0))"
                                   "?hb"
         using hb_iso iso_iff eq group_hom_axioms_def group_hom_def by fastforce
       show ?thesis
       proof (rule inj_onD [OF inj])
         have *: "hom_induced (int n - 1) (nsphere (n - Suc 0)) {} (nsphere (n - Suc 0)) {} neg z
                  = z [^]\<^bsub>homology_group (int n - 1) (nsphere (n - Suc 0))\<^esub> Brouwer_degree2 (n - Suc 0) neg"
           using Brouwer_degree2 [of z "n - Suc 0" neg] False zcarr
           by (simp add: int_ops group.int_pow_subgroup_generated reduced_homology_group_def)
         have "?hb \<circ>
               hom_induced n (lsphere n) (equator n) (usphere n) (equator n) neg
             = hom_induced (int n - 1) (nsphere (n - Suc 0)) {} (nsphere (n - Suc 0)) {} neg \<circ>
               hom_boundary n (lsphere n) (equator n)"
           apply (subst naturality_hom_induced [OF cm_neg_lu])
            apply (force simp: equator_def neg_def)
           by (simp add: equ)
         then have "?hb
                     (hom_induced n (lsphere n) (equator n) (usphere n) (equator n) neg zp)
             = (z [^]\<^bsub>homology_group (int n - 1) (nsphere (n - Suc 0))\<^esub> Brouwer_degree2 (n - Suc 0) neg)"
           by (metis "*" comp_apply zp_z)
         also have "\<dots> = ?hb (zn [^]\<^bsub>relative_homology_group n (usphere n) (equator n)\<^esub>
           Brouwer_degree2 (n - Suc 0) neg)"
           by (metis group.int_pow_subgroup_generated group_relative_homology_group hb_hom.hom_int_pow reduced_homology_group_def zcarr zn_z zncarr)
         finally show "?hb (hom_induced n (lsphere n) (equator n) (usphere n) (equator n) neg zp) =
         ?hb (zn [^]\<^bsub>relative_homology_group n (usphere n) (equator n)\<^esub>
           Brouwer_degree2 (n - Suc 0) neg)" by simp
       qed (auto simp: hom_induced_carrier group.int_pow_closed zncarr)
     qed
     finally show ?thesis
       by (metis (no_types, lifting) group_hom.hom_int_pow group_hom_axioms_def group_hom_def group_relative_homology_group hom_induced local.up_def un_def zncarr)
   qed
   have "continuous_map (nsphere (n - Suc 0)) (nsphere (n - Suc 0)) neg"
     using cm_neg by blast
   then have "homeomorphic_map (nsphere (n - Suc 0)) (nsphere (n - Suc 0)) neg"
     apply (auto simp: homeomorphic_map_maps homeomorphic_maps_def)
     apply (rule_tac x=neg in exI, auto)
     done
   then have Brouwer_degree2_21: "Brouwer_degree2 (n - Suc 0) neg ^ 2 = 1"
     using Brouwer_degree2_homeomorphic_map power2_eq_1_iff by force
   have hi_un_eq_up: "?hi_ee neg un = up [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 (n - Suc 0) neg" (is "?f un = ?y")
   proof -
     have [simp]: "neg \<circ> neg = id"
       by force
     have "?f (?f ?y) = ?y"
       apply (subst hom_induced_compose' [OF cm_neg _ cm_neg])
        apply(force simp: equator_def)
       apply (simp add: upcarr hom_induced_id_gen)
       done
     moreover have "?f ?y = un"
       using upcarr apply (simp only: gh_een.hom_int_pow hi_up_eq_un)
       by (metis (no_types, lifting) Brouwer_degree2_21 GE.group_l_invI GE.l_inv_ex group.int_pow_1 group.int_pow_pow power2_eq_1_iff uncarr zmult_eq_1_iff)
     ultimately show "?f un = ?y"
       by simp
   qed
   have "?hi_ee f un = un [^]\<^bsub>?rhgn (equator n)\<^esub> a \<otimes>\<^bsub>?rhgn (equator n)\<^esub> up [^]\<^bsub>?rhgn (equator n)\<^esub> b"
   proof -
     let ?TE = "topspace (nsphere n) \<inter> equator n"
     have fneg: "(f \<circ> neg) x = (neg \<circ> f) x" if "x \<in> topspace (nsphere n)" for x
       using f [OF that] by (force simp: neg_def)
     have neg_im: "neg ` (topspace (nsphere n) \<inter> equator n) \<subseteq> topspace (nsphere n) \<inter> equator n"
       by (metis cm_neg continuous_map_image_subset_topspace equ(1) topspace_subtopology)
     have 1: "hom_induced n (nsphere n) ?TE (nsphere n) ?TE f \<circ> hom_induced n (nsphere n) ?TE (nsphere n) ?TE neg
            = hom_induced n (nsphere n) ?TE (nsphere n) ?TE neg \<circ> hom_induced n (nsphere n) ?TE (nsphere n) ?TE f"
       using neg_im fimeq cm_neg cmf
       apply (simp add: flip: hom_induced_compose del: hom_induced_restrict)
       using fneg by (auto intro: hom_induced_eq)
     have "(un [^]\<^bsub>?rhgn (equator n)\<^esub> a) \<otimes>\<^bsub>?rhgn (equator n)\<^esub> (up [^]\<^bsub>?rhgn (equator n)\<^esub> b)
         = un [^]\<^bsub>?rhgn (equator n)\<^esub> (Brouwer_degree2 (n - 1) neg * a * Brouwer_degree2 (n - 1) neg)
           \<otimes>\<^bsub>?rhgn (equator n)\<^esub>
           up [^]\<^bsub>?rhgn (equator n)\<^esub> (Brouwer_degree2 (n - 1) neg * b * Brouwer_degree2 (n - 1) neg)"
     proof -
       have "Brouwer_degree2 (n - Suc 0) neg = 1 \<or> Brouwer_degree2 (n - Suc 0) neg = - 1"
         using Brouwer_degree2_21 power2_eq_1_iff by blast
       then show ?thesis
         by fastforce
     qed
     also have "\<dots> = ((un [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 (n - 1) neg) [^]\<^bsub>?rhgn (equator n)\<^esub> a \<otimes>\<^bsub>?rhgn (equator n)\<^esub>
            (up [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 (n - 1) neg) [^]\<^bsub>?rhgn (equator n)\<^esub> b) [^]\<^bsub>?rhgn (equator n)\<^esub>
           Brouwer_degree2 (n - 1) neg"
       by (simp add: GE.int_pow_distrib GE.int_pow_pow uncarr upcarr)
     also have "\<dots> = ?hi_ee neg (?hi_ee f up) [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 (n - Suc 0) neg"
       by (simp add: gh_een.hom_int_pow hi_un_eq_up hi_up_eq_un uncarr up_ab upcarr)
     finally have 2: "(un [^]\<^bsub>?rhgn (equator n)\<^esub> a) \<otimes>\<^bsub>?rhgn (equator n)\<^esub> (up [^]\<^bsub>?rhgn (equator n)\<^esub> b)
              = ?hi_ee neg (?hi_ee f up) [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 (n - Suc 0) neg" .
     have "un = ?hi_ee neg up [^]\<^bsub>?rhgn (equator n)\<^esub> Brouwer_degree2 (n - Suc 0) neg"
       by (metis (no_types, opaque_lifting) Brouwer_degree2_21 GE.int_pow_1 GE.int_pow_pow hi_up_eq_un power2_eq_1_iff uncarr zmult_eq_1_iff)
     moreover have "?hi_ee f ((?hi_ee neg up) [^]\<^bsub>?rhgn (equator n)\<^esub> (Brouwer_degree2 (n - Suc 0) neg))
                  = un [^]\<^bsub>?rhgn (equator n)\<^esub> a \<otimes>\<^bsub>?rhgn (equator n)\<^esub> up [^]\<^bsub>?rhgn (equator n)\<^esub> b"
       using 1 2 by (simp add: hom_induced_carrier gh_eef.hom_int_pow fun_eq_iff)
     ultimately show ?thesis
       by blast
   qed
   then have "?hi_ee f u = u [^]\<^bsub>?rhgn (equator n)\<^esub> (a - b)"
     by (simp add: u_def upcarr uncarr up_ab GE.int_pow_diff GE.m_ac GE.int_pow_distrib GE.int_pow_inv GE.inv_mult_group)
   ultimately
   have "Brouwer_degree2 n f = a - b"
     using iff by blast
   with Bd_ab show ?thesis
     by simp
 qed simp
 
 
 subsection \<open>General Jordan-Brouwer separation theorem and invariance of dimension\<close>
 
 proposition relative_homology_group_Euclidean_complement_step:
   assumes "closedin (Euclidean_space n) S"
   shows "relative_homology_group p (Euclidean_space n) (topspace(Euclidean_space n) - S)
       \<cong> relative_homology_group (p + k) (Euclidean_space (n+k)) (topspace(Euclidean_space (n+k)) - S)"
 proof -
   have *: "relative_homology_group p (Euclidean_space n) (topspace(Euclidean_space n) - S)
            \<cong> relative_homology_group (p + 1) (Euclidean_space (Suc n)) (topspace(Euclidean_space (Suc n)) - {x \<in> S. x n = 0})"
     (is "?lhs \<cong> ?rhs")
     if clo: "closedin (Euclidean_space (Suc n)) S" and cong: "\<And>x y. \<lbrakk>x \<in> S; \<And>i. i \<noteq> n \<Longrightarrow> x i = y i\<rbrakk> \<Longrightarrow> y \<in> S"
       for p n S
   proof -
     have Ssub: "S \<subseteq> topspace (Euclidean_space (Suc n))"
       by (meson clo closedin_def)
     define lo where "lo \<equiv> {x \<in> topspace(Euclidean_space (Suc n)). x n < (if x \<in> S then 0 else 1)}"
     define hi where "hi = {x \<in> topspace(Euclidean_space (Suc n)). x n > (if x \<in> S then 0 else -1)}"
     have lo_hi_Int: "lo \<inter> hi = {x \<in> topspace(Euclidean_space (Suc n)) - S. x n \<in> {-1<..<1}}"
       by (auto simp: hi_def lo_def)
     have lo_hi_Un: "lo \<union> hi = topspace(Euclidean_space (Suc n)) - {x \<in> S. x n = 0}"
       by (auto simp: hi_def lo_def)
     define ret where "ret \<equiv> \<lambda>c::real. \<lambda>x i. if i = n then c else x i"
     have cm_ret: "continuous_map (powertop_real UNIV) (powertop_real UNIV) (ret t)" for t
       by (auto simp: ret_def continuous_map_componentwise_UNIV intro: continuous_map_product_projection)
     let ?ST = "\<lambda>t. subtopology (Euclidean_space (Suc n)) {x. x n = t}"
     define squashable where
       "squashable \<equiv> \<lambda>t S. \<forall>x t'. x \<in> S \<and> (x n \<le> t' \<and> t' \<le> t \<or> t \<le> t' \<and> t' \<le> x n) \<longrightarrow> ret t' x \<in> S"
     have squashable: "squashable t (topspace(Euclidean_space(Suc n)))" for t
       by (simp add: squashable_def topspace_Euclidean_space ret_def)
     have squashableD: "\<lbrakk>squashable t S; x \<in> S; x n \<le> t' \<and> t' \<le> t \<or> t \<le> t' \<and> t' \<le> x n\<rbrakk> \<Longrightarrow> ret t' x \<in> S" for x t' t S
       by (auto simp: squashable_def)
     have "squashable 1 hi"
       by (force simp: squashable_def hi_def ret_def topspace_Euclidean_space intro: cong)
     have "squashable t UNIV" for t
       by (force simp: squashable_def hi_def ret_def topspace_Euclidean_space intro: cong)
     have squashable_0_lohi: "squashable 0 (lo \<inter> hi)"
       using Ssub
       by (auto simp: squashable_def hi_def lo_def ret_def topspace_Euclidean_space intro: cong)
     have rm_ret: "retraction_maps (subtopology (Euclidean_space (Suc n)) U)
                                   (subtopology (Euclidean_space (Suc n)) {x. x \<in> U \<and> x n = t})
                                   (ret t) id"
       if "squashable t U" for t U
       unfolding retraction_maps_def
     proof (intro conjI ballI)
       show "continuous_map (subtopology (Euclidean_space (Suc n)) U)
              (subtopology (Euclidean_space (Suc n)) {x \<in> U. x n = t}) (ret t)"
         apply (simp add: cm_ret continuous_map_in_subtopology continuous_map_from_subtopology Euclidean_space_def)
         using that by (fastforce simp: squashable_def ret_def)
     next
       show "continuous_map (subtopology (Euclidean_space (Suc n)) {x \<in> U. x n = t})
                            (subtopology (Euclidean_space (Suc n)) U) id"
         using continuous_map_in_subtopology by fastforce
       show "ret t (id x) = x"
         if "x \<in> topspace (subtopology (Euclidean_space (Suc n)) {x \<in> U. x n = t})" for x
         using that by (simp add: topspace_Euclidean_space ret_def fun_eq_iff)
     qed
     have cm_snd: "continuous_map (prod_topology (top_of_set {0..1}) (subtopology (powertop_real UNIV) S))
                               euclideanreal (\<lambda>x. snd x k)" for k::nat and S
       using continuous_map_componentwise_UNIV continuous_map_into_fulltopology continuous_map_snd by fastforce
     have cm_fstsnd: "continuous_map (prod_topology (top_of_set {0..1}) (subtopology (powertop_real UNIV) S))
                               euclideanreal (\<lambda>x. fst x * snd x k)" for k::nat and S
       by (intro continuous_intros continuous_map_into_fulltopology [OF continuous_map_fst] cm_snd)
     have hw_sub: "homotopic_with (\<lambda>k. k ` V \<subseteq> V) (subtopology (Euclidean_space (Suc n)) U)
                                  (subtopology (Euclidean_space (Suc n)) U) (ret t) id"
       if "squashable t U" "squashable t V" for U V t
       unfolding homotopic_with_def
     proof (intro exI conjI allI ballI)
       let ?h = "\<lambda>(z,x). ret ((1 - z) * t + z * x n) x"
       show "(\<lambda>x. ?h (u, x)) ` V \<subseteq> V" if "u \<in> {0..1}" for u
         using that
         by clarsimp (metis squashableD [OF \<open>squashable t V\<close>] convex_bound_le diff_ge_0_iff_ge eq_diff_eq' le_cases less_eq_real_def segment_bound_lemma)
       have 1: "?h ` ({0..1} \<times> ({x. \<forall>i\<ge>Suc n. x i = 0} \<inter> U)) \<subseteq> U"
         by clarsimp (metis squashableD [OF \<open>squashable t U\<close>] convex_bound_le diff_ge_0_iff_ge eq_diff_eq' le_cases less_eq_real_def segment_bound_lemma)
       show "continuous_map (prod_topology (top_of_set {0..1}) (subtopology (Euclidean_space (Suc n)) U))
                            (subtopology (Euclidean_space (Suc n)) U) ?h"
         apply (simp add: continuous_map_in_subtopology Euclidean_space_def subtopology_subtopology 1)
         apply (auto simp: case_prod_unfold ret_def continuous_map_componentwise_UNIV)
          apply (intro continuous_map_into_fulltopology [OF continuous_map_fst] cm_snd continuous_intros)
         by (auto simp: cm_snd)
     qed (auto simp: ret_def)
     have cs_hi: "contractible_space(subtopology (Euclidean_space(Suc n)) hi)"
     proof -
       have "homotopic_with (\<lambda>x. True) (?ST 1) (?ST 1) id (\<lambda>x. (\<lambda>i. if i = n then 1 else 0))"
         apply (subst homotopic_with_sym)
         apply (simp add: homotopic_with)
         apply (rule_tac x="(\<lambda>(z,x) i. if i=n then 1 else z * x i)" in exI)
         apply (auto simp: Euclidean_space_def subtopology_subtopology continuous_map_in_subtopology case_prod_unfold continuous_map_componentwise_UNIV cm_fstsnd)
         done
       then have "contractible_space (?ST 1)"
         unfolding contractible_space_def by metis
       moreover have "?thesis = contractible_space (?ST 1)"
       proof (intro deformation_retract_imp_homotopy_equivalent_space homotopy_equivalent_space_contractibility)
         have "{x. \<forall>i\<ge>Suc n. x i = 0} \<inter> {x \<in> hi. x n = 1} = {x. \<forall>i\<ge>Suc n. x i = 0} \<inter> {x. x n = 1}"
           by (auto simp: hi_def topspace_Euclidean_space)
         then have eq: "subtopology (Euclidean_space (Suc n)) {x. x \<in> hi \<and> x n = 1} = ?ST 1"
           by (simp add: Euclidean_space_def subtopology_subtopology)
         show "homotopic_with (\<lambda>x. True) (subtopology (Euclidean_space (Suc n)) hi) (subtopology (Euclidean_space (Suc n)) hi) (ret 1) id"
           using hw_sub [OF \<open>squashable 1 hi\<close> \<open>squashable 1 UNIV\<close>] eq by simp
         show "retraction_maps (subtopology (Euclidean_space (Suc n)) hi) (?ST 1) (ret 1) id"
           using rm_ret [OF \<open>squashable 1 hi\<close>] eq by simp
       qed
       ultimately show ?thesis by metis
     qed
     have "?lhs \<cong> relative_homology_group p (Euclidean_space (Suc n)) (lo \<inter> hi)"
     proof (rule group.iso_sym [OF _ deformation_retract_imp_isomorphic_relative_homology_groups])
       have "{x. \<forall>i\<ge>Suc n. x i = 0} \<inter> {x. x n = 0} = {x. \<forall>i\<ge>n. x i = (0::real)}"
         by auto (metis le_less_Suc_eq not_le)
       then have "?ST 0 = Euclidean_space n"
         by (simp add: Euclidean_space_def subtopology_subtopology)
       then show "retraction_maps (Euclidean_space (Suc n)) (Euclidean_space n) (ret 0) id"
         using rm_ret [OF \<open>squashable 0 UNIV\<close>] by auto
       then have "ret 0 x \<in> topspace (Euclidean_space n)"
         if "x \<in> topspace (Euclidean_space (Suc n))" "-1 < x n" "x n < 1" for x
         using that by (simp add: continuous_map_def retraction_maps_def)
       then show "(ret 0) ` (lo \<inter> hi) \<subseteq> topspace (Euclidean_space n) - S"
         by (auto simp: local.cong ret_def hi_def lo_def)
       show "homotopic_with (\<lambda>h. h ` (lo \<inter> hi) \<subseteq> lo \<inter> hi) (Euclidean_space (Suc n)) (Euclidean_space (Suc n)) (ret 0) id"
         using hw_sub [OF squashable squashable_0_lohi] by simp
     qed (auto simp: lo_def hi_def Euclidean_space_def)
     also have "\<dots> \<cong> relative_homology_group p (subtopology (Euclidean_space (Suc n)) hi) (lo \<inter> hi)"
     proof (rule group.iso_sym [OF _ isomorphic_relative_homology_groups_inclusion_contractible])
       show "contractible_space (subtopology (Euclidean_space (Suc n)) hi)"
         by (simp add: cs_hi)
       show "topspace (Euclidean_space (Suc n)) \<inter> hi \<noteq> {}"
         apply (simp add: hi_def topspace_Euclidean_space set_eq_iff)
         apply (rule_tac x="\<lambda>i. if i = n then 1 else 0" in exI, auto)
         done
     qed auto
     also have "\<dots> \<cong> relative_homology_group p (subtopology (Euclidean_space (Suc n)) (lo \<union> hi)) lo"
     proof -
       have oo: "openin (Euclidean_space (Suc n)) {x \<in> topspace (Euclidean_space (Suc n)). x n \<in> A}"
         if "open A" for A
       proof (rule openin_continuous_map_preimage)
         show "continuous_map (Euclidean_space (Suc n)) euclideanreal (\<lambda>x. x n)"
         proof -
           have "\<forall>n f. continuous_map (product_topology f UNIV) (f (n::nat)) (\<lambda>f. f n::real)"
             by (simp add: continuous_map_product_projection)
           then show ?thesis
             using Euclidean_space_def continuous_map_from_subtopology
             by (metis (mono_tags))
         qed
       qed (auto intro: that)
       have "openin (Euclidean_space(Suc n)) lo"
         apply (simp add: openin_subopen [of _ lo])
         apply (simp add: lo_def, safe)
          apply (force intro: oo [of "lessThan 0", simplified] open_Collect_less)
         apply (rule_tac x="{x \<in> topspace(Euclidean_space(Suc n)). x n < 1}
                             \<inter> (topspace(Euclidean_space(Suc n)) - S)" in exI)
         using clo apply (force intro: oo [of "lessThan 1", simplified] open_Collect_less)
         done
       moreover have "openin (Euclidean_space(Suc n)) hi"
         apply (simp add: openin_subopen [of _ hi])
         apply (simp add: hi_def, safe)
          apply (force intro: oo [of "greaterThan 0", simplified] open_Collect_less)
         apply (rule_tac x="{x \<in> topspace(Euclidean_space(Suc n)). x n > -1}
                                 \<inter> (topspace(Euclidean_space(Suc n)) - S)" in exI)
         using clo apply (force intro: oo [of "greaterThan (-1)", simplified] open_Collect_less)
         done
       ultimately
       have *: "subtopology (Euclidean_space (Suc n)) (lo \<union> hi) closure_of
                    (topspace (subtopology (Euclidean_space (Suc n)) (lo \<union> hi)) - hi)
                    \<subseteq> subtopology (Euclidean_space (Suc n)) (lo \<union> hi) interior_of lo"
         by (metis (no_types, lifting) Diff_idemp Diff_subset_conv Un_commute Un_upper2 closure_of_interior_of interior_of_closure_of interior_of_complement interior_of_eq lo_hi_Un openin_Un openin_open_subtopology topspace_subtopology_subset)
       have eq: "((lo \<union> hi) \<inter> (lo \<union> hi - (topspace (Euclidean_space (Suc n)) \<inter> (lo \<union> hi) - hi))) = hi"
         "(lo - (topspace (Euclidean_space (Suc n)) \<inter> (lo \<union> hi) - hi)) = lo \<inter> hi"
         by (auto simp: lo_def hi_def Euclidean_space_def)
       show ?thesis
         using homology_excision_axiom [OF *, of "lo \<union> hi" p]
         by (force simp: subtopology_subtopology eq is_iso_def)
     qed
     also have "\<dots> \<cong> relative_homology_group (p + 1 - 1) (subtopology (Euclidean_space (Suc n)) (lo \<union> hi)) lo"
       by simp
     also have "\<dots> \<cong> relative_homology_group (p + 1) (Euclidean_space (Suc n)) (lo \<union> hi)"
     proof (rule group.iso_sym [OF _ isomorphic_relative_homology_groups_relboundary_contractible])
       have proj: "continuous_map (powertop_real UNIV) euclideanreal (\<lambda>f. f n)"
         by (metis UNIV_I continuous_map_product_projection)
       have hilo: "\<And>x. x \<in> hi \<Longrightarrow> (\<lambda>i. if i = n then - x i else x i) \<in> lo"
                  "\<And>x. x \<in> lo \<Longrightarrow> (\<lambda>i. if i = n then - x i else x i) \<in> hi"
         using local.cong
         by (auto simp: hi_def lo_def topspace_Euclidean_space split: if_split_asm)
       have "subtopology (Euclidean_space (Suc n)) hi homeomorphic_space subtopology (Euclidean_space (Suc n)) lo"
         unfolding homeomorphic_space_def
         apply (rule_tac x="\<lambda>x i. if i = n then -(x i) else x i" in exI)+
         using proj
         apply (auto simp: homeomorphic_maps_def Euclidean_space_def continuous_map_in_subtopology
                           hilo continuous_map_componentwise_UNIV continuous_map_from_subtopology continuous_map_minus
                     intro: continuous_map_from_subtopology continuous_map_product_projection)
         done
       then have "contractible_space(subtopology (Euclidean_space(Suc n)) hi)
              \<longleftrightarrow> contractible_space (subtopology (Euclidean_space (Suc n)) lo)"
         by (rule homeomorphic_space_contractibility)
       then show "contractible_space (subtopology (Euclidean_space (Suc n)) lo)"
         using cs_hi by auto
       show "topspace (Euclidean_space (Suc n)) \<inter> lo \<noteq> {}"
         apply (simp add: lo_def Euclidean_space_def set_eq_iff)
         apply (rule_tac x="\<lambda>i. if i = n then -1 else 0" in exI, auto)
         done
     qed auto
     also have "\<dots> \<cong> ?rhs"
       by (simp flip: lo_hi_Un)
     finally show ?thesis .
   qed
   show ?thesis
   proof (induction k)
     case (Suc m)
     with assms obtain T where cloT: "closedin (powertop_real UNIV) T"
                          and SeqT: "S = T \<inter> {x. \<forall>i\<ge>n. x i = 0}"
       by (auto simp: Euclidean_space_def closedin_subtopology)
     then have "closedin (Euclidean_space (m + n)) S"
       apply (simp add: Euclidean_space_def closedin_subtopology)
       apply (rule_tac x="T \<inter> topspace(Euclidean_space n)" in exI)
       using closedin_Euclidean_space topspace_Euclidean_space by force
     moreover have "relative_homology_group p (Euclidean_space n) (topspace (Euclidean_space n) - S)
                 \<cong> relative_homology_group (p + 1) (Euclidean_space (Suc n)) (topspace (Euclidean_space (Suc n)) - S)"
       if "closedin (Euclidean_space n) S" for p n
     proof -
       define S' where "S' \<equiv> {x \<in> topspace(Euclidean_space(Suc n)). (\<lambda>i. if i < n then x i else 0) \<in> S}"
       have Ssub_n: "S \<subseteq> topspace (Euclidean_space n)"
         by (meson that closedin_def)
       have "relative_homology_group p (Euclidean_space n) (topspace(Euclidean_space n) - S')
            \<cong> relative_homology_group (p + 1) (Euclidean_space (Suc n)) (topspace(Euclidean_space (Suc n)) - {x \<in> S'. x n = 0})"
       proof (rule *)
         have cm: "continuous_map (powertop_real UNIV) euclideanreal (\<lambda>f. f u)" for u
           by (metis UNIV_I continuous_map_product_projection)
         have "continuous_map (subtopology (powertop_real UNIV) {x. \<forall>i>n. x i = 0}) euclideanreal
                 (\<lambda>x. if k \<le> n then x k else 0)" for k
           by (simp add: continuous_map_from_subtopology [OF cm])
         moreover have "\<forall>i\<ge>n. (if i < n then x i else 0) = 0"
           if "x \<in> topspace (subtopology (powertop_real UNIV) {x. \<forall>i>n. x i = 0})" for x
           using that by simp
         ultimately have "continuous_map (Euclidean_space (Suc n)) (Euclidean_space n) (\<lambda>x i. if i < n then x i else 0)"
           by (simp add: Euclidean_space_def continuous_map_in_subtopology continuous_map_componentwise_UNIV
                         continuous_map_from_subtopology [OF cm] image_subset_iff)
         then show "closedin (Euclidean_space (Suc n)) S'"
           unfolding S'_def using that by (rule closedin_continuous_map_preimage)
       next
         fix x y
         assume xy: "\<And>i. i \<noteq> n \<Longrightarrow> x i = y i" "x \<in> S'"
         then have "(\<lambda>i. if i < n then x i else 0) = (\<lambda>i. if i < n then y i else 0)"
           by (simp add: S'_def Euclidean_space_def fun_eq_iff)
         with xy show "y \<in> S'"
           by (simp add: S'_def Euclidean_space_def)
       qed
       moreover
       have abs_eq: "(\<lambda>i. if i < n then x i else 0) = x" if "\<And>i. i \<ge> n \<Longrightarrow> x i = 0" for x :: "nat \<Rightarrow> real" and n
         using that by auto
       then have "topspace (Euclidean_space n) - S' = topspace (Euclidean_space n) - S"
         by (simp add: S'_def Euclidean_space_def set_eq_iff cong: conj_cong)
       moreover
       have "topspace (Euclidean_space (Suc n)) - {x \<in> S'. x n = 0} = topspace (Euclidean_space (Suc n)) - S"
         using Ssub_n
         apply (auto simp: S'_def subset_iff Euclidean_space_def set_eq_iff abs_eq  cong: conj_cong)
         by (metis abs_eq le_antisym not_less_eq_eq)
       ultimately show ?thesis
         by simp
     qed
     ultimately have "relative_homology_group (p + m)(Euclidean_space (m + n))(topspace (Euclidean_space (m + n)) - S)
             \<cong> relative_homology_group (p + m + 1) (Euclidean_space (Suc (m + n))) (topspace (Euclidean_space (Suc (m + n))) - S)"
       by (metis \<open>closedin (Euclidean_space (m + n)) S\<close>)
     then show ?case
       using Suc.IH iso_trans by (force simp: algebra_simps)
   qed (simp add: iso_refl)
 qed
 
 lemma iso_Euclidean_complements_lemma1:
   assumes S: "closedin (Euclidean_space m) S" and cmf: "continuous_map(subtopology (Euclidean_space m) S) (Euclidean_space n) f"
   obtains g where "continuous_map (Euclidean_space m) (Euclidean_space n) g"
                   "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   have cont: "continuous_on (topspace (Euclidean_space m) \<inter> S) (\<lambda>x. f x i)" for i
     by (metis (no_types) continuous_on_product_then_coordinatewise
             cm_Euclidean_space_iff_continuous_on cmf topspace_subtopology)
   have "f ` (topspace (Euclidean_space m) \<inter> S) \<subseteq> topspace (Euclidean_space n)"
     using cmf continuous_map_image_subset_topspace by fastforce
   then
   have "\<exists>g. continuous_on (topspace (Euclidean_space m)) g \<and> (\<forall>x \<in> S. g x = f x i)" for i
     using S Tietze_unbounded [OF cont [of i]]
     by (metis closedin_Euclidean_space_iff closedin_closed_Int topspace_subtopology topspace_subtopology_subset)
   then obtain g where cmg: "\<And>i. continuous_map (Euclidean_space m) euclideanreal (g i)"
     and gf: "\<And>i x. x \<in> S \<Longrightarrow> g i x = f x i"
     unfolding continuous_map_Euclidean_space_iff by metis
   let ?GG = "\<lambda>x i. if i < n then g i x else 0"
   show thesis
   proof
     show "continuous_map (Euclidean_space m) (Euclidean_space n) ?GG"
       unfolding Euclidean_space_def [of n]
       by (auto simp: continuous_map_in_subtopology continuous_map_componentwise cmg)
     show "?GG x = f x" if "x \<in> S" for x
     proof -
       have "S \<subseteq> topspace (Euclidean_space m)"
         by (meson S closedin_def)
       then have "f x \<in> topspace (Euclidean_space n)"
         using cmf that unfolding continuous_map_def topspace_subtopology by blast
       then show ?thesis
         by (force simp: topspace_Euclidean_space gf that)
     qed
   qed
 qed
 
 
 lemma iso_Euclidean_complements_lemma2:
   assumes S: "closedin (Euclidean_space m) S"
       and T: "closedin (Euclidean_space n) T"
       and hom: "homeomorphic_map (subtopology (Euclidean_space m) S) (subtopology (Euclidean_space n) T) f"
   obtains g where "homeomorphic_map (prod_topology (Euclidean_space m) (Euclidean_space n))
                                     (prod_topology (Euclidean_space n) (Euclidean_space m)) g"
                   "\<And>x. x \<in> S \<Longrightarrow> g(x,(\<lambda>i. 0)) = (f x,(\<lambda>i. 0))"
 proof -
   obtain g where cmf: "continuous_map (subtopology (Euclidean_space m) S) (subtopology (Euclidean_space n) T) f"
            and cmg: "continuous_map (subtopology (Euclidean_space n) T) (subtopology (Euclidean_space m) S) g"
            and gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
            and fg: "\<And>y. y \<in> T \<Longrightarrow> f (g y) = y"
     using hom S T closedin_subset unfolding homeomorphic_map_maps homeomorphic_maps_def
     by fastforce
   obtain f' where cmf': "continuous_map (Euclidean_space m) (Euclidean_space n) f'"
              and f'f: "\<And>x. x \<in> S \<Longrightarrow> f' x = f x"
     using iso_Euclidean_complements_lemma1 S cmf continuous_map_into_fulltopology by metis
   obtain g' where cmg': "continuous_map (Euclidean_space n) (Euclidean_space m) g'"
              and g'g: "\<And>x. x \<in> T \<Longrightarrow> g' x = g x"
     using iso_Euclidean_complements_lemma1 T cmg continuous_map_into_fulltopology by metis
   define p  where "p \<equiv> \<lambda>(x,y). (x,(\<lambda>i. y i + f' x i))"
   define p' where "p' \<equiv> \<lambda>(x,y). (x,(\<lambda>i. y i - f' x i))"
   define q  where "q \<equiv> \<lambda>(x,y). (x,(\<lambda>i. y i + g' x i))"
   define q' where "q' \<equiv> \<lambda>(x,y). (x,(\<lambda>i. y i - g' x i))"
   have "homeomorphic_maps (prod_topology (Euclidean_space m) (Euclidean_space n))
                           (prod_topology (Euclidean_space m) (Euclidean_space n))
                           p p'"
        "homeomorphic_maps (prod_topology (Euclidean_space n) (Euclidean_space m))
                           (prod_topology (Euclidean_space n) (Euclidean_space m))
                           q q'"
        "homeomorphic_maps (prod_topology (Euclidean_space m) (Euclidean_space n))
                           (prod_topology (Euclidean_space n) (Euclidean_space m)) (\<lambda>(x,y). (y,x)) (\<lambda>(x,y). (y,x))"
     apply (simp_all add: p_def p'_def q_def q'_def homeomorphic_maps_def continuous_map_pairwise)
     apply (force simp: case_prod_unfold continuous_map_of_fst [unfolded o_def] cmf' cmg' intro: continuous_intros)+
     done
   then have "homeomorphic_maps (prod_topology (Euclidean_space m) (Euclidean_space n))
                           (prod_topology (Euclidean_space n) (Euclidean_space m))
                           (q' \<circ> (\<lambda>(x,y). (y,x)) \<circ> p) (p' \<circ> ((\<lambda>(x,y). (y,x)) \<circ> q))"
     using homeomorphic_maps_compose homeomorphic_maps_sym by (metis (no_types, lifting))
   moreover
   have "\<And>x. x \<in> S \<Longrightarrow> (q' \<circ> (\<lambda>(x,y). (y,x)) \<circ> p) (x, \<lambda>i. 0) = (f x, \<lambda>i. 0)"
     apply (simp add: q'_def p_def f'f)
     apply (simp add: fun_eq_iff)
     by (metis S T closedin_subset g'g gf hom homeomorphic_imp_surjective_map image_eqI topspace_subtopology_subset)
   ultimately
   show thesis
     using homeomorphic_map_maps that by blast
 qed
 
 
 proposition isomorphic_relative_homology_groups_Euclidean_complements:
   assumes S: "closedin (Euclidean_space n) S" and T: "closedin (Euclidean_space n) T"
    and hom: "(subtopology (Euclidean_space n) S) homeomorphic_space (subtopology (Euclidean_space n) T)"
    shows "relative_homology_group p (Euclidean_space n) (topspace(Euclidean_space n) - S)
           \<cong> relative_homology_group p (Euclidean_space n) (topspace(Euclidean_space n) - T)"
 proof -
   have subST: "S \<subseteq> topspace(Euclidean_space n)" "T \<subseteq> topspace(Euclidean_space n)"
     by (meson S T closedin_def)+
   have "relative_homology_group p (Euclidean_space n) (topspace (Euclidean_space n) - S)
         \<cong> relative_homology_group (p + int n) (Euclidean_space (n + n)) (topspace (Euclidean_space (n + n)) - S)"
     using relative_homology_group_Euclidean_complement_step [OF S] by blast
   moreover have "relative_homology_group p (Euclidean_space n) (topspace (Euclidean_space n) - T)
         \<cong> relative_homology_group (p + int n) (Euclidean_space (n + n)) (topspace (Euclidean_space (n + n)) - T)"
     using relative_homology_group_Euclidean_complement_step [OF T] by blast
   moreover have "relative_homology_group (p + int n) (Euclidean_space (n + n)) (topspace (Euclidean_space (n + n)) - S)
                \<cong> relative_homology_group (p + int n) (Euclidean_space (n + n)) (topspace (Euclidean_space (n + n)) - T)"
   proof -
     obtain f where f: "homeomorphic_map (subtopology (Euclidean_space n) S)
                                         (subtopology (Euclidean_space n) T) f"
       using hom unfolding homeomorphic_space by blast
     obtain g where g: "homeomorphic_map (prod_topology (Euclidean_space n) (Euclidean_space n))
                                         (prod_topology (Euclidean_space n) (Euclidean_space n)) g"
               and gf: "\<And>x. x \<in> S \<Longrightarrow> g(x,(\<lambda>i. 0)) = (f x,(\<lambda>i. 0))"
       using S T f iso_Euclidean_complements_lemma2 by blast
     define h where "h \<equiv> \<lambda>x::nat \<Rightarrow>real. ((\<lambda>i. if i < n then x i else 0), (\<lambda>j. if j < n then x(n + j) else 0))"
     define k where "k \<equiv> \<lambda>(x,y) i. if i < 2 * n then if i < n then x i else y(i - n) else (0::real)"
     have hk: "homeomorphic_maps (Euclidean_space(2 * n)) (prod_topology (Euclidean_space n) (Euclidean_space n)) h k"
       unfolding homeomorphic_maps_def
     proof safe
       show "continuous_map (Euclidean_space (2 * n))
                            (prod_topology (Euclidean_space n) (Euclidean_space n)) h"
         apply (simp add: h_def continuous_map_pairwise o_def continuous_map_componentwise_Euclidean_space)
         unfolding Euclidean_space_def
         by (metis (mono_tags) UNIV_I continuous_map_from_subtopology continuous_map_product_projection)
       have "continuous_map (prod_topology (Euclidean_space n) (Euclidean_space n)) euclideanreal (\<lambda>p. fst p i)" for i
         using Euclidean_space_def continuous_map_into_fulltopology continuous_map_fst by fastforce
       moreover
       have "continuous_map (prod_topology (Euclidean_space n) (Euclidean_space n)) euclideanreal (\<lambda>p. snd p (i - n))" for i
         using Euclidean_space_def continuous_map_into_fulltopology continuous_map_snd by fastforce
       ultimately
       show "continuous_map (prod_topology (Euclidean_space n) (Euclidean_space n))
                            (Euclidean_space (2 * n)) k"
         by (simp add: k_def continuous_map_pairwise o_def continuous_map_componentwise_Euclidean_space case_prod_unfold)
     qed (auto simp: k_def h_def fun_eq_iff topspace_Euclidean_space)
     define kgh where "kgh \<equiv> k \<circ> g \<circ> h"
     let ?i = "hom_induced (p + n) (Euclidean_space(2 * n)) (topspace(Euclidean_space(2 * n)) - S)
                                  (Euclidean_space(2 * n)) (topspace(Euclidean_space(2 * n)) - T) kgh"
     have "?i \<in> iso (relative_homology_group (p + int n) (Euclidean_space (2 * n))
                     (topspace (Euclidean_space (2 * n)) - S))
                    (relative_homology_group (p + int n) (Euclidean_space (2 * n))
                     (topspace (Euclidean_space (2 * n)) - T))"
     proof (rule homeomorphic_map_relative_homology_iso)
       show hm: "homeomorphic_map (Euclidean_space (2 * n)) (Euclidean_space (2 * n)) kgh"
         unfolding kgh_def by (meson hk g homeomorphic_map_maps homeomorphic_maps_compose homeomorphic_maps_sym)
       have Teq: "T = f ` S"
         using f homeomorphic_imp_surjective_map subST(1) subST(2) topspace_subtopology_subset by blast
       have khf: "\<And>x. x \<in> S \<Longrightarrow> k(h(f x)) = f x"
         by (metis (no_types, lifting) Teq hk homeomorphic_maps_def image_subset_iff le_add1 mult_2 subST(2) subsetD subset_Euclidean_space)
       have gh: "g(h x) = h(f x)" if "x \<in> S" for x
       proof -
         have [simp]: "(\<lambda>i. if i < n then x i else 0) = x"
           using subST(1) that topspace_Euclidean_space by (auto simp: fun_eq_iff)
         have "f x \<in> topspace(Euclidean_space n)"
           using Teq subST(2) that by blast
         moreover have "(\<lambda>j. if j < n then x (n + j) else 0) = (\<lambda>j. 0::real)"
           using Euclidean_space_def subST(1) that by force
         ultimately show ?thesis
           by (simp add: topspace_Euclidean_space h_def gf \<open>x \<in> S\<close> fun_eq_iff)
       qed
       have *: "\<lbrakk>S \<subseteq> U; T \<subseteq> U; kgh ` U = U; inj_on kgh U; kgh ` S = T\<rbrakk> \<Longrightarrow> kgh ` (U - S) = U - T" for U
         unfolding inj_on_def set_eq_iff by blast
       show "kgh ` (topspace (Euclidean_space (2 * n)) - S) = topspace (Euclidean_space (2 * n)) - T"
       proof (rule *)
         show "kgh ` topspace (Euclidean_space (2 * n)) = topspace (Euclidean_space (2 * n))"
           by (simp add: hm homeomorphic_imp_surjective_map)
         show "inj_on kgh (topspace (Euclidean_space (2 * n)))"
           using hm homeomorphic_map_def by auto
         show "kgh ` S = T"
           by (simp add: Teq kgh_def gh khf)
       qed (use subST topspace_Euclidean_space in \<open>fastforce+\<close>)
     qed auto
     then show ?thesis
       by (simp add: is_isoI mult_2)
   qed
   ultimately show ?thesis
     by (meson group.iso_sym iso_trans group_relative_homology_group)
 qed
 
 lemma lemma_iod:
   assumes "S \<subseteq> T" "S \<noteq> {}" and Tsub: "T \<subseteq> topspace(Euclidean_space n)"
       and S: "\<And>a b u. \<lbrakk>a \<in> S; b \<in> T; 0 < u; u < 1\<rbrakk> \<Longrightarrow> (\<lambda>i. (1 - u) * a i + u * b i) \<in> S"
     shows "path_connectedin (Euclidean_space n) T"
 proof -
   obtain a where "a \<in> S"
     using assms by blast
   have "path_component_of (subtopology (Euclidean_space n) T) a b" if "b \<in> T" for b
     unfolding path_component_of_def
   proof (intro exI conjI)
     have [simp]: "\<forall>i\<ge>n. a i = 0"
       using Tsub \<open>a \<in> S\<close> assms(1) topspace_Euclidean_space by auto
     have [simp]: "\<forall>i\<ge>n. b i = 0"
       using Tsub that topspace_Euclidean_space by auto
     have inT: "(\<lambda>i. (1 - x) * a i + x * b i) \<in> T" if "0 \<le> x" "x \<le> 1" for x
     proof (cases "x = 0 \<or> x = 1")
       case True
       with \<open>a \<in> S\<close> \<open>b \<in> T\<close> \<open>S \<subseteq> T\<close> show ?thesis
         by force
     next
       case False
       then show ?thesis
         using subsetD [OF \<open>S \<subseteq> T\<close> S] \<open>a \<in> S\<close> \<open>b \<in> T\<close> that by auto
     qed
     have "continuous_on {0..1} (\<lambda>x. (1 - x) * a k + x * b k)" for k
       by (intro continuous_intros)
     then show "pathin (subtopology (Euclidean_space n) T) (\<lambda>t i. (1 - t) * a i + t * b i)"
       apply (simp add: Euclidean_space_def subtopology_subtopology pathin_subtopology)
       apply (simp add: pathin_def continuous_map_componentwise_UNIV inT)
       done
   qed auto
   then have "path_connected_space (subtopology (Euclidean_space n) T)"
     by (metis Tsub path_component_of_equiv path_connected_space_iff_path_component topspace_subtopology_subset)
   then show ?thesis
     by (simp add: Tsub path_connectedin_def)
 qed
 
 
 lemma invariance_of_dimension_closedin_Euclidean_space:
   assumes "closedin (Euclidean_space n) S"
   shows "subtopology (Euclidean_space n) S homeomorphic_space Euclidean_space n
          \<longleftrightarrow> S = topspace(Euclidean_space n)"
          (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   have Ssub: "S \<subseteq> topspace (Euclidean_space n)"
     by (meson assms closedin_def)
   moreover have False if "a \<notin> S" and "a \<in> topspace (Euclidean_space n)" for a
   proof -
     have cl_n: "closedin (Euclidean_space (Suc n)) (topspace(Euclidean_space n))"
       using Euclidean_space_def closedin_Euclidean_space closedin_subtopology by fastforce
     then have sub: "subtopology (Euclidean_space(Suc n)) (topspace(Euclidean_space n)) = Euclidean_space n"
       by (metis (no_types, lifting) Euclidean_space_def closedin_subset subtopology_subtopology topspace_Euclidean_space topspace_subtopology topspace_subtopology_subset)
     then have cl_S: "closedin (Euclidean_space(Suc n)) S"
       using cl_n assms closedin_closed_subtopology by fastforce
     have sub_SucS: "subtopology (Euclidean_space (Suc n)) S = subtopology (Euclidean_space n) S"
       by (metis Ssub sub subtopology_subtopology topspace_subtopology topspace_subtopology_subset)
     have non0: "{y. \<exists>x::nat\<Rightarrow>real. (\<forall>i\<ge>Suc n. x i = 0) \<and> (\<exists>i\<ge>n. x i \<noteq> 0) \<and> y = x n} = -{0}"
     proof safe
       show "False" if "\<forall>i\<ge>Suc n. f i = 0" "0 = f n" "n \<le> i" "f i \<noteq> 0" for f::"nat\<Rightarrow>real" and i
         by (metis that le_antisym not_less_eq_eq)
       show "\<exists>f::nat\<Rightarrow>real. (\<forall>i\<ge>Suc n. f i = 0) \<and> (\<exists>i\<ge>n. f i \<noteq> 0) \<and> a = f n" if "a \<noteq> 0" for a
         by (rule_tac x="(\<lambda>i. 0)(n:= a)" in exI) (force simp: that)
     qed
     have "homology_group 0 (subtopology (Euclidean_space (Suc n)) (topspace (Euclidean_space (Suc n)) - S))
           \<cong> homology_group 0 (subtopology (Euclidean_space (Suc n)) (topspace (Euclidean_space (Suc n)) - topspace (Euclidean_space n)))"
     proof (rule isomorphic_relative_contractible_space_imp_homology_groups)
       show "(topspace (Euclidean_space (Suc n)) - S = {}) =
             (topspace (Euclidean_space (Suc n)) - topspace (Euclidean_space n) = {})"
         using cl_n closedin_subset that by auto
     next
       fix p
       show "relative_homology_group p (Euclidean_space (Suc n))
          (topspace (Euclidean_space (Suc n)) - S) \<cong>
         relative_homology_group p (Euclidean_space (Suc n))
          (topspace (Euclidean_space (Suc n)) - topspace (Euclidean_space n))"
         by (simp add: L sub_SucS cl_S cl_n isomorphic_relative_homology_groups_Euclidean_complements sub)
     qed (auto simp: L)
     moreover
     have "continuous_map (powertop_real UNIV) euclideanreal (\<lambda>x. x n)"
       by (metis (no_types) UNIV_I continuous_map_product_projection)
     then have cm: "continuous_map (subtopology (Euclidean_space (Suc n)) (topspace (Euclidean_space (Suc n)) - topspace (Euclidean_space n)))
                                   euclideanreal (\<lambda>x. x n)"
       by (simp add: Euclidean_space_def continuous_map_from_subtopology)
     have False if "path_connected_space
                       (subtopology (Euclidean_space (Suc n))
                        (topspace (Euclidean_space (Suc n)) - topspace (Euclidean_space n)))"
       using path_connectedin_continuous_map_image [OF cm that [unfolded path_connectedin_topspace [symmetric]]]
             bounded_path_connected_Compl_real [of "{0}"]
       by (simp add: topspace_Euclidean_space image_def Bex_def non0 flip: path_connectedin_topspace)
     moreover
     have eq: "T = T \<inter> {x. x n \<le> 0} \<union> T \<inter> {x. x n \<ge> 0}" for T :: "(nat \<Rightarrow> real) set"
       by auto
     have "path_connectedin (Euclidean_space (Suc n)) (topspace (Euclidean_space (Suc n)) - S)"
     proof (subst eq, rule path_connectedin_Un)
       have "topspace(Euclidean_space(Suc n)) \<inter> {x. x n = 0} = topspace(Euclidean_space n)"
         apply (auto simp: topspace_Euclidean_space)
         by (metis Suc_leI inf.absorb_iff2 inf.orderE leI)
       let ?S = "topspace(Euclidean_space(Suc n)) \<inter> {x. x n < 0}"
       show "path_connectedin (Euclidean_space (Suc n))
               ((topspace (Euclidean_space (Suc n)) - S) \<inter> {x. x n \<le> 0})"
       proof (rule lemma_iod)
         show "?S \<subseteq> (topspace (Euclidean_space (Suc n)) - S) \<inter> {x. x n \<le> 0}"
           using Ssub topspace_Euclidean_space by auto
         show "?S \<noteq> {}"
           apply (simp add: topspace_Euclidean_space set_eq_iff)
           apply (rule_tac x="(\<lambda>i. 0)(n:= -1)" in exI)
           apply auto
           done
         fix a b and u::real
         assume
           "a \<in> ?S" "0 < u" "u < 1"
           "b \<in> (topspace (Euclidean_space (Suc n)) - S) \<inter> {x. x n \<le> 0}"
         then show "(\<lambda>i. (1 - u) * a i + u * b i) \<in> ?S"
           by (simp add: topspace_Euclidean_space add_neg_nonpos less_eq_real_def mult_less_0_iff)
       qed (simp add: topspace_Euclidean_space subset_iff)
       let ?T = "topspace(Euclidean_space(Suc n)) \<inter> {x. x n > 0}"
       show "path_connectedin (Euclidean_space (Suc n))
               ((topspace (Euclidean_space (Suc n)) - S) \<inter> {x. 0 \<le> x n})"
       proof (rule lemma_iod)
         show "?T \<subseteq> (topspace (Euclidean_space (Suc n)) - S) \<inter> {x. 0 \<le> x n}"
           using Ssub topspace_Euclidean_space by auto
         show "?T \<noteq> {}"
           apply (simp add: topspace_Euclidean_space set_eq_iff)
           apply (rule_tac x="(\<lambda>i. 0)(n:= 1)" in exI)
           apply auto
           done
         fix a b and u::real
         assume  "a \<in> ?T" "0 < u" "u < 1" "b \<in> (topspace (Euclidean_space (Suc n)) - S) \<inter> {x. 0 \<le> x n}"
         then show "(\<lambda>i. (1 - u) * a i + u * b i) \<in> ?T"
           by (simp add: topspace_Euclidean_space add_pos_nonneg)
       qed (simp add: topspace_Euclidean_space subset_iff)
       show "(topspace (Euclidean_space (Suc n)) - S) \<inter> {x. x n \<le> 0} \<inter>
             ((topspace (Euclidean_space (Suc n)) - S) \<inter> {x. 0 \<le> x n}) \<noteq> {}"
         using that
         apply (auto simp: Set.set_eq_iff topspace_Euclidean_space)
         by (metis Suc_leD order_refl)
     qed
     then have "path_connected_space (subtopology (Euclidean_space (Suc n))
                                          (topspace (Euclidean_space (Suc n)) - S))"
       apply (simp add: path_connectedin_subtopology flip: path_connectedin_topspace)
       by (metis Int_Diff inf_idem)
     ultimately
     show ?thesis
       using isomorphic_homology_imp_path_connectedness by blast
   qed
   ultimately show ?rhs
     by blast
 qed (simp add: homeomorphic_space_refl)
 
 
 
 lemma isomorphic_homology_groups_Euclidean_complements:
   assumes "closedin (Euclidean_space n) S" "closedin (Euclidean_space n) T"
            "(subtopology (Euclidean_space n) S) homeomorphic_space (subtopology (Euclidean_space n) T)"
   shows "homology_group p (subtopology (Euclidean_space n) (topspace(Euclidean_space n) - S))
          \<cong> homology_group p (subtopology (Euclidean_space n) (topspace(Euclidean_space n) - T))"
 proof (rule isomorphic_relative_contractible_space_imp_homology_groups)
   show "topspace (Euclidean_space n) - S \<subseteq> topspace (Euclidean_space n)"
     using assms homeomorphic_space_sym invariance_of_dimension_closedin_Euclidean_space subtopology_superset by fastforce
   show "topspace (Euclidean_space n) - T \<subseteq> topspace (Euclidean_space n)"
     using assms invariance_of_dimension_closedin_Euclidean_space subtopology_superset by force
   show "(topspace (Euclidean_space n) - S = {}) = (topspace (Euclidean_space n) - T = {})"
     by (metis Diff_eq_empty_iff assms closedin_subset homeomorphic_space_sym invariance_of_dimension_closedin_Euclidean_space subset_antisym subtopology_topspace)
   show "relative_homology_group p (Euclidean_space n) (topspace (Euclidean_space n) - S) \<cong>
         relative_homology_group p (Euclidean_space n) (topspace (Euclidean_space n) - T)" for p
     using assms isomorphic_relative_homology_groups_Euclidean_complements by blast
 qed auto
 
 lemma eqpoll_path_components_Euclidean_complements:
   assumes "closedin (Euclidean_space n) S" "closedin (Euclidean_space n) T"
           "(subtopology (Euclidean_space n) S) homeomorphic_space (subtopology (Euclidean_space n) T)"
  shows "path_components_of
              (subtopology (Euclidean_space n)
                           (topspace(Euclidean_space n) - S))
       \<approx> path_components_of
              (subtopology (Euclidean_space n)
                           (topspace(Euclidean_space n) - T))"
   by (simp add: assms isomorphic_homology_groups_Euclidean_complements isomorphic_homology_imp_path_components)
 
 lemma path_connectedin_Euclidean_complements:
   assumes "closedin (Euclidean_space n) S" "closedin (Euclidean_space n) T"
           "(subtopology (Euclidean_space n) S) homeomorphic_space (subtopology (Euclidean_space n) T)"
   shows "path_connectedin (Euclidean_space n) (topspace(Euclidean_space n) - S)
          \<longleftrightarrow> path_connectedin (Euclidean_space n) (topspace(Euclidean_space n) - T)"
   by (meson Diff_subset assms isomorphic_homology_groups_Euclidean_complements isomorphic_homology_imp_path_connectedness path_connectedin_def)
 
 lemma eqpoll_connected_components_Euclidean_complements:
   assumes S: "closedin (Euclidean_space n) S" and T: "closedin (Euclidean_space n) T"
      and ST: "(subtopology (Euclidean_space n) S) homeomorphic_space (subtopology (Euclidean_space n) T)"
   shows "connected_components_of
              (subtopology (Euclidean_space n)
                           (topspace(Euclidean_space n) - S))
         \<approx> connected_components_of
              (subtopology (Euclidean_space n)
                           (topspace(Euclidean_space n) - T))"
   using eqpoll_path_components_Euclidean_complements [OF assms]
   by (metis S T closedin_def locally_path_connected_Euclidean_space locally_path_connected_space_open_subset path_components_eq_connected_components_of)
 
 lemma connected_in_Euclidean_complements:
   assumes "closedin (Euclidean_space n) S" "closedin (Euclidean_space n) T"
           "(subtopology (Euclidean_space n) S) homeomorphic_space (subtopology (Euclidean_space n) T)"
   shows "connectedin (Euclidean_space n) (topspace(Euclidean_space n) - S)
      \<longleftrightarrow> connectedin (Euclidean_space n) (topspace(Euclidean_space n) - T)"
   apply (simp add: connectedin_def connected_space_iff_components_subset_singleton subset_singleton_iff_lepoll)
   using eqpoll_connected_components_Euclidean_complements [OF assms]
   by (meson eqpoll_sym lepoll_trans1)
 
 
 theorem invariance_of_dimension_Euclidean_space:
    "Euclidean_space m homeomorphic_space Euclidean_space n \<longleftrightarrow> m = n"
 proof (cases m n rule: linorder_cases)
   case less
   then have *: "topspace (Euclidean_space m) \<subseteq> topspace (Euclidean_space n)"
     by (meson le_cases not_le subset_Euclidean_space)
   then have "Euclidean_space m = subtopology (Euclidean_space n) (topspace(Euclidean_space m))"
     by (simp add: Euclidean_space_def inf.absorb_iff2 subtopology_subtopology)
   then show ?thesis
     by (metis (no_types, lifting) * Euclidean_space_def closedin_Euclidean_space closedin_closed_subtopology eq_iff invariance_of_dimension_closedin_Euclidean_space subset_Euclidean_space topspace_Euclidean_space)
 next
   case equal
   then show ?thesis
     by (simp add: homeomorphic_space_refl)
 next
   case greater
   then have *: "topspace (Euclidean_space n) \<subseteq> topspace (Euclidean_space m)"
     by (meson le_cases not_le subset_Euclidean_space)
   then have "Euclidean_space n = subtopology (Euclidean_space m) (topspace(Euclidean_space n))"
     by (simp add: Euclidean_space_def inf.absorb_iff2 subtopology_subtopology)
   then show ?thesis
     by (metis (no_types, lifting) "*" Euclidean_space_def closedin_Euclidean_space closedin_closed_subtopology eq_iff homeomorphic_space_sym invariance_of_dimension_closedin_Euclidean_space subset_Euclidean_space topspace_Euclidean_space)
 qed
 
 
 
 lemma biglemma:
   assumes "n \<noteq> 0" and S: "compactin (Euclidean_space n) S"
       and cmh: "continuous_map (subtopology (Euclidean_space n) S) (Euclidean_space n) h"
       and "inj_on h S"
     shows "path_connectedin (Euclidean_space n) (topspace(Euclidean_space n) - h ` S)
        \<longleftrightarrow> path_connectedin (Euclidean_space n) (topspace(Euclidean_space n) - S)"
 proof (rule path_connectedin_Euclidean_complements)
   have hS_sub: "h ` S \<subseteq> topspace(Euclidean_space n)"
     by (metis (no_types) S cmh compactin_subspace continuous_map_image_subset_topspace topspace_subtopology_subset)
   show clo_S: "closedin (Euclidean_space n) S"
     using assms by (simp add: continuous_map_in_subtopology Hausdorff_Euclidean_space compactin_imp_closedin)
   show clo_hS: "closedin (Euclidean_space n) (h ` S)"
     using Hausdorff_Euclidean_space S cmh compactin_absolute compactin_imp_closedin image_compactin by blast
   have "homeomorphic_map (subtopology (Euclidean_space n) S) (subtopology (Euclidean_space n) (h ` S)) h"
   proof (rule continuous_imp_homeomorphic_map)
     show "compact_space (subtopology (Euclidean_space n) S)"
       by (simp add: S compact_space_subtopology)
     show "Hausdorff_space (subtopology (Euclidean_space n) (h ` S))"
       using hS_sub
       by (simp add: Hausdorff_Euclidean_space Hausdorff_space_subtopology)
     show "continuous_map (subtopology (Euclidean_space n) S) (subtopology (Euclidean_space n) (h ` S)) h"
       using cmh continuous_map_in_subtopology by fastforce
     show "h ` topspace (subtopology (Euclidean_space n) S) = topspace (subtopology (Euclidean_space n) (h ` S))"
       using clo_hS clo_S closedin_subset by auto
     show "inj_on h (topspace (subtopology (Euclidean_space n) S))"
       by (metis \<open>inj_on h S\<close> clo_S closedin_def topspace_subtopology_subset)
   qed
   then show "subtopology (Euclidean_space n) (h ` S) homeomorphic_space subtopology (Euclidean_space n) S"
     using homeomorphic_space homeomorphic_space_sym by blast
 qed
 
 
 lemma lemmaIOD:
   assumes
     "\<exists>T. T \<in> U \<and> c \<subseteq> T" "\<exists>T. T \<in> U \<and> d \<subseteq> T" "\<Union>U = c \<union> d" "\<And>T. T \<in> U \<Longrightarrow> T \<noteq> {}"
     "pairwise disjnt U" "~(\<exists>T. U \<subseteq> {T})"
   shows "c \<in> U"
   using assms
   apply safe
   subgoal for C' D'
   proof (cases "C'=D'")
     show "c \<in> U"
       if UU: "\<Union> U = c \<union> d"
         and U: "\<And>T. T \<in> U \<Longrightarrow> T \<noteq> {}" "disjoint U" and "\<nexists>T. U \<subseteq> {T}" "c \<subseteq> C'" "D' \<in> U" "d \<subseteq> D'" "C' = D'"
     proof -
       have "c \<union> d = D'"
         using Union_upper sup_mono UU that(5) that(6) that(7) that(8) by auto
       then have "\<Union>U = D'"
         by (simp add: UU)
       with U have "U = {D'}"
         by (metis (no_types, lifting) disjnt_Union1 disjnt_self_iff_empty insertCI pairwiseD subset_iff that(4) that(6))
       then show ?thesis
         using that(4) by auto
     qed
     show "c \<in> U"
       if "\<Union> U = c \<union> d""disjoint U" "C' \<in> U" "c \<subseteq> C'""D' \<in> U" "d \<subseteq> D'" "C' \<noteq> D'"
     proof -
       have "C' \<inter> D' = {}"
         using \<open>disjoint U\<close> \<open>C' \<in> U\<close> \<open>D' \<in> U\<close> \<open>C' \<noteq> D'\<close>unfolding disjnt_iff pairwise_def
         by blast
       then show ?thesis
         using subset_antisym that(1) \<open>C' \<in> U\<close> \<open>c \<subseteq> C'\<close> \<open>d \<subseteq> D'\<close> by fastforce
     qed
   qed
   done
 
 
 
 
 theorem invariance_of_domain_Euclidean_space:
   assumes U: "openin (Euclidean_space n) U"
     and cmf: "continuous_map (subtopology (Euclidean_space n) U) (Euclidean_space n) f"
     and "inj_on f U"
   shows "openin (Euclidean_space n) (f ` U)"   (is "openin ?E (f ` U)")
 proof (cases "n = 0")
   case True
   have [simp]: "Euclidean_space 0 = discrete_topology {\<lambda>i. 0}"
     by (auto simp: subtopology_eq_discrete_topology_sing topspace_Euclidean_space)
   show ?thesis
     using cmf True U by auto
 next
   case False
   define enorm where "enorm \<equiv> \<lambda>x. sqrt(\<Sum>i<n. x i ^ 2)"
   have enorm_if [simp]: "enorm (\<lambda>i. if i = k then d else 0) = (if k < n then \<bar>d\<bar> else 0)" for k d
     using \<open>n \<noteq> 0\<close> by (auto simp:  enorm_def power2_eq_square if_distrib [of "\<lambda>x. x * _"] cong: if_cong)
   define zero::"nat\<Rightarrow>real" where "zero \<equiv> \<lambda>i. 0"
   have zero_in [simp]: "zero \<in> topspace ?E"
     using False by (simp add: zero_def topspace_Euclidean_space)
   have enorm_eq_0 [simp]: "enorm x = 0 \<longleftrightarrow> x = zero"
     if "x \<in> topspace(Euclidean_space n)" for x
     using that unfolding zero_def enorm_def
     apply (simp add: sum_nonneg_eq_0_iff fun_eq_iff topspace_Euclidean_space)
     using le_less_linear by blast
   have [simp]: "enorm zero = 0"
     by (simp add: zero_def enorm_def)
   have cm_enorm: "continuous_map ?E euclideanreal enorm"
     unfolding enorm_def
   proof (intro continuous_intros)
     show "continuous_map ?E euclideanreal (\<lambda>x. x i)"
       if "i \<in> {..<n}" for i
       using that by (auto simp: Euclidean_space_def intro: continuous_map_product_projection continuous_map_from_subtopology)
   qed auto
   have enorm_ge0: "0 \<le> enorm x" for x
     by (auto simp: enorm_def sum_nonneg)
   have le_enorm: "\<bar>x i\<bar> \<le> enorm x" if "i < n" for i x
   proof -
     have "\<bar>x i\<bar> \<le> sqrt (\<Sum>k\<in>{i}. (x k)\<^sup>2)"
       by auto
     also have "\<dots> \<le> sqrt (\<Sum>k<n. (x k)\<^sup>2)"
       by (rule real_sqrt_le_mono [OF sum_mono2]) (use that in auto)
     finally show ?thesis
       by (simp add: enorm_def)
   qed
   define B where "B \<equiv> \<lambda>r. {x \<in> topspace ?E. enorm x < r}"
   define C where "C \<equiv> \<lambda>r. {x \<in> topspace ?E. enorm x \<le> r}"
   define S where "S \<equiv> \<lambda>r. {x \<in> topspace ?E. enorm x = r}"
   have BC: "B r \<subseteq> C r" and SC: "S r \<subseteq> C r" and disjSB: "disjnt (S r) (B r)" and eqC: "B r \<union> S r = C r" for r
     by (auto simp: B_def C_def S_def disjnt_def)
   consider "n = 1" | "n \<ge> 2"
     using False by linarith
   then have **: "openin ?E (h ` (B r))"
     if "r > 0" and cmh: "continuous_map(subtopology ?E (C r)) ?E h" and injh: "inj_on h (C r)" for r h
   proof cases
     case 1
     define e :: "[real,nat]\<Rightarrow>real" where "e \<equiv> \<lambda>x i. if i = 0 then x else 0"
     define e' :: "(nat\<Rightarrow>real)\<Rightarrow>real" where "e' \<equiv> \<lambda>x. x 0"
     have "continuous_map euclidean euclideanreal (\<lambda>f. f (0::nat))"
       by auto
     then have "continuous_map (subtopology (powertop_real UNIV) {f. \<forall>n\<ge>Suc 0. f n = 0}) euclideanreal (\<lambda>f. f 0)"
       by (metis (mono_tags) continuous_map_from_subtopology euclidean_product_topology)
     then have hom_ee': "homeomorphic_maps euclideanreal (Euclidean_space 1) e e'"
       by (auto simp: homeomorphic_maps_def e_def e'_def continuous_map_in_subtopology Euclidean_space_def)
     have eBr: "e ` {-r<..<r} = B r"
       unfolding B_def e_def C_def
       by(force simp: "1" topspace_Euclidean_space enorm_def power2_eq_square if_distrib [of "\<lambda>x. x * _"] cong: if_cong)
     have in_Cr: "\<And>x. \<lbrakk>-r < x; x < r\<rbrakk> \<Longrightarrow> (\<lambda>i. if i = 0 then x else 0) \<in> C r"
       using \<open>n \<noteq> 0\<close> by (auto simp: C_def topspace_Euclidean_space)
     have inj: "inj_on (e' \<circ> h \<circ> e) {- r<..<r}"
     proof (clarsimp simp: inj_on_def e_def e'_def)
       show "(x::real) = y"
         if f: "h (\<lambda>i. if i = 0 then x else 0) 0 = h (\<lambda>i. if i = 0 then y else 0) 0"
           and "-r < x" "x < r" "-r < y" "y < r"
         for x y :: real
       proof -
         have x: "(\<lambda>i. if i = 0 then x else 0) \<in> C r" and y: "(\<lambda>i. if i = 0 then y else 0) \<in> C r"
           by (blast intro: inj_onD [OF \<open>inj_on h (C r)\<close>] that in_Cr)+
         have "continuous_map (subtopology (Euclidean_space (Suc 0)) (C r)) (Euclidean_space (Suc 0)) h"
           using cmh by (simp add: 1)
         then have "h ` ({x. \<forall>i\<ge>Suc 0. x i = 0} \<inter> C r) \<subseteq> {x. \<forall>i\<ge>Suc 0. x i = 0}"
           by (force simp: Euclidean_space_def subtopology_subtopology continuous_map_def)
         have "h (\<lambda>i. if i = 0 then x else 0) j = h (\<lambda>i. if i = 0 then y else 0) j" for j
         proof (cases j)
           case (Suc j')
           have "h ` ({x. \<forall>i\<ge>Suc 0. x i = 0} \<inter> C r) \<subseteq> {x. \<forall>i\<ge>Suc 0. x i = 0}"
             using continuous_map_image_subset_topspace [OF cmh]
             by (simp add: 1 Euclidean_space_def subtopology_subtopology)
           with Suc f x y show ?thesis
             by (simp add: "1" image_subset_iff)
         qed (use f in blast)
         then have "(\<lambda>i. if i = 0 then x else 0) = (\<lambda>i::nat. if i = 0 then y else 0)"
           by (blast intro: inj_onD [OF \<open>inj_on h (C r)\<close>] that in_Cr)
         then show ?thesis
           by (simp add: fun_eq_iff) presburger
       qed
     qed
     have hom_e': "homeomorphic_map (Euclidean_space 1) euclideanreal e'"
       using hom_ee' homeomorphic_maps_map by blast
     have "openin (Euclidean_space n) (h ` e ` {- r<..<r})"
       unfolding 1
     proof (subst homeomorphic_map_openness [OF hom_e', symmetric])
       show "h ` e ` {- r<..<r} \<subseteq> topspace (Euclidean_space 1)"
         using "1" C_def \<open>\<And>r. B r \<subseteq> C r\<close> cmh continuous_map_image_subset_topspace eBr by fastforce
       have cont: "continuous_on {- r<..<r} (e' \<circ> h \<circ> e)"
       proof (intro continuous_on_compose)
         have "\<And>i. continuous_on {- r<..<r} (\<lambda>x. if i = 0 then x else 0)"
           by (auto simp: continuous_on_topological)
         then show "continuous_on {- r<..<r} e"
           by (force simp: e_def intro: continuous_on_coordinatewise_then_product)
         have subCr: "e ` {- r<..<r} \<subseteq> topspace (subtopology ?E (C r))"
           by (auto simp: eBr \<open>\<And>r. B r \<subseteq> C r\<close>) (auto simp: B_def)
         with cmh show "continuous_on (e ` {- r<..<r}) h"
           by (meson cm_Euclidean_space_iff_continuous_on continuous_on_subset)
         have "h ` (e ` {- r<..<r}) \<subseteq> topspace ?E"
           using subCr cmh by (simp add: continuous_map_def image_subset_iff)
         moreover have "continuous_on (topspace ?E) e'"
           by (metis "1" continuous_map_Euclidean_space_iff hom_ee' homeomorphic_maps_def)
         ultimately show "continuous_on (h ` e ` {- r<..<r}) e'"
           by (simp add: e'_def continuous_on_subset)
       qed
       show "openin euclideanreal (e' ` h ` e ` {- r<..<r})"
         using injective_eq_1d_open_map_UNIV [OF cont] inj by (simp add: image_image is_interval_1)
     qed
     then show ?thesis
       by (simp flip: eBr)
   next
     case 2
     have cloC: "\<And>r. closedin (Euclidean_space n) (C r)"
       unfolding C_def
       by (rule closedin_continuous_map_preimage [OF cm_enorm, of concl:  "{.._}", simplified])
     have cloS: "\<And>r. closedin (Euclidean_space n) (S r)"
       unfolding S_def
       by (rule closedin_continuous_map_preimage [OF cm_enorm, of concl:  "{_}", simplified])
     have C_subset: "C r \<subseteq> UNIV \<rightarrow>\<^sub>E {- \<bar>r\<bar>..\<bar>r\<bar>}"
       using le_enorm \<open>r > 0\<close>
       apply (auto simp: C_def topspace_Euclidean_space abs_le_iff)
        apply (metis add.inverse_neutral le_cases less_minus_iff not_le order_trans)
       by (metis enorm_ge0 not_le order.trans)
     have compactinC: "compactin (Euclidean_space n) (C r)"
       unfolding Euclidean_space_def compactin_subtopology
     proof
       show "compactin (powertop_real UNIV) (C r)"
       proof (rule closed_compactin [OF _ C_subset])
         show "closedin (powertop_real UNIV) (C r)"
           by (metis Euclidean_space_def cloC closedin_Euclidean_space closedin_closed_subtopology topspace_Euclidean_space)
       qed (simp add: compactin_PiE)
     qed (auto simp: C_def topspace_Euclidean_space)
     have compactinS: "compactin (Euclidean_space n) (S r)"
       unfolding Euclidean_space_def compactin_subtopology
     proof
       show "compactin (powertop_real UNIV) (S r)"
       proof (rule closed_compactin)
         show "S r \<subseteq> UNIV \<rightarrow>\<^sub>E {- \<bar>r\<bar>..\<bar>r\<bar>}"
           using C_subset \<open>\<And>r. S r \<subseteq> C r\<close> by blast
         show "closedin (powertop_real UNIV) (S r)"
           by (metis Euclidean_space_def cloS closedin_Euclidean_space closedin_closed_subtopology topspace_Euclidean_space)
       qed (simp add: compactin_PiE)
     qed (auto simp: S_def topspace_Euclidean_space)
     have h_if_B: "\<And>y. y \<in> B r \<Longrightarrow> h y \<in> topspace ?E"
       using B_def \<open>\<And>r. B r \<union> S r = C r\<close> cmh continuous_map_image_subset_topspace by fastforce
     have com_hSr: "compactin (Euclidean_space n) (h ` S r)"
       by (meson \<open>\<And>r. S r \<subseteq> C r\<close> cmh compactinS compactin_subtopology image_compactin)
     have ope_comp_hSr: "openin (Euclidean_space n) (topspace (Euclidean_space n) - h ` S r)"
     proof (rule openin_diff)
       show "closedin (Euclidean_space n) (h ` S r)"
         using Hausdorff_Euclidean_space com_hSr compactin_imp_closedin by blast
     qed auto
     have h_pcs: "h ` (B r) \<in> path_components_of (subtopology ?E (topspace ?E - h ` (S r)))"
     proof (rule lemmaIOD)
       have pc_interval: "path_connectedin (Euclidean_space n) {x \<in> topspace(Euclidean_space n). enorm x \<in> T}"
         if T: "is_interval T" for T
       proof -
         define mul :: "[real, nat \<Rightarrow> real, nat] \<Rightarrow> real" where "mul \<equiv> \<lambda>a x i. a * x i"
         let ?neg = "mul (-1)"
         have neg_neg [simp]: "?neg (?neg x) = x" for x
           by (simp add: mul_def)
         have enorm_mul [simp]: "enorm(mul a x) = abs a * enorm x" for a x
           by (simp add: enorm_def mul_def power_mult_distrib) (metis real_sqrt_abs real_sqrt_mult sum_distrib_left)
         have mul_in_top: "mul a x \<in> topspace ?E"
             if "x \<in> topspace ?E" for a x
           using mul_def that topspace_Euclidean_space by auto
         have neg_in_S: "?neg x \<in> S r"
             if "x \<in> S r" for x r
           using that topspace_Euclidean_space S_def by simp (simp add: mul_def)
         have *: "path_connectedin ?E (S d)"
           if "d \<ge> 0" for d
         proof (cases "d = 0")
           let ?ES = "subtopology ?E (S d)"
           case False
           then have "d > 0"
             using that by linarith
           moreover have "path_connected_space ?ES"
             unfolding path_connected_space_iff_path_component
           proof clarify
             have **: "path_component_of ?ES x y"
               if x: "x \<in> topspace ?ES" and y: "y \<in> topspace ?ES" "x \<noteq> ?neg y" for x y
             proof -
               show ?thesis
                 unfolding path_component_of_def pathin_def S_def
               proof (intro exI conjI)
                 let ?g = "(\<lambda>x. mul (d / enorm x) x) \<circ> (\<lambda>t i. (1 - t) * x i + t * y i)"
                 show "continuous_map (top_of_set {0::real..1}) (subtopology ?E {x \<in> topspace ?E. enorm x = d}) ?g"
                 proof (rule continuous_map_compose)
                   let ?Y = "subtopology ?E (- {zero})"
                   have **: False
                     if eq0: "\<And>j. (1 - r) * x j + r * y j = 0"
                       and ne: "x i \<noteq> - y i"
                       and d: "enorm x = d" "enorm y = d"
                       and r: "0 \<le> r" "r \<le> 1"
                     for i r
                   proof -
                     have "mul (1-r) x = ?neg (mul r y)"
                       using eq0 by (simp add: mul_def fun_eq_iff algebra_simps)
                     then have "enorm (mul (1-r) x) = enorm (?neg (mul r y))"
                       by metis
                     with r have "(1-r) * enorm x = r * enorm y"
                       by simp
                     then have r12: "r = 1/2"
                       using \<open>d \<noteq> 0\<close> d by auto
                     show ?thesis
                       using ne eq0 [of i] unfolding r12 by (simp add: algebra_simps)
                   qed
                   show "continuous_map (top_of_set {0..1}) ?Y (\<lambda>t i. (1 - t) * x i + t * y i)"
                     using x y
                     unfolding continuous_map_componentwise_UNIV Euclidean_space_def continuous_map_in_subtopology
                     apply (intro conjI allI continuous_intros)
                           apply (auto simp: zero_def mul_def S_def Euclidean_space_def fun_eq_iff)
                     using ** by blast
                   have cm_enorm': "continuous_map (subtopology (powertop_real UNIV) A) euclideanreal enorm" for A
                     unfolding enorm_def by (intro continuous_intros) auto
                   have "continuous_map ?Y (subtopology ?E {x. enorm x = d}) (\<lambda>x. mul (d / enorm x) x)"
                     unfolding continuous_map_in_subtopology
                   proof (intro conjI)
                     show "continuous_map ?Y (Euclidean_space n) (\<lambda>x. mul (d / enorm x) x)"
                       unfolding continuous_map_in_subtopology Euclidean_space_def mul_def zero_def subtopology_subtopology continuous_map_componentwise_UNIV
                     proof (intro conjI allI cm_enorm' continuous_intros)
                       show "enorm x \<noteq> 0"
                         if "x \<in> topspace (subtopology (powertop_real UNIV) ({x. \<forall>i\<ge>n. x i = 0} \<inter> - {\<lambda>i. 0}))" for x
                         using that by simp (metis abs_le_zero_iff le_enorm not_less)
                     qed auto
                   qed (use \<open>d > 0\<close> enorm_ge0 in auto)
                   moreover have "subtopology ?E {x \<in> topspace ?E. enorm x = d} = subtopology ?E {x. enorm x = d}"
                     by (simp add: subtopology_restrict Collect_conj_eq)
                   ultimately show "continuous_map ?Y (subtopology (Euclidean_space n) {x \<in> topspace (Euclidean_space n). enorm x = d}) (\<lambda>x. mul (d / enorm x) x)"
                     by metis
                 qed
                 show "?g (0::real) = x" "?g (1::real) = y"
                   using that by (auto simp: S_def zero_def mul_def fun_eq_iff)
               qed
             qed
             obtain a b where a: "a \<in> topspace ?ES" and b: "b \<in> topspace ?ES"
               and "a \<noteq> b" and negab: "?neg a \<noteq> b"
             proof
               let ?v = "\<lambda>j i::nat. if i = j then d else 0"
               show "?v 0 \<in> topspace (subtopology ?E (S d))" "?v 1 \<in> topspace (subtopology ?E (S d))"
                 using \<open>n \<ge> 2\<close> \<open>d \<ge> 0\<close> by (auto simp: S_def topspace_Euclidean_space)
               show "?v 0 \<noteq> ?v 1" "?neg (?v 0) \<noteq> (?v 1)"
                 using \<open>d > 0\<close> by (auto simp: mul_def fun_eq_iff)
             qed
             show "path_component_of ?ES x y"
               if x: "x \<in> topspace ?ES" and y: "y \<in> topspace ?ES"
               for x y
             proof -
               have "path_component_of ?ES x (?neg x)"
               proof -
                 have "path_component_of ?ES x a"
                   by (metis (no_types, opaque_lifting) ** a b \<open>a \<noteq> b\<close> negab path_component_of_trans path_component_of_sym x)
                 moreover
                 have pa_ab: "path_component_of ?ES a b" using "**" a b negab neg_neg by blast
                 then have "path_component_of ?ES a (?neg x)"
                   by (metis "**" \<open>a \<noteq> b\<close> cloS closedin_def neg_in_S path_component_of_equiv topspace_subtopology_subset x)
                 ultimately show ?thesis
                   by (meson path_component_of_trans)
               qed
               then show ?thesis
                 using "**" x y by force
             qed
           qed
           ultimately show ?thesis
             by (simp add: cloS closedin_subset path_connectedin_def)
         qed (simp add: S_def cong: conj_cong)
         have "path_component_of (subtopology ?E {x \<in> topspace ?E. enorm x \<in> T}) x y"
           if "enorm x = a" "x \<in> topspace ?E" "enorm x \<in> T" "enorm y = b" "y \<in> topspace ?E" "enorm y \<in> T"
           for x y a b
           using that
           proof (induction a b arbitrary: x y rule: linorder_less_wlog)
             case (less a b)
             then have "a \<ge> 0"
               using enorm_ge0 by blast
             with less.hyps have "b > 0"
               by linarith
             show ?case
             proof (rule path_component_of_trans)
               have y'_ts: "mul (a / b) y \<in> topspace ?E"
                 using \<open>y \<in> topspace ?E\<close> mul_in_top by blast
               moreover have "enorm (mul (a / b) y) = a"
                 unfolding enorm_mul using \<open>0 < b\<close> \<open>0 \<le> a\<close> less.prems by simp
               ultimately have y'_S: "mul (a / b) y \<in> S a"
                 using S_def by blast
               have "x \<in> S a"
                 using S_def less.prems by blast
               with \<open>x \<in> topspace ?E\<close> y'_ts y'_S
               have "path_component_of (subtopology ?E (S a)) x (mul (a / b) y)"
                 by (metis * [OF \<open>a \<ge> 0\<close>] path_connected_space_iff_path_component path_connectedin_def topspace_subtopology_subset)
               moreover
               have "{f \<in> topspace ?E. enorm f = a} \<subseteq> {f \<in> topspace ?E. enorm f \<in> T}"
                 using \<open>enorm x = a\<close> \<open>enorm x \<in> T\<close> by force
               ultimately
               show "path_component_of (subtopology ?E {x. x \<in> topspace ?E \<and> enorm x \<in> T}) x (mul (a / b) y)"
                 by (simp add: S_def path_component_of_mono)
               have "pathin ?E (\<lambda>t. mul (((1 - t) * b + t * a) / b) y)"
                 using \<open>b > 0\<close> \<open>y \<in> topspace ?E\<close>
                 unfolding pathin_def Euclidean_space_def mul_def continuous_map_in_subtopology continuous_map_componentwise_UNIV
                 by (intro allI conjI continuous_intros) auto
               moreover have "mul (((1 - t) * b + t * a) / b) y \<in> topspace ?E"
                 if "t \<in> {0..1}" for t
                 using \<open>y \<in> topspace ?E\<close> mul_in_top by blast
                 moreover have "enorm (mul (((1 - t) * b + t * a) / b) y) \<in> T"
                   if "t \<in> {0..1}" for t
                 proof -
                   have "a \<in> T" "b \<in> T"
                     using less.prems by auto
                   then have "\<bar>(1 - t) * b + t * a\<bar> \<in> T"
                   proof (rule mem_is_interval_1_I [OF T])
                     show "a \<le> \<bar>(1 - t) * b + t * a\<bar>"
                       using that \<open>a \<ge> 0\<close> less.hyps segment_bound_lemma by auto
                     show "\<bar>(1 - t) * b + t * a\<bar> \<le> b"
                       using that \<open>a \<ge> 0\<close> less.hyps by (auto intro: convex_bound_le)
                   qed
                 then show ?thesis
                   unfolding enorm_mul \<open>enorm y = b\<close> using that \<open>b > 0\<close> by simp
               qed
               ultimately have pa: "pathin (subtopology ?E {x \<in> topspace ?E. enorm x \<in> T})
                                           (\<lambda>t. mul (((1 - t) * b + t * a) / b) y)"
                 by (auto simp: pathin_subtopology)
               have ex_pathin: "\<exists>g. pathin (subtopology ?E {x \<in> topspace ?E. enorm x \<in> T}) g \<and>
                                    g 0 = y \<and> g 1 = mul (a / b) y"
                 apply (rule_tac x="\<lambda>t. mul (((1 - t) * b + t * a) / b) y" in exI)
                 using \<open>b > 0\<close> pa by (auto simp: mul_def)
               show "path_component_of (subtopology ?E {x. x \<in> topspace ?E \<and> enorm x \<in> T}) (mul (a / b) y) y"
                 by (rule path_component_of_sym) (simp add: path_component_of_def ex_pathin)
             qed
           next
             case (refl a)
             then have pc: "path_component_of (subtopology ?E (S (enorm u))) u v"
               if "u \<in> topspace ?E \<inter> S (enorm x)" "v \<in> topspace ?E \<inter> S (enorm u)" for u v
               using * [of a] enorm_ge0 that
               by (auto simp: path_connectedin_def path_connected_space_iff_path_component S_def)
             have sub: "{u \<in> topspace ?E. enorm u = enorm x} \<subseteq> {u \<in> topspace ?E. enorm u \<in> T}"
               using \<open>enorm x \<in> T\<close> by auto
             show ?case
               using pc [of x y] refl by (auto simp: S_def path_component_of_mono [OF _ sub])
           next
             case (sym a b)
             then show ?case
               by (blast intro: path_component_of_sym)
           qed
         then show ?thesis
           by (simp add: path_connectedin_def path_connected_space_iff_path_component)
       qed
       have "h ` S r \<subseteq> topspace ?E"
         by (meson SC cmh compact_imp_compactin_subtopology compactinS compactin_subset_topspace image_compactin)
       moreover
       have "\<not> compact_space ?E "
         by (metis compact_Euclidean_space \<open>n \<noteq> 0\<close>)
       then have "\<not> compactin ?E (topspace ?E)"
         by (simp add: compact_space_def topspace_Euclidean_space)
       then have "h ` S r \<noteq> topspace ?E"
         using com_hSr by auto
       ultimately have top_hSr_ne: "topspace (subtopology ?E (topspace ?E - h ` S r)) \<noteq> {}"
         by auto
       show pc1: "\<exists>T. T \<in> path_components_of (subtopology ?E (topspace ?E - h ` S r)) \<and> h ` B r \<subseteq> T"
       proof (rule exists_path_component_of_superset [OF _ top_hSr_ne])
         have "path_connectedin ?E (h ` B r)"
         proof (rule path_connectedin_continuous_map_image)
           show "continuous_map (subtopology ?E (C r)) ?E h"
             by (simp add: cmh)
           have "path_connectedin ?E (B r)"
             using pc_interval[of "{..<r}"] is_interval_convex_1 unfolding B_def by auto
             then show "path_connectedin (subtopology ?E (C r)) (B r)"
               by (simp add: path_connectedin_subtopology BC)
           qed
           moreover have "h ` B r \<subseteq> topspace ?E - h ` S r"
             apply (auto simp: h_if_B)
             by (metis BC SC disjSB disjnt_iff inj_onD [OF injh] subsetD)
         ultimately show "path_connectedin (subtopology ?E (topspace ?E - h ` S r)) (h ` B r)"
           by (simp add: path_connectedin_subtopology)
       qed metis
       show "\<exists>T. T \<in> path_components_of (subtopology ?E (topspace ?E - h ` S r)) \<and> topspace ?E - h ` (C r) \<subseteq> T"
       proof (rule exists_path_component_of_superset [OF _ top_hSr_ne])
         have eq: "topspace ?E - {x \<in> topspace ?E. enorm x \<le> r} = {x \<in> topspace ?E. r < enorm x}"
           by auto
         have "path_connectedin ?E (topspace ?E - C r)"
           using pc_interval[of "{r<..}"] is_interval_convex_1 unfolding C_def eq by auto
         then have "path_connectedin ?E (topspace ?E - h ` C r)"
           by (metis biglemma [OF \<open>n \<noteq> 0\<close> compactinC cmh injh])
         then show "path_connectedin (subtopology ?E (topspace ?E - h ` S r)) (topspace ?E - h ` C r)"
           by (simp add: Diff_mono SC image_mono path_connectedin_subtopology)
       qed metis
       have "topspace ?E \<inter> (topspace ?E - h ` S r) = h ` B r \<union> (topspace ?E - h ` C r)"         (is "?lhs = ?rhs")
       proof
         show "?lhs \<subseteq> ?rhs"
           using \<open>\<And>r. B r \<union> S r = C r\<close> by auto
         have "h ` B r \<inter> h ` S r = {}"
           by (metis Diff_triv \<open>\<And>r. B r \<union> S r = C r\<close> \<open>\<And>r. disjnt (S r) (B r)\<close> disjnt_def inf_commute inj_on_Un injh)
         then show "?rhs \<subseteq> ?lhs"
           using path_components_of_subset pc1 \<open>\<And>r. B r \<union> S r = C r\<close>
           by (fastforce simp add: h_if_B)
       qed
       then show "\<Union> (path_components_of (subtopology ?E (topspace ?E - h ` S r))) = h ` B r \<union> (topspace ?E - h ` (C r))"
         by (simp add: Union_path_components_of)
       show "T \<noteq> {}"
         if "T \<in> path_components_of (subtopology ?E (topspace ?E - h ` S r))" for T
         using that by (simp add: nonempty_path_components_of)
       show "disjoint (path_components_of (subtopology ?E (topspace ?E - h ` S r)))"
         by (simp add: pairwise_disjoint_path_components_of)
       have "\<not> path_connectedin ?E (topspace ?E - h ` S r)"
       proof (subst biglemma [OF \<open>n \<noteq> 0\<close> compactinS])
         show "continuous_map (subtopology ?E (S r)) ?E h"
           by (metis Un_commute Un_upper1 cmh continuous_map_from_subtopology_mono eqC)
         show "inj_on h (S r)"
           using SC inj_on_subset injh by blast
         show "\<not> path_connectedin ?E (topspace ?E - S r)"
         proof
           have "topspace ?E - S r = {x \<in> topspace ?E. enorm x \<noteq> r}"
             by (auto simp: S_def)
           moreover have "enorm ` {x \<in> topspace ?E. enorm x \<noteq> r} = {0..} - {r}"
           proof
             have "\<exists>x. x \<in> topspace ?E \<and> enorm x \<noteq> r \<and> d = enorm x"
               if "d \<noteq> r" "d \<ge> 0" for d
             proof (intro exI conjI)
               show "(\<lambda>i. if i = 0 then d else 0) \<in> topspace ?E"
                 using \<open>n \<noteq> 0\<close> by (auto simp: Euclidean_space_def)
               show "enorm (\<lambda>i. if i = 0 then d else 0) \<noteq> r"  "d = enorm (\<lambda>i. if i = 0 then d else 0)"
                 using \<open>n \<noteq> 0\<close> that by simp_all
             qed
             then show "{0..} - {r} \<subseteq> enorm ` {x \<in> topspace ?E. enorm x \<noteq> r}"
               by (auto simp: image_def)
           qed (auto simp: enorm_ge0)
           ultimately have non_r: "enorm ` (topspace ?E - S r) = {0..} - {r}"
             by simp
           have "\<exists>x\<ge>0. x \<noteq> r \<and> r \<le> x"
             by (metis gt_ex le_cases not_le order_trans)
           then have "\<not> is_interval ({0..} - {r})"
             unfolding is_interval_1
             using  \<open>r > 0\<close> by (auto simp: Bex_def)
           then show False
             if "path_connectedin ?E (topspace ?E - S r)"
             using path_connectedin_continuous_map_image [OF cm_enorm that] by (simp add: is_interval_path_connected_1 non_r)
         qed
       qed
       then have "\<not> path_connected_space (subtopology ?E (topspace ?E - h ` S r))"
         by (simp add: path_connectedin_def)
       then show "\<nexists>T. path_components_of (subtopology ?E (topspace ?E - h ` S r)) \<subseteq> {T}"
         by (simp add: path_components_of_subset_singleton)
     qed
     moreover have "openin ?E A"
       if "A \<in> path_components_of (subtopology ?E (topspace ?E - h ` (S r)))" for A
       using locally_path_connected_Euclidean_space [of n] that ope_comp_hSr
       by (simp add: locally_path_connected_space_open_path_components)
     ultimately show ?thesis by metis
   qed
   have "\<exists>T. openin ?E T \<and> f x \<in> T \<and> T \<subseteq> f ` U"
     if "x \<in> U" for x
   proof -
     have x: "x \<in> topspace ?E"
       by (meson U in_mono openin_subset that)
     obtain V where V: "openin (powertop_real UNIV) V" and Ueq: "U = V \<inter> {x. \<forall>i\<ge>n. x i = 0}"
       using U by (auto simp: openin_subtopology Euclidean_space_def)
     with \<open>x \<in> U\<close> have "x \<in> V" by blast
     then obtain T where Tfin: "finite {i. T i \<noteq> UNIV}" and Topen: "\<And>i. open (T i)"
       and Tx: "x \<in> Pi\<^sub>E UNIV T" and TV: "Pi\<^sub>E UNIV T \<subseteq> V"
       using V by (force simp: openin_product_topology_alt)
     have "\<exists>e>0. \<forall>x'. \<bar>x' - x i\<bar> < e \<longrightarrow> x' \<in> T i" for i
       using Topen [of i] Tx by (auto simp: open_real)
     then obtain \<beta> where B0: "\<And>i. \<beta> i > 0" and BT: "\<And>i x'. \<bar>x' - x i\<bar> < \<beta> i \<Longrightarrow> x' \<in> T i"
       by metis
     define r where "r \<equiv> Min (insert 1 (\<beta> ` {i. T i \<noteq> UNIV}))"
     have "r > 0"
       by (simp add: B0 Tfin r_def)
     have inU: "y \<in> U"
       if y: "y \<in> topspace ?E" and yxr: "\<And>i. i<n \<Longrightarrow> \<bar>y i - x i\<bar> < r" for y
     proof -
       have "y i \<in> T i" for i
       proof (cases "T i = UNIV")
         show "y i \<in> T i" if "T i \<noteq> UNIV"
         proof (cases "i < n")
           case True
           then show ?thesis
             using yxr [OF True] that by (simp add: r_def BT Tfin)
         next
           case False
           then show ?thesis
             using B0 Ueq \<open>x \<in> U\<close> topspace_Euclidean_space y by (force intro: BT)
         qed
       qed auto
       with TV have "y \<in> V" by auto
       then show ?thesis
         using that by (auto simp: Ueq topspace_Euclidean_space)
     qed
     have xinU: "(\<lambda>i. x i + y i) \<in> U" if "y \<in> C(r/2)" for y
     proof (rule inU)
       have y: "y \<in> topspace ?E"
         using C_def that by blast
       show "(\<lambda>i. x i + y i) \<in> topspace ?E"
         using x y by (simp add: topspace_Euclidean_space)
       have "enorm y \<le> r/2"
         using that by (simp add: C_def)
       then show "\<bar>x i + y i - x i\<bar> < r" if "i < n" for i
         using le_enorm enorm_ge0 that \<open>0 < r\<close> leI order_trans by fastforce
     qed
     show ?thesis
     proof (intro exI conjI)
       show "openin ?E ((f \<circ> (\<lambda>y i. x i + y i)) ` B (r/2))"
       proof (rule **)
         have "continuous_map (subtopology ?E (C(r/2))) (subtopology ?E U) (\<lambda>y i. x i + y i)"
           by (auto simp: xinU continuous_map_in_subtopology
               intro!: continuous_intros continuous_map_Euclidean_space_add x)
         then show "continuous_map (subtopology ?E (C(r/2))) ?E (f \<circ> (\<lambda>y i. x i + y i))"
           by (rule continuous_map_compose) (simp add: cmf)
         show "inj_on (f \<circ> (\<lambda>y i. x i + y i)) (C(r/2))"
         proof (clarsimp simp add: inj_on_def C_def topspace_Euclidean_space simp del: divide_const_simps)
           show "y' = y"
             if ey: "enorm y \<le> r / 2" and ey': "enorm y' \<le> r / 2"
               and y0: "\<forall>i\<ge>n. y i = 0" and y'0: "\<forall>i\<ge>n. y' i = 0"
               and feq: "f (\<lambda>i. x i + y' i) = f (\<lambda>i. x i + y i)"
             for y' y :: "nat \<Rightarrow> real"
           proof -
             have "(\<lambda>i. x i + y i) \<in> U"
             proof (rule inU)
               show "(\<lambda>i. x i + y i) \<in> topspace ?E"
                 using topspace_Euclidean_space x y0 by auto
               show "\<bar>x i + y i - x i\<bar> < r" if "i < n" for i
                 using ey le_enorm [of _ y] \<open>r > 0\<close> that by fastforce
             qed
             moreover have "(\<lambda>i. x i + y' i) \<in> U"
             proof (rule inU)
               show "(\<lambda>i. x i + y' i) \<in> topspace ?E"
                 using topspace_Euclidean_space x y'0 by auto
               show "\<bar>x i + y' i - x i\<bar> < r" if "i < n" for i
                 using ey' le_enorm [of _ y'] \<open>r > 0\<close> that by fastforce
             qed
             ultimately have "(\<lambda>i. x i + y' i) = (\<lambda>i. x i + y i)"
               using feq by (meson \<open>inj_on f U\<close> inj_on_def)
             then show ?thesis
               by (auto simp: fun_eq_iff)
           qed
         qed
       qed (simp add: \<open>0 < r\<close>)
       have "x \<in> (\<lambda>y i. x i + y i) ` B (r / 2)"
       proof
         show "x = (\<lambda>i. x i + zero i)"
           by (simp add: zero_def)
       qed (auto simp: B_def \<open>r > 0\<close>)
       then show "f x \<in> (f \<circ> (\<lambda>y i. x i + y i)) ` B (r/2)"
         by (metis image_comp image_eqI)
       show "(f \<circ> (\<lambda>y i. x i + y i)) ` B (r/2) \<subseteq> f ` U"
         using \<open>\<And>r. B r \<subseteq> C r\<close> xinU by fastforce
     qed
   qed
   then show ?thesis
     using openin_subopen by force
 qed
 
 
 corollary invariance_of_domain_Euclidean_space_embedding_map:
   assumes "openin (Euclidean_space n) U"
     and cmf: "continuous_map(subtopology (Euclidean_space n) U) (Euclidean_space n) f"
     and "inj_on f U"
   shows "embedding_map(subtopology (Euclidean_space n) U) (Euclidean_space n) f"
 proof (rule injective_open_imp_embedding_map [OF cmf])
   show "open_map (subtopology (Euclidean_space n) U) (Euclidean_space n) f"
     unfolding open_map_def
     by (meson assms continuous_map_from_subtopology_mono inj_on_subset invariance_of_domain_Euclidean_space openin_imp_subset openin_trans_full)
   show "inj_on f (topspace (subtopology (Euclidean_space n) U))"
     using assms openin_subset topspace_subtopology_subset by fastforce
 qed
 
 corollary invariance_of_domain_Euclidean_space_gen:
   assumes "n \<le> m" and U: "openin (Euclidean_space m) U"
     and cmf: "continuous_map(subtopology (Euclidean_space m) U) (Euclidean_space n) f"
     and "inj_on f U"
   shows "openin (Euclidean_space n) (f ` U)"
 proof -
   have *: "Euclidean_space n = subtopology (Euclidean_space m) (topspace(Euclidean_space n))"
     by (metis Euclidean_space_def \<open>n \<le> m\<close> inf.absorb_iff2 subset_Euclidean_space subtopology_subtopology topspace_Euclidean_space)
   moreover have "U \<subseteq> topspace (subtopology (Euclidean_space m) U)"
     by (metis U inf.absorb_iff2 openin_subset openin_subtopology openin_topspace)
   ultimately show ?thesis
     by (metis (no_types) U \<open>inj_on f U\<close> cmf continuous_map_in_subtopology inf.absorb_iff2
         inf.orderE invariance_of_domain_Euclidean_space openin_imp_subset openin_subtopology openin_topspace)
 qed
 
 corollary invariance_of_domain_Euclidean_space_embedding_map_gen:
   assumes "n \<le> m" and U: "openin (Euclidean_space m) U"
     and cmf: "continuous_map(subtopology (Euclidean_space m) U) (Euclidean_space n) f"
     and "inj_on f U"
   shows "embedding_map(subtopology (Euclidean_space m) U) (Euclidean_space n) f"
   proof (rule injective_open_imp_embedding_map [OF cmf])
   show "open_map (subtopology (Euclidean_space m) U) (Euclidean_space n) f"
     by (meson U \<open>n \<le> m\<close> \<open>inj_on f U\<close> cmf continuous_map_from_subtopology_mono invariance_of_domain_Euclidean_space_gen open_map_def openin_open_subtopology subset_inj_on)
   show "inj_on f (topspace (subtopology (Euclidean_space m) U))"
     using assms openin_subset topspace_subtopology_subset by fastforce
 qed
 
 
 subsection\<open>Relating two variants of Euclidean space, one within product topology.    \<close>
 
 proposition homeomorphic_maps_Euclidean_space_euclidean_gen_OLD:
   fixes B :: "'n::euclidean_space set"
   assumes "finite B" "independent B" and orth: "pairwise orthogonal B" and n: "card B = n"
   obtains f g where "homeomorphic_maps (Euclidean_space n) (top_of_set (span B)) f g"
 proof -
   note representation_basis [OF \<open>independent B\<close>, simp]
   obtain b where injb: "inj_on b {..<n}" and beq: "b ` {..<n} = B"
     using finite_imp_nat_seg_image_inj_on [OF \<open>finite B\<close>]
     by (metis n card_Collect_less_nat card_image lessThan_def)
   then have biB: "\<And>i. i < n \<Longrightarrow> b i \<in> B"
     by force
   have repr: "\<And>v. v \<in> span B \<Longrightarrow> (\<Sum>i<n. representation B v (b i) *\<^sub>R b i) = v"
     using real_vector.sum_representation_eq [OF \<open>independent B\<close> _ \<open>finite B\<close>]
     by (metis (no_types, lifting) injb beq order_refl sum.reindex_cong)
   let ?f = "\<lambda>x. \<Sum>i<n. x i *\<^sub>R b i"
   let ?g = "\<lambda>v i. if i < n then representation B v (b i) else 0"
   show thesis
   proof
     show "homeomorphic_maps (Euclidean_space n) (top_of_set (span B)) ?f ?g"
       unfolding homeomorphic_maps_def
     proof (intro conjI)
       have *: "continuous_map euclidean (top_of_set (span B)) ?f"
         by (metis (mono_tags) biB continuous_map_span_sum lessThan_iff)
       show "continuous_map (Euclidean_space n) (top_of_set (span B)) ?f"
         unfolding Euclidean_space_def
         by (rule continuous_map_from_subtopology) (simp add: euclidean_product_topology *)
       show "continuous_map (top_of_set (span B)) (Euclidean_space n) ?g"
         unfolding Euclidean_space_def
         by (auto simp: continuous_map_in_subtopology continuous_map_componentwise_UNIV continuous_on_representation \<open>independent B\<close> biB orth pairwise_orthogonal_imp_finite)
       have [simp]: "\<And>x i. i<n \<Longrightarrow> x i *\<^sub>R b i \<in> span B"
         by (simp add: biB span_base span_scale)
       have "representation B (?f x) (b j) = x j"
         if 0: "\<forall>i\<ge>n. x i = (0::real)" and "j < n" for x j
       proof -
         have "representation B (?f x) (b j) = (\<Sum>i<n. representation B (x i *\<^sub>R b i) (b j))"
           by (subst real_vector.representation_sum) (auto simp add: \<open>independent B\<close>)
         also have "... = (\<Sum>i<n. x i * representation B (b i) (b j))"
           by (simp add: assms(2) biB representation_scale span_base)
         also have "... = (\<Sum>i<n. if b j = b i then x i else 0)"
           by (simp add: biB if_distrib cong: if_cong)
         also have "... = x j"
           using that inj_on_eq_iff [OF injb] by auto
         finally show ?thesis .
       qed
       then show "\<forall>x\<in>topspace (Euclidean_space n). ?g (?f x) = x"
         by (auto simp: Euclidean_space_def)
       show "\<forall>y\<in>topspace (top_of_set (span B)). ?f (?g y) = y"
         using repr by (auto simp: Euclidean_space_def)
     qed
   qed
 qed
 
 proposition homeomorphic_maps_Euclidean_space_euclidean_gen:
   fixes B :: "'n::euclidean_space set"
   assumes "independent B" and orth: "pairwise orthogonal B" and n: "card B = n"
     and 1: "\<And>u. u \<in> B \<Longrightarrow> norm u = 1"
   obtains f g where "homeomorphic_maps (Euclidean_space n) (top_of_set (span B)) f g"
     and "\<And>x. x \<in> topspace (Euclidean_space n) \<Longrightarrow> (norm (f x))\<^sup>2 = (\<Sum>i<n. (x i)\<^sup>2)"
 proof -
   note representation_basis [OF \<open>independent B\<close>, simp]
   have "finite B"
     using \<open>independent B\<close> finiteI_independent by metis
   obtain b where injb: "inj_on b {..<n}" and beq: "b ` {..<n} = B"
     using finite_imp_nat_seg_image_inj_on [OF \<open>finite B\<close>]
     by (metis n card_Collect_less_nat card_image lessThan_def)
   then have biB: "\<And>i. i < n \<Longrightarrow> b i \<in> B"
     by force
   have "0 \<notin> B"
     using \<open>independent B\<close> dependent_zero by blast
   have [simp]: "b i \<bullet> b j = (if j = i then 1 else 0)"
     if "i < n" "j < n" for i j
   proof (cases "i = j")
     case True
     with 1 that show ?thesis
       by (auto simp: norm_eq_sqrt_inner biB)
   next
     case False
     then have "b i \<noteq> b j"
       by (meson inj_onD injb lessThan_iff that)
     then show ?thesis
       using orth by (auto simp: orthogonal_def pairwise_def norm_eq_sqrt_inner that biB)
   qed
   have [simp]: "\<And>x i. i<n \<Longrightarrow> x i *\<^sub>R b i \<in> span B"
     by (simp add: biB span_base span_scale)
   have repr: "\<And>v. v \<in> span B \<Longrightarrow> (\<Sum>i<n. representation B v (b i) *\<^sub>R b i) = v"
     using real_vector.sum_representation_eq [OF \<open>independent B\<close> _ \<open>finite B\<close>]
     by (metis (no_types, lifting) injb beq order_refl sum.reindex_cong)
     define f where "f \<equiv> \<lambda>x. \<Sum>i<n. x i *\<^sub>R b i"
     define g where "g \<equiv> \<lambda>v i. if i < n then representation B v (b i) else 0"
   show thesis
   proof
     show "homeomorphic_maps (Euclidean_space n) (top_of_set (span B)) f g"
       unfolding homeomorphic_maps_def
     proof (intro conjI)
       have *: "continuous_map euclidean (top_of_set (span B)) f"
         unfolding f_def
         by (rule continuous_map_span_sum) (use biB \<open>0 \<notin> B\<close> in auto)
       show "continuous_map (Euclidean_space n) (top_of_set (span B)) f"
         unfolding Euclidean_space_def
         by (rule continuous_map_from_subtopology) (simp add: euclidean_product_topology *)
       show "continuous_map (top_of_set (span B)) (Euclidean_space n) g"
         unfolding Euclidean_space_def g_def
         by (auto simp: continuous_map_in_subtopology continuous_map_componentwise_UNIV continuous_on_representation \<open>independent B\<close> biB orth pairwise_orthogonal_imp_finite)
       have "representation B (f x) (b j) = x j"
         if 0: "\<forall>i\<ge>n. x i = (0::real)" and "j < n" for x j
       proof -
         have "representation B (f x) (b j) = (\<Sum>i<n. representation B (x i *\<^sub>R b i) (b j))"
           unfolding f_def
           by (subst real_vector.representation_sum) (auto simp add: \<open>independent B\<close>)
         also have "... = (\<Sum>i<n. x i * representation B (b i) (b j))"
           by (simp add: \<open>independent B\<close> biB representation_scale span_base)
         also have "... = (\<Sum>i<n. if b j = b i then x i else 0)"
           by (simp add: biB if_distrib cong: if_cong)
         also have "... = x j"
           using that inj_on_eq_iff [OF injb] by auto
         finally show ?thesis .
       qed
       then show "\<forall>x\<in>topspace (Euclidean_space n). g (f x) = x"
         by (auto simp: Euclidean_space_def f_def g_def)
       show "\<forall>y\<in>topspace (top_of_set (span B)). f (g y) = y"
         using repr by (auto simp: Euclidean_space_def f_def g_def)
     qed
     show normeq: "(norm (f x))\<^sup>2 = (\<Sum>i<n. (x i)\<^sup>2)" if "x \<in> topspace (Euclidean_space n)" for x
       unfolding f_def  dot_square_norm [symmetric]
       by (simp add: power2_eq_square inner_sum_left inner_sum_right if_distrib biB cong: if_cong)
   qed
 qed
 
 corollary homeomorphic_maps_Euclidean_space_euclidean:
   obtains f :: "(nat \<Rightarrow> real) \<Rightarrow> 'n::euclidean_space" and g
   where "homeomorphic_maps (Euclidean_space (DIM('n))) euclidean f g"
   by (force intro: homeomorphic_maps_Euclidean_space_euclidean_gen [OF independent_Basis orthogonal_Basis refl norm_Basis])
 
 lemma homeomorphic_maps_nsphere_euclidean_sphere:
   fixes B :: "'n::euclidean_space set"
   assumes B: "independent B" and orth: "pairwise orthogonal B" and n: "card B = n" and "n \<noteq> 0"
     and 1: "\<And>u. u \<in> B \<Longrightarrow> norm u = 1"
   obtains f :: "(nat \<Rightarrow> real) \<Rightarrow> 'n::euclidean_space" and g
   where "homeomorphic_maps (nsphere(n - 1)) (top_of_set (sphere 0 1 \<inter> span B)) f g"
 proof -
   have "finite B"
     using \<open>independent B\<close> finiteI_independent by metis
   obtain f g where fg: "homeomorphic_maps (Euclidean_space n) (top_of_set (span B)) f g"
     and normf: "\<And>x. x \<in> topspace (Euclidean_space n) \<Longrightarrow> (norm (f x))\<^sup>2 = (\<Sum>i<n. (x i)\<^sup>2)"
     using homeomorphic_maps_Euclidean_space_euclidean_gen [OF B orth n 1]
     by blast
   obtain b where injb: "inj_on b {..<n}" and beq: "b ` {..<n} = B"
     using finite_imp_nat_seg_image_inj_on [OF \<open>finite B\<close>]
     by (metis n card_Collect_less_nat card_image lessThan_def)
   then have biB: "\<And>i. i < n \<Longrightarrow> b i \<in> B"
     by force
   have [simp]: "\<And>i. i < n \<Longrightarrow> b i \<noteq> 0"
     using \<open>independent B\<close> biB dependent_zero by fastforce
   have [simp]: "b i \<bullet> b j = (if j = i then (norm (b i))\<^sup>2 else 0)"
     if "i < n" "j < n" for i j
   proof (cases "i = j")
     case False
     then have "b i \<noteq> b j"
       by (meson inj_onD injb lessThan_iff that)
     then show ?thesis
       using orth by (auto simp: orthogonal_def pairwise_def norm_eq_sqrt_inner that biB)
   qed (auto simp: norm_eq_sqrt_inner)
   have [simp]: "Suc (n - Suc 0) = n"
     using Suc_pred \<open>n \<noteq> 0\<close> by blast
   then have [simp]: "{..card B - Suc 0} = {..<card B}"
     using n by fastforce
   show thesis
   proof
     have 1: "norm (f x) = 1"
       if "(\<Sum>i<card B. (x i)\<^sup>2) = (1::real)" "x \<in> topspace (Euclidean_space n)" for x
     proof -
       have "norm (f x)^2 = 1"
         using normf that by (simp add: n)
       with that show ?thesis
         by (simp add: power2_eq_imp_eq)
     qed
     have "homeomorphic_maps (nsphere (n - 1)) (top_of_set (span B \<inter> sphere 0 1)) f g"
       unfolding nsphere_def subtopology_subtopology [symmetric]
       proof (rule homeomorphic_maps_subtopologies_alt)
   show "homeomorphic_maps (Euclidean_space (Suc (n - 1))) (top_of_set (span B)) f g"
       using fg by (force simp add: )
     show "f ` (topspace (Euclidean_space (Suc (n - 1))) \<inter> {x. (\<Sum>i\<le>n - 1. (x i)\<^sup>2) = 1}) \<subseteq> sphere 0 1"
       using n by (auto simp: image_subset_iff Euclidean_space_def 1)
     have "(\<Sum>i\<le>n - Suc 0. (g u i)\<^sup>2) = 1"
       if "u \<in> span B" and "norm (u::'n) = 1" for u
     proof -
       obtain v where [simp]: "u = f v" "v \<in> topspace (Euclidean_space n)"
         using fg unfolding homeomorphic_maps_map subset_iff
         by (metis \<open>u \<in> span B\<close> homeomorphic_imp_surjective_map image_eqI topspace_euclidean_subtopology)
       then have [simp]: "g (f v) = v"
         by (meson fg homeomorphic_maps_map)
       have fv21: "norm (f v) ^ 2 = 1"
         using that by simp
       show ?thesis
         using that normf fv21 \<open>v \<in> topspace (Euclidean_space n)\<close> n by force
     qed
     then show "g ` (topspace (top_of_set (span B)) \<inter> sphere 0 1) \<subseteq> {x. (\<Sum>i\<le>n - 1. (x i)\<^sup>2) = 1}"
       by auto
   qed
   then show "homeomorphic_maps (nsphere(n - 1)) (top_of_set (sphere 0 1 \<inter> span B)) f g"
     by (simp add: inf_commute)
   qed
 qed
 
 
 subsection\<open> Invariance of dimension and domain\<close>
 
 lemma homeomorphic_maps_iff_homeomorphism [simp]:
    "homeomorphic_maps (top_of_set S) (top_of_set T) f g \<longleftrightarrow> homeomorphism S T f g"
   unfolding homeomorphic_maps_def homeomorphism_def by force
 
 lemma homeomorphic_space_iff_homeomorphic [simp]:
    "(top_of_set S) homeomorphic_space (top_of_set T) \<longleftrightarrow> S homeomorphic T"
   by (simp add: homeomorphic_def homeomorphic_space_def)
 
 lemma homeomorphic_subspace_Euclidean_space:
   fixes S :: "'a::euclidean_space set"
   assumes "subspace S"
   shows "top_of_set S homeomorphic_space Euclidean_space n \<longleftrightarrow> dim S = n"
 proof -
   obtain B where B: "B \<subseteq> S" "independent B" "span B = S" "card B = dim S"
            and orth: "pairwise orthogonal B" and 1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
     by (metis assms orthonormal_basis_subspace)
   then have "finite B"
     by (simp add: pairwise_orthogonal_imp_finite)
   have "top_of_set S homeomorphic_space top_of_set (span B)"
     unfolding homeomorphic_space_iff_homeomorphic
     by (auto simp: assms B intro: homeomorphic_subspaces)
   also have "\<dots> homeomorphic_space Euclidean_space (dim S)"
     unfolding homeomorphic_space_def
     using homeomorphic_maps_Euclidean_space_euclidean_gen [OF \<open>independent B\<close> orth] homeomorphic_maps_sym 1 B
     by metis
   finally have "top_of_set S homeomorphic_space Euclidean_space (dim S)" .
   then show ?thesis
     using homeomorphic_space_sym homeomorphic_space_trans invariance_of_dimension_Euclidean_space by blast
 qed
 
 lemma homeomorphic_subspace_Euclidean_space_dim:
   fixes S :: "'a::euclidean_space set"
   assumes "subspace S"
   shows "top_of_set S homeomorphic_space Euclidean_space (dim S)"
   by (simp add: homeomorphic_subspace_Euclidean_space assms)
 
 lemma homeomorphic_subspaces_eq:
   fixes S T:: "'a::euclidean_space set"
   assumes "subspace S" "subspace T"
   shows "S homeomorphic T \<longleftrightarrow> dim S = dim T"
 proof
   show "dim S = dim T"
     if "S homeomorphic T"
   proof -
     have "Euclidean_space (dim S) homeomorphic_space top_of_set S"
       using \<open>subspace S\<close> homeomorphic_space_sym homeomorphic_subspace_Euclidean_space_dim by blast
     also have "\<dots> homeomorphic_space top_of_set T"
       by (simp add: that)
     also have "\<dots> homeomorphic_space Euclidean_space (dim T)"
       by (simp add: homeomorphic_subspace_Euclidean_space assms)
     finally have "Euclidean_space (dim S) homeomorphic_space Euclidean_space (dim T)" .
     then show ?thesis
       by (simp add: invariance_of_dimension_Euclidean_space)
   qed
 next
   show "S homeomorphic T"
     if "dim S = dim T"
     by (metis that assms homeomorphic_subspaces)
 qed
 
 lemma homeomorphic_affine_Euclidean_space:
   assumes "affine S"
   shows "top_of_set S homeomorphic_space Euclidean_space n \<longleftrightarrow> aff_dim S = n"
    (is "?X homeomorphic_space ?E \<longleftrightarrow> aff_dim S = n")
 proof (cases "S = {}")
   case True
   with assms show ?thesis
     using homeomorphic_empty_space nonempty_Euclidean_space by fastforce
 next
   case False
   then obtain a where "a \<in> S"
     by force
   have "(?X homeomorphic_space ?E)
        = (top_of_set (image (\<lambda>x. -a + x) S) homeomorphic_space ?E)"
   proof
     show "top_of_set ((+) (- a) ` S) homeomorphic_space ?E"
       if "?X homeomorphic_space ?E"
       using that
       by (meson homeomorphic_space_iff_homeomorphic homeomorphic_space_sym homeomorphic_space_trans homeomorphic_translation)
     show "?X homeomorphic_space ?E"
       if "top_of_set ((+) (- a) ` S) homeomorphic_space ?E"
       using that
       by (meson homeomorphic_space_iff_homeomorphic homeomorphic_space_trans homeomorphic_translation)
   qed
   also have "\<dots> \<longleftrightarrow> aff_dim S = n"
     by (metis \<open>a \<in> S\<close> aff_dim_eq_dim affine_diffs_subspace affine_hull_eq assms homeomorphic_subspace_Euclidean_space of_nat_eq_iff)
   finally show ?thesis .
 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 -
   have "S \<subseteq> U"
     using openin_imp_subset [OF ope] .
   have Uhom: "top_of_set U homeomorphic_space Euclidean_space (dim U)"
    and Vhom: "top_of_set V homeomorphic_space Euclidean_space (dim V)"
     by (simp_all add: assms homeomorphic_subspace_Euclidean_space_dim)
   then obtain \<phi> \<phi>' where hom: "homeomorphic_maps (top_of_set U) (Euclidean_space (dim U)) \<phi> \<phi>'"
     by (auto simp: homeomorphic_space_def)
   obtain \<psi> \<psi>' where \<psi>: "homeomorphic_map (top_of_set V) (Euclidean_space (dim V)) \<psi>"
               and \<psi>'\<psi>: "\<forall>x\<in>V. \<psi>' (\<psi> x) = x"
     using Vhom by (auto simp: homeomorphic_space_def homeomorphic_maps_map)
   have "((\<psi> \<circ> f \<circ> \<phi>') o \<phi>) ` S = (\<psi> o f) ` S"
   proof (rule image_cong [OF refl])
     show "(\<psi> \<circ> f \<circ> \<phi>' \<circ> \<phi>) x = (\<psi> \<circ> f) x" if "x \<in> S" for x
       using that unfolding o_def
       by (metis \<open>S \<subseteq> U\<close> hom homeomorphic_maps_map in_mono topspace_euclidean_subtopology)
   qed
   moreover
   have "openin (Euclidean_space (dim V)) ((\<psi> \<circ> f \<circ> \<phi>') ` \<phi> ` S)"
   proof (rule invariance_of_domain_Euclidean_space_gen [OF VU])
     show "openin (Euclidean_space (dim U)) (\<phi> ` S)"
       using homeomorphic_map_openness_eq hom homeomorphic_maps_map ope by blast
     show "continuous_map (subtopology (Euclidean_space (dim U)) (\<phi> ` S)) (Euclidean_space (dim V)) (\<psi> \<circ> f \<circ> \<phi>')"
     proof (intro continuous_map_compose)
       have "continuous_on ({x. \<forall>i\<ge>dim U. x i = 0} \<inter> \<phi> ` S) \<phi>'"
         if "continuous_on {x. \<forall>i\<ge>dim U. x i = 0} \<phi>'"
         using that by (force elim: continuous_on_subset)
       moreover have "\<phi>' ` ({x. \<forall>i\<ge>dim U. x i = 0} \<inter> \<phi> ` S) \<subseteq> S"
         if "\<forall>x\<in>U. \<phi>' (\<phi> x) = x"
         using that \<open>S \<subseteq> U\<close> by fastforce
       ultimately show "continuous_map (subtopology (Euclidean_space (dim U)) (\<phi> ` S)) (top_of_set S) \<phi>'"
         using hom unfolding homeomorphic_maps_def
         by (simp add:  Euclidean_space_def subtopology_subtopology euclidean_product_topology)
       show "continuous_map (top_of_set S) (top_of_set V) f"
         by (simp add: contf fim)
       show "continuous_map (top_of_set V) (Euclidean_space (dim V)) \<psi>"
         by (simp add: \<psi> homeomorphic_imp_continuous_map)
     qed
     show "inj_on (\<psi> \<circ> f \<circ> \<phi>') (\<phi> ` S)"
       using injf hom
       unfolding inj_on_def homeomorphic_maps_map
       by simp (metis \<open>S \<subseteq> U\<close> \<psi>'\<psi> fim imageI subsetD)
   qed
   ultimately have "openin (Euclidean_space (dim V)) (\<psi> ` f ` S)"
     by (simp add: image_comp)
   then show ?thesis
     by (simp add: fim homeomorphic_map_openness_eq [OF \<psi>])
 qed
 
 lemma 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)"
   using invariance_of_domain_subspaces [of UNIV S UNIV] assms by (force simp add: )
 
 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 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 auto
 
 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)
 
 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
 
 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)
   have "openin (top_of_set (f ` S)) (f ` (S \<inter> T))"
   proof (rule open_openin_trans [OF invariance_of_domain_gen])
     show "inj_on f S"
       using inj_on_inverseI gf by auto
     show "open (f ` (S \<inter> T))"
       by (meson \<open>inj_on f S\<close> \<open>open T\<close> assms(1-3) continuous_on_subset inf_le1 inj_on_subset invariance_of_domain_gen open_Int)
   qed (use assms in auto)
   then show "openin (top_of_set (f ` S)) (f ` S \<inter> g -` T)"
     by (simp add: eq)
 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)"
 proof (rule interior_maximal)
   show "f ` interior S \<subseteq> f ` S"
     by (simp add: image_mono interior_subset)
   show "open (f ` interior S)"
     using assms
     by (auto simp: subset_inj_on interior_subset continuous_on_subset invariance_of_domain_gen)
 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)
     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)
     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
 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_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
   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
   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
   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
   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
+      using uniformly_continuous_imp_Cauchy_continuous \<open>Cauchy \<sigma>\<close> \<sigma> contf 
+      unfolding Cauchy_continuous_on_def 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
 
 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])
       by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
     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
     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)
     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
     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 empty_interior_lowdim_gen:
   fixes S :: "'N::euclidean_space set" and T :: "'M::euclidean_space set"
   assumes dim: "DIM('M) < DIM('N)" and ST: "S homeomorphic T" 
   shows "interior S = {}"
 proof -
   obtain h :: "'M \<Rightarrow> 'N" where "linear h" "\<And>x. norm(h x) = norm x"
     by (rule isometry_subset_subspace [OF subspace_UNIV subspace_UNIV, where ?'a = 'M and ?'b = 'N])
        (use dim in auto)
   then have "inj h"
     by (metis linear_inj_iff_eq_0 norm_eq_zero)
   then have "h ` T homeomorphic T"
     using \<open>linear h\<close> homeomorphic_sym linear_homeomorphic_image by blast
   then have "interior (h ` T) homeomorphic interior S"
     using homeomorphic_interiors_same_dimension
     by (metis ST homeomorphic_sym homeomorphic_trans)
   moreover   
   have "interior (range h) = {}"
     by (simp add: \<open>inj h\<close> \<open>linear h\<close> dim dim_image_eq empty_interior_lowdim)
   then have "interior (h ` T) = {}"
     by (metis image_mono interior_mono subset_empty top_greatest)
   ultimately show ?thesis
     by simp
 qed
 
 lemma empty_interior_lowdim_gen_le:
   fixes S :: "'N::euclidean_space set" and T :: "'M::euclidean_space set"
   assumes "DIM('M) \<le> DIM('N)"  "interior T = {}" "S homeomorphic T" 
   shows "interior S = {}"
   by (metis assms empty_interior_lowdim_gen homeomorphic_empty(1) homeomorphic_interiors_same_dimension less_le)
 
 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 :: "'M::euclidean_space" and c :: "'N::euclidean_space"
   assumes "a \<noteq> 0" "c \<noteq> 0" 
   shows "({x. a \<bullet> x = b} homeomorphic {x. c \<bullet> x = d} \<longleftrightarrow> DIM('M) = DIM('N))" (is "?lhs = ?rhs")
 proof -
   have "(DIM('M) - Suc 0 = DIM('N) - Suc 0) \<longleftrightarrow> (DIM('M) = DIM('N))"
     by auto (metis DIM_positive Suc_pred)
   then show ?thesis
     using assms by (simp add: homeomorphic_affine_sets_eq affine_hyperplane)
 qed
 
 end
diff --git a/src/HOL/Limits.thy b/src/HOL/Limits.thy
--- a/src/HOL/Limits.thy
+++ b/src/HOL/Limits.thy
@@ -1,3271 +1,3266 @@
 (*  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
 
 lemma range_mult [simp]:
   fixes a::"real" shows "range ((*) a) = (if a=0 then {0} else UNIV)"
   by (simp add: surj_def) (meson dvdE dvd_field_iff)
 
 
 subsection \<open>Filter going to infinity norm\<close>
 
 definition at_infinity :: "'a::real_normed_vector filter"
   where "at_infinity = (INF r. principal {x. r \<le> norm x})"
 
 lemma eventually_at_infinity: "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. b \<le> norm x \<longrightarrow> P x)"
   unfolding at_infinity_def
   by (subst eventually_INF_base)
      (auto simp: subset_eq eventually_principal intro!: exI[of _ "max a b" for a b])
 
 corollary eventually_at_infinity_pos:
   "eventually p at_infinity \<longleftrightarrow> (\<exists>b. 0 < b \<and> (\<forall>x. norm x \<ge> b \<longrightarrow> p x))"
   unfolding eventually_at_infinity
   by (meson le_less_trans norm_ge_zero not_le zero_less_one)
 
 lemma at_infinity_eq_at_top_bot: "(at_infinity :: real filter) = sup at_top at_bot"
 proof -
   have 1: "\<lbrakk>\<forall>n\<ge>u. A n; \<forall>n\<le>v. A n\<rbrakk>
        \<Longrightarrow> \<exists>b. \<forall>x. b \<le> \<bar>x\<bar> \<longrightarrow> A x" for A and u v::real
     by (rule_tac x="max (- v) u" in exI) (auto simp: abs_real_def)
   have 2: "\<forall>x. u \<le> \<bar>x\<bar> \<longrightarrow> A x \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. A n" for A and u::real
     by (meson abs_less_iff le_cases less_le_not_le)
   have 3: "\<forall>x. u \<le> \<bar>x\<bar> \<longrightarrow> A x \<Longrightarrow> \<exists>N. \<forall>n\<le>N. A n" for A and u::real
     by (metis (full_types) abs_ge_self abs_minus_cancel le_minus_iff order_trans)
   show ?thesis
     by (auto simp: filter_eq_iff eventually_sup eventually_at_infinity
       eventually_at_top_linorder eventually_at_bot_linorder intro: 1 2 3)
 qed
 
 lemma at_top_le_at_infinity: "at_top \<le> (at_infinity :: real filter)"
   unfolding at_infinity_eq_at_top_bot by simp
 
 lemma at_bot_le_at_infinity: "at_bot \<le> (at_infinity :: real filter)"
   unfolding at_infinity_eq_at_top_bot by simp
 
 lemma filterlim_at_top_imp_at_infinity: "filterlim f at_top F \<Longrightarrow> filterlim f at_infinity F"
   for f :: "_ \<Rightarrow> real"
   by (rule filterlim_mono[OF _ at_top_le_at_infinity order_refl])
 
 lemma filterlim_real_at_infinity_sequentially: "filterlim real at_infinity sequentially"
   by (simp add: filterlim_at_top_imp_at_infinity filterlim_real_sequentially)
 
 lemma lim_infinity_imp_sequentially: "(f \<longlongrightarrow> l) at_infinity \<Longrightarrow> ((\<lambda>n. f(n)) \<longlongrightarrow> l) sequentially"
   by (simp add: filterlim_at_top_imp_at_infinity filterlim_compose filterlim_real_sequentially)
 
 
 subsubsection \<open>Boundedness\<close>
 
 definition Bfun :: "('a \<Rightarrow> 'b::metric_space) \<Rightarrow> 'a filter \<Rightarrow> bool"
   where Bfun_metric_def: "Bfun f F = (\<exists>y. \<exists>K>0. eventually (\<lambda>x. dist (f x) y \<le> K) F)"
 
 abbreviation Bseq :: "(nat \<Rightarrow> 'a::metric_space) \<Rightarrow> bool"
   where "Bseq X \<equiv> Bfun X sequentially"
 
 lemma Bseq_conv_Bfun: "Bseq X \<longleftrightarrow> Bfun X sequentially" ..
 
 lemma Bseq_ignore_initial_segment: "Bseq X \<Longrightarrow> Bseq (\<lambda>n. X (n + k))"
   unfolding Bfun_metric_def by (subst eventually_sequentially_seg)
 
 lemma Bseq_offset: "Bseq (\<lambda>n. X (n + k)) \<Longrightarrow> Bseq X"
   unfolding Bfun_metric_def by (subst (asm) eventually_sequentially_seg)
 
 lemma Bfun_def: "Bfun f F \<longleftrightarrow> (\<exists>K>0. eventually (\<lambda>x. norm (f x) \<le> K) F)"
   unfolding Bfun_metric_def norm_conv_dist
 proof safe
   fix y K
   assume K: "0 < K" and *: "eventually (\<lambda>x. dist (f x) y \<le> K) F"
   moreover have "eventually (\<lambda>x. dist (f x) 0 \<le> dist (f x) y + dist 0 y) F"
     by (intro always_eventually) (metis dist_commute dist_triangle)
   with * have "eventually (\<lambda>x. dist (f x) 0 \<le> K + dist 0 y) F"
     by eventually_elim auto
   with \<open>0 < K\<close> show "\<exists>K>0. eventually (\<lambda>x. dist (f x) 0 \<le> K) F"
     by (intro exI[of _ "K + dist 0 y"] add_pos_nonneg conjI zero_le_dist) auto
 qed (force simp del: norm_conv_dist [symmetric])
 
 lemma BfunI:
   assumes K: "eventually (\<lambda>x. norm (f x) \<le> K) F"
   shows "Bfun f F"
   unfolding Bfun_def
 proof (intro exI conjI allI)
   show "0 < max K 1" by simp
   show "eventually (\<lambda>x. norm (f x) \<le> max K 1) F"
     using K by (rule eventually_mono) simp
 qed
 
 lemma BfunE:
   assumes "Bfun f F"
   obtains B where "0 < B" and "eventually (\<lambda>x. norm (f x) \<le> B) F"
   using assms unfolding Bfun_def by blast
 
 lemma Cauchy_Bseq:
   assumes "Cauchy X" shows "Bseq X"
 proof -
   have "\<exists>y K. 0 < K \<and> (\<exists>N. \<forall>n\<ge>N. dist (X n) y \<le> K)"
     if "\<And>m n. \<lbrakk>m \<ge> M; n \<ge> M\<rbrakk> \<Longrightarrow> dist (X m) (X n) < 1" for M
     by (meson order.order_iff_strict that zero_less_one)
   with assms show ?thesis
     by (force simp: Cauchy_def Bfun_metric_def eventually_sequentially)
 qed
 
 subsubsection \<open>Bounded Sequences\<close>
 
 lemma BseqI': "(\<And>n. norm (X n) \<le> K) \<Longrightarrow> Bseq X"
   by (intro BfunI) (auto simp: eventually_sequentially)
 
 lemma Bseq_def: "Bseq X \<longleftrightarrow> (\<exists>K>0. \<forall>n. norm (X n) \<le> K)"
   unfolding Bfun_def eventually_sequentially
 proof safe
   fix N K
   assume "0 < K" "\<forall>n\<ge>N. norm (X n) \<le> K"
   then show "\<exists>K>0. \<forall>n. norm (X n) \<le> K"
     by (intro exI[of _ "max (Max (norm ` X ` {..N})) K"] max.strict_coboundedI2)
        (auto intro!: imageI not_less[where 'a=nat, THEN iffD1] Max_ge simp: le_max_iff_disj)
 qed auto
 
 lemma BseqE: "Bseq X \<Longrightarrow> (\<And>K. 0 < K \<Longrightarrow> \<forall>n. norm (X n) \<le> K \<Longrightarrow> Q) \<Longrightarrow> Q"
   unfolding Bseq_def by auto
 
 lemma BseqD: "Bseq X \<Longrightarrow> \<exists>K. 0 < K \<and> (\<forall>n. norm (X n) \<le> K)"
   by (simp add: Bseq_def)
 
 lemma BseqI: "0 < K \<Longrightarrow> \<forall>n. norm (X n) \<le> K \<Longrightarrow> Bseq X"
   by (auto simp: Bseq_def)
 
 lemma Bseq_bdd_above: "Bseq X \<Longrightarrow> bdd_above (range X)"
   for X :: "nat \<Rightarrow> real"
 proof (elim BseqE, intro bdd_aboveI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "X n \<le> K"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_bdd_above': "Bseq X \<Longrightarrow> bdd_above (range (\<lambda>n. norm (X n)))"
   for X :: "nat \<Rightarrow> 'a :: real_normed_vector"
 proof (elim BseqE, intro bdd_aboveI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "norm (X n) \<le> K"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_bdd_below: "Bseq X \<Longrightarrow> bdd_below (range X)"
   for X :: "nat \<Rightarrow> real"
 proof (elim BseqE, intro bdd_belowI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "- K \<le> X n"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_eventually_mono:
   assumes "eventually (\<lambda>n. norm (f n) \<le> norm (g n)) sequentially" "Bseq g"
   shows "Bseq f"
 proof -
   from assms(2) obtain K where "0 < K" and "eventually (\<lambda>n. norm (g n) \<le> K) sequentially"
     unfolding Bfun_def by fast
   with assms(1) have "eventually (\<lambda>n. norm (f n) \<le> K) sequentially"
     by (fast elim: eventually_elim2 order_trans)
   with \<open>0 < K\<close> show "Bseq f"
     unfolding Bfun_def by fast
 qed
 
 lemma lemma_NBseq_def: "(\<exists>K > 0. \<forall>n. norm (X n) \<le> K) \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) \<le> real(Suc N))"
 proof safe
   fix K :: real
   from reals_Archimedean2 obtain n :: nat where "K < real n" ..
   then have "K \<le> real (Suc n)" by auto
   moreover assume "\<forall>m. norm (X m) \<le> K"
   ultimately have "\<forall>m. norm (X m) \<le> real (Suc n)"
     by (blast intro: order_trans)
   then show "\<exists>N. \<forall>n. norm (X n) \<le> real (Suc N)" ..
 next
   show "\<And>N. \<forall>n. norm (X n) \<le> real (Suc N) \<Longrightarrow> \<exists>K>0. \<forall>n. norm (X n) \<le> K"
     using of_nat_0_less_iff by blast
 qed
 
 text \<open>Alternative definition for \<open>Bseq\<close>.\<close>
 lemma Bseq_iff: "Bseq X \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) \<le> real(Suc N))"
   by (simp add: Bseq_def) (simp add: lemma_NBseq_def)
 
 lemma lemma_NBseq_def2: "(\<exists>K > 0. \<forall>n. norm (X n) \<le> K) = (\<exists>N. \<forall>n. norm (X n) < real(Suc N))"
 proof -
   have *: "\<And>N. \<forall>n. norm (X n) \<le> 1 + real N \<Longrightarrow>
          \<exists>N. \<forall>n. norm (X n) < 1 + real N"
     by (metis add.commute le_less_trans less_add_one of_nat_Suc)
   then show ?thesis
     unfolding lemma_NBseq_def
     by (metis less_le_not_le not_less_iff_gr_or_eq of_nat_Suc)
 qed
 
 text \<open>Yet another definition for Bseq.\<close>
 lemma Bseq_iff1a: "Bseq X \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) < real (Suc N))"
   by (simp add: Bseq_def lemma_NBseq_def2)
 
 subsubsection \<open>A Few More Equivalence Theorems for Boundedness\<close>
 
 text \<open>Alternative formulation for boundedness.\<close>
 lemma Bseq_iff2: "Bseq X \<longleftrightarrow> (\<exists>k > 0. \<exists>x. \<forall>n. norm (X n + - x) \<le> k)"
   by (metis BseqE BseqI' add.commute add_cancel_right_left add_uminus_conv_diff norm_add_leD
             norm_minus_cancel norm_minus_commute)
 
 text \<open>Alternative formulation for boundedness.\<close>
 lemma Bseq_iff3: "Bseq X \<longleftrightarrow> (\<exists>k>0. \<exists>N. \<forall>n. norm (X n + - X N) \<le> k)"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then obtain K where *: "0 < K" and **: "\<And>n. norm (X n) \<le> K"
     by (auto simp: Bseq_def)
   from * have "0 < K + norm (X 0)" by (rule order_less_le_trans) simp
   from ** have "\<forall>n. norm (X n - X 0) \<le> K + norm (X 0)"
     by (auto intro: order_trans norm_triangle_ineq4)
   then have "\<forall>n. norm (X n + - X 0) \<le> K + norm (X 0)"
     by simp
   with \<open>0 < K + norm (X 0)\<close> show ?Q by blast
 next
   assume ?Q
   then show ?P by (auto simp: Bseq_iff2)
 qed
 
 
 subsubsection \<open>Upper Bounds and Lubs of Bounded Sequences\<close>
 
 lemma Bseq_minus_iff: "Bseq (\<lambda>n. - (X n) :: 'a::real_normed_vector) \<longleftrightarrow> Bseq X"
   by (simp add: Bseq_def)
 
 lemma Bseq_add:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
   assumes "Bseq f"
   shows "Bseq (\<lambda>x. f x + c)"
 proof -
   from assms obtain K where K: "\<And>x. norm (f x) \<le> K"
     unfolding Bseq_def by blast
   {
     fix x :: nat
     have "norm (f x + c) \<le> norm (f x) + norm c" by (rule norm_triangle_ineq)
     also have "norm (f x) \<le> K" by (rule K)
     finally have "norm (f x + c) \<le> K + norm c" by simp
   }
   then show ?thesis by (rule BseqI')
 qed
 
 lemma Bseq_add_iff: "Bseq (\<lambda>x. f x + c) \<longleftrightarrow> Bseq f"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   using Bseq_add[of f c] Bseq_add[of "\<lambda>x. f x + c" "-c"] by auto
 
 lemma Bseq_mult:
   fixes f g :: "nat \<Rightarrow> 'a::real_normed_field"
   assumes "Bseq f" and "Bseq g"
   shows "Bseq (\<lambda>x. f x * g x)"
 proof -
   from assms obtain K1 K2 where K: "norm (f x) \<le> K1" "K1 > 0" "norm (g x) \<le> K2" "K2 > 0"
     for x
     unfolding Bseq_def by blast
   then have "norm (f x * g x) \<le> K1 * K2" for x
     by (auto simp: norm_mult intro!: mult_mono)
   then show ?thesis by (rule BseqI')
 qed
 
 lemma Bfun_const [simp]: "Bfun (\<lambda>_. c) F"
   unfolding Bfun_metric_def by (auto intro!: exI[of _ c] exI[of _ "1::real"])
 
 lemma Bseq_cmult_iff:
   fixes c :: "'a::real_normed_field"
   assumes "c \<noteq> 0"
   shows "Bseq (\<lambda>x. c * f x) \<longleftrightarrow> Bseq f"
 proof
   assume "Bseq (\<lambda>x. c * f x)"
   with Bfun_const have "Bseq (\<lambda>x. inverse c * (c * f x))"
     by (rule Bseq_mult)
   with \<open>c \<noteq> 0\<close> show "Bseq f"
     by (simp add: field_split_simps)
 qed (intro Bseq_mult Bfun_const)
 
 lemma Bseq_subseq: "Bseq f \<Longrightarrow> Bseq (\<lambda>x. f (g x))"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   unfolding Bseq_def by auto
 
 lemma Bseq_Suc_iff: "Bseq (\<lambda>n. f (Suc n)) \<longleftrightarrow> Bseq f"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   using Bseq_offset[of f 1] by (auto intro: Bseq_subseq)
 
 lemma increasing_Bseq_subseq_iff:
   assumes "\<And>x y. x \<le> y \<Longrightarrow> norm (f x :: 'a::real_normed_vector) \<le> norm (f y)" "strict_mono g"
   shows "Bseq (\<lambda>x. f (g x)) \<longleftrightarrow> Bseq f"
 proof
   assume "Bseq (\<lambda>x. f (g x))"
   then obtain K where K: "\<And>x. norm (f (g x)) \<le> K"
     unfolding Bseq_def by auto
   {
     fix x :: nat
     from filterlim_subseq[OF assms(2)] obtain y where "g y \<ge> x"
       by (auto simp: filterlim_at_top eventually_at_top_linorder)
     then have "norm (f x) \<le> norm (f (g y))"
       using assms(1) by blast
     also have "norm (f (g y)) \<le> K" by (rule K)
     finally have "norm (f x) \<le> K" .
   }
   then show "Bseq f" by (rule BseqI')
 qed (use Bseq_subseq[of f g] in simp_all)
 
 lemma nonneg_incseq_Bseq_subseq_iff:
   fixes f :: "nat \<Rightarrow> real"
     and g :: "nat \<Rightarrow> nat"
   assumes "\<And>x. f x \<ge> 0" "incseq f" "strict_mono g"
   shows "Bseq (\<lambda>x. f (g x)) \<longleftrightarrow> Bseq f"
   using assms by (intro increasing_Bseq_subseq_iff) (auto simp: incseq_def)
 
 lemma Bseq_eq_bounded: "range f \<subseteq> {a..b} \<Longrightarrow> Bseq f"
   for a b :: real
 proof (rule BseqI'[where K="max (norm a) (norm b)"])
   fix n assume "range f \<subseteq> {a..b}"
   then have "f n \<in> {a..b}"
     by blast
   then show "norm (f n) \<le> max (norm a) (norm b)"
     by auto
 qed
 
 lemma incseq_bounded: "incseq X \<Longrightarrow> \<forall>i. X i \<le> B \<Longrightarrow> Bseq X"
   for B :: real
   by (intro Bseq_eq_bounded[of X "X 0" B]) (auto simp: incseq_def)
 
 lemma decseq_bounded: "decseq X \<Longrightarrow> \<forall>i. B \<le> X i \<Longrightarrow> Bseq X"
   for B :: real
   by (intro Bseq_eq_bounded[of X B "X 0"]) (auto simp: decseq_def)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Polynomal function extremal theorem, from HOL Light\<close>
 
 lemma polyfun_extremal_lemma: 
     fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   assumes "0 < e"
     shows "\<exists>M. \<forall>z. M \<le> norm(z) \<longrightarrow> norm (\<Sum>i\<le>n. c(i) * z^i) \<le> e * norm(z) ^ (Suc n)"
 proof (induct n)
   case 0 with assms
   show ?case
     apply (rule_tac x="norm (c 0) / e" in exI)
     apply (auto simp: field_simps)
     done
 next
   case (Suc n)
   obtain M where M: "\<And>z. M \<le> norm z \<Longrightarrow> norm (\<Sum>i\<le>n. c i * z^i) \<le> e * norm z ^ Suc n"
     using Suc assms by blast
   show ?case
   proof (rule exI [where x= "max M (1 + norm(c(Suc n)) / e)"], clarsimp simp del: power_Suc)
     fix z::'a
     assume z1: "M \<le> norm z" and "1 + norm (c (Suc n)) / e \<le> norm z"
     then have z2: "e + norm (c (Suc n)) \<le> e * norm z"
       using assms by (simp add: field_simps)
     have "norm (\<Sum>i\<le>n. c i * z^i) \<le> e * norm z ^ Suc n"
       using M [OF z1] by simp
     then have "norm (\<Sum>i\<le>n. c i * z^i) + norm (c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc n + norm (c (Suc n) * z ^ Suc n)"
       by simp
     then have "norm ((\<Sum>i\<le>n. c i * z^i) + c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc n + norm (c (Suc n) * z ^ Suc n)"
       by (blast intro: norm_triangle_le elim: )
     also have "... \<le> (e + norm (c (Suc n))) * norm z ^ Suc n"
       by (simp add: norm_power norm_mult algebra_simps)
     also have "... \<le> (e * norm z) * norm z ^ Suc n"
       by (metis z2 mult.commute mult_left_mono norm_ge_zero norm_power)
     finally show "norm ((\<Sum>i\<le>n. c i * z^i) + c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc (Suc n)"
       by simp
   qed
 qed
 
 lemma polyfun_extremal: (*COMPLEX_POLYFUN_EXTREMAL in HOL Light*)
     fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   assumes k: "c k \<noteq> 0" "1\<le>k" and kn: "k\<le>n"
     shows "eventually (\<lambda>z. norm (\<Sum>i\<le>n. c(i) * z^i) \<ge> B) at_infinity"
 using kn
 proof (induction n)
   case 0
   then show ?case
     using k by simp
 next
   case (Suc m)
   show ?case
   proof (cases "c (Suc m) = 0")
     case True
     then show ?thesis using Suc k
       by auto (metis antisym_conv less_eq_Suc_le not_le)
   next
     case False
     then obtain M where M:
           "\<And>z. M \<le> norm z \<Longrightarrow> norm (\<Sum>i\<le>m. c i * z^i) \<le> norm (c (Suc m)) / 2 * norm z ^ Suc m"
       using polyfun_extremal_lemma [of "norm(c (Suc m)) / 2" c m] Suc
       by auto
     have "\<exists>b. \<forall>z. b \<le> norm z \<longrightarrow> B \<le> norm (\<Sum>i\<le>Suc m. c i * z^i)"
     proof (rule exI [where x="max M (max 1 (\<bar>B\<bar> / (norm(c (Suc m)) / 2)))"], clarsimp simp del: power_Suc)
       fix z::'a
       assume z1: "M \<le> norm z" "1 \<le> norm z"
          and "\<bar>B\<bar> * 2 / norm (c (Suc m)) \<le> norm z"
       then have z2: "\<bar>B\<bar> \<le> norm (c (Suc m)) * norm z / 2"
         using False by (simp add: field_simps)
       have nz: "norm z \<le> norm z ^ Suc m"
         by (metis \<open>1 \<le> norm z\<close> One_nat_def less_eq_Suc_le power_increasing power_one_right zero_less_Suc)
       have *: "\<And>y x. norm (c (Suc m)) * norm z / 2 \<le> norm y - norm x \<Longrightarrow> B \<le> norm (x + y)"
         by (metis abs_le_iff add.commute norm_diff_ineq order_trans z2)
       have "norm z * norm (c (Suc m)) + 2 * norm (\<Sum>i\<le>m. c i * z^i)
             \<le> norm (c (Suc m)) * norm z + norm (c (Suc m)) * norm z ^ Suc m"
         using M [of z] Suc z1  by auto
       also have "... \<le> 2 * (norm (c (Suc m)) * norm z ^ Suc m)"
         using nz by (simp add: mult_mono del: power_Suc)
       finally show "B \<le> norm ((\<Sum>i\<le>m. c i * z^i) + c (Suc m) * z ^ Suc m)"
         using Suc.IH
         apply (auto simp: eventually_at_infinity)
         apply (rule *)
         apply (simp add: field_simps norm_mult norm_power)
         done
     qed
     then show ?thesis
       by (simp add: eventually_at_infinity)
   qed
 qed
 
 subsection \<open>Convergence to Zero\<close>
 
 definition Zfun :: "('a \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a filter \<Rightarrow> bool"
   where "Zfun f F = (\<forall>r>0. eventually (\<lambda>x. norm (f x) < r) F)"
 
 lemma ZfunI: "(\<And>r. 0 < r \<Longrightarrow> eventually (\<lambda>x. norm (f x) < r) F) \<Longrightarrow> Zfun f F"
   by (simp add: Zfun_def)
 
 lemma ZfunD: "Zfun f F \<Longrightarrow> 0 < r \<Longrightarrow> eventually (\<lambda>x. norm (f x) < r) F"
   by (simp add: Zfun_def)
 
 lemma Zfun_ssubst: "eventually (\<lambda>x. f x = g x) F \<Longrightarrow> Zfun g F \<Longrightarrow> Zfun f F"
   unfolding Zfun_def by (auto elim!: eventually_rev_mp)
 
 lemma Zfun_zero: "Zfun (\<lambda>x. 0) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_norm_iff: "Zfun (\<lambda>x. norm (f x)) F = Zfun (\<lambda>x. f x) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_imp_Zfun:
   assumes f: "Zfun f F"
     and g: "eventually (\<lambda>x. norm (g x) \<le> norm (f x) * K) F"
   shows "Zfun (\<lambda>x. g x) F"
 proof (cases "0 < K")
   case K: True
   show ?thesis
   proof (rule ZfunI)
     fix r :: real
     assume "0 < r"
     then have "0 < r / K" using K by simp
     then have "eventually (\<lambda>x. norm (f x) < r / K) F"
       using ZfunD [OF f] by blast
     with g show "eventually (\<lambda>x. norm (g x) < r) F"
     proof eventually_elim
       case (elim x)
       then have "norm (f x) * K < r"
         by (simp add: pos_less_divide_eq K)
       then show ?case
         by (simp add: order_le_less_trans [OF elim(1)])
     qed
   qed
 next
   case False
   then have K: "K \<le> 0" by (simp only: not_less)
   show ?thesis
   proof (rule ZfunI)
     fix r :: real
     assume "0 < r"
     from g show "eventually (\<lambda>x. norm (g x) < r) F"
     proof eventually_elim
       case (elim x)
       also have "norm (f x) * K \<le> norm (f x) * 0"
         using K norm_ge_zero by (rule mult_left_mono)
       finally show ?case
         using \<open>0 < r\<close> by simp
     qed
   qed
 qed
 
 lemma Zfun_le: "Zfun g F \<Longrightarrow> \<forall>x. norm (f x) \<le> norm (g x) \<Longrightarrow> Zfun f F"
   by (erule Zfun_imp_Zfun [where K = 1]) simp
 
 lemma Zfun_add:
   assumes f: "Zfun f F"
     and g: "Zfun g F"
   shows "Zfun (\<lambda>x. f x + g x) F"
 proof (rule ZfunI)
   fix r :: real
   assume "0 < r"
   then have r: "0 < r / 2" by simp
   have "eventually (\<lambda>x. norm (f x) < r/2) F"
     using f r by (rule ZfunD)
   moreover
   have "eventually (\<lambda>x. norm (g x) < r/2) F"
     using g r by (rule ZfunD)
   ultimately
   show "eventually (\<lambda>x. norm (f x + g x) < r) F"
   proof eventually_elim
     case (elim x)
     have "norm (f x + g x) \<le> norm (f x) + norm (g x)"
       by (rule norm_triangle_ineq)
     also have "\<dots> < r/2 + r/2"
       using elim by (rule add_strict_mono)
     finally show ?case
       by simp
   qed
 qed
 
 lemma Zfun_minus: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. - f x) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_diff: "Zfun f F \<Longrightarrow> Zfun g F \<Longrightarrow> Zfun (\<lambda>x. f x - g x) F"
   using Zfun_add [of f F "\<lambda>x. - g x"] by (simp add: Zfun_minus)
 
 lemma (in bounded_linear) Zfun:
   assumes g: "Zfun g F"
   shows "Zfun (\<lambda>x. f (g x)) F"
 proof -
   obtain K where "norm (f x) \<le> norm x * K" for x
     using bounded by blast
   then have "eventually (\<lambda>x. norm (f (g x)) \<le> norm (g x) * K) F"
     by simp
   with g show ?thesis
     by (rule Zfun_imp_Zfun)
 qed
 
 lemma (in bounded_bilinear) Zfun:
   assumes f: "Zfun f F"
     and g: "Zfun g F"
   shows "Zfun (\<lambda>x. f x ** g x) F"
 proof (rule ZfunI)
   fix r :: real
   assume r: "0 < r"
   obtain K where K: "0 < K"
     and norm_le: "norm (x ** y) \<le> norm x * norm y * K" for x y
     using pos_bounded by blast
   from K have K': "0 < inverse K"
     by (rule positive_imp_inverse_positive)
   have "eventually (\<lambda>x. norm (f x) < r) F"
     using f r by (rule ZfunD)
   moreover
   have "eventually (\<lambda>x. norm (g x) < inverse K) F"
     using g K' by (rule ZfunD)
   ultimately
   show "eventually (\<lambda>x. norm (f x ** g x) < r) F"
   proof eventually_elim
     case (elim x)
     have "norm (f x ** g x) \<le> norm (f x) * norm (g x) * K"
       by (rule norm_le)
     also have "norm (f x) * norm (g x) * K < r * inverse K * K"
       by (intro mult_strict_right_mono mult_strict_mono' norm_ge_zero elim K)
     also from K have "r * inverse K * K = r"
       by simp
     finally show ?case .
   qed
 qed
 
 lemma (in bounded_bilinear) Zfun_left: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. f x ** a) F"
   by (rule bounded_linear_left [THEN bounded_linear.Zfun])
 
 lemma (in bounded_bilinear) Zfun_right: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. a ** f x) F"
   by (rule bounded_linear_right [THEN bounded_linear.Zfun])
 
 lemmas Zfun_mult = bounded_bilinear.Zfun [OF bounded_bilinear_mult]
 lemmas Zfun_mult_right = bounded_bilinear.Zfun_right [OF bounded_bilinear_mult]
 lemmas Zfun_mult_left = bounded_bilinear.Zfun_left [OF bounded_bilinear_mult]
 
 lemma tendsto_Zfun_iff: "(f \<longlongrightarrow> a) F = Zfun (\<lambda>x. f x - a) F"
   by (simp only: tendsto_iff Zfun_def dist_norm)
 
 lemma tendsto_0_le:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> eventually (\<lambda>x. norm (g x) \<le> norm (f x) * K) F \<Longrightarrow> (g \<longlongrightarrow> 0) F"
   by (simp add: Zfun_imp_Zfun tendsto_Zfun_iff)
 
 
 subsubsection \<open>Distance and norms\<close>
 
 lemma tendsto_dist [tendsto_intros]:
   fixes l m :: "'a::metric_space"
   assumes f: "(f \<longlongrightarrow> l) F"
     and g: "(g \<longlongrightarrow> m) F"
   shows "((\<lambda>x. dist (f x) (g x)) \<longlongrightarrow> dist l m) F"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   then have e2: "0 < e/2" by simp
   from tendstoD [OF f e2] tendstoD [OF g e2]
   show "eventually (\<lambda>x. dist (dist (f x) (g x)) (dist l m) < e) F"
   proof (eventually_elim)
     case (elim x)
     then show "dist (dist (f x) (g x)) (dist l m) < e"
       unfolding dist_real_def
       using dist_triangle2 [of "f x" "g x" "l"]
         and dist_triangle2 [of "g x" "l" "m"]
         and dist_triangle3 [of "l" "m" "f x"]
         and dist_triangle [of "f x" "m" "g x"]
       by arith
   qed
 qed
 
 lemma continuous_dist[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'a :: metric_space"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. dist (f x) (g x))"
   unfolding continuous_def by (rule tendsto_dist)
 
 lemma continuous_on_dist[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'a :: metric_space"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. dist (f x) (g x))"
   unfolding continuous_on_def by (auto intro: tendsto_dist)
 
 lemma continuous_at_dist: "isCont (dist a) b"
   using continuous_on_dist [OF continuous_on_const continuous_on_id] continuous_on_eq_continuous_within by blast
 
 lemma tendsto_norm [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. norm (f x)) \<longlongrightarrow> norm a) F"
   unfolding norm_conv_dist by (intro tendsto_intros)
 
 lemma continuous_norm [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. norm (f x))"
   unfolding continuous_def by (rule tendsto_norm)
 
 lemma continuous_on_norm [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. norm (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_norm)
 
 lemma continuous_on_norm_id [continuous_intros]: "continuous_on S norm"
   by (intro continuous_on_id continuous_on_norm)
 
 lemma tendsto_norm_zero: "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F"
   by (drule tendsto_norm) simp
 
 lemma tendsto_norm_zero_cancel: "((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> 0) F"
   unfolding tendsto_iff dist_norm by simp
 
 lemma tendsto_norm_zero_iff: "((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F \<longleftrightarrow> (f \<longlongrightarrow> 0) F"
   unfolding tendsto_iff dist_norm by simp
 
 lemma tendsto_rabs [tendsto_intros]: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> \<bar>l\<bar>) F"
   for l :: real
   by (fold real_norm_def) (rule tendsto_norm)
 
 lemma continuous_rabs [continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F (\<lambda>x. \<bar>f x :: real\<bar>)"
   unfolding real_norm_def[symmetric] by (rule continuous_norm)
 
 lemma continuous_on_rabs [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. \<bar>f x :: real\<bar>)"
   unfolding real_norm_def[symmetric] by (rule continuous_on_norm)
 
 lemma tendsto_rabs_zero: "(f \<longlongrightarrow> (0::real)) F \<Longrightarrow> ((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero)
 
 lemma tendsto_rabs_zero_cancel: "((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> (0::real)) F \<Longrightarrow> (f \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero_cancel)
 
 lemma tendsto_rabs_zero_iff: "((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> (0::real)) F \<longleftrightarrow> (f \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero_iff)
 
 
 subsection \<open>Topological Monoid\<close>
 
 class topological_monoid_add = topological_space + monoid_add +
   assumes tendsto_add_Pair: "LIM x (nhds a \<times>\<^sub>F nhds b). fst x + snd x :> nhds (a + b)"
 
 class topological_comm_monoid_add = topological_monoid_add + comm_monoid_add
 
 lemma tendsto_add [tendsto_intros]:
   fixes a b :: "'a::topological_monoid_add"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x + g x) \<longlongrightarrow> a + b) F"
   using filterlim_compose[OF tendsto_add_Pair, of "\<lambda>x. (f x, g x)" a b F]
   by (simp add: nhds_prod[symmetric] tendsto_Pair)
 
 lemma continuous_add [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x + g x)"
   unfolding continuous_def by (rule tendsto_add)
 
 lemma continuous_on_add [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
   unfolding continuous_on_def by (auto intro: tendsto_add)
 
 lemma tendsto_add_zero:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "(f \<longlongrightarrow> 0) F \<Longrightarrow> (g \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x + g x) \<longlongrightarrow> 0) F"
   by (drule (1) tendsto_add) simp
 
 lemma tendsto_sum [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> (f i \<longlongrightarrow> a i) F) \<Longrightarrow> ((\<lambda>x. \<Sum>i\<in>I. f i x) \<longlongrightarrow> (\<Sum>i\<in>I. a i)) F"
   by (induct I rule: infinite_finite_induct) (simp_all add: tendsto_add)
 
 lemma tendsto_null_sum:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_add"
   assumes "\<And>i. i \<in> I \<Longrightarrow> ((\<lambda>x. f x i) \<longlongrightarrow> 0) F"
   shows "((\<lambda>i. sum (f i) I) \<longlongrightarrow> 0) F"
   using tendsto_sum [of I "\<lambda>x y. f y x" "\<lambda>x. 0"] assms by simp
 
 lemma continuous_sum [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous F (f i)) \<Longrightarrow> continuous F (\<lambda>x. \<Sum>i\<in>I. f i x)"
   unfolding continuous_def by (rule tendsto_sum)
 
 lemma continuous_on_sum [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::topological_space \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous_on S (f i)) \<Longrightarrow> continuous_on S (\<lambda>x. \<Sum>i\<in>I. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_sum)
 
 instance nat :: topological_comm_monoid_add
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 instance int :: topological_comm_monoid_add
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 
 subsubsection \<open>Topological group\<close>
 
 class topological_group_add = topological_monoid_add + group_add +
   assumes tendsto_uminus_nhds: "(uminus \<longlongrightarrow> - a) (nhds a)"
 begin
 
 lemma tendsto_minus [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. - f x) \<longlongrightarrow> - a) F"
   by (rule filterlim_compose[OF tendsto_uminus_nhds])
 
 end
 
 class topological_ab_group_add = topological_group_add + ab_group_add
 
 instance topological_ab_group_add < topological_comm_monoid_add ..
 
 lemma continuous_minus [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. - f x)"
   for f :: "'a::t2_space \<Rightarrow> 'b::topological_group_add"
   unfolding continuous_def by (rule tendsto_minus)
 
 lemma continuous_on_minus [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
   for f :: "_ \<Rightarrow> 'b::topological_group_add"
   unfolding continuous_on_def by (auto intro: tendsto_minus)
 
 lemma tendsto_minus_cancel: "((\<lambda>x. - f x) \<longlongrightarrow> - a) F \<Longrightarrow> (f \<longlongrightarrow> a) F"
   for a :: "'a::topological_group_add"
   by (drule tendsto_minus) simp
 
 lemma tendsto_minus_cancel_left:
   "(f \<longlongrightarrow> - (y::_::topological_group_add)) F \<longleftrightarrow> ((\<lambda>x. - f x) \<longlongrightarrow> y) F"
   using tendsto_minus_cancel[of f "- y" F]  tendsto_minus[of f "- y" F]
   by auto
 
 lemma tendsto_diff [tendsto_intros]:
   fixes a b :: "'a::topological_group_add"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x - g x) \<longlongrightarrow> a - b) F"
   using tendsto_add [of f a F "\<lambda>x. - g x" "- b"] by (simp add: tendsto_minus)
 
 lemma continuous_diff [continuous_intros]:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::topological_group_add"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x - g x)"
   unfolding continuous_def by (rule tendsto_diff)
 
 lemma continuous_on_diff [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_group_add"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
   unfolding continuous_on_def by (auto intro: tendsto_diff)
 
 lemma continuous_on_op_minus: "continuous_on (s::'a::topological_group_add set) ((-) x)"
   by (rule continuous_intros | simp)+
 
 instance real_normed_vector < topological_ab_group_add
 proof
   fix a b :: 'a
   show "((\<lambda>x. fst x + snd x) \<longlongrightarrow> a + b) (nhds a \<times>\<^sub>F nhds b)"
     unfolding tendsto_Zfun_iff add_diff_add
     using tendsto_fst[OF filterlim_ident, of "(a,b)"] tendsto_snd[OF filterlim_ident, of "(a,b)"]
     by (intro Zfun_add)
        (auto simp: tendsto_Zfun_iff[symmetric] nhds_prod[symmetric] intro!: tendsto_fst)
   show "(uminus \<longlongrightarrow> - a) (nhds a)"
     unfolding tendsto_Zfun_iff minus_diff_minus
     using filterlim_ident[of "nhds a"]
     by (intro Zfun_minus) (simp add: tendsto_Zfun_iff)
 qed
 
 lemmas real_tendsto_sandwich = tendsto_sandwich[where 'a=real]
 
 
 subsubsection \<open>Linear operators and multiplication\<close>
 
 lemma linear_times [simp]: "linear (\<lambda>x. c * x)"
   for c :: "'a::real_algebra"
   by (auto simp: linearI distrib_left)
 
 lemma (in bounded_linear) tendsto: "(g \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f (g x)) \<longlongrightarrow> f a) F"
   by (simp only: tendsto_Zfun_iff diff [symmetric] Zfun)
 
 lemma (in bounded_linear) continuous: "continuous F g \<Longrightarrow> continuous F (\<lambda>x. f (g x))"
   using tendsto[of g _ F] by (auto simp: continuous_def)
 
 lemma (in bounded_linear) continuous_on: "continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f (g x))"
   using tendsto[of g] by (auto simp: continuous_on_def)
 
 lemma (in bounded_linear) tendsto_zero: "(g \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f (g x)) \<longlongrightarrow> 0) F"
   by (drule tendsto) (simp only: zero)
 
 lemma (in bounded_bilinear) tendsto:
   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x ** g x) \<longlongrightarrow> a ** b) F"
   by (simp only: tendsto_Zfun_iff prod_diff_prod Zfun_add Zfun Zfun_left Zfun_right)
 
 lemma (in bounded_bilinear) continuous:
   "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x ** g x)"
   using tendsto[of f _ F g] by (auto simp: continuous_def)
 
 lemma (in bounded_bilinear) continuous_on:
   "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x ** g x)"
   using tendsto[of f _ _ g] by (auto simp: continuous_on_def)
 
 lemma (in bounded_bilinear) tendsto_zero:
   assumes f: "(f \<longlongrightarrow> 0) F"
     and g: "(g \<longlongrightarrow> 0) F"
   shows "((\<lambda>x. f x ** g x) \<longlongrightarrow> 0) F"
   using tendsto [OF f g] by (simp add: zero_left)
 
 lemma (in bounded_bilinear) tendsto_left_zero:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x ** c) \<longlongrightarrow> 0) F"
   by (rule bounded_linear.tendsto_zero [OF bounded_linear_left])
 
 lemma (in bounded_bilinear) tendsto_right_zero:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. c ** f x) \<longlongrightarrow> 0) F"
   by (rule bounded_linear.tendsto_zero [OF bounded_linear_right])
 
 lemmas tendsto_of_real [tendsto_intros] =
   bounded_linear.tendsto [OF bounded_linear_of_real]
 
 lemmas tendsto_scaleR [tendsto_intros] =
   bounded_bilinear.tendsto [OF bounded_bilinear_scaleR]
 
 
 text\<open>Analogous type class for multiplication\<close>
 class topological_semigroup_mult = topological_space + semigroup_mult +
   assumes tendsto_mult_Pair: "LIM x (nhds a \<times>\<^sub>F nhds b). fst x * snd x :> nhds (a * b)"
 
 instance real_normed_algebra < topological_semigroup_mult
 proof
   fix a b :: 'a
   show "((\<lambda>x. fst x * snd x) \<longlongrightarrow> a * b) (nhds a \<times>\<^sub>F nhds b)"
     unfolding nhds_prod[symmetric]
     using tendsto_fst[OF filterlim_ident, of "(a,b)"] tendsto_snd[OF filterlim_ident, of "(a,b)"]
     by (simp add: bounded_bilinear.tendsto [OF bounded_bilinear_mult])
 qed
 
 lemma tendsto_mult [tendsto_intros]:
   fixes a b :: "'a::topological_semigroup_mult"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x * g x) \<longlongrightarrow> a * b) F"
   using filterlim_compose[OF tendsto_mult_Pair, of "\<lambda>x. (f x, g x)" a b F]
   by (simp add: nhds_prod[symmetric] tendsto_Pair)
 
 lemma tendsto_mult_left: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. c * (f x)) \<longlongrightarrow> c * l) F"
   for c :: "'a::topological_semigroup_mult"
   by (rule tendsto_mult [OF tendsto_const])
 
 lemma tendsto_mult_right: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. (f x) * c) \<longlongrightarrow> l * c) F"
   for c :: "'a::topological_semigroup_mult"
   by (rule tendsto_mult [OF _ tendsto_const])
 
 lemma tendsto_mult_left_iff [simp]:
    "c \<noteq> 0 \<Longrightarrow> tendsto(\<lambda>x. c * f x) (c * l) F \<longleftrightarrow> tendsto f l F" for c :: "'a::{topological_semigroup_mult,field}"
   by (auto simp: tendsto_mult_left dest: tendsto_mult_left [where c = "1/c"])
 
 lemma tendsto_mult_right_iff [simp]:
    "c \<noteq> 0 \<Longrightarrow> tendsto(\<lambda>x. f x * c) (l * c) F \<longleftrightarrow> tendsto f l F" for c :: "'a::{topological_semigroup_mult,field}"
   by (auto simp: tendsto_mult_right dest: tendsto_mult_left [where c = "1/c"])
 
 lemma tendsto_zero_mult_left_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. c * a n)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using assms tendsto_mult_left tendsto_mult_left_iff by fastforce
 
 lemma tendsto_zero_mult_right_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. a n * c)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using assms tendsto_mult_right tendsto_mult_right_iff by fastforce
 
 lemma tendsto_zero_divide_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. a n / c)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using tendsto_zero_mult_right_iff [of "1/c" a] assms by (simp add: field_simps)
 
 lemma lim_const_over_n [tendsto_intros]:
   fixes a :: "'a::real_normed_field"
   shows "(\<lambda>n. a / of_nat n) \<longlonglongrightarrow> 0"
   using tendsto_mult [OF tendsto_const [of a] lim_1_over_n] by simp
 
 lemmas continuous_of_real [continuous_intros] =
   bounded_linear.continuous [OF bounded_linear_of_real]
 
 lemmas continuous_scaleR [continuous_intros] =
   bounded_bilinear.continuous [OF bounded_bilinear_scaleR]
 
 lemmas continuous_mult [continuous_intros] =
   bounded_bilinear.continuous [OF bounded_bilinear_mult]
 
 lemmas continuous_on_of_real [continuous_intros] =
   bounded_linear.continuous_on [OF bounded_linear_of_real]
 
 lemmas continuous_on_scaleR [continuous_intros] =
   bounded_bilinear.continuous_on [OF bounded_bilinear_scaleR]
 
 lemmas continuous_on_mult [continuous_intros] =
   bounded_bilinear.continuous_on [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_zero =
   bounded_bilinear.tendsto_zero [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_left_zero =
   bounded_bilinear.tendsto_left_zero [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_right_zero =
   bounded_bilinear.tendsto_right_zero [OF bounded_bilinear_mult]
 
 
 lemma continuous_mult_left:
   fixes c::"'a::real_normed_algebra"
   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. c * f x)"
 by (rule continuous_mult [OF continuous_const])
 
 lemma continuous_mult_right:
   fixes c::"'a::real_normed_algebra"
   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. f x * c)"
 by (rule continuous_mult [OF _ continuous_const])
 
 lemma continuous_on_mult_left:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. c * f x)"
 by (rule continuous_on_mult [OF continuous_on_const])
 
 lemma continuous_on_mult_right:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. f x * c)"
 by (rule continuous_on_mult [OF _ continuous_on_const])
 
 lemma continuous_on_mult_const [simp]:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s ((*) c)"
   by (intro continuous_on_mult_left continuous_on_id)
 
 lemma tendsto_divide_zero:
   fixes c :: "'a::real_normed_field"
   shows "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x / c) \<longlongrightarrow> 0) F"
   by (cases "c=0") (simp_all add: divide_inverse tendsto_mult_left_zero)
 
 lemma tendsto_power [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f x ^ n) \<longlongrightarrow> a ^ n) F"
   for f :: "'a \<Rightarrow> 'b::{power,real_normed_algebra}"
   by (induct n) (simp_all add: tendsto_mult)
 
 lemma tendsto_null_power: "\<lbrakk>(f \<longlongrightarrow> 0) F; 0 < n\<rbrakk> \<Longrightarrow> ((\<lambda>x. f x ^ n) \<longlongrightarrow> 0) F"
     for f :: "'a \<Rightarrow> 'b::{power,real_normed_algebra_1}"
   using tendsto_power [of f 0 F n] by (simp add: power_0_left)
 
 lemma continuous_power [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. (f x)^n)"
   for f :: "'a::t2_space \<Rightarrow> 'b::{power,real_normed_algebra}"
   unfolding continuous_def by (rule tendsto_power)
 
 lemma continuous_on_power [continuous_intros]:
   fixes f :: "_ \<Rightarrow> 'b::{power,real_normed_algebra}"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. (f x)^n)"
   unfolding continuous_on_def by (auto intro: tendsto_power)
 
 lemma tendsto_prod [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> (f i \<longlongrightarrow> L i) F) \<Longrightarrow> ((\<lambda>x. \<Prod>i\<in>S. f i x) \<longlongrightarrow> (\<Prod>i\<in>S. L i)) F"
   by (induct S rule: infinite_finite_induct) (simp_all add: tendsto_mult)
 
 lemma continuous_prod [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> continuous F (f i)) \<Longrightarrow> continuous F (\<lambda>x. \<Prod>i\<in>S. f i x)"
   unfolding continuous_def by (rule tendsto_prod)
 
 lemma continuous_on_prod [continuous_intros]:
   fixes f :: "'a \<Rightarrow> _ \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> continuous_on s (f i)) \<Longrightarrow> continuous_on s (\<lambda>x. \<Prod>i\<in>S. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_prod)
 
 lemma tendsto_of_real_iff:
   "((\<lambda>x. of_real (f x) :: 'a::real_normed_div_algebra) \<longlongrightarrow> of_real c) F \<longleftrightarrow> (f \<longlongrightarrow> c) F"
   unfolding tendsto_iff by simp
 
 lemma tendsto_add_const_iff:
   "((\<lambda>x. c + f x :: 'a::topological_group_add) \<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 LIMSEQ_prod_0: 
   fixes f :: "nat \<Rightarrow> 'a::{semidom,topological_space}"
   assumes "f i = 0"
   shows "(\<lambda>n. prod f {..n}) \<longlonglongrightarrow> 0"
 proof (subst tendsto_cong)
   show "\<forall>\<^sub>F n in sequentially. prod f {..n} = 0"
     using assms eventually_at_top_linorder by auto
 qed auto
 
 lemma LIMSEQ_prod_nonneg: 
   fixes f :: "nat \<Rightarrow> 'a::{linordered_semidom,linorder_topology}"
   assumes 0: "\<And>n. 0 \<le> f n" and a: "(\<lambda>n. prod f {..n}) \<longlonglongrightarrow> a"
   shows "a \<ge> 0"
   by (simp add: "0" prod_nonneg LIMSEQ_le_const [OF a])
 
 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_power_int' [tendsto_intros]:
   fixes a :: "'a::real_normed_div_algebra"
   assumes f: "(f \<longlongrightarrow> a) F"
     and a: "a \<noteq> 0 \<or> n \<ge> 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 tendsto_sgn [tendsto_intros]: "(f \<longlongrightarrow> l) F \<Longrightarrow> l \<noteq> 0 \<Longrightarrow> ((\<lambda>x. sgn (f x)) \<longlongrightarrow> sgn l) F"
   for l :: "'a::real_normed_vector"
   unfolding sgn_div_norm by (simp add: tendsto_intros)
 
 lemma continuous_sgn:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous F f"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_def by (rule tendsto_sgn)
 
 lemma continuous_at_within_sgn[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous (at a within s) f"
     and "f a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_within by (rule tendsto_sgn)
 
 lemma isCont_sgn[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "isCont f a"
     and "f a \<noteq> 0"
   shows "isCont (\<lambda>x. sgn (f x)) a"
   using assms unfolding continuous_at by (rule tendsto_sgn)
 
 lemma continuous_on_sgn[continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous_on s f"
     and "\<forall>x\<in>s. f x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_on_def by (blast intro: tendsto_sgn)
 
 lemma filterlim_at_infinity:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_vector"
   assumes "0 \<le> c"
   shows "(LIM x F. f x :> at_infinity) \<longleftrightarrow> (\<forall>r>c. eventually (\<lambda>x. r \<le> norm (f x)) F)"
   unfolding filterlim_iff eventually_at_infinity
 proof safe
   fix P :: "'a \<Rightarrow> bool"
   fix b
   assume *: "\<forall>r>c. eventually (\<lambda>x. r \<le> norm (f x)) F"
   assume P: "\<forall>x. b \<le> norm x \<longrightarrow> P x"
   have "max b (c + 1) > c" by auto
   with * have "eventually (\<lambda>x. max b (c + 1) \<le> norm (f x)) F"
     by auto
   then show "eventually (\<lambda>x. P (f x)) F"
   proof eventually_elim
     case (elim x)
     with P show "P (f x)" by auto
   qed
 qed force
 
 lemma filterlim_at_infinity_imp_norm_at_top:
   fixes F
   assumes "filterlim f at_infinity F"
   shows   "filterlim (\<lambda>x. norm (f x)) at_top F"
 proof -
   {
     fix r :: real
     have "\<forall>\<^sub>F x in F. r \<le> norm (f x)" using filterlim_at_infinity[of 0 f F] assms
       by (cases "r > 0")
          (auto simp: not_less intro: always_eventually order.trans[OF _ norm_ge_zero])
   }
   thus ?thesis by (auto simp: filterlim_at_top)
 qed
 
 lemma filterlim_norm_at_top_imp_at_infinity:
   fixes F
   assumes "filterlim (\<lambda>x. norm (f x)) at_top F"
   shows   "filterlim f at_infinity F"
   using filterlim_at_infinity[of 0 f F] assms by (auto simp: filterlim_at_top)
 
 lemma filterlim_norm_at_top: "filterlim norm at_top at_infinity"
   by (rule filterlim_at_infinity_imp_norm_at_top) (rule filterlim_ident)
 
 lemma filterlim_at_infinity_conv_norm_at_top:
   "filterlim f at_infinity G \<longleftrightarrow> filterlim (\<lambda>x. norm (f x)) at_top G"
   by (auto simp: filterlim_at_infinity[OF order.refl] filterlim_at_top_gt[of _ _ 0])
 
 lemma eventually_not_equal_at_infinity:
   "eventually (\<lambda>x. x \<noteq> (a :: 'a :: {real_normed_vector})) at_infinity"
 proof -
   from filterlim_norm_at_top[where 'a = 'a]
     have "\<forall>\<^sub>F x in at_infinity. norm a < norm (x::'a)" by (auto simp: filterlim_at_top_dense)
   thus ?thesis by eventually_elim auto
 qed
 
 lemma filterlim_int_of_nat_at_topD:
   fixes F
   assumes "filterlim (\<lambda>x. f (int x)) F at_top"
   shows   "filterlim f F at_top"
 proof -
   have "filterlim (\<lambda>x. f (int (nat x))) F at_top"
     by (rule filterlim_compose[OF assms filterlim_nat_sequentially])
   also have "?this \<longleftrightarrow> filterlim f F at_top"
     by (intro filterlim_cong refl eventually_mono [OF eventually_ge_at_top[of "0::int"]]) auto
   finally show ?thesis .
 qed
 
 lemma filterlim_int_sequentially [tendsto_intros]:
   "filterlim int at_top sequentially"
   unfolding filterlim_at_top
 proof
   fix C :: int
   show "eventually (\<lambda>n. int n \<ge> C) at_top"
     using eventually_ge_at_top[of "nat \<lceil>C\<rceil>"] by eventually_elim linarith
 qed
 
 lemma filterlim_real_of_int_at_top [tendsto_intros]:
   "filterlim real_of_int at_top at_top"
   unfolding filterlim_at_top
 proof
   fix C :: real
   show "eventually (\<lambda>n. real_of_int n \<ge> C) at_top"
     using eventually_ge_at_top[of "\<lceil>C\<rceil>"] by eventually_elim linarith
 qed
 
 lemma filterlim_abs_real: "filterlim (abs::real \<Rightarrow> real) at_top at_top"
 proof (subst filterlim_cong[OF refl refl])
   from eventually_ge_at_top[of "0::real"] show "eventually (\<lambda>x::real. \<bar>x\<bar> = x) at_top"
     by eventually_elim simp
 qed (simp_all add: filterlim_ident)
 
 lemma filterlim_of_real_at_infinity [tendsto_intros]:
   "filterlim (of_real :: real \<Rightarrow> 'a :: real_normed_algebra_1) at_infinity at_top"
   by (intro filterlim_norm_at_top_imp_at_infinity) (auto simp: filterlim_abs_real)
 
 lemma not_tendsto_and_filterlim_at_infinity:
   fixes c :: "'a::real_normed_vector"
   assumes "F \<noteq> bot"
     and "(f \<longlongrightarrow> c) F"
     and "filterlim f at_infinity F"
   shows False
 proof -
   from tendstoD[OF assms(2), of "1/2"]
   have "eventually (\<lambda>x. dist (f x) c < 1/2) F"
     by simp
   moreover
   from filterlim_at_infinity[of "norm c" f F] assms(3)
   have "eventually (\<lambda>x. norm (f x) \<ge> norm c + 1) F" by simp
   ultimately have "eventually (\<lambda>x. False) F"
   proof eventually_elim
     fix x
     assume A: "dist (f x) c < 1/2"
     assume "norm (f x) \<ge> norm c + 1"
     also have "norm (f x) = dist (f x) 0" by simp
     also have "\<dots> \<le> dist (f x) c + dist c 0" by (rule dist_triangle)
     finally show False using A by simp
   qed
   with assms show False by simp
 qed
 
 lemma filterlim_at_infinity_imp_not_convergent:
   assumes "filterlim f at_infinity sequentially"
   shows "\<not> convergent f"
   by (rule notI, rule not_tendsto_and_filterlim_at_infinity[OF _ _ assms])
      (simp_all add: convergent_LIMSEQ_iff)
 
 lemma filterlim_at_infinity_imp_eventually_ne:
   assumes "filterlim f at_infinity F"
   shows "eventually (\<lambda>z. f z \<noteq> c) F"
 proof -
   have "norm c + 1 > 0"
     by (intro add_nonneg_pos) simp_all
   with filterlim_at_infinity[OF order.refl, of f F] assms
   have "eventually (\<lambda>z. norm (f z) \<ge> norm c + 1) F"
     by blast
   then show ?thesis
     by eventually_elim auto
 qed
 
 lemma tendsto_of_nat [tendsto_intros]:
   "filterlim (of_nat :: nat \<Rightarrow> 'a::real_normed_algebra_1) at_infinity sequentially"
 proof (subst filterlim_at_infinity[OF order.refl], intro allI impI)
   fix r :: real
   assume r: "r > 0"
   define n where "n = nat \<lceil>r\<rceil>"
   from r have n: "\<forall>m\<ge>n. of_nat m \<ge> r"
     unfolding n_def by linarith
   from eventually_ge_at_top[of n] show "eventually (\<lambda>m. norm (of_nat m :: 'a) \<ge> r) sequentially"
     by eventually_elim (use n in simp_all)
 qed
 
 
 subsection \<open>Relate \<^const>\<open>at\<close>, \<^const>\<open>at_left\<close> and \<^const>\<open>at_right\<close>\<close>
 
 text \<open>
   This lemmas are useful for conversion between \<^term>\<open>at x\<close> to \<^term>\<open>at_left x\<close> and
   \<^term>\<open>at_right x\<close> and also \<^term>\<open>at_right 0\<close>.
 \<close>
 
 lemmas filterlim_split_at_real = filterlim_split_at[where 'a=real]
 
 lemma filtermap_nhds_shift: "filtermap (\<lambda>x. x - d) (nhds a) = nhds (a - d)"
   for a d :: "'a::real_normed_vector"
   by (rule filtermap_fun_inverse[where g="\<lambda>x. x + d"])
     (auto intro!: tendsto_eq_intros filterlim_ident)
 
 lemma filtermap_nhds_minus: "filtermap (\<lambda>x. - x) (nhds a) = nhds (- a)"
   for a :: "'a::real_normed_vector"
   by (rule filtermap_fun_inverse[where g=uminus])
     (auto intro!: tendsto_eq_intros filterlim_ident)
 
 lemma filtermap_at_shift: "filtermap (\<lambda>x. x - d) (at a) = at (a - d)"
   for a d :: "'a::real_normed_vector"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_shift[symmetric])
 
 lemma filtermap_at_right_shift: "filtermap (\<lambda>x. x - d) (at_right a) = at_right (a - d)"
   for a d :: "real"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_shift[symmetric])
 
 lemma filterlim_shift:
   fixes d :: "'a::real_normed_vector"
   assumes "filterlim f F (at a)"
   shows "filterlim (f \<circ> (+) d) F (at (a - d))"
   unfolding filterlim_iff
 proof (intro strip)
   fix P
   assume "eventually P F"
   then have "\<forall>\<^sub>F x in filtermap (\<lambda>y. y - d) (at a). P (f (d + x))"
     using assms by (force simp add: filterlim_iff eventually_filtermap)
   then show "(\<forall>\<^sub>F x in at (a - d). P ((f \<circ> (+) d) x))"
     by (force simp add: filtermap_at_shift)
 qed
 
 lemma filterlim_shift_iff:
   fixes d :: "'a::real_normed_vector"
   shows "filterlim (f \<circ> (+) d) F (at (a - d)) = filterlim f F (at a)"   (is "?lhs = ?rhs")
 proof
   assume L: ?lhs show ?rhs
     using filterlim_shift [OF L, of "-d"] by (simp add: filterlim_iff)
 qed (metis filterlim_shift)
 
 lemma at_right_to_0: "at_right a = filtermap (\<lambda>x. x + a) (at_right 0)"
   for a :: real
   using filtermap_at_right_shift[of "-a" 0] by simp
 
 lemma filterlim_at_right_to_0:
   "filterlim f F (at_right a) \<longleftrightarrow> filterlim (\<lambda>x. f (x + a)) F (at_right 0)"
   for a :: real
   unfolding filterlim_def filtermap_filtermap at_right_to_0[of a] ..
 
 lemma eventually_at_right_to_0:
   "eventually P (at_right a) \<longleftrightarrow> eventually (\<lambda>x. P (x + a)) (at_right 0)"
   for a :: real
   unfolding at_right_to_0[of a] by (simp add: eventually_filtermap)
 
 lemma at_to_0: "at a = filtermap (\<lambda>x. x + a) (at 0)"
   for a :: "'a::real_normed_vector"
   using filtermap_at_shift[of "-a" 0] by simp
 
 lemma filterlim_at_to_0:
   "filterlim f F (at a) \<longleftrightarrow> filterlim (\<lambda>x. f (x + a)) F (at 0)"
   for a :: "'a::real_normed_vector"
   unfolding filterlim_def filtermap_filtermap at_to_0[of a] ..
 
 lemma eventually_at_to_0:
   "eventually P (at a) \<longleftrightarrow> eventually (\<lambda>x. P (x + a)) (at 0)"
   for a ::  "'a::real_normed_vector"
   unfolding at_to_0[of a] by (simp add: eventually_filtermap)
 
 lemma filtermap_at_minus: "filtermap (\<lambda>x. - x) (at a) = at (- a)"
   for a :: "'a::real_normed_vector"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 lemma at_left_minus: "at_left a = filtermap (\<lambda>x. - x) (at_right (- a))"
   for a :: real
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 lemma at_right_minus: "at_right a = filtermap (\<lambda>x. - x) (at_left (- a))"
   for a :: real
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 
 lemma filterlim_at_left_to_right:
   "filterlim f F (at_left a) \<longleftrightarrow> filterlim (\<lambda>x. f (- x)) F (at_right (-a))"
   for a :: real
   unfolding filterlim_def filtermap_filtermap at_left_minus[of a] ..
 
 lemma eventually_at_left_to_right:
   "eventually P (at_left a) \<longleftrightarrow> eventually (\<lambda>x. P (- x)) (at_right (-a))"
   for a :: real
   unfolding at_left_minus[of a] by (simp add: eventually_filtermap)
 
 lemma filterlim_uminus_at_top_at_bot: "LIM x at_bot. - x :: real :> at_top"
   unfolding filterlim_at_top eventually_at_bot_dense
   by (metis leI minus_less_iff order_less_asym)
 
 lemma filterlim_uminus_at_bot_at_top: "LIM x at_top. - x :: real :> at_bot"
   unfolding filterlim_at_bot eventually_at_top_dense
   by (metis leI less_minus_iff order_less_asym)
 
 lemma at_bot_mirror :
   shows "(at_bot::('a::{ordered_ab_group_add,linorder} filter)) = filtermap uminus at_top"
 proof (rule filtermap_fun_inverse[symmetric])
   show "filterlim uminus at_top (at_bot::'a filter)"
     using eventually_at_bot_linorder filterlim_at_top le_minus_iff by force
   show "filterlim uminus (at_bot::'a filter) at_top"
     by (simp add: filterlim_at_bot minus_le_iff)
 qed auto
 
 lemma at_top_mirror :
   shows "(at_top::('a::{ordered_ab_group_add,linorder} filter)) = filtermap uminus at_bot"
   apply (subst at_bot_mirror)
   by (auto simp: filtermap_filtermap)
 
 lemma filterlim_at_top_mirror: "(LIM x at_top. f x :> F) \<longleftrightarrow> (LIM x at_bot. f (-x::real) :> F)"
   unfolding filterlim_def at_top_mirror filtermap_filtermap ..
 
 lemma filterlim_at_bot_mirror: "(LIM x at_bot. f x :> F) \<longleftrightarrow> (LIM x at_top. f (-x::real) :> F)"
   unfolding filterlim_def at_bot_mirror filtermap_filtermap ..
 
 lemma filterlim_uminus_at_top: "(LIM x F. f x :> at_top) \<longleftrightarrow> (LIM x F. - (f x) :: real :> at_bot)"
   using filterlim_compose[OF filterlim_uminus_at_bot_at_top, of f F]
     and filterlim_compose[OF filterlim_uminus_at_top_at_bot, of "\<lambda>x. - f x" F]
   by auto
 
 lemma tendsto_at_botI_sequentially:
   fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
   assumes *: "\<And>X. filterlim X at_bot sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
   shows "(f \<longlongrightarrow> y) at_bot"
   unfolding filterlim_at_bot_mirror
 proof (rule tendsto_at_topI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume "filterlim X at_top sequentially"
   thus "(\<lambda>n. f (-X n)) \<longlonglongrightarrow> y" by (intro *) (auto simp: filterlim_uminus_at_top)
 qed
 
 lemma filterlim_at_infinity_imp_filterlim_at_top:
   assumes "filterlim (f :: 'a \<Rightarrow> real) at_infinity F"
   assumes "eventually (\<lambda>x. f x > 0) F"
   shows   "filterlim f at_top F"
 proof -
   from assms(2) have *: "eventually (\<lambda>x. norm (f x) = f x) F" by eventually_elim simp
   from assms(1) show ?thesis unfolding filterlim_at_infinity_conv_norm_at_top
     by (subst (asm) filterlim_cong[OF refl refl *])
 qed
 
 lemma filterlim_at_infinity_imp_filterlim_at_bot:
   assumes "filterlim (f :: 'a \<Rightarrow> real) at_infinity F"
   assumes "eventually (\<lambda>x. f x < 0) F"
   shows   "filterlim f at_bot F"
 proof -
   from assms(2) have *: "eventually (\<lambda>x. norm (f x) = -f x) F" by eventually_elim simp
   from assms(1) have "filterlim (\<lambda>x. - f x) at_top F"
     unfolding filterlim_at_infinity_conv_norm_at_top
     by (subst (asm) filterlim_cong[OF refl refl *])
   thus ?thesis by (simp add: filterlim_uminus_at_top)
 qed
 
 lemma filterlim_uminus_at_bot: "(LIM x F. f x :> at_bot) \<longleftrightarrow> (LIM x F. - (f x) :: real :> at_top)"
   unfolding filterlim_uminus_at_top by simp
 
 lemma filterlim_inverse_at_top_right: "LIM x at_right (0::real). inverse x :> at_top"
   unfolding filterlim_at_top_gt[where c=0] eventually_at_filter
 proof safe
   fix Z :: real
   assume [arith]: "0 < Z"
   then have "eventually (\<lambda>x. x < inverse Z) (nhds 0)"
     by (auto simp: eventually_nhds_metric dist_real_def intro!: exI[of _ "\<bar>inverse Z\<bar>"])
   then show "eventually (\<lambda>x. x \<noteq> 0 \<longrightarrow> x \<in> {0<..} \<longrightarrow> Z \<le> inverse x) (nhds 0)"
     by (auto elim!: eventually_mono simp: inverse_eq_divide field_simps)
 qed
 
 lemma tendsto_inverse_0:
   fixes x :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   shows "(inverse \<longlongrightarrow> (0::'a)) at_infinity"
   unfolding tendsto_Zfun_iff diff_0_right Zfun_def eventually_at_infinity
 proof safe
   fix r :: real
   assume "0 < r"
   show "\<exists>b. \<forall>x. b \<le> norm x \<longrightarrow> norm (inverse x :: 'a) < r"
   proof (intro exI[of _ "inverse (r / 2)"] allI impI)
     fix x :: 'a
     from \<open>0 < r\<close> have "0 < inverse (r / 2)" by simp
     also assume *: "inverse (r / 2) \<le> norm x"
     finally show "norm (inverse x) < r"
       using * \<open>0 < r\<close>
       by (subst nonzero_norm_inverse) (simp_all add: inverse_eq_divide field_simps)
   qed
 qed
 
 lemma tendsto_add_filterlim_at_infinity:
   fixes c :: "'b::real_normed_vector"
     and F :: "'a filter"
   assumes "(f \<longlongrightarrow> c) F"
     and "filterlim g at_infinity F"
   shows "filterlim (\<lambda>x. f x + g x) at_infinity F"
 proof (subst filterlim_at_infinity[OF order_refl], safe)
   fix r :: real
   assume r: "r > 0"
   from assms(1) have "((\<lambda>x. norm (f x)) \<longlongrightarrow> norm c) F"
     by (rule tendsto_norm)
   then have "eventually (\<lambda>x. norm (f x) < norm c + 1) F"
     by (rule order_tendstoD) simp_all
   moreover from r have "r + norm c + 1 > 0"
     by (intro add_pos_nonneg) simp_all
   with assms(2) have "eventually (\<lambda>x. norm (g x) \<ge> r + norm c + 1) F"
     unfolding filterlim_at_infinity[OF order_refl]
     by (elim allE[of _ "r + norm c + 1"]) simp_all
   ultimately show "eventually (\<lambda>x. norm (f x + g x) \<ge> r) F"
   proof eventually_elim
     fix x :: 'a
     assume A: "norm (f x) < norm c + 1" and B: "r + norm c + 1 \<le> norm (g x)"
     from A B have "r \<le> norm (g x) - norm (f x)"
       by simp
     also have "norm (g x) - norm (f x) \<le> norm (g x + f x)"
       by (rule norm_diff_ineq)
     finally show "r \<le> norm (f x + g x)"
       by (simp add: add_ac)
   qed
 qed
 
 lemma tendsto_add_filterlim_at_infinity':
   fixes c :: "'b::real_normed_vector"
     and F :: "'a filter"
   assumes "filterlim f at_infinity F"
     and "(g \<longlongrightarrow> c) F"
   shows "filterlim (\<lambda>x. f x + g x) at_infinity F"
   by (subst add.commute) (rule tendsto_add_filterlim_at_infinity assms)+
 
 lemma filterlim_inverse_at_right_top: "LIM x at_top. inverse x :> at_right (0::real)"
   unfolding filterlim_at
   by (auto simp: eventually_at_top_dense)
      (metis tendsto_inverse_0 filterlim_mono at_top_le_at_infinity order_refl)
 
 lemma filterlim_inverse_at_top:
   "(f \<longlongrightarrow> (0 :: real)) F \<Longrightarrow> eventually (\<lambda>x. 0 < f x) F \<Longrightarrow> LIM x F. inverse (f x) :> at_top"
   by (intro filterlim_compose[OF filterlim_inverse_at_top_right])
      (simp add: filterlim_def eventually_filtermap eventually_mono at_within_def le_principal)
 
 lemma filterlim_inverse_at_bot_neg:
   "LIM x (at_left (0::real)). inverse x :> at_bot"
   by (simp add: filterlim_inverse_at_top_right filterlim_uminus_at_bot filterlim_at_left_to_right)
 
 lemma filterlim_inverse_at_bot:
   "(f \<longlongrightarrow> (0 :: real)) F \<Longrightarrow> eventually (\<lambda>x. f x < 0) F \<Longrightarrow> LIM x F. inverse (f x) :> at_bot"
   unfolding filterlim_uminus_at_bot inverse_minus_eq[symmetric]
   by (rule filterlim_inverse_at_top) (simp_all add: tendsto_minus_cancel_left[symmetric])
 
 lemma at_right_to_top: "(at_right (0::real)) = filtermap inverse at_top"
   by (intro filtermap_fun_inverse[symmetric, where g=inverse])
      (auto intro: filterlim_inverse_at_top_right filterlim_inverse_at_right_top)
 
 lemma eventually_at_right_to_top:
   "eventually P (at_right (0::real)) \<longleftrightarrow> eventually (\<lambda>x. P (inverse x)) at_top"
   unfolding at_right_to_top eventually_filtermap ..
 
 lemma filterlim_at_right_to_top:
   "filterlim f F (at_right (0::real)) \<longleftrightarrow> (LIM x at_top. f (inverse x) :> F)"
   unfolding filterlim_def at_right_to_top filtermap_filtermap ..
 
 lemma at_top_to_right: "at_top = filtermap inverse (at_right (0::real))"
   unfolding at_right_to_top filtermap_filtermap inverse_inverse_eq filtermap_ident ..
 
 lemma eventually_at_top_to_right:
   "eventually P at_top \<longleftrightarrow> eventually (\<lambda>x. P (inverse x)) (at_right (0::real))"
   unfolding at_top_to_right eventually_filtermap ..
 
 lemma filterlim_at_top_to_right:
   "filterlim f F at_top \<longleftrightarrow> (LIM x (at_right (0::real)). f (inverse x) :> F)"
   unfolding filterlim_def at_top_to_right filtermap_filtermap ..
 
 lemma filterlim_inverse_at_infinity:
   fixes x :: "_ \<Rightarrow> 'a::{real_normed_div_algebra, division_ring}"
   shows "filterlim inverse at_infinity (at (0::'a))"
   unfolding filterlim_at_infinity[OF order_refl]
 proof safe
   fix r :: real
   assume "0 < r"
   then show "eventually (\<lambda>x::'a. r \<le> norm (inverse x)) (at 0)"
     unfolding eventually_at norm_inverse
     by (intro exI[of _ "inverse r"])
        (auto simp: norm_conv_dist[symmetric] field_simps inverse_eq_divide)
 qed
 
 lemma filterlim_inverse_at_iff:
   fixes g :: "'a \<Rightarrow> 'b::{real_normed_div_algebra, division_ring}"
   shows "(LIM x F. inverse (g x) :> at 0) \<longleftrightarrow> (LIM x F. g x :> at_infinity)"
   unfolding filterlim_def filtermap_filtermap[symmetric]
 proof
   assume "filtermap g F \<le> at_infinity"
   then have "filtermap inverse (filtermap g F) \<le> filtermap inverse at_infinity"
     by (rule filtermap_mono)
   also have "\<dots> \<le> at 0"
     using tendsto_inverse_0[where 'a='b]
     by (auto intro!: exI[of _ 1]
         simp: le_principal eventually_filtermap filterlim_def at_within_def eventually_at_infinity)
   finally show "filtermap inverse (filtermap g F) \<le> at 0" .
 next
   assume "filtermap inverse (filtermap g F) \<le> at 0"
   then have "filtermap inverse (filtermap inverse (filtermap g F)) \<le> filtermap inverse (at 0)"
     by (rule filtermap_mono)
   with filterlim_inverse_at_infinity show "filtermap g F \<le> at_infinity"
     by (auto intro: order_trans simp: filterlim_def filtermap_filtermap)
 qed
 
 lemma tendsto_mult_filterlim_at_infinity:
   fixes c :: "'a::real_normed_field"
   assumes  "(f \<longlongrightarrow> c) F" "c \<noteq> 0"
   assumes "filterlim g at_infinity F"
   shows "filterlim (\<lambda>x. f x * g x) at_infinity F"
 proof -
   have "((\<lambda>x. inverse (f x) * inverse (g x)) \<longlongrightarrow> inverse c * 0) F"
     by (intro tendsto_mult tendsto_inverse assms filterlim_compose[OF tendsto_inverse_0])
   then have "filterlim (\<lambda>x. inverse (f x) * inverse (g x)) (at (inverse c * 0)) F"
     unfolding filterlim_at
     using assms
     by (auto intro: filterlim_at_infinity_imp_eventually_ne tendsto_imp_eventually_ne eventually_conj)
   then show ?thesis
     by (subst filterlim_inverse_at_iff[symmetric]) simp_all
 qed
 
 lemma filterlim_power_int_neg_at_infinity:
   fixes f :: "_ \<Rightarrow> 'a::{real_normed_div_algebra, division_ring}"
   assumes "n < 0" and lim: "(f \<longlongrightarrow> 0) F" and ev: "eventually (\<lambda>x. f x \<noteq> 0) F"
   shows   "filterlim (\<lambda>x. f x powi n) at_infinity F"
 proof -
   have lim': "((\<lambda>x. f x ^ nat (- n)) \<longlongrightarrow> 0) F"
     by (rule tendsto_eq_intros lim)+ (use \<open>n < 0\<close> in auto)
   have ev': "eventually (\<lambda>x. f x ^ nat (-n) \<noteq> 0) F"
     using ev by eventually_elim (use \<open>n < 0\<close> in auto)
   have "filterlim (\<lambda>x. inverse (f x ^ nat (-n))) at_infinity F"
     by (intro filterlim_compose[OF filterlim_inverse_at_infinity])
        (use lim' ev' in \<open>auto simp: filterlim_at\<close>)
   thus ?thesis
     using \<open>n < 0\<close> by (simp add: power_int_def power_inverse)
 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 filterlim_inverse_at_top_iff:
   "eventually (\<lambda>x. 0 < f x) F \<Longrightarrow> (LIM x F. inverse (f x) :> at_top) \<longleftrightarrow> (f \<longlongrightarrow> (0 :: real)) F"
   by (auto dest: tendsto_inverse_0_at_top filterlim_inverse_at_top)
 
 lemma filterlim_at_top_iff_inverse_0:
   "eventually (\<lambda>x. 0 < f x) F \<Longrightarrow> (LIM x F. f x :> at_top) \<longleftrightarrow> ((inverse \<circ> f) \<longlongrightarrow> (0 :: real)) F"
   using filterlim_inverse_at_top_iff [of "inverse \<circ> f"] by auto
 
 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_cmult_at_bot_at_top:
   assumes "filterlim (h :: _ \<Rightarrow> real) at_top F" "c \<noteq> 0" "G = (if c > 0 then at_top else at_bot)"
   shows   "filterlim (\<lambda>x. c * h x) G F"
   using assms filterlim_tendsto_pos_mult_at_top[OF tendsto_const[of c], of h F]
               filterlim_tendsto_neg_mult_at_bot[OF tendsto_const[of c], of h F] 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>More about @{term filterlim} (thanks to Wenda Li)\<close>
 
 lemma filterlim_at_infinity_times:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_field"
   assumes "filterlim f at_infinity F" "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> 0 * 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 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 filterlim_at_top_at_bot[elim]:
   fixes f::"'a \<Rightarrow> 'b::unbounded_dense_linorder" and F::"'a filter"
   assumes top:"filterlim f at_top F" and bot: "filterlim f at_bot F" and "F\<noteq>bot"
   shows False
 proof -
   obtain c::'b where True by auto
   have "\<forall>\<^sub>F x in F. c < f x" 
     using top unfolding filterlim_at_top_dense by auto
   moreover have "\<forall>\<^sub>F x in F. f x < c" 
     using bot unfolding filterlim_at_bot_dense by auto
   ultimately have "\<forall>\<^sub>F x in F. c < f x \<and> f x < c" 
     using eventually_conj by auto
   then have "\<forall>\<^sub>F x in F. False" by (auto elim:eventually_mono)
   then show False using \<open>F\<noteq>bot\<close> by auto
 qed  
 
 lemma filterlim_at_top_nhds[elim]:      
   fixes f::"'a \<Rightarrow> 'b::{unbounded_dense_linorder,order_topology}" and F::"'a filter"
   assumes top:"filterlim f at_top F" and tendsto: "(f \<longlongrightarrow> c) F" and "F\<noteq>bot"
   shows False
 proof -
   obtain c'::'b where "c'>c" using gt_ex by blast
   have "\<forall>\<^sub>F x in F. c' < f x" 
     using top unfolding filterlim_at_top_dense by auto
   moreover have "\<forall>\<^sub>F x in F. f x < c'" 
     using order_tendstoD[OF tendsto,of c'] \<open>c'>c\<close> by auto
   ultimately have "\<forall>\<^sub>F x in F. c' < f x \<and> f x < c'" 
     using eventually_conj by auto
   then have "\<forall>\<^sub>F x in F. False" by (auto elim:eventually_mono)
   then show False using \<open>F\<noteq>bot\<close> by auto
 qed
 
 lemma filterlim_at_bot_nhds[elim]:      
   fixes f::"'a \<Rightarrow> 'b::{unbounded_dense_linorder,order_topology}" and F::"'a filter"
   assumes top:"filterlim f at_bot F" and tendsto: "(f \<longlongrightarrow> c) F" and "F\<noteq>bot"
   shows False
 proof -
   obtain c'::'b where "c'<c" using lt_ex by blast
   have "\<forall>\<^sub>F x in F. c' > f x" 
     using top unfolding filterlim_at_bot_dense by auto
   moreover have "\<forall>\<^sub>F x in F. f x > c'" 
     using order_tendstoD[OF tendsto,of c'] \<open>c'<c\<close> by auto
   ultimately have "\<forall>\<^sub>F x in F. c' < f x \<and> f x < c'" 
     using eventually_conj by auto
   then have "\<forall>\<^sub>F x in F. False" by (auto elim:eventually_mono)
   then show False using \<open>F\<noteq>bot\<close> by auto
 qed  
 
 lemma eventually_times_inverse_1:
   fixes f::"'a \<Rightarrow> 'b::{field,t2_space}"
   assumes "(f \<longlongrightarrow> c) F" "c\<noteq>0"
   shows "\<forall>\<^sub>F x in F. inverse (f x) * f x = 1"
   by (smt (verit) assms eventually_mono mult.commute right_inverse tendsto_imp_eventually_ne)
   
 lemma filterlim_at_infinity_divide_iff:
   fixes f::"'a \<Rightarrow> 'b::real_normed_field"
   assumes "(f \<longlongrightarrow> c) F" "c\<noteq>0"
   shows "(LIM x F. f x / g x :> at_infinity) \<longleftrightarrow> (LIM x F. g x :> at 0)"
 proof 
   assume "LIM x F. f x / g x :> at_infinity"
   then have "LIM x F. inverse (f x) * (f x / g x) :> at_infinity"
     using assms tendsto_inverse tendsto_mult_filterlim_at_infinity by fastforce
   then have "LIM x F. inverse (g x) :> at_infinity"
     apply (elim filterlim_mono_eventually)
     using eventually_times_inverse_1[OF assms] 
     by (auto elim:eventually_mono simp add:field_simps)
   then show "filterlim g (at 0) F" using filterlim_inverse_at_iff[symmetric] by force 
 next
   assume "filterlim g (at 0) F" 
   then have "filterlim (\<lambda>x. inverse (g x)) at_infinity F"
     using filterlim_compose filterlim_inverse_at_infinity by blast
   then have "LIM x F. f x * inverse (g x) :> at_infinity"
     using tendsto_mult_filterlim_at_infinity[OF assms, of "\<lambda>x. inverse(g x)"] 
     by simp
   then show "LIM x F. f x / g x :> at_infinity" by (simp add: divide_inverse)
 qed  
 
 lemma filterlim_tendsto_pos_mult_at_top_iff:
   fixes f::"'a \<Rightarrow> real"
   assumes "(f \<longlongrightarrow> c) F" and "0 < c"
   shows "(LIM x F. (f x * g x) :> at_top) \<longleftrightarrow> (LIM x F. g x :> at_top)"
 proof 
   assume "filterlim g at_top F"
   then show "LIM x F. f x * g x :> at_top" 
     using filterlim_tendsto_pos_mult_at_top[OF assms] by auto
 next
   assume asm:"LIM x F. f x * g x :> at_top"
   have "((\<lambda>x. inverse (f x)) \<longlongrightarrow> inverse c) F" 
     using tendsto_inverse[OF assms(1)] \<open>0<c\<close> by auto
   moreover have "inverse c >0" using assms(2) by auto
   ultimately have "LIM x F. inverse (f x) * (f x * g x) :> at_top"
     using filterlim_tendsto_pos_mult_at_top[OF _ _ asm,of "\<lambda>x. inverse (f x)" "inverse c"] by auto
   then show "LIM x F. g x :> at_top"
     apply (elim filterlim_mono_eventually)
       apply simp_all[2]
     using eventually_times_inverse_1[OF assms(1)] \<open>c>0\<close> eventually_mono by fastforce
 qed  
 
 lemma filterlim_tendsto_pos_mult_at_bot_iff:
   fixes c :: real
   assumes "(f \<longlongrightarrow> c) F" "0 < c" 
   shows "(LIM x F. f x * g x :> at_bot) \<longleftrightarrow> filterlim g at_bot F"
   using filterlim_tendsto_pos_mult_at_top_iff[OF assms(1,2), of "\<lambda>x. - g x"] 
   unfolding filterlim_uminus_at_bot by simp    
 
 lemma filterlim_tendsto_neg_mult_at_top_iff:
   fixes f::"'a \<Rightarrow> real"
   assumes "(f \<longlongrightarrow> c) F" and "c < 0"
   shows "(LIM x F. (f x * g x) :> at_top) \<longleftrightarrow> (LIM x F. g x :> at_bot)"  
 proof -
   have "(LIM x F. f x * g x :> at_top) = (LIM x F. - g x :> at_top)"
     apply (rule filterlim_tendsto_pos_mult_at_top_iff[of "\<lambda>x. - f x" "-c" F "\<lambda>x. - g x", simplified])
     using assms by (auto intro: tendsto_intros )
   also have "... = (LIM x F. g x :> at_bot)" 
     using filterlim_uminus_at_bot[symmetric] by auto
   finally show ?thesis .
 qed
 
 lemma filterlim_tendsto_neg_mult_at_bot_iff:
   fixes c :: real
   assumes "(f \<longlongrightarrow> c) F" "0 > c" 
   shows "(LIM x F. f x * g x :> at_bot) \<longleftrightarrow> filterlim g at_top F"
   using filterlim_tendsto_neg_mult_at_top_iff[OF assms(1,2), of "\<lambda>x. - g x"] 
   unfolding filterlim_uminus_at_top by simp    
 
 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 "1 < inverse x"
     using \<open>x < 1\<close> by (simp add: one_less_inverse)
   then have "(\<lambda>n. inverse (inverse x ^ n)) \<longlonglongrightarrow> 0"
     by (rule LIMSEQ_inverse_realpow_zero)
   then show ?thesis by (simp add: power_inverse)
 next
   case True
   show ?thesis
     by (rule LIMSEQ_imp_Suc) (simp add: True)
 qed
 
 lemma LIMSEQ_power_zero [tendsto_intros]: "norm x < 1 \<Longrightarrow> (\<lambda>n. x ^ n) \<longlonglongrightarrow> 0"
   for x :: "'a::real_normed_algebra_1"
   apply (drule LIMSEQ_realpow_zero [OF norm_ge_zero])
   by (simp add: Zfun_le norm_power_ineq tendsto_Zfun_iff)
 
 lemma LIMSEQ_divide_realpow_zero: "1 < x \<Longrightarrow> (\<lambda>n. a / (x ^ n) :: real) \<longlonglongrightarrow> 0"
   by (rule tendsto_divide_0 [OF tendsto_const filterlim_realpow_sequentially_gt1]) simp
 
 lemma
   tendsto_power_zero:
   fixes x::"'a::real_normed_algebra_1"
   assumes "filterlim f at_top F"
   assumes "norm x < 1"
   shows "((\<lambda>y. x ^ (f y)) \<longlongrightarrow> 0) F"
 proof (rule tendstoI)
   fix e::real assume "0 < e"
   from tendstoD[OF LIMSEQ_power_zero[OF \<open>norm x < 1\<close>] \<open>0 < e\<close>]
   have "\<forall>\<^sub>F xa in sequentially. norm (x ^ xa) < e"
     by simp
   then obtain N where N: "norm (x ^ n) < e" if "n \<ge> N" for n
     by (auto simp: eventually_sequentially)
   have "\<forall>\<^sub>F i in F. f i \<ge> N"
     using \<open>filterlim f sequentially F\<close>
     by (simp add: filterlim_at_top)
   then show "\<forall>\<^sub>F i in F. dist (x ^ f i) 0 < e"
     by eventually_elim (auto simp: N)
 qed
 
 text \<open>Limit of \<^term>\<open>c^n\<close> for \<^term>\<open>\<bar>c\<bar> < 1\<close>.\<close>
 
 lemma LIMSEQ_abs_realpow_zero: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. \<bar>c\<bar> ^ n :: real) \<longlonglongrightarrow> 0"
   by (rule LIMSEQ_realpow_zero [OF abs_ge_zero])
 
 lemma LIMSEQ_abs_realpow_zero2: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. c ^ n :: real) \<longlonglongrightarrow> 0"
   by (rule LIMSEQ_power_zero) simp
 
 
 subsection \<open>Limits of Functions\<close>
 
 lemma LIM_eq: "f \<midarrow>a\<rightarrow> L = (\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r)"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_def dist_norm)
 
 lemma LIM_I:
   "(\<And>r. 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r) \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_eq)
 
 lemma LIM_D: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>s>0.\<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_eq)
 
 lemma LIM_offset: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. f (x + k)) \<midarrow>(a - k)\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (simp add: filtermap_at_shift[symmetric, of a k] filterlim_def filtermap_filtermap)
 
 lemma LIM_offset_zero: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (drule LIM_offset [where k = a]) (simp add: add.commute)
 
 lemma LIM_offset_zero_cancel: "(\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (drule LIM_offset [where k = "- a"]) simp
 
 lemma LIM_offset_zero_iff: "NO_MATCH 0 a \<Longrightarrow> f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L"
   for f :: "'a :: real_normed_vector \<Rightarrow> _"
   using LIM_offset_zero_cancel[of f a L] LIM_offset_zero[of f L a] by auto
 
 lemma tendsto_offset_zero_iff:
   fixes f :: "'a :: real_normed_vector \<Rightarrow> _"
   assumes " NO_MATCH 0 a" "a \<in> S" "open S"
   shows "(f \<longlongrightarrow> L) (at a within S) \<longleftrightarrow> ((\<lambda>h. f (a + h)) \<longlongrightarrow> L) (at 0)"
   using assms by (simp add: tendsto_within_open_NO_MATCH LIM_offset_zero_iff)
 
 lemma LIM_zero: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. f x - l) \<longlongrightarrow> 0) F"
   for f :: "'a \<Rightarrow> 'b::real_normed_vector"
   unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_zero_cancel:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   shows "((\<lambda>x. f x - l) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> l) F"
 unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_zero_iff: "((\<lambda>x. f x - l) \<longlongrightarrow> 0) F = (f \<longlongrightarrow> l) F"
   for f :: "'a \<Rightarrow> 'b::real_normed_vector"
   unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_imp_LIM:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   fixes g :: "'a::topological_space \<Rightarrow> 'c::real_normed_vector"
   assumes f: "f \<midarrow>a\<rightarrow> l"
     and le: "\<And>x. x \<noteq> a \<Longrightarrow> norm (g x - m) \<le> norm (f x - l)"
   shows "g \<midarrow>a\<rightarrow> m"
   by (rule metric_LIM_imp_LIM [OF f]) (simp add: dist_norm le)
 
 lemma LIM_equal2:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   assumes "0 < R"
     and "\<And>x. x \<noteq> a \<Longrightarrow> norm (x - a) < R \<Longrightarrow> f x = g x"
   shows "g \<midarrow>a\<rightarrow> l \<Longrightarrow> f \<midarrow>a\<rightarrow> l"
   by (rule metric_LIM_equal2 [OF _ assms]) (simp_all add: dist_norm)
 
 lemma LIM_compose2:
   fixes a :: "'a::real_normed_vector"
   assumes f: "f \<midarrow>a\<rightarrow> b"
     and g: "g \<midarrow>b\<rightarrow> c"
     and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> f x \<noteq> b"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> c"
   by (rule metric_LIM_compose2 [OF f g inj [folded dist_norm]])
 
 lemma real_LIM_sandwich_zero:
   fixes f g :: "'a::topological_space \<Rightarrow> real"
   assumes f: "f \<midarrow>a\<rightarrow> 0"
     and 1: "\<And>x. x \<noteq> a \<Longrightarrow> 0 \<le> g x"
     and 2: "\<And>x. x \<noteq> a \<Longrightarrow> g x \<le> f x"
   shows "g \<midarrow>a\<rightarrow> 0"
 proof (rule LIM_imp_LIM [OF f]) (* FIXME: use tendsto_sandwich *)
   fix x
   assume x: "x \<noteq> a"
   with 1 have "norm (g x - 0) = g x" by simp
   also have "g x \<le> f x" by (rule 2 [OF x])
   also have "f x \<le> \<bar>f x\<bar>" by (rule abs_ge_self)
   also have "\<bar>f x\<bar> = norm (f x - 0)" by simp
   finally show "norm (g x - 0) \<le> norm (f x - 0)" .
 qed
 
 
 subsection \<open>Continuity\<close>
 
 lemma LIM_isCont_iff: "(f \<midarrow>a\<rightarrow> f a) = ((\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> f a)"
   for f :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   by (rule iffI [OF LIM_offset_zero LIM_offset_zero_cancel])
 
 lemma isCont_iff: "isCont f x = (\<lambda>h. f (x + h)) \<midarrow>0\<rightarrow> f x"
   for f :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   by (simp add: isCont_def LIM_isCont_iff)
 
 lemma isCont_LIM_compose2:
   fixes a :: "'a::real_normed_vector"
   assumes f [unfolded isCont_def]: "isCont f a"
     and g: "g \<midarrow>f a\<rightarrow> l"
     and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> f x \<noteq> f a"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> l"
   by (rule LIM_compose2 [OF f g inj])
 
 lemma isCont_norm [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. norm (f x)) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_norm)
 
 lemma isCont_rabs [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. \<bar>f x\<bar>) a"
   for f :: "'a::t2_space \<Rightarrow> real"
   by (fact continuous_rabs)
 
 lemma isCont_add [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x + g x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::topological_monoid_add"
   by (fact continuous_add)
 
 lemma isCont_minus [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. - f x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_minus)
 
 lemma isCont_diff [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x - g x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_diff)
 
 lemma isCont_mult [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x * g x) a"
   for f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_algebra"
   by (fact continuous_mult)
 
 lemma (in bounded_linear) isCont: "isCont g a \<Longrightarrow> isCont (\<lambda>x. f (g x)) a"
   by (fact continuous)
 
 lemma (in bounded_bilinear) isCont: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x ** g x) a"
   by (fact continuous)
 
 lemmas isCont_scaleR [simp] =
   bounded_bilinear.isCont [OF bounded_bilinear_scaleR]
 
 lemmas isCont_of_real [simp] =
   bounded_linear.isCont [OF bounded_linear_of_real]
 
 lemma isCont_power [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. f x ^ n) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::{power,real_normed_algebra}"
   by (fact continuous_power)
 
 lemma isCont_sum [simp]: "\<forall>i\<in>A. isCont (f i) a \<Longrightarrow> isCont (\<lambda>x. \<Sum>i\<in>A. f i x) a"
   for f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::topological_comm_monoid_add"
   by (auto intro: continuous_sum)
 
 
 subsection \<open>Uniform Continuity\<close>
 
 lemma uniformly_continuous_on_def:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   shows "uniformly_continuous_on s f \<longleftrightarrow>
     (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e)"
   unfolding uniformly_continuous_on_uniformity
     uniformity_dist filterlim_INF filterlim_principal eventually_inf_principal
   by (force simp: Ball_def uniformity_dist[symmetric] eventually_uniformity_metric)
 
 abbreviation isUCont :: "['a::metric_space \<Rightarrow> 'b::metric_space] \<Rightarrow> bool"
   where "isUCont f \<equiv> uniformly_continuous_on UNIV f"
 
 lemma isUCont_def: "isUCont f \<longleftrightarrow> (\<forall>r>0. \<exists>s>0. \<forall>x y. dist x y < s \<longrightarrow> dist (f x) (f y) < r)"
   by (auto simp: uniformly_continuous_on_def dist_commute)
 
 lemma isUCont_isCont: "isUCont f \<Longrightarrow> isCont f x"
   by (drule uniformly_continuous_imp_continuous) (simp add: continuous_on_eq_continuous_at)
 
 lemma uniformly_continuous_on_Cauchy:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   assumes "uniformly_continuous_on S f" "Cauchy X" "\<And>n. X n \<in> S"
   shows "Cauchy (\<lambda>n. f (X n))"
   using assms
   unfolding uniformly_continuous_on_def  by (meson Cauchy_def)
 
 lemma isUCont_Cauchy: "isUCont f \<Longrightarrow> Cauchy X \<Longrightarrow> Cauchy (\<lambda>n. f (X n))"
   by (rule uniformly_continuous_on_Cauchy[where S=UNIV and f=f]) simp_all
 
-lemma uniformly_continuous_imp_Cauchy_continuous:
-  fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
-  shows "\<lbrakk>uniformly_continuous_on S f; Cauchy \<sigma>; \<And>n. (\<sigma> n) \<in> S\<rbrakk> \<Longrightarrow> Cauchy(f \<circ> \<sigma>)"
-  by (simp add: uniformly_continuous_on_def Cauchy_def) meson
-
 lemma (in bounded_linear) isUCont: "isUCont f"
   unfolding isUCont_def dist_norm
 proof (intro allI impI)
   fix r :: real
   assume r: "0 < r"
   obtain K where K: "0 < K" and norm_le: "norm (f x) \<le> norm x * K" for x
     using pos_bounded by blast
   show "\<exists>s>0. \<forall>x y. norm (x - y) < s \<longrightarrow> norm (f x - f y) < r"
   proof (rule exI, safe)
     from r K show "0 < r / K" by simp
   next
     fix x y :: 'a
     assume xy: "norm (x - y) < r / K"
     have "norm (f x - f y) = norm (f (x - y))" by (simp only: diff)
     also have "\<dots> \<le> norm (x - y) * K" by (rule norm_le)
     also from K xy have "\<dots> < r" by (simp only: pos_less_divide_eq)
     finally show "norm (f x - f y) < r" .
   qed
 qed
 
 lemma (in bounded_linear) Cauchy: "Cauchy X \<Longrightarrow> Cauchy (\<lambda>n. f (X n))"
   by (rule isUCont [THEN isUCont_Cauchy])
 
 lemma LIM_less_bound:
   fixes f :: "real \<Rightarrow> real"
   assumes ev: "b < x" "\<forall> x' \<in> { b <..< x}. 0 \<le> f x'" and "isCont f x"
   shows "0 \<le> f x"
 proof (rule tendsto_lowerbound)
   show "(f \<longlongrightarrow> f x) (at_left x)"
     using \<open>isCont f x\<close> by (simp add: filterlim_at_split isCont_def)
   show "eventually (\<lambda>x. 0 \<le> f x) (at_left x)"
     using ev by (auto simp: eventually_at dist_real_def intro!: exI[of _ "x - b"])
 qed simp
 
 
 subsection \<open>Nested Intervals and Bisection -- Needed for Compactness\<close>
 
 lemma nested_sequence_unique:
   assumes "\<forall>n. f n \<le> f (Suc n)" "\<forall>n. g (Suc n) \<le> g n" "\<forall>n. f n \<le> g n" "(\<lambda>n. f n - g n) \<longlonglongrightarrow> 0"
   shows "\<exists>l::real. ((\<forall>n. f n \<le> l) \<and> f \<longlonglongrightarrow> l) \<and> ((\<forall>n. l \<le> g n) \<and> g \<longlonglongrightarrow> l)"
 proof -
   have "incseq f" unfolding incseq_Suc_iff by fact
   have "decseq g" unfolding decseq_Suc_iff by fact
   have "f n \<le> g 0" for n
   proof -
     from \<open>decseq g\<close> have "g n \<le> g 0"
       by (rule decseqD) simp
     with \<open>\<forall>n. f n \<le> g n\<close>[THEN spec, of n] show ?thesis
       by auto
   qed
   then obtain u where "f \<longlonglongrightarrow> u" "\<forall>i. f i \<le> u"
     using incseq_convergent[OF \<open>incseq f\<close>] by auto
   moreover have "f 0 \<le> g n" for n
   proof -
     from \<open>incseq f\<close> have "f 0 \<le> f n" by (rule incseqD) simp
     with \<open>\<forall>n. f n \<le> g n\<close>[THEN spec, of n] show ?thesis
       by simp
   qed
   then obtain l where "g \<longlonglongrightarrow> l" "\<forall>i. l \<le> g i"
     using decseq_convergent[OF \<open>decseq g\<close>] by auto
   moreover note LIMSEQ_unique[OF assms(4) tendsto_diff[OF \<open>f \<longlonglongrightarrow> u\<close> \<open>g \<longlonglongrightarrow> l\<close>]]
   ultimately show ?thesis by auto
 qed
 
 lemma Bolzano[consumes 1, case_names trans local]:
   fixes P :: "real \<Rightarrow> real \<Rightarrow> bool"
   assumes [arith]: "a \<le> b"
     and trans: "\<And>a b c. P a b \<Longrightarrow> P b c \<Longrightarrow> a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> P a c"
     and local: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> \<exists>d>0. \<forall>a b. a \<le> x \<and> x \<le> b \<and> b - a < d \<longrightarrow> P a b"
   shows "P a b"
 proof -
   define bisect where "bisect \<equiv> \<lambda>(x,y). if P x ((x+y) / 2) then ((x+y)/2, y) else (x, (x+y)/2)"
   define l u where "l n \<equiv> fst ((bisect^^n)(a,b))" and "u n \<equiv> snd ((bisect^^n)(a,b))" 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)
 
 lemma Lim_topological:
   "(f \<longlongrightarrow> l) net \<longleftrightarrow>
     trivial_limit net \<or> (\<forall>S. open S \<longrightarrow> l \<in> S \<longrightarrow> eventually (\<lambda>x. f x \<in> S) net)"
   unfolding tendsto_def trivial_limit_eq by auto
 
 lemma eventually_within_Un:
   "eventually P (at x within (s \<union> t)) \<longleftrightarrow>
     eventually P (at x within s) \<and> eventually P (at x within t)"
   unfolding eventually_at_filter
   by (auto elim!: eventually_rev_mp)
 
 lemma Lim_within_Un:
  "(f \<longlongrightarrow> l) (at x within (s \<union> t)) \<longleftrightarrow>
   (f \<longlongrightarrow> l) (at x within s) \<and> (f \<longlongrightarrow> l) (at x within t)"
   unfolding tendsto_def
   by (auto simp: eventually_within_Un)
 
 end