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,2634 +1,3348 @@
 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 + 
+locale Submetric = Metric_space + 
   fixes A
   assumes subset: "A \<subseteq> M"
 
-sublocale submetric \<subseteq> sub: Metric_space A d
+sublocale Submetric \<subseteq> sub: Metric_space A d
   by (simp add: subset subspace)
 
-context submetric
+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)
+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)
+
+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)
 
 
 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)
+  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:
+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
+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" 
+  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) 
+  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)
+    by (meson Submetric.subset subspace)
   interpret MA: Metric_space A d
-    by (meson A submetric.subset subspace)
+    by (meson A Submetric.subset subspace)
   interpret MB: Metric_space B d
-    by (meson B submetric.subset subspace)
+    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" 
+    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 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"
+  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
+  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)
+  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)
+    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)
+        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')
+            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)
+            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)
+        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"
+  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)
+  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>)
+    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:
+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:
+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:
+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"
+    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 
+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)
+
+
+
+end
+
diff --git a/src/HOL/Analysis/Abstract_Topology.thy b/src/HOL/Analysis/Abstract_Topology.thy
--- a/src/HOL/Analysis/Abstract_Topology.thy
+++ b/src/HOL/Analysis/Abstract_Topology.thy
@@ -1,5090 +1,5102 @@
 (*  Author:     L C Paulson, University of Cambridge [ported from HOL Light] *)
 
 section \<open>Operators involving abstract topology\<close>
 
 theory Abstract_Topology
   imports
     Complex_Main
     "HOL-Library.Set_Idioms"
     "HOL-Library.FuncSet"
 begin
 
 subsection \<open>General notion of a topology as a value\<close>
 
 definition\<^marker>\<open>tag important\<close> istopology :: "('a set \<Rightarrow> bool) \<Rightarrow> bool" where
   "istopology L \<equiv> (\<forall>S T. L S \<longrightarrow> L T \<longrightarrow> L (S \<inter> T)) \<and> (\<forall>\<K>. (\<forall>K\<in>\<K>. L K) \<longrightarrow> L (\<Union>\<K>))"
 
 typedef\<^marker>\<open>tag important\<close> 'a topology = "{L::('a set) \<Rightarrow> bool. istopology L}"
   morphisms "openin" "topology"
   unfolding istopology_def by blast
 
 lemma istopology_openin[iff]: "istopology(openin U)"
   using openin[of U] by blast
 
 lemma istopology_open[iff]: "istopology open"
   by (auto simp: istopology_def)
 
 lemma topology_inverse' [simp]: "istopology U \<Longrightarrow> openin (topology U) = U"
   using topology_inverse[unfolded mem_Collect_eq] .
 
 lemma topology_inverse_iff: "istopology U \<longleftrightarrow> openin (topology U) = U"
   by (metis istopology_openin topology_inverse')
 
 lemma topology_eq: "T1 = T2 \<longleftrightarrow> (\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S)"
 proof
   assume "T1 = T2"
   then show "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S" by simp
 next
   assume H: "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S"
   then have "openin T1 = openin T2" by (simp add: fun_eq_iff)
   then have "topology (openin T1) = topology (openin T2)" by simp
   then show "T1 = T2" unfolding openin_inverse .
 qed
 
 
 text\<open>The "universe": the union of all sets in the topology.\<close>
 definition "topspace T = \<Union>{S. openin T S}"
 
 subsubsection \<open>Main properties of open sets\<close>
 
 proposition openin_clauses:
   fixes U :: "'a topology"
   shows
     "openin U {}"
     "\<And>S T. openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S\<inter>T)"
     "\<And>K. (\<forall>S \<in> K. openin U S) \<Longrightarrow> openin U (\<Union>K)"
   using openin[of U] unfolding istopology_def by auto
 
 lemma openin_subset: "openin U S \<Longrightarrow> S \<subseteq> topspace U"
   unfolding topspace_def by blast
 
 lemma openin_empty[simp]: "openin U {}"
   by (rule openin_clauses)
 
 lemma openin_Int[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<inter> T)"
   by (rule openin_clauses)
 
 lemma openin_Union[intro]: "(\<And>S. S \<in> K \<Longrightarrow> openin U S) \<Longrightarrow> openin U (\<Union>K)"
   using openin_clauses by blast
 
 lemma openin_Un[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<union> T)"
   using openin_Union[of "{S,T}" U] by auto
 
 lemma openin_topspace[intro, simp]: "openin U (topspace U)"
   by (force simp: openin_Union topspace_def)
 
 lemma openin_subopen: "openin U S \<longleftrightarrow> (\<forall>x \<in> S. \<exists>T. openin U T \<and> x \<in> T \<and> T \<subseteq> S)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then show ?rhs by auto
 next
   assume H: ?rhs
   let ?t = "\<Union>{T. openin U T \<and> T \<subseteq> S}"
   have "openin U ?t" by (force simp: openin_Union)
   also have "?t = S" using H by auto
   finally show "openin U S" .
 qed
 
 lemma openin_INT [intro]:
   assumes "finite I"
           "\<And>i. i \<in> I \<Longrightarrow> openin T (U i)"
   shows "openin T ((\<Inter>i \<in> I. U i) \<inter> topspace T)"
 using assms by (induct, auto simp: inf_sup_aci(2) openin_Int)
 
 lemma openin_INT2 [intro]:
   assumes "finite I" "I \<noteq> {}"
           "\<And>i. i \<in> I \<Longrightarrow> openin T (U i)"
   shows "openin T (\<Inter>i \<in> I. U i)"
 proof -
   have "(\<Inter>i \<in> I. U i) \<subseteq> topspace T"
     using \<open>I \<noteq> {}\<close> openin_subset[OF assms(3)] by auto
   then show ?thesis
     using openin_INT[of _ _ U, OF assms(1) assms(3)] by (simp add: inf.absorb2 inf_commute)
 qed
 
 lemma openin_Inter [intro]:
   assumes "finite \<F>" "\<F> \<noteq> {}" "\<And>X. X \<in> \<F> \<Longrightarrow> openin T X" shows "openin T (\<Inter>\<F>)"
   by (metis (full_types) assms openin_INT2 image_ident)
 
 lemma openin_Int_Inter:
   assumes "finite \<F>" "openin T U" "\<And>X. X \<in> \<F> \<Longrightarrow> openin T X" shows "openin T (U \<inter> \<Inter>\<F>)"
   using openin_Inter [of "insert U \<F>"] assms by auto
 
 
 subsubsection \<open>Closed sets\<close>
 
 definition\<^marker>\<open>tag important\<close> closedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> bool" where
 "closedin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> openin U (topspace U - S)"
 
 lemma closedin_subset: "closedin U S \<Longrightarrow> S \<subseteq> topspace U"
   by (metis closedin_def)
 
 lemma closedin_empty[simp]: "closedin U {}"
   by (simp add: closedin_def)
 
 lemma closedin_topspace[intro, simp]: "closedin U (topspace U)"
   by (simp add: closedin_def)
 
 lemma closedin_Un[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<union> T)"
   by (auto simp: Diff_Un closedin_def)
 
 lemma Diff_Inter[intro]: "A - \<Inter>S = \<Union>{A - s|s. s\<in>S}"
   by auto
 
 lemma closedin_Union:
   assumes "finite S" "\<And>T. T \<in> S \<Longrightarrow> closedin U T"
     shows "closedin U (\<Union>S)"
   using assms by induction auto
 
 lemma closedin_Inter[intro]:
   assumes Ke: "K \<noteq> {}"
     and Kc: "\<And>S. S \<in>K \<Longrightarrow> closedin U S"
   shows "closedin U (\<Inter>K)"
   using Ke Kc unfolding closedin_def Diff_Inter by auto
 
 lemma closedin_INT[intro]:
   assumes "A \<noteq> {}" "\<And>x. x \<in> A \<Longrightarrow> closedin U (B x)"
   shows "closedin U (\<Inter>x\<in>A. B x)"
   using assms by blast
 
 lemma closedin_Int[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<inter> T)"
   using closedin_Inter[of "{S,T}" U] by auto
 
 lemma openin_closedin_eq: "openin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> closedin U (topspace U - S)"
   by (metis Diff_subset closedin_def double_diff equalityD1 openin_subset)
 
 lemma topology_finer_closedin:
   "topspace X = topspace Y \<Longrightarrow> (\<forall>S. openin Y S \<longrightarrow> openin X S) \<longleftrightarrow> (\<forall>S. closedin Y S \<longrightarrow> closedin X S)"
   by (metis closedin_def openin_closedin_eq)
 
 lemma openin_closedin: "S \<subseteq> topspace U \<Longrightarrow> (openin U S \<longleftrightarrow> closedin U (topspace U - S))"
   by (simp add: openin_closedin_eq)
 
 lemma openin_diff[intro]:
   assumes oS: "openin U S"
     and cT: "closedin U T"
   shows "openin U (S - T)"
   by (metis Int_Diff cT closedin_def inf.orderE oS openin_Int openin_subset)
 
 lemma closedin_diff[intro]:
   assumes oS: "closedin U S"
     and cT: "openin U T"
   shows "closedin U (S - T)"
   by (metis Int_Diff cT closedin_Int closedin_subset inf.orderE oS openin_closedin_eq)
 
 lemma all_openin: "(\<forall>U. openin X U \<longrightarrow> P U) \<longleftrightarrow> (\<forall>U. closedin X U \<longrightarrow> P (topspace X - U))"
   by (metis Diff_Diff_Int closedin_def inf.absorb_iff2 openin_closedin_eq)
 
 lemma all_closedin: "(\<forall>U. closedin X U \<longrightarrow> P U) \<longleftrightarrow> (\<forall>U. openin X U \<longrightarrow> P (topspace X - U))"
   by (metis Diff_Diff_Int closedin_subset inf.absorb_iff2 openin_closedin_eq)
 
 lemma ex_openin: "(\<exists>U. openin X U \<and> P U) \<longleftrightarrow> (\<exists>U. closedin X U \<and> P (topspace X - U))"
   by (metis Diff_Diff_Int closedin_def inf.absorb_iff2 openin_closedin_eq)
 
 lemma ex_closedin: "(\<exists>U. closedin X U \<and> P U) \<longleftrightarrow> (\<exists>U. openin X U \<and> P (topspace X - U))"
   by (metis Diff_Diff_Int closedin_subset inf.absorb_iff2 openin_closedin_eq)
 
 
 subsection\<open>The discrete topology\<close>
 
 definition discrete_topology where "discrete_topology U \<equiv> topology (\<lambda>S. S \<subseteq> U)"
 
 lemma openin_discrete_topology [simp]: "openin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U"
 proof -
   have "istopology (\<lambda>S. S \<subseteq> U)"
     by (auto simp: istopology_def)
   then show ?thesis
     by (simp add: discrete_topology_def topology_inverse')
 qed
 
 lemma topspace_discrete_topology [simp]: "topspace(discrete_topology U) = U"
   by (meson openin_discrete_topology openin_subset openin_topspace order_refl subset_antisym)
 
 lemma closedin_discrete_topology [simp]: "closedin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U"
   by (simp add: closedin_def)
 
 lemma discrete_topology_unique:
    "discrete_topology U = X \<longleftrightarrow> topspace X = U \<and> (\<forall>x \<in> U. openin X {x})" (is "?lhs = ?rhs")
 proof
   assume R: ?rhs
   then have "openin X S" if "S \<subseteq> U" for S
     using openin_subopen subsetD that by fastforce
   then show ?lhs
     by (metis R openin_discrete_topology openin_subset topology_eq)
 qed auto
 
 lemma discrete_topology_unique_alt:
   "discrete_topology U = X \<longleftrightarrow> topspace X \<subseteq> U \<and> (\<forall>x \<in> U. openin X {x})"
   using openin_subset
   by (auto simp: discrete_topology_unique)
 
 lemma subtopology_eq_discrete_topology_empty:
    "X = discrete_topology {} \<longleftrightarrow> topspace X = {}"
   using discrete_topology_unique [of "{}" X] by auto
 
 lemma subtopology_eq_discrete_topology_sing:
    "X = discrete_topology {a} \<longleftrightarrow> topspace X = {a}"
   by (metis discrete_topology_unique openin_topspace singletonD)
 
 
 subsection \<open>Subspace topology\<close>
 
 definition\<^marker>\<open>tag important\<close> subtopology :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a topology" 
   where "subtopology U V = topology (\<lambda>T. \<exists>S. T = S \<inter> V \<and> openin U S)"
 
 lemma istopology_subtopology: "istopology (\<lambda>T. \<exists>S. T = S \<inter> V \<and> openin U S)"
   (is "istopology ?L")
 proof -
   have "?L {}" by blast
   {
     fix A B
     assume A: "?L A" and B: "?L B"
     from A B obtain Sa and Sb where Sa: "openin U Sa" "A = Sa \<inter> V" and Sb: "openin U Sb" "B = Sb \<inter> V"
       by blast
     have "A \<inter> B = (Sa \<inter> Sb) \<inter> V" "openin U (Sa \<inter> Sb)"
       using Sa Sb by blast+
     then have "?L (A \<inter> B)" by blast
   }
   moreover
   {
     fix K
     assume K: "K \<subseteq> Collect ?L"
     have th0: "Collect ?L = (\<lambda>S. S \<inter> V) ` Collect (openin U)"
       by blast
     from K[unfolded th0 subset_image_iff]
     obtain Sk where Sk: "Sk \<subseteq> Collect (openin U)" "K = (\<lambda>S. S \<inter> V) ` Sk"
       by blast
     have "\<Union>K = (\<Union>Sk) \<inter> V"
       using Sk by auto
     moreover have "openin U (\<Union>Sk)"
       using Sk by (auto simp: subset_eq)
     ultimately have "?L (\<Union>K)" by blast
   }
   ultimately show ?thesis
     unfolding subset_eq mem_Collect_eq istopology_def by auto
 qed
 
 lemma openin_subtopology: "openin (subtopology U V) S \<longleftrightarrow> (\<exists>T. openin U T \<and> S = T \<inter> V)"
   unfolding subtopology_def topology_inverse'[OF istopology_subtopology]
   by auto
 
 lemma subset_openin_subtopology:
    "\<lbrakk>openin X S; S \<subseteq> T\<rbrakk> \<Longrightarrow> openin (subtopology X T) S"
   by (metis inf.orderE openin_subtopology)
 
 lemma openin_subtopology_Int:
    "openin X S \<Longrightarrow> openin (subtopology X T) (S \<inter> T)"
   using openin_subtopology by auto
 
 lemma openin_subtopology_Int2:
    "openin X T \<Longrightarrow> openin (subtopology X S) (S \<inter> T)"
   using openin_subtopology by auto
 
 lemma openin_subtopology_diff_closed:
    "\<lbrakk>S \<subseteq> topspace X; closedin X T\<rbrakk> \<Longrightarrow> openin (subtopology X S) (S - T)"
   unfolding closedin_def openin_subtopology
   by (rule_tac x="topspace X - T" in exI) auto
 
 lemma openin_relative_to: "(openin X relative_to S) = openin (subtopology X S)"
   by (force simp: relative_to_def openin_subtopology)
 
 lemma topspace_subtopology [simp]: "topspace (subtopology U V) = topspace U \<inter> V"
   by (auto simp: topspace_def openin_subtopology)
 
 lemma topspace_subtopology_subset:
    "S \<subseteq> topspace X \<Longrightarrow> topspace(subtopology X S) = S"
   by (simp add: inf.absorb_iff2)
 
 lemma closedin_subtopology: "closedin (subtopology U V) S \<longleftrightarrow> (\<exists>T. closedin U T \<and> S = T \<inter> V)"
   unfolding closedin_def topspace_subtopology
   by (auto simp: openin_subtopology)
 
 lemma closedin_subtopology_Int_closed:
    "closedin X T \<Longrightarrow> closedin (subtopology X S) (S \<inter> T)"
   using closedin_subtopology inf_commute by blast
 
 lemma closedin_subset_topspace:
    "\<lbrakk>closedin X S; S \<subseteq> T\<rbrakk> \<Longrightarrow> closedin (subtopology X T) S"
   using closedin_subtopology by fastforce
 
 lemma closedin_relative_to:
    "(closedin X relative_to S) = closedin (subtopology X S)"
   by (force simp: relative_to_def closedin_subtopology)
 
 lemma openin_subtopology_refl: "openin (subtopology U V) V \<longleftrightarrow> V \<subseteq> topspace U"
   unfolding openin_subtopology
   by auto (metis IntD1 in_mono openin_subset)
 
 lemma subtopology_subtopology:
    "subtopology (subtopology X S) T = subtopology X (S \<inter> T)"
 proof -
   have eq: "\<And>T'. (\<exists>S'. T' = S' \<inter> T \<and> (\<exists>T. openin X T \<and> S' = T \<inter> S)) = (\<exists>Sa. T' = Sa \<inter> (S \<inter> T) \<and> openin X Sa)"
     by (metis inf_assoc)
   have "subtopology (subtopology X S) T = topology (\<lambda>Ta. \<exists>Sa. Ta = Sa \<inter> T \<and> openin (subtopology X S) Sa)"
     by (simp add: subtopology_def)
   also have "\<dots> = subtopology X (S \<inter> T)"
     by (simp add: openin_subtopology eq) (simp add: subtopology_def)
   finally show ?thesis .
 qed
 
 lemma openin_subtopology_alt:
      "openin (subtopology X U) S \<longleftrightarrow> S \<in> (\<lambda>T. U \<inter> T) ` Collect (openin X)"
   by (simp add: image_iff inf_commute openin_subtopology)
 
 lemma closedin_subtopology_alt:
      "closedin (subtopology X U) S \<longleftrightarrow> S \<in> (\<lambda>T. U \<inter> T) ` Collect (closedin X)"
   by (simp add: image_iff inf_commute closedin_subtopology)
 
 lemma subtopology_superset:
   assumes UV: "topspace U \<subseteq> V"
   shows "subtopology U V = U"
 proof -
   { fix S
     have "openin U S" if "openin U T" "S = T \<inter> V" for T
       by (metis Int_subset_iff assms inf.orderE openin_subset that)
     then have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S"
       by (metis assms inf.orderE inf_assoc openin_subset)
   }
   then show ?thesis
     unfolding topology_eq openin_subtopology by blast
 qed
 
 lemma subtopology_topspace[simp]: "subtopology U (topspace U) = U"
   by (simp add: subtopology_superset)
 
 lemma subtopology_UNIV[simp]: "subtopology U UNIV = U"
   by (simp add: subtopology_superset)
 
 lemma subtopology_restrict:
    "subtopology X (topspace X \<inter> S) = subtopology X S"
   by (metis subtopology_subtopology subtopology_topspace)
 
 lemma openin_subtopology_empty:
   "openin (subtopology U {}) S \<longleftrightarrow> S = {}"
   by (metis Int_empty_right openin_empty openin_subtopology)
 
 lemma closedin_subtopology_empty:
   "closedin (subtopology U {}) S \<longleftrightarrow> S = {}"
   by (metis Int_empty_right closedin_empty closedin_subtopology)
 
 lemma closedin_subtopology_refl [simp]:
   "closedin (subtopology U X) X \<longleftrightarrow> X \<subseteq> topspace U"
   by (metis closedin_def closedin_topspace inf.absorb_iff2 le_inf_iff topspace_subtopology)
 
 lemma closedin_topspace_empty: "topspace T = {} \<Longrightarrow> (closedin T S \<longleftrightarrow> S = {})"
   by (simp add: closedin_def)
 
 lemma open_in_topspace_empty:
    "topspace X = {} \<Longrightarrow> openin X S \<longleftrightarrow> S = {}"
   by (simp add: openin_closedin_eq)
 
 lemma openin_imp_subset:
   "openin (subtopology U S) T \<Longrightarrow> T \<subseteq> S"
   by (metis Int_iff openin_subtopology subsetI)
 
 lemma closedin_imp_subset:
   "closedin (subtopology U S) T \<Longrightarrow> T \<subseteq> S"
   by (simp add: closedin_def)
 
 lemma openin_open_subtopology:
      "openin X S \<Longrightarrow> openin (subtopology X S) T \<longleftrightarrow> openin X T \<and> T \<subseteq> S"
   by (metis inf.orderE openin_Int openin_imp_subset openin_subtopology)
 
 lemma closedin_closed_subtopology:
      "closedin X S \<Longrightarrow> (closedin (subtopology X S) T \<longleftrightarrow> closedin X T \<and> T \<subseteq> S)"
   by (metis closedin_Int closedin_imp_subset closedin_subtopology inf.orderE)
 
 lemma closedin_trans_full:
    "\<lbrakk>closedin (subtopology X U) S; closedin X U\<rbrakk> \<Longrightarrow> closedin X S"
   using closedin_closed_subtopology by blast
 
 lemma openin_subtopology_Un:
     "\<lbrakk>openin (subtopology X T) S; openin (subtopology X U) S\<rbrakk>
      \<Longrightarrow> openin (subtopology X (T \<union> U)) S"
 by (simp add: openin_subtopology) blast
 
 lemma closedin_subtopology_Un:
     "\<lbrakk>closedin (subtopology X T) S; closedin (subtopology X U) S\<rbrakk>
      \<Longrightarrow> closedin (subtopology X (T \<union> U)) S"
 by (simp add: closedin_subtopology) blast
 
 lemma openin_trans_full:
    "\<lbrakk>openin (subtopology X U) S; openin X U\<rbrakk> \<Longrightarrow> openin X S"
   by (simp add: openin_open_subtopology)
 
 
 subsection \<open>The canonical topology from the underlying type class\<close>
 
 abbreviation\<^marker>\<open>tag important\<close> euclidean :: "'a::topological_space topology"
   where "euclidean \<equiv> topology open"
 
 abbreviation top_of_set :: "'a::topological_space set \<Rightarrow> 'a topology"
   where "top_of_set \<equiv> subtopology (topology open)"
 
 lemma open_openin: "open S \<longleftrightarrow> openin euclidean S"
   by simp
 
 declare open_openin [symmetric, simp]
 
 lemma topspace_euclidean [simp]: "topspace euclidean = UNIV"
   by (force simp: topspace_def)
 
 lemma topspace_euclidean_subtopology[simp]: "topspace (top_of_set S) = S"
   by (simp)
 
 lemma closed_closedin: "closed S \<longleftrightarrow> closedin euclidean S"
   by (simp add: closed_def closedin_def Compl_eq_Diff_UNIV)
 
 declare closed_closedin [symmetric, simp]
 
 lemma openin_subtopology_self [simp]: "openin (top_of_set S) S"
   by (metis openin_topspace topspace_euclidean_subtopology)
 
 subsubsection\<open>The most basic facts about the usual topology and metric on R\<close>
 
 abbreviation euclideanreal :: "real topology"
   where "euclideanreal \<equiv> topology open"
 
 subsection \<open>Basic "localization" results are handy for connectedness.\<close>
 
 lemma openin_open: "openin (top_of_set U) S \<longleftrightarrow> (\<exists>T. open T \<and> (S = U \<inter> T))"
   by (auto simp: openin_subtopology)
 
 lemma openin_Int_open:
    "\<lbrakk>openin (top_of_set U) S; open T\<rbrakk>
         \<Longrightarrow> openin (top_of_set U) (S \<inter> T)"
 by (metis open_Int Int_assoc openin_open)
 
 lemma openin_open_Int[intro]: "open S \<Longrightarrow> openin (top_of_set U) (U \<inter> S)"
   by (auto simp: openin_open)
 
 lemma open_openin_trans[trans]:
   "open S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> openin (top_of_set S) T"
   by (metis Int_absorb1  openin_open_Int)
 
 lemma open_subset: "S \<subseteq> T \<Longrightarrow> open S \<Longrightarrow> openin (top_of_set T) S"
   by (auto simp: openin_open)
 
 lemma closedin_closed: "closedin (top_of_set U) S \<longleftrightarrow> (\<exists>T. closed T \<and> S = U \<inter> T)"
   by (simp add: closedin_subtopology Int_ac)
 
 lemma closedin_closed_Int: "closed S \<Longrightarrow> closedin (top_of_set U) (U \<inter> S)"
   by (metis closedin_closed)
 
 lemma closed_subset: "S \<subseteq> T \<Longrightarrow> closed S \<Longrightarrow> closedin (top_of_set T) S"
   by (auto simp: closedin_closed)
 
 lemma closedin_closed_subset:
  "\<lbrakk>closedin (top_of_set U) V; T \<subseteq> U; S = V \<inter> T\<rbrakk>
              \<Longrightarrow> closedin (top_of_set T) S"
   by (metis (no_types, lifting) Int_assoc Int_commute closedin_closed inf.orderE)
 
 lemma finite_imp_closedin:
   fixes S :: "'a::t1_space set"
   shows "\<lbrakk>finite S; S \<subseteq> T\<rbrakk> \<Longrightarrow> closedin (top_of_set T) S"
     by (simp add: finite_imp_closed closed_subset)
 
 lemma closedin_singleton [simp]:
   fixes a :: "'a::t1_space"
   shows "closedin (top_of_set U) {a} \<longleftrightarrow> a \<in> U"
 using closedin_subset  by (force intro: closed_subset)
 
 lemma openin_euclidean_subtopology_iff:
   fixes S U :: "'a::metric_space set"
   shows "openin (top_of_set U) S \<longleftrightarrow>
     S \<subseteq> U \<and> (\<forall>x\<in>S. \<exists>e>0. \<forall>x'\<in>U. dist x' x < e \<longrightarrow> x'\<in> S)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding openin_open open_dist by blast
 next
   define T where "T = {x. \<exists>a\<in>S. \<exists>d>0. (\<forall>y\<in>U. dist y a < d \<longrightarrow> y \<in> S) \<and> dist x a < d}"
   have 1: "\<forall>x\<in>T. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> T"
     unfolding T_def
     apply clarsimp
     apply (rule_tac x="d - dist x a" in exI)
     by (metis add_0_left dist_commute dist_triangle_lt less_diff_eq)
   assume ?rhs then have 2: "S = U \<inter> T"
     unfolding T_def
     by auto (metis dist_self)
   from 1 2 show ?lhs
     unfolding openin_open open_dist by fast
 qed
 
 lemma connected_openin:
       "connected S \<longleftrightarrow>
        \<not>(\<exists>E1 E2. openin (top_of_set S) E1 \<and>
                  openin (top_of_set S) E2 \<and>
                  S \<subseteq> E1 \<union> E2 \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
   unfolding connected_def openin_open disjoint_iff_not_equal by blast
 
 lemma connected_openin_eq:
       "connected S \<longleftrightarrow>
        \<not>(\<exists>E1 E2. openin (top_of_set S) E1 \<and>
                  openin (top_of_set S) E2 \<and>
                  E1 \<union> E2 = S \<and> E1 \<inter> E2 = {} \<and>
                  E1 \<noteq> {} \<and> E2 \<noteq> {})"
   unfolding connected_openin
   by (metis (no_types, lifting) Un_subset_iff openin_imp_subset subset_antisym)
 
 lemma connected_closedin:
       "connected S \<longleftrightarrow>
        (\<nexists>E1 E2.
         closedin (top_of_set S) E1 \<and>
         closedin (top_of_set S) E2 \<and>
         S \<subseteq> E1 \<union> E2 \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
        (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs 
     by (auto simp add: connected_closed closedin_closed)
 next
   assume R: ?rhs
   then show ?lhs 
   proof (clarsimp simp add: connected_closed closedin_closed)
     fix A B 
     assume s_sub: "S \<subseteq> A \<union> B" "B \<inter> S \<noteq> {}"
       and disj: "A \<inter> B \<inter> S = {}"
       and cl: "closed A" "closed B"
     have "S - A = B \<inter> S"
       using Diff_subset_conv Un_Diff_Int disj s_sub(1) by auto
     then show "A \<inter> S = {}"
       by (metis Int_Diff_Un Int_Diff_disjoint R cl closedin_closed_Int dual_order.refl inf_commute s_sub(2))
   qed
 qed
 
 lemma connected_closedin_eq:
       "connected S \<longleftrightarrow>
            \<not>(\<exists>E1 E2.
                  closedin (top_of_set S) E1 \<and>
                  closedin (top_of_set S) E2 \<and>
                  E1 \<union> E2 = S \<and> E1 \<inter> E2 = {} \<and>
                  E1 \<noteq> {} \<and> E2 \<noteq> {})"
   unfolding connected_closedin
   by (metis Un_subset_iff closedin_imp_subset subset_antisym)
 
 text \<open>These "transitivity" results are handy too\<close>
 
 lemma openin_trans[trans]:
   "openin (top_of_set T) S \<Longrightarrow> openin (top_of_set U) T \<Longrightarrow>
     openin (top_of_set U) S"
   by (metis openin_Int_open openin_open)
 
 lemma openin_open_trans: "openin (top_of_set T) S \<Longrightarrow> open T \<Longrightarrow> open S"
   by (auto simp: openin_open intro: openin_trans)
 
 lemma closedin_trans[trans]:
   "closedin (top_of_set T) S \<Longrightarrow> closedin (top_of_set U) T \<Longrightarrow>
     closedin (top_of_set U) S"
   by (auto simp: closedin_closed closed_Inter Int_assoc)
 
 lemma closedin_closed_trans: "closedin (top_of_set T) S \<Longrightarrow> closed T \<Longrightarrow> closed S"
   by (auto simp: closedin_closed intro: closedin_trans)
 
 lemma openin_subtopology_Int_subset:
    "\<lbrakk>openin (top_of_set u) (u \<inter> S); v \<subseteq> u\<rbrakk> \<Longrightarrow> openin (top_of_set v) (v \<inter> S)"
   by (auto simp: openin_subtopology)
 
 lemma openin_open_eq: "open s \<Longrightarrow> (openin (top_of_set s) t \<longleftrightarrow> open t \<and> t \<subseteq> s)"
   using open_subset openin_open_trans openin_subset by fastforce
 
 
 subsection\<open>Derived set (set of limit points)\<close>
 
 definition derived_set_of :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "derived'_set'_of" 80)
   where "X derived_set_of S \<equiv>
          {x \<in> topspace X.
                 (\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y\<noteq>x. y \<in> S \<and> y \<in> T))}"
 
 lemma derived_set_of_restrict [simp]:
    "X derived_set_of (topspace X \<inter> S) = X derived_set_of S"
   by (simp add: derived_set_of_def) (metis openin_subset subset_iff)
 
 lemma in_derived_set_of:
    "x \<in> X derived_set_of S \<longleftrightarrow> x \<in> topspace X \<and> (\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y\<noteq>x. y \<in> S \<and> y \<in> T))"
   by (simp add: derived_set_of_def)
 
 lemma derived_set_of_subset_topspace:
    "X derived_set_of S \<subseteq> topspace X"
   by (auto simp add: derived_set_of_def)
 
 lemma derived_set_of_subtopology:
    "(subtopology X U) derived_set_of S = U \<inter> (X derived_set_of (U \<inter> S))"
   by (simp add: derived_set_of_def openin_subtopology) blast
 
 lemma derived_set_of_subset_subtopology:
    "(subtopology X S) derived_set_of T \<subseteq> S"
   by (simp add: derived_set_of_subtopology)
 
 lemma derived_set_of_empty [simp]: "X derived_set_of {} = {}"
   by (auto simp: derived_set_of_def)
 
 lemma derived_set_of_mono:
    "S \<subseteq> T \<Longrightarrow> X derived_set_of S \<subseteq> X derived_set_of T"
   unfolding derived_set_of_def by blast
 
 lemma derived_set_of_Un:
    "X derived_set_of (S \<union> T) = X derived_set_of S \<union> X derived_set_of T" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (clarsimp simp: in_derived_set_of) (metis IntE IntI openin_Int)
   show "?rhs \<subseteq> ?lhs"
     by (simp add: derived_set_of_mono)
 qed
 
 lemma derived_set_of_Union:
    "finite \<F> \<Longrightarrow> X derived_set_of (\<Union>\<F>) = (\<Union>S \<in> \<F>. X derived_set_of S)"
 proof (induction \<F> rule: finite_induct)
   case (insert S \<F>)
   then show ?case
     by (simp add: derived_set_of_Un)
 qed auto
 
 lemma derived_set_of_topspace:
   "X derived_set_of (topspace X) = {x \<in> topspace X. \<not> openin X {x}}" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (auto simp: in_derived_set_of)
   show "?rhs \<subseteq> ?lhs"
     by (clarsimp simp: in_derived_set_of) (metis openin_closedin_eq openin_subopen singletonD subset_eq)
 qed
 
 lemma discrete_topology_unique_derived_set:
      "discrete_topology U = X \<longleftrightarrow> topspace X = U \<and> X derived_set_of U = {}"
   by (auto simp: discrete_topology_unique derived_set_of_topspace)
 
 lemma subtopology_eq_discrete_topology_eq:
    "subtopology X U = discrete_topology U \<longleftrightarrow> U \<subseteq> topspace X \<and> U \<inter> X derived_set_of U = {}"
   using discrete_topology_unique_derived_set [of U "subtopology X U"]
   by (auto simp: eq_commute derived_set_of_subtopology)
 
 lemma subtopology_eq_discrete_topology:
    "S \<subseteq> topspace X \<and> S \<inter> X derived_set_of S = {}
         \<Longrightarrow> subtopology X S = discrete_topology S"
   by (simp add: subtopology_eq_discrete_topology_eq)
 
 lemma subtopology_eq_discrete_topology_gen:
   assumes "S \<inter> X derived_set_of S = {}"
   shows "subtopology X S = discrete_topology(topspace X \<inter> S)"
 proof -
   have "subtopology X S = subtopology X (topspace X \<inter> S)"
     by (simp add: subtopology_restrict)
   then show ?thesis
     using assms by (simp add: inf.assoc subtopology_eq_discrete_topology_eq)
 qed
 
 lemma subtopology_discrete_topology [simp]: 
   "subtopology (discrete_topology U) S = discrete_topology(U \<inter> S)"
 proof -
   have "(\<lambda>T. \<exists>Sa. T = Sa \<inter> S \<and> Sa \<subseteq> U) = (\<lambda>Sa. Sa \<subseteq> U \<and> Sa \<subseteq> S)"
     by force
   then show ?thesis
     by (simp add: subtopology_def) (simp add: discrete_topology_def)
 qed
 
 lemma openin_Int_derived_set_of_subset:
    "openin X S \<Longrightarrow> S \<inter> X derived_set_of T \<subseteq> X derived_set_of (S \<inter> T)"
   by (auto simp: derived_set_of_def)
 
 lemma openin_Int_derived_set_of_eq:
   assumes "openin X S"
   shows "S \<inter> X derived_set_of T = S \<inter> X derived_set_of (S \<inter> T)" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (simp add: assms openin_Int_derived_set_of_subset)
   show "?rhs \<subseteq> ?lhs"
     by (metis derived_set_of_mono inf_commute inf_le1 inf_mono order_refl)
 qed
 
 
 subsection\<open> Closure with respect to a topological space\<close>
 
 definition closure_of :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixr "closure'_of" 80)
   where "X closure_of S \<equiv> {x \<in> topspace X. \<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y \<in> S. y \<in> T)}"
 
 lemma closure_of_restrict: "X closure_of S = X closure_of (topspace X \<inter> S)"
   unfolding closure_of_def
   using openin_subset by blast
 
 lemma in_closure_of:
    "x \<in> X closure_of S \<longleftrightarrow>
     x \<in> topspace X \<and> (\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y. y \<in> S \<and> y \<in> T))"
   by (auto simp: closure_of_def)
 
 lemma closure_of: "X closure_of S = topspace X \<inter> (S \<union> X derived_set_of S)"
   by (fastforce simp: in_closure_of in_derived_set_of)
 
 lemma closure_of_alt: "X closure_of S = topspace X \<inter> S \<union> X derived_set_of S"
   using derived_set_of_subset_topspace [of X S]
   unfolding closure_of_def in_derived_set_of
   by safe (auto simp: in_derived_set_of)
 
 lemma derived_set_of_subset_closure_of:
    "X derived_set_of S \<subseteq> X closure_of S"
   by (fastforce simp: closure_of_def in_derived_set_of)
 
 lemma closure_of_subtopology:
   "(subtopology X U) closure_of S = U \<inter> (X closure_of (U \<inter> S))"
   unfolding closure_of_def topspace_subtopology openin_subtopology
   by safe (metis (full_types) IntI Int_iff inf.commute)+
 
 lemma closure_of_empty [simp]: "X closure_of {} = {}"
   by (simp add: closure_of_alt)
 
 lemma closure_of_topspace [simp]: "X closure_of topspace X = topspace X"
   by (simp add: closure_of)
 
 lemma closure_of_UNIV [simp]: "X closure_of UNIV = topspace X"
   by (simp add: closure_of)
 
 lemma closure_of_subset_topspace: "X closure_of S \<subseteq> topspace X"
   by (simp add: closure_of)
 
 lemma closure_of_subset_subtopology: "(subtopology X S) closure_of T \<subseteq> S"
   by (simp add: closure_of_subtopology)
 
 lemma closure_of_mono: "S \<subseteq> T \<Longrightarrow> X closure_of S \<subseteq> X closure_of T"
   by (fastforce simp add: closure_of_def)
 
 lemma closure_of_subtopology_subset:
    "(subtopology X U) closure_of S \<subseteq> (X closure_of S)"
   unfolding closure_of_subtopology
   by clarsimp (meson closure_of_mono contra_subsetD inf.cobounded2)
 
 lemma closure_of_subtopology_mono:
    "T \<subseteq> U \<Longrightarrow> (subtopology X T) closure_of S \<subseteq> (subtopology X U) closure_of S"
   unfolding closure_of_subtopology
   by auto (meson closure_of_mono inf_mono subset_iff)
 
 lemma closure_of_Un [simp]: "X closure_of (S \<union> T) = X closure_of S \<union> X closure_of T"
   by (simp add: Un_assoc Un_left_commute closure_of_alt derived_set_of_Un inf_sup_distrib1)
 
 lemma closure_of_Union:
    "finite \<F> \<Longrightarrow> X closure_of (\<Union>\<F>) = (\<Union>S \<in> \<F>. X closure_of S)"
 by (induction \<F> rule: finite_induct) auto
 
 lemma closure_of_subset: "S \<subseteq> topspace X \<Longrightarrow> S \<subseteq> X closure_of S"
   by (auto simp: closure_of_def)
 
 lemma closure_of_subset_Int: "topspace X \<inter> S \<subseteq> X closure_of S"
   by (auto simp: closure_of_def)
 
 lemma closure_of_subset_eq: "S \<subseteq> topspace X \<and> X closure_of S \<subseteq> S \<longleftrightarrow> closedin X S"
 proof -
   have "openin X (topspace X - S)"
     if "\<And>x. \<lbrakk>x \<in> topspace X; \<forall>T. x \<in> T \<and> openin X T \<longrightarrow> S \<inter> T \<noteq> {}\<rbrakk> \<Longrightarrow> x \<in> S"
     apply (subst openin_subopen)
     by (metis Diff_iff Diff_mono Diff_triv inf.commute openin_subset order_refl that)
   then show ?thesis
     by (auto simp: closedin_def closure_of_def disjoint_iff_not_equal)
 qed
 
 lemma closure_of_eq: "X closure_of S = S \<longleftrightarrow> closedin X S"
   by (metis closure_of_subset closure_of_subset_eq closure_of_subset_topspace subset_antisym)
 
 lemma closedin_contains_derived_set:
    "closedin X S \<longleftrightarrow> X derived_set_of S \<subseteq> S \<and> S \<subseteq> topspace X"
 proof (intro iffI conjI)
   show "closedin X S \<Longrightarrow> X derived_set_of S \<subseteq> S"
     using closure_of_eq derived_set_of_subset_closure_of by fastforce
   show "closedin X S \<Longrightarrow> S \<subseteq> topspace X"
     using closedin_subset by blast
   show "X derived_set_of S \<subseteq> S \<and> S \<subseteq> topspace X \<Longrightarrow> closedin X S"
     by (metis closure_of closure_of_eq inf.absorb_iff2 sup.orderE)
 qed
 
 lemma derived_set_subset_gen:
    "X derived_set_of S \<subseteq> S \<longleftrightarrow> closedin X (topspace X \<inter> S)"
   by (simp add: closedin_contains_derived_set derived_set_of_subset_topspace)
 
 lemma derived_set_subset: "S \<subseteq> topspace X \<Longrightarrow> (X derived_set_of S \<subseteq> S \<longleftrightarrow> closedin X S)"
   by (simp add: closedin_contains_derived_set)
 
 lemma closedin_derived_set:
      "closedin (subtopology X T) S \<longleftrightarrow>
       S \<subseteq> topspace X \<and> S \<subseteq> T \<and> (\<forall>x. x \<in> X derived_set_of S \<and> x \<in> T \<longrightarrow> x \<in> S)"
   by (auto simp: closedin_contains_derived_set derived_set_of_subtopology Int_absorb1)
 
 lemma closedin_Int_closure_of:
      "closedin (subtopology X S) T \<longleftrightarrow> S \<inter> X closure_of T = T"
   by (metis Int_left_absorb closure_of_eq closure_of_subtopology)
 
 lemma closure_of_closedin: "closedin X S \<Longrightarrow> X closure_of S = S"
   by (simp add: closure_of_eq)
 
 lemma closure_of_eq_diff: "X closure_of S = topspace X - \<Union>{T. openin X T \<and> disjnt S T}"
   by (auto simp: closure_of_def disjnt_iff)
 
 lemma closedin_closure_of [simp]: "closedin X (X closure_of S)"
   unfolding closure_of_eq_diff by blast
 
 lemma closure_of_closure_of [simp]: "X closure_of (X closure_of S) = X closure_of S"
   by (simp add: closure_of_eq)
 
 lemma closure_of_hull:
   assumes "S \<subseteq> topspace X" shows "X closure_of S = (closedin X) hull S"
   by (metis assms closedin_closure_of closure_of_eq closure_of_mono closure_of_subset hull_unique)
 
 lemma closure_of_minimal:
    "\<lbrakk>S \<subseteq> T; closedin X T\<rbrakk> \<Longrightarrow> (X closure_of S) \<subseteq> T"
   by (metis closure_of_eq closure_of_mono)
 
 lemma closure_of_minimal_eq:
    "\<lbrakk>S \<subseteq> topspace X; closedin X T\<rbrakk> \<Longrightarrow> (X closure_of S) \<subseteq> T \<longleftrightarrow> S \<subseteq> T"
   by (meson closure_of_minimal closure_of_subset subset_trans)
 
 lemma closure_of_unique:
    "\<lbrakk>S \<subseteq> T; closedin X T;
      \<And>T'. \<lbrakk>S \<subseteq> T'; closedin X T'\<rbrakk> \<Longrightarrow> T \<subseteq> T'\<rbrakk>
     \<Longrightarrow> X closure_of S = T"
   by (meson closedin_closure_of closedin_subset closure_of_minimal closure_of_subset eq_iff order.trans)
 
 lemma closure_of_eq_empty_gen: "X closure_of S = {} \<longleftrightarrow> disjnt (topspace X) S"
   unfolding disjnt_def closure_of_restrict [where S=S]
   using closure_of by fastforce
 
 lemma closure_of_eq_empty: "S \<subseteq> topspace X \<Longrightarrow> X closure_of S = {} \<longleftrightarrow> S = {}"
   using closure_of_subset by fastforce
 
 lemma openin_Int_closure_of_subset:
   assumes "openin X S"
   shows "S \<inter> X closure_of T \<subseteq> X closure_of (S \<inter> T)"
 proof -
   have "S \<inter> X derived_set_of T = S \<inter> X derived_set_of (S \<inter> T)"
     by (meson assms openin_Int_derived_set_of_eq)
   moreover have "S \<inter> (S \<inter> T) = S \<inter> T"
     by fastforce
   ultimately show ?thesis
     by (metis closure_of_alt inf.cobounded2 inf_left_commute inf_sup_distrib1)
 qed
 
 lemma closure_of_openin_Int_closure_of:
   assumes "openin X S"
   shows "X closure_of (S \<inter> X closure_of T) = X closure_of (S \<inter> T)"
 proof
   show "X closure_of (S \<inter> X closure_of T) \<subseteq> X closure_of (S \<inter> T)"
     by (simp add: assms closure_of_minimal openin_Int_closure_of_subset)
 next
   show "X closure_of (S \<inter> T) \<subseteq> X closure_of (S \<inter> X closure_of T)"
     by (metis Int_subset_iff assms closure_of_alt closure_of_mono inf_mono openin_subset subset_refl sup.coboundedI1)
 qed
 
 lemma openin_Int_closure_of_eq:
   assumes "openin X S" shows "S \<inter> X closure_of T = S \<inter> X closure_of (S \<inter> T)"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (simp add: assms openin_Int_closure_of_subset)
   show "?rhs \<subseteq> ?lhs"
     by (metis closure_of_mono inf_commute inf_le1 inf_mono order_refl)
 qed
 
 lemma openin_Int_closure_of_eq_empty:
   assumes "openin X S" shows "S \<inter> X closure_of T = {} \<longleftrightarrow> S \<inter> T = {}"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding disjoint_iff
     by (meson assms in_closure_of in_mono openin_subset)
   show "?rhs \<Longrightarrow> ?lhs"
     by (simp add: assms openin_Int_closure_of_eq)
 qed
 
 lemma closure_of_openin_Int_superset:
    "openin X S \<and> S \<subseteq> X closure_of T
         \<Longrightarrow> X closure_of (S \<inter> T) = X closure_of S"
   by (metis closure_of_openin_Int_closure_of inf.orderE)
 
 lemma closure_of_openin_subtopology_Int_closure_of:
   assumes S: "openin (subtopology X U) S" and "T \<subseteq> U"
   shows "X closure_of (S \<inter> X closure_of T) = X closure_of (S \<inter> T)" (is "?lhs = ?rhs")
 proof
   obtain S0 where S0: "openin X S0" "S = S0 \<inter> U"
     using assms by (auto simp: openin_subtopology)
   then show "?lhs \<subseteq> ?rhs"
   proof -
     have "S0 \<inter> X closure_of T = S0 \<inter> X closure_of (S0 \<inter> T)"
       by (meson S0(1) openin_Int_closure_of_eq)
     moreover have "S0 \<inter> T = S0 \<inter> U \<inter> T"
       using \<open>T \<subseteq> U\<close> by fastforce
     ultimately have "S \<inter> X closure_of T \<subseteq> X closure_of (S \<inter> T)"
       using S0(2) by auto
     then show ?thesis
       by (meson closedin_closure_of closure_of_minimal)
   qed
 next
   show "?rhs \<subseteq> ?lhs"
   proof -
     have "T \<inter> S \<subseteq> T \<union> X derived_set_of T"
       by force
     then show ?thesis
       by (smt (verit, del_insts) Int_iff in_closure_of inf.orderE openin_subset subsetI)
   qed
 qed
 
 lemma closure_of_subtopology_open:
      "openin X U \<or> S \<subseteq> U \<Longrightarrow> (subtopology X U) closure_of S = U \<inter> X closure_of S"
   by (metis closure_of_subtopology inf_absorb2 openin_Int_closure_of_eq)
 
 lemma discrete_topology_closure_of:
      "(discrete_topology U) closure_of S = U \<inter> S"
   by (metis closedin_discrete_topology closure_of_restrict closure_of_unique discrete_topology_unique inf_sup_ord(1) order_refl)
 
 
 text\<open> Interior with respect to a topological space.                             \<close>
 
 definition interior_of :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixr "interior'_of" 80)
   where "X interior_of S \<equiv> {x. \<exists>T. openin X T \<and> x \<in> T \<and> T \<subseteq> S}"
 
 lemma interior_of_restrict:
    "X interior_of S = X interior_of (topspace X \<inter> S)"
   using openin_subset by (auto simp: interior_of_def)
 
 lemma interior_of_eq: "(X interior_of S = S) \<longleftrightarrow> openin X S"
   unfolding interior_of_def  using openin_subopen by blast
 
 lemma interior_of_openin: "openin X S \<Longrightarrow> X interior_of S = S"
   by (simp add: interior_of_eq)
 
 lemma interior_of_empty [simp]: "X interior_of {} = {}"
   by (simp add: interior_of_eq)
 
 lemma interior_of_topspace [simp]: "X interior_of (topspace X) = topspace X"
   by (simp add: interior_of_eq)
 
 lemma openin_interior_of [simp]: "openin X (X interior_of S)"
   unfolding interior_of_def
   using openin_subopen by fastforce
 
 lemma interior_of_interior_of [simp]:
    "X interior_of X interior_of S = X interior_of S"
   by (simp add: interior_of_eq)
 
 lemma interior_of_subset: "X interior_of S \<subseteq> S"
   by (auto simp: interior_of_def)
 
 lemma interior_of_subset_closure_of: "X interior_of S \<subseteq> X closure_of S"
   by (metis closure_of_subset_Int dual_order.trans interior_of_restrict interior_of_subset)
 
 lemma subset_interior_of_eq: "S \<subseteq> X interior_of S \<longleftrightarrow> openin X S"
   by (metis interior_of_eq interior_of_subset subset_antisym)
 
 lemma interior_of_mono: "S \<subseteq> T \<Longrightarrow> X interior_of S \<subseteq> X interior_of T"
   by (auto simp: interior_of_def)
 
 lemma interior_of_maximal: "\<lbrakk>T \<subseteq> S; openin X T\<rbrakk> \<Longrightarrow> T \<subseteq> X interior_of S"
   by (auto simp: interior_of_def)
 
 lemma interior_of_maximal_eq: "openin X T \<Longrightarrow> T \<subseteq> X interior_of S \<longleftrightarrow> T \<subseteq> S"
   by (meson interior_of_maximal interior_of_subset order_trans)
 
 lemma interior_of_unique:
    "\<lbrakk>T \<subseteq> S; openin X T; \<And>T'. \<lbrakk>T' \<subseteq> S; openin X T'\<rbrakk> \<Longrightarrow> T' \<subseteq> T\<rbrakk> \<Longrightarrow> X interior_of S = T"
   by (simp add: interior_of_maximal_eq interior_of_subset subset_antisym)
 
 lemma interior_of_subset_topspace: "X interior_of S \<subseteq> topspace X"
   by (simp add: openin_subset)
 
 lemma interior_of_subset_subtopology: "(subtopology X S) interior_of T \<subseteq> S"
   by (meson openin_imp_subset openin_interior_of)
 
 lemma interior_of_Int: "X interior_of (S \<inter> T) = X interior_of S \<inter> X interior_of T"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (simp add: interior_of_mono)
   show "?rhs \<subseteq> ?lhs"
     by (meson inf_mono interior_of_maximal interior_of_subset openin_Int openin_interior_of)
 qed
 
 lemma interior_of_Inter_subset: "X interior_of (\<Inter>\<F>) \<subseteq> (\<Inter>S \<in> \<F>. X interior_of S)"
   by (simp add: INT_greatest Inf_lower interior_of_mono)
 
 lemma union_interior_of_subset:
    "X interior_of S \<union> X interior_of T \<subseteq> X interior_of (S \<union> T)"
   by (simp add: interior_of_mono)
 
 lemma interior_of_eq_empty:
    "X interior_of S = {} \<longleftrightarrow> (\<forall>T. openin X T \<and> T \<subseteq> S \<longrightarrow> T = {})"
   by (metis bot.extremum_uniqueI interior_of_maximal interior_of_subset openin_interior_of)
 
 lemma interior_of_eq_empty_alt:
    "X interior_of S = {} \<longleftrightarrow> (\<forall>T. openin X T \<and> T \<noteq> {} \<longrightarrow> T - S \<noteq> {})"
   by (auto simp: interior_of_eq_empty)
 
 lemma interior_of_Union_openin_subsets:
    "\<Union>{T. openin X T \<and> T \<subseteq> S} = X interior_of S"
   by (rule interior_of_unique [symmetric]) auto
 
 lemma interior_of_complement:
    "X interior_of (topspace X - S) = topspace X - X closure_of S"
   by (auto simp: interior_of_def closure_of_def)
 
 lemma interior_of_closure_of:
    "X interior_of S = topspace X - X closure_of (topspace X - S)"
   unfolding interior_of_complement [symmetric]
   by (metis Diff_Diff_Int interior_of_restrict)
 
 lemma closure_of_interior_of:
    "X closure_of S = topspace X - X interior_of (topspace X - S)"
   by (simp add: interior_of_complement Diff_Diff_Int closure_of)
 
 lemma closure_of_complement: "X closure_of (topspace X - S) = topspace X - X interior_of S"
   unfolding interior_of_def closure_of_def
   by (blast dest: openin_subset)
 
 lemma interior_of_eq_empty_complement:
   "X interior_of S = {} \<longleftrightarrow> X closure_of (topspace X - S) = topspace X"
   using interior_of_subset_topspace [of X S] closure_of_complement by fastforce
 
 lemma closure_of_eq_topspace:
    "X closure_of S = topspace X \<longleftrightarrow> X interior_of (topspace X - S) = {}"
   using closure_of_subset_topspace [of X S] interior_of_complement by fastforce
 
 lemma interior_of_subtopology_subset:
      "U \<inter> X interior_of S \<subseteq> (subtopology X U) interior_of S"
   by (auto simp: interior_of_def openin_subtopology)
 
 lemma interior_of_subtopology_subsets:
    "T \<subseteq> U \<Longrightarrow> T \<inter> (subtopology X U) interior_of S \<subseteq> (subtopology X T) interior_of S"
   by (metis inf.absorb_iff2 interior_of_subtopology_subset subtopology_subtopology)
 
 lemma interior_of_subtopology_mono:
    "\<lbrakk>S \<subseteq> T; T \<subseteq> U\<rbrakk> \<Longrightarrow> (subtopology X U) interior_of S \<subseteq> (subtopology X T) interior_of S"
   by (metis dual_order.trans inf.orderE inf_commute interior_of_subset interior_of_subtopology_subsets)
 
 lemma interior_of_subtopology_open:
   assumes "openin X U"
   shows "(subtopology X U) interior_of S = U \<inter> X interior_of S" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (meson assms interior_of_maximal interior_of_subset le_infI openin_interior_of openin_open_subtopology)
   show "?rhs \<subseteq> ?lhs"
     by (simp add: interior_of_subtopology_subset)
 qed
 
 lemma dense_intersects_open:
    "X closure_of S = topspace X \<longleftrightarrow> (\<forall>T. openin X T \<and> T \<noteq> {} \<longrightarrow> S \<inter> T \<noteq> {})"
 proof -
   have "X closure_of S = topspace X \<longleftrightarrow> (topspace X - X interior_of (topspace X - S) = topspace X)"
     by (simp add: closure_of_interior_of)
   also have "\<dots> \<longleftrightarrow> X interior_of (topspace X - S) = {}"
     by (simp add: closure_of_complement interior_of_eq_empty_complement)
   also have "\<dots> \<longleftrightarrow> (\<forall>T. openin X T \<and> T \<noteq> {} \<longrightarrow> S \<inter> T \<noteq> {})"
     unfolding interior_of_eq_empty_alt
     using openin_subset by fastforce
   finally show ?thesis .
 qed
 
 lemma interior_of_closedin_union_empty_interior_of:
   assumes "closedin X S" and disj: "X interior_of T = {}"
   shows "X interior_of (S \<union> T) = X interior_of S"
 proof -
   have "X closure_of (topspace X - T) = topspace X"
     by (metis Diff_Diff_Int disj closure_of_eq_topspace closure_of_restrict interior_of_closure_of)
   then show ?thesis
     unfolding interior_of_closure_of
     by (metis Diff_Un Diff_subset assms(1) closedin_def closure_of_openin_Int_superset)
 qed
 
 lemma interior_of_union_eq_empty:
    "closedin X S
         \<Longrightarrow> (X interior_of (S \<union> T) = {} \<longleftrightarrow>
              X interior_of S = {} \<and> X interior_of T = {})"
   by (metis interior_of_closedin_union_empty_interior_of le_sup_iff subset_empty union_interior_of_subset)
 
 lemma discrete_topology_interior_of [simp]:
     "(discrete_topology U) interior_of S = U \<inter> S"
   by (simp add: interior_of_restrict [of _ S] interior_of_eq)
 
 
 subsection \<open>Frontier with respect to topological space \<close>
 
 definition frontier_of :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixr "frontier'_of" 80)
   where "X frontier_of S \<equiv> X closure_of S - X interior_of S"
 
 lemma frontier_of_closures:
      "X frontier_of S = X closure_of S \<inter> X closure_of (topspace X - S)"
   by (metis Diff_Diff_Int closure_of_complement closure_of_subset_topspace double_diff frontier_of_def interior_of_subset_closure_of)
 
 lemma interior_of_union_frontier_of [simp]:
      "X interior_of S \<union> X frontier_of S = X closure_of S"
   by (simp add: frontier_of_def interior_of_subset_closure_of subset_antisym)
 
 lemma frontier_of_restrict: "X frontier_of S = X frontier_of (topspace X \<inter> S)"
   by (metis closure_of_restrict frontier_of_def interior_of_restrict)
 
 lemma closedin_frontier_of: "closedin X (X frontier_of S)"
   by (simp add: closedin_Int frontier_of_closures)
 
 lemma frontier_of_subset_topspace: "X frontier_of S \<subseteq> topspace X"
   by (simp add: closedin_frontier_of closedin_subset)
 
 lemma frontier_of_subset_subtopology: "(subtopology X S) frontier_of T \<subseteq> S"
   by (metis (no_types) closedin_derived_set closedin_frontier_of)
 
 lemma frontier_of_subtopology_subset:
   "U \<inter> (subtopology X U) frontier_of S \<subseteq> (X frontier_of S)"
 proof -
   have "U \<inter> X interior_of S - subtopology X U interior_of S = {}"
     by (simp add: interior_of_subtopology_subset)
   moreover have "X closure_of S \<inter> subtopology X U closure_of S = subtopology X U closure_of S"
     by (meson closure_of_subtopology_subset inf.absorb_iff2)
   ultimately show ?thesis
     unfolding frontier_of_def
     by blast
 qed
 
 lemma frontier_of_subtopology_mono:
    "\<lbrakk>S \<subseteq> T; T \<subseteq> U\<rbrakk> \<Longrightarrow> (subtopology X T) frontier_of S \<subseteq> (subtopology X U) frontier_of S"
     by (simp add: frontier_of_def Diff_mono closure_of_subtopology_mono interior_of_subtopology_mono)
 
 lemma clopenin_eq_frontier_of:
    "closedin X S \<and> openin X S \<longleftrightarrow> S \<subseteq> topspace X \<and> X frontier_of S = {}"
 proof (cases "S \<subseteq> topspace X")
   case True
   then show ?thesis
     by (metis Diff_eq_empty_iff closure_of_eq closure_of_subset_eq frontier_of_def interior_of_eq interior_of_subset interior_of_union_frontier_of sup_bot_right)
 next
   case False
   then show ?thesis
     by (simp add: frontier_of_closures openin_closedin_eq)
 qed
 
 lemma frontier_of_eq_empty:
      "S \<subseteq> topspace X \<Longrightarrow> (X frontier_of S = {} \<longleftrightarrow> closedin X S \<and> openin X S)"
   by (simp add: clopenin_eq_frontier_of)
 
 lemma frontier_of_openin:
      "openin X S \<Longrightarrow> X frontier_of S = X closure_of S - S"
   by (metis (no_types) frontier_of_def interior_of_eq)
 
 lemma frontier_of_openin_straddle_Int:
   assumes "openin X U" "U \<inter> X frontier_of S \<noteq> {}"
   shows "U \<inter> S \<noteq> {}" "U - S \<noteq> {}"
 proof -
   have "U \<inter> (X closure_of S \<inter> X closure_of (topspace X - S)) \<noteq> {}"
     using assms by (simp add: frontier_of_closures)
   then show "U \<inter> S \<noteq> {}"
     using assms openin_Int_closure_of_eq_empty by fastforce
   show "U - S \<noteq> {}"
   proof -
     have "\<exists>A. X closure_of (A - S) \<inter> U \<noteq> {}"
       using \<open>U \<inter> (X closure_of S \<inter> X closure_of (topspace X - S)) \<noteq> {}\<close> by blast
     then have "\<not> U \<subseteq> S"
       by (metis Diff_disjoint Diff_eq_empty_iff Int_Diff assms(1) inf_commute openin_Int_closure_of_eq_empty)
     then show ?thesis
       by blast
   qed
 qed
 
 lemma frontier_of_subset_closedin: "closedin X S \<Longrightarrow> (X frontier_of S) \<subseteq> S"
   using closure_of_eq frontier_of_def by fastforce
 
 lemma frontier_of_empty [simp]: "X frontier_of {} = {}"
   by (simp add: frontier_of_def)
 
 lemma frontier_of_topspace [simp]: "X frontier_of topspace X = {}"
   by (simp add: frontier_of_def)
 
 lemma frontier_of_subset_eq:
   assumes "S \<subseteq> topspace X"
   shows "(X frontier_of S) \<subseteq> S \<longleftrightarrow> closedin X S"
 proof
   show "X frontier_of S \<subseteq> S \<Longrightarrow> closedin X S"
     by (metis assms closure_of_subset_eq interior_of_subset interior_of_union_frontier_of le_sup_iff)
   show "closedin X S \<Longrightarrow> X frontier_of S \<subseteq> S"
     by (simp add: frontier_of_subset_closedin)
 qed
 
 lemma frontier_of_complement: "X frontier_of (topspace X - S) = X frontier_of S"
   by (metis Diff_Diff_Int closure_of_restrict frontier_of_closures inf_commute)
 
 lemma frontier_of_disjoint_eq:
   assumes "S \<subseteq> topspace X"
   shows "((X frontier_of S) \<inter> S = {} \<longleftrightarrow> openin X S)"
 proof
   assume "X frontier_of S \<inter> S = {}"
   then have "closedin X (topspace X - S)"
     using assms closure_of_subset frontier_of_def interior_of_eq interior_of_subset by fastforce
   then show "openin X S"
     using assms by (simp add: openin_closedin)
 next
   show "openin X S \<Longrightarrow> X frontier_of S \<inter> S = {}"
     by (simp add: Diff_Diff_Int closedin_def frontier_of_openin inf.absorb_iff2 inf_commute)
 qed
 
 lemma frontier_of_disjoint_eq_alt:
   "S \<subseteq> (topspace X - X frontier_of S) \<longleftrightarrow> openin X S"
 proof (cases "S \<subseteq> topspace X")
   case True
   show ?thesis
     using True frontier_of_disjoint_eq by auto
 next
   case False
   then show ?thesis
     by (meson Diff_subset openin_subset subset_trans)
 qed
 
 lemma frontier_of_Int:
      "X frontier_of (S \<inter> T) =
       X closure_of (S \<inter> T) \<inter> (X frontier_of S \<union> X frontier_of T)"
 proof -
   have *: "U \<subseteq> S \<and> U \<subseteq> T \<Longrightarrow> U \<inter> (S \<inter> A \<union> T \<inter> B) = U \<inter> (A \<union> B)" for U S T A B :: "'a set"
     by blast
   show ?thesis
     by (simp add: frontier_of_closures closure_of_mono Diff_Int * flip: closure_of_Un)
 qed
 
 lemma frontier_of_Int_subset: "X frontier_of (S \<inter> T) \<subseteq> X frontier_of S \<union> X frontier_of T"
   by (simp add: frontier_of_Int)
 
 lemma frontier_of_Int_closedin:
   assumes "closedin X S" "closedin X T" 
   shows "X frontier_of(S \<inter> T) = X frontier_of S \<inter> T \<union> S \<inter> X frontier_of T"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     using assms by (force simp add: frontier_of_Int closedin_Int closure_of_closedin)
   show "?rhs \<subseteq> ?lhs"
     using assms frontier_of_subset_closedin
     by (auto simp add: frontier_of_Int closedin_Int closure_of_closedin)
 qed
 
 lemma frontier_of_Un_subset: "X frontier_of(S \<union> T) \<subseteq> X frontier_of S \<union> X frontier_of T"
   by (metis Diff_Un frontier_of_Int_subset frontier_of_complement)
 
 lemma frontier_of_Union_subset:
    "finite \<F> \<Longrightarrow> X frontier_of (\<Union>\<F>) \<subseteq> (\<Union>T \<in> \<F>. X frontier_of T)"
 proof (induction \<F> rule: finite_induct)
   case (insert A \<F>)
   then show ?case
     using frontier_of_Un_subset by fastforce
 qed simp
 
 lemma frontier_of_frontier_of_subset:
      "X frontier_of (X frontier_of S) \<subseteq> X frontier_of S"
   by (simp add: closedin_frontier_of frontier_of_subset_closedin)
 
 lemma frontier_of_subtopology_open:
      "openin X U \<Longrightarrow> (subtopology X U) frontier_of S = U \<inter> X frontier_of S"
   by (simp add: Diff_Int_distrib closure_of_subtopology_open frontier_of_def interior_of_subtopology_open)
 
 lemma discrete_topology_frontier_of [simp]:
      "(discrete_topology U) frontier_of S = {}"
   by (simp add: Diff_eq discrete_topology_closure_of frontier_of_closures)
 
 lemma openin_subset_topspace_eq:
   assumes "disjnt S (X frontier_of U)"
   shows "openin (subtopology X U) S \<longleftrightarrow> openin X S \<and> S \<subseteq> U"
 proof
   assume S: "openin (subtopology X U) S"
   show "openin X S \<and> S \<subseteq> U"
   proof
     show "S \<subseteq> U"
       using S openin_imp_subset by blast
     have "disjnt S (X frontier_of (topspace X \<inter> U))"
       by (metis assms frontier_of_restrict)
     moreover
     have "openin (subtopology X (topspace X \<inter> U)) S"
       by (simp add: S subtopology_restrict)
     moreover
     have "openin X S" 
       if dis: "disjnt S (X frontier_of U)" and ope: "openin (subtopology X U) S" and "U \<subseteq> topspace X" 
       for S U
     proof -
       obtain T where T: "openin X T" "S = T \<inter> U"
         using ope by (auto simp: openin_subtopology)
       have "T \<inter> U = T \<inter> X interior_of U"
         using that T interior_of_subset in_closure_of by (fastforce simp: disjnt_iff frontier_of_def)
       then show ?thesis
         using \<open>S = T \<inter> U\<close> \<open>openin X T\<close> by auto
     qed
   ultimately show "openin X S"
       by blast
   qed 
 qed (metis inf.absorb_iff1 openin_subtopology_Int)
 
 
 subsection\<open>Locally finite collections\<close>
 
 definition locally_finite_in
   where
  "locally_finite_in X \<A> \<longleftrightarrow>
         (\<Union>\<A> \<subseteq> topspace X) \<and>
         (\<forall>x \<in> topspace X. \<exists>V. openin X V \<and> x \<in> V \<and> finite {U \<in> \<A>. U \<inter> V \<noteq> {}})"
 
 lemma finite_imp_locally_finite_in:
    "\<lbrakk>finite \<A>; \<Union>\<A> \<subseteq> topspace X\<rbrakk> \<Longrightarrow> locally_finite_in X \<A>"
   by (auto simp: locally_finite_in_def)
 
 lemma locally_finite_in_subset:
   assumes "locally_finite_in X \<A>" "\<B> \<subseteq> \<A>"
   shows "locally_finite_in X \<B>"
 proof -
   have "finite (\<A> \<inter> {U. U \<inter> V \<noteq> {}}) \<Longrightarrow> finite (\<B> \<inter> {U. U \<inter> V \<noteq> {}})" for V
     by (meson \<open>\<B> \<subseteq> \<A>\<close> finite_subset inf_le1 inf_le2 le_inf_iff subset_trans)
   then show ?thesis
     using assms unfolding locally_finite_in_def Int_def by fastforce
 qed
 
 lemma locally_finite_in_refinement:
   assumes \<A>: "locally_finite_in X \<A>" and f: "\<And>S. S \<in> \<A> \<Longrightarrow> f S \<subseteq> S"
   shows "locally_finite_in X (f ` \<A>)"
 proof -
   show ?thesis
     unfolding locally_finite_in_def
   proof safe
     fix x
     assume "x \<in> topspace X"
     then obtain V where "openin X V" "x \<in> V" "finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
       using \<A> unfolding locally_finite_in_def by blast
     moreover have "{U \<in> \<A>. f U \<inter> V \<noteq> {}} \<subseteq> {U \<in> \<A>. U \<inter> V \<noteq> {}}" for V
       using f by blast
     ultimately have "finite {U \<in> \<A>. f U \<inter> V \<noteq> {}}"
       using finite_subset by blast
     moreover have "f ` {U \<in> \<A>. f U \<inter> V \<noteq> {}} = {U \<in> f ` \<A>. U \<inter> V \<noteq> {}}"
       by blast
     ultimately have "finite {U \<in> f ` \<A>. U \<inter> V \<noteq> {}}"
       by (metis (no_types, lifting) finite_imageI)
     then show "\<exists>V. openin X V \<and> x \<in> V \<and> finite {U \<in> f ` \<A>. U \<inter> V \<noteq> {}}"
       using \<open>openin X V\<close> \<open>x \<in> V\<close> by blast
   next
     show "\<And>x xa. \<lbrakk>xa \<in> \<A>; x \<in> f xa\<rbrakk> \<Longrightarrow> x \<in> topspace X"
       by (meson Sup_upper \<A> f locally_finite_in_def subset_iff)
   qed
 qed
 
 lemma locally_finite_in_subtopology:
   assumes \<A>: "locally_finite_in X \<A>" "\<Union>\<A> \<subseteq> S"
   shows "locally_finite_in (subtopology X S) \<A>"
   unfolding locally_finite_in_def
 proof safe
   fix x
   assume x: "x \<in> topspace (subtopology X S)"
   then obtain V where "openin X V" "x \<in> V" and fin: "finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
     using \<A> unfolding locally_finite_in_def topspace_subtopology by blast
   show "\<exists>V. openin (subtopology X S) V \<and> x \<in> V \<and> finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
   proof (intro exI conjI)
     show "openin (subtopology X S) (S \<inter> V)"
       by (simp add: \<open>openin X V\<close> openin_subtopology_Int2)
     have "{U \<in> \<A>. U \<inter> (S \<inter> V) \<noteq> {}} \<subseteq> {U \<in> \<A>. U \<inter> V \<noteq> {}}"
       by auto
     with fin show "finite {U \<in> \<A>. U \<inter> (S \<inter> V) \<noteq> {}}"
       using finite_subset by auto
     show "x \<in> S \<inter> V"
       using x \<open>x \<in> V\<close> by (simp)
   qed
 next
   show "\<And>x A. \<lbrakk>x \<in> A; A \<in> \<A>\<rbrakk> \<Longrightarrow> x \<in> topspace (subtopology X S)"
     using assms unfolding locally_finite_in_def topspace_subtopology by blast
 qed
 
 
 lemma closedin_locally_finite_Union:
   assumes clo: "\<And>S. S \<in> \<A> \<Longrightarrow> closedin X S" and \<A>: "locally_finite_in X \<A>"
   shows "closedin X (\<Union>\<A>)"
   using \<A> unfolding locally_finite_in_def closedin_def
 proof clarify
   show "openin X (topspace X - \<Union>\<A>)"
   proof (subst openin_subopen, clarify)
     fix x
     assume "x \<in> topspace X" and "x \<notin> \<Union>\<A>"
     then obtain V where "openin X V" "x \<in> V" and fin: "finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
       using \<A> unfolding locally_finite_in_def by blast
     let ?T = "V - \<Union>{S \<in> \<A>. S \<inter> V \<noteq> {}}"
     show "\<exists>T. openin X T \<and> x \<in> T \<and> T \<subseteq> topspace X - \<Union>\<A>"
     proof (intro exI conjI)
       show "openin X ?T"
         by (metis (no_types, lifting) fin \<open>openin X V\<close> clo closedin_Union mem_Collect_eq openin_diff)
       show "x \<in> ?T"
         using \<open>x \<notin> \<Union>\<A>\<close> \<open>x \<in> V\<close> by auto
       show "?T \<subseteq> topspace X - \<Union>\<A>"
         using \<open>openin X V\<close> openin_subset by auto
     qed
   qed
 qed
 
 lemma locally_finite_in_closure:
   assumes \<A>: "locally_finite_in X \<A>"
   shows "locally_finite_in X ((\<lambda>S. X closure_of S) ` \<A>)"
   using \<A> unfolding locally_finite_in_def
 proof (intro conjI; clarsimp)
   fix x A
   assume "x \<in> X closure_of A"
   then show "x \<in> topspace X"
     by (meson in_closure_of)
 next
   fix x
   assume "x \<in> topspace X" and "\<Union>\<A> \<subseteq> topspace X"
   then obtain V where V: "openin X V" "x \<in> V" and fin: "finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
     using \<A> unfolding locally_finite_in_def by blast
   have eq: "{y \<in> f ` \<A>. Q y} = f ` {x. x \<in> \<A> \<and> Q(f x)}" for f and Q :: "'a set \<Rightarrow> bool"
     by blast
   have eq2: "{A \<in> \<A>. X closure_of A \<inter> V \<noteq> {}} = {A \<in> \<A>. A \<inter> V \<noteq> {}}"
     using openin_Int_closure_of_eq_empty V  by blast
   have "finite {U \<in> (closure_of) X ` \<A>. U \<inter> V \<noteq> {}}"
     by (simp add: eq eq2 fin)
   with V show "\<exists>V. openin X V \<and> x \<in> V \<and> finite {U \<in> (closure_of) X ` \<A>. U \<inter> V \<noteq> {}}"
     by blast
 qed
 
 lemma closedin_Union_locally_finite_closure:
    "locally_finite_in X \<A> \<Longrightarrow> closedin X (\<Union>((\<lambda>S. X closure_of S) ` \<A>))"
   by (metis (mono_tags) closedin_closure_of closedin_locally_finite_Union imageE locally_finite_in_closure)
 
 lemma closure_of_Union_subset: "\<Union>((\<lambda>S. X closure_of S) ` \<A>) \<subseteq> X closure_of (\<Union>\<A>)"
   by (simp add: SUP_le_iff Sup_upper closure_of_mono)
 
 lemma closure_of_locally_finite_Union:
   assumes "locally_finite_in X \<A>" 
   shows "X closure_of (\<Union>\<A>) = \<Union>((\<lambda>S. X closure_of S) ` \<A>)"  
 proof (rule closure_of_unique)
   show "\<Union> \<A> \<subseteq> \<Union> ((closure_of) X ` \<A>)"
     using assms by (simp add: SUP_upper2 Sup_le_iff closure_of_subset locally_finite_in_def)
   show "closedin X (\<Union> ((closure_of) X ` \<A>))"
     using assms by (simp add: closedin_Union_locally_finite_closure)
   show "\<And>T'. \<lbrakk>\<Union> \<A> \<subseteq> T'; closedin X T'\<rbrakk> \<Longrightarrow> \<Union> ((closure_of) X ` \<A>) \<subseteq> T'"
     by (simp add: Sup_le_iff closure_of_minimal)
 qed
 
 
 subsection\<^marker>\<open>tag important\<close> \<open>Continuous maps\<close>
 
 text \<open>We will need to deal with continuous maps in terms of topologies and not in terms
 of type classes, as defined below.\<close>
 
 definition continuous_map where
   "continuous_map X Y f \<equiv>
      (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and>
      (\<forall>U. openin Y U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U})"
 
 lemma continuous_map:
    "continuous_map X Y f \<longleftrightarrow>
         f ` (topspace X) \<subseteq> topspace Y \<and> (\<forall>U. openin Y U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U})"
   by (auto simp: continuous_map_def)
 
 lemma continuous_map_image_subset_topspace:
    "continuous_map X Y f \<Longrightarrow> f ` (topspace X) \<subseteq> topspace Y"
   by (auto simp: continuous_map_def)
 
 lemma continuous_map_on_empty: "topspace X = {} \<Longrightarrow> continuous_map X Y f"
   by (auto simp: continuous_map_def)
 
 lemma continuous_map_closedin:
    "continuous_map X Y f \<longleftrightarrow>
          (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and>
          (\<forall>C. closedin Y C \<longrightarrow> closedin X {x \<in> topspace X. f x \<in> C})"
 proof -
   have "(\<forall>U. openin Y U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U}) =
         (\<forall>C. closedin Y C \<longrightarrow> closedin X {x \<in> topspace X. f x \<in> C})"
     if "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
   proof -
     have eq: "{x \<in> topspace X. f x \<in> topspace Y \<and> f x \<notin> C} = (topspace X - {x \<in> topspace X. f x \<in> C})" for C
       using that by blast
     show ?thesis
     proof (intro iffI allI impI)
       fix C
       assume "\<forall>U. openin Y U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U}" and "closedin Y C"
       then show "closedin X {x \<in> topspace X. f x \<in> C}"
         by (auto simp add: closedin_def eq)
     next
       fix U
       assume "\<forall>C. closedin Y C \<longrightarrow> closedin X {x \<in> topspace X. f x \<in> C}" and "openin Y U"
       then show "openin X {x \<in> topspace X. f x \<in> U}"
         by (auto simp add: openin_closedin_eq eq)
     qed
   qed
   then show ?thesis
     by (auto simp: continuous_map_def)
 qed
 
 lemma openin_continuous_map_preimage:
    "\<lbrakk>continuous_map X Y f; openin Y U\<rbrakk> \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
   by (simp add: continuous_map_def)
 
 lemma closedin_continuous_map_preimage:
    "\<lbrakk>continuous_map X Y f; closedin Y C\<rbrakk> \<Longrightarrow> closedin X {x \<in> topspace X. f x \<in> C}"
   by (simp add: continuous_map_closedin)
 
 lemma openin_continuous_map_preimage_gen:
   assumes "continuous_map X Y f" "openin X U" "openin Y V"
   shows "openin X {x \<in> U. f x \<in> V}"
 proof -
   have eq: "{x \<in> U. f x \<in> V} = U \<inter> {x \<in> topspace X. f x \<in> V}"
     using assms(2) openin_closedin_eq by fastforce
   show ?thesis
     unfolding eq
     using assms openin_continuous_map_preimage by fastforce
 qed
 
 lemma closedin_continuous_map_preimage_gen:
   assumes "continuous_map X Y f" "closedin X U" "closedin Y V"
   shows "closedin X {x \<in> U. f x \<in> V}"
 proof -
   have eq: "{x \<in> U. f x \<in> V} = U \<inter> {x \<in> topspace X. f x \<in> V}"
     using assms(2) closedin_def by fastforce
   show ?thesis
     unfolding eq
     using assms closedin_continuous_map_preimage by fastforce
 qed
 
 lemma continuous_map_image_closure_subset:
   assumes "continuous_map X Y f"
   shows "f ` (X closure_of S) \<subseteq> Y closure_of f ` S"
 proof -
   have *: "f ` (topspace X) \<subseteq> topspace Y"
     by (meson assms continuous_map)
   have "X closure_of T \<subseteq> {x \<in> X closure_of T. f x \<in> Y closure_of (f ` T)}"
     if "T \<subseteq> topspace X" for T
   proof (rule closure_of_minimal)
     show "T \<subseteq> {x \<in> X closure_of T. f x \<in> Y closure_of f ` T}"
       using closure_of_subset * that  by (fastforce simp: in_closure_of)
   next
     show "closedin X {x \<in> X closure_of T. f x \<in> Y closure_of f ` T}"
       using assms closedin_continuous_map_preimage_gen by fastforce
   qed
   then show ?thesis
     by (smt (verit, ccfv_threshold) assms continuous_map image_eqI image_subset_iff in_closure_of mem_Collect_eq)
 qed
 
 lemma continuous_map_subset_aux1: "continuous_map X Y f \<Longrightarrow>
        (\<forall>S. f ` (X closure_of S) \<subseteq> Y closure_of f ` S)"
   using continuous_map_image_closure_subset by blast
 
 lemma continuous_map_subset_aux2:
   assumes "\<forall>S. S \<subseteq> topspace X \<longrightarrow> f ` (X closure_of S) \<subseteq> Y closure_of f ` S"
   shows "continuous_map X Y f"
   unfolding continuous_map_closedin
 proof (intro conjI ballI allI impI)
   fix x
   assume "x \<in> topspace X"
   then show "f x \<in> topspace Y"
     using assms closure_of_subset_topspace by fastforce
 next
   fix C
   assume "closedin Y C"
   then show "closedin X {x \<in> topspace X. f x \<in> C}"
   proof (clarsimp simp flip: closure_of_subset_eq, intro conjI)
     fix x
     assume x: "x \<in> X closure_of {x \<in> topspace X. f x \<in> C}"
       and "C \<subseteq> topspace Y" and "Y closure_of C \<subseteq> C"
     show "x \<in> topspace X"
       by (meson x in_closure_of)
     have "{a \<in> topspace X. f a \<in> C} \<subseteq> topspace X"
       by simp
     moreover have "Y closure_of f ` {a \<in> topspace X. f a \<in> C} \<subseteq> C"
       by (simp add: \<open>closedin Y C\<close> closure_of_minimal image_subset_iff)
     ultimately show "f x \<in> C"
       using x assms by blast
   qed
 qed
 
 lemma continuous_map_eq_image_closure_subset:
      "continuous_map X Y f \<longleftrightarrow> (\<forall>S. f ` (X closure_of S) \<subseteq> Y closure_of f ` S)"
   using continuous_map_subset_aux1 continuous_map_subset_aux2 by metis
 
 lemma continuous_map_eq_image_closure_subset_alt:
      "continuous_map X Y f \<longleftrightarrow> (\<forall>S. S \<subseteq> topspace X \<longrightarrow> f ` (X closure_of S) \<subseteq> Y closure_of f ` S)"
   using continuous_map_subset_aux1 continuous_map_subset_aux2 by metis
 
 lemma continuous_map_eq_image_closure_subset_gen:
      "continuous_map X Y f \<longleftrightarrow>
         f ` (topspace X) \<subseteq> topspace Y \<and>
         (\<forall>S. f ` (X closure_of S) \<subseteq> Y closure_of f ` S)"
   using continuous_map_subset_aux1 continuous_map_subset_aux2 continuous_map_image_subset_topspace by metis
 
 lemma continuous_map_closure_preimage_subset:
    "continuous_map X Y f
         \<Longrightarrow> X closure_of {x \<in> topspace X. f x \<in> T}
             \<subseteq> {x \<in> topspace X. f x \<in> Y closure_of T}"
   unfolding continuous_map_closedin
   by (rule closure_of_minimal) (use in_closure_of in \<open>fastforce+\<close>)
 
 
 lemma continuous_map_frontier_frontier_preimage_subset:
   assumes "continuous_map X Y f"
   shows "X frontier_of {x \<in> topspace X. f x \<in> T} \<subseteq> {x \<in> topspace X. f x \<in> Y frontier_of T}"
 proof -
   have eq: "topspace X - {x \<in> topspace X. f x \<in> T} = {x \<in> topspace X. f x \<in> topspace Y - T}"
     using assms unfolding continuous_map_def by blast
   have "X closure_of {x \<in> topspace X. f x \<in> T} \<subseteq> {x \<in> topspace X. f x \<in> Y closure_of T}"
     by (simp add: assms continuous_map_closure_preimage_subset)
   moreover
   have "X closure_of (topspace X - {x \<in> topspace X. f x \<in> T}) \<subseteq> {x \<in> topspace X. f x \<in> Y closure_of (topspace Y - T)}"
     using continuous_map_closure_preimage_subset [OF assms] eq by presburger
   ultimately show ?thesis
     by (auto simp: frontier_of_closures)
 qed
 
 lemma topology_finer_continuous_id:
   assumes "topspace X = topspace Y" 
   shows "(\<forall>S. openin X S \<longrightarrow> openin Y S) \<longleftrightarrow> continuous_map Y X id"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding continuous_map_def
     using assms openin_subopen openin_subset by fastforce
   show "?rhs \<Longrightarrow> ?lhs"
     unfolding continuous_map_def
     using assms openin_subopen topspace_def by fastforce
 qed
 
 lemma continuous_map_const [simp]:
    "continuous_map X Y (\<lambda>x. C) \<longleftrightarrow> topspace X = {} \<or> C \<in> topspace Y"
 proof (cases "topspace X = {}")
   case False
   show ?thesis
   proof (cases "C \<in> topspace Y")
     case True
     with openin_subopen show ?thesis
       by (auto simp: continuous_map_def)
   next
     case False
     then show ?thesis
       unfolding continuous_map_def by fastforce
   qed
 qed (auto simp: continuous_map_on_empty)
 
 declare continuous_map_const [THEN iffD2, continuous_intros]
 
 lemma continuous_map_compose [continuous_intros]:
   assumes f: "continuous_map X X' f" and g: "continuous_map X' X'' g"
   shows "continuous_map X X'' (g \<circ> f)"
   unfolding continuous_map_def
 proof (intro conjI ballI allI impI)
   fix x
   assume "x \<in> topspace X"
   then show "(g \<circ> f) x \<in> topspace X''"
     using assms unfolding continuous_map_def by force
 next
   fix U
   assume "openin X'' U"
   have eq: "{x \<in> topspace X. (g \<circ> f) x \<in> U} = {x \<in> topspace X. f x \<in> {y. y \<in> topspace X' \<and> g y \<in> U}}"
     by auto (meson f continuous_map_def)
   show "openin X {x \<in> topspace X. (g \<circ> f) x \<in> U}"
     unfolding eq
     using assms unfolding continuous_map_def
     using \<open>openin X'' U\<close> by blast
 qed
 
 lemma continuous_map_eq:
   assumes "continuous_map X X' f" and "\<And>x. x \<in> topspace X \<Longrightarrow> f x = g x" 
   shows "continuous_map X X' g"
 proof -
   have eq: "{x \<in> topspace X. f x \<in> U} = {x \<in> topspace X. g x \<in> U}" for U
     using assms by auto
   show ?thesis
     using assms by (simp add: continuous_map_def eq)
 qed
 
 lemma restrict_continuous_map [simp]:
      "topspace X \<subseteq> S \<Longrightarrow> continuous_map X X' (restrict f S) \<longleftrightarrow> continuous_map X X' f"
   by (auto simp: elim!: continuous_map_eq)
 
 lemma continuous_map_in_subtopology:
   "continuous_map X (subtopology X' S) f \<longleftrightarrow> continuous_map X X' f \<and> f ` (topspace X) \<subseteq> S"
   (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof -
     have "\<And>A. f ` (X closure_of A) \<subseteq> subtopology X' S closure_of f ` A"
       by (meson L continuous_map_image_closure_subset)
     then show ?thesis
       by (metis (no_types) closure_of_subset_subtopology closure_of_subtopology_subset closure_of_topspace continuous_map_eq_image_closure_subset order.trans)
   qed
 next
   assume R: ?rhs
   then have eq: "{x \<in> topspace X. f x \<in> U} = {x \<in> topspace X. f x \<in> U \<and> f x \<in> S}" for U
     by auto
   show ?lhs
     using R
     unfolding continuous_map
     by (auto simp: openin_subtopology eq)
 qed
 
 
 lemma continuous_map_from_subtopology:
      "continuous_map X X' f \<Longrightarrow> continuous_map (subtopology X S) X' f"
   by (auto simp: continuous_map openin_subtopology)
 
 lemma continuous_map_into_fulltopology:
    "continuous_map X (subtopology X' T) f \<Longrightarrow> continuous_map X X' f"
   by (auto simp: continuous_map_in_subtopology)
 
 lemma continuous_map_into_subtopology:
    "\<lbrakk>continuous_map X X' f; f ` topspace X \<subseteq> T\<rbrakk> \<Longrightarrow> continuous_map X (subtopology X' T) f"
   by (auto simp: continuous_map_in_subtopology)
 
 lemma continuous_map_from_subtopology_mono:
      "\<lbrakk>continuous_map (subtopology X T) X' f; S \<subseteq> T\<rbrakk>
       \<Longrightarrow> continuous_map (subtopology X S) X' f"
   by (metis inf.absorb_iff2 continuous_map_from_subtopology subtopology_subtopology)
 
 lemma continuous_map_from_discrete_topology [simp]:
   "continuous_map (discrete_topology U) X f \<longleftrightarrow> f ` U \<subseteq> topspace X"
   by (auto simp: continuous_map_def)
 
 lemma continuous_map_iff_continuous [simp]: "continuous_map (top_of_set S) euclidean g = continuous_on S g"
   by (fastforce simp add: continuous_map openin_subtopology continuous_on_open_invariant)
 
 lemma continuous_map_iff_continuous2 [simp]: "continuous_map euclidean euclidean g = continuous_on UNIV g"
   by (metis continuous_map_iff_continuous subtopology_UNIV)
 
 lemma continuous_map_openin_preimage_eq:
    "continuous_map X Y f \<longleftrightarrow>
         f ` (topspace X) \<subseteq> topspace Y \<and> (\<forall>U. openin Y U \<longrightarrow> openin X (topspace X \<inter> f -` U))"
   by (auto simp: continuous_map_def vimage_def Int_def)
 
 lemma continuous_map_closedin_preimage_eq:
    "continuous_map X Y f \<longleftrightarrow>
         f ` (topspace X) \<subseteq> topspace Y \<and> (\<forall>U. closedin Y U \<longrightarrow> closedin X (topspace X \<inter> f -` U))"
   by (auto simp: continuous_map_closedin vimage_def Int_def)
 
 lemma continuous_map_square_root: "continuous_map euclideanreal euclideanreal sqrt"
   by (simp add: continuous_at_imp_continuous_on isCont_real_sqrt)
 
 lemma continuous_map_sqrt [continuous_intros]:
    "continuous_map X euclideanreal f \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. sqrt(f x))"
   by (meson continuous_map_compose continuous_map_eq continuous_map_square_root o_apply)
 
 lemma continuous_map_id [simp, continuous_intros]: "continuous_map X X id"
   unfolding continuous_map_def  using openin_subopen topspace_def by fastforce
 
 declare continuous_map_id [unfolded id_def, simp, continuous_intros]
 
 lemma continuous_map_id_subt [simp]: "continuous_map (subtopology X S) X id"
   by (simp add: continuous_map_from_subtopology)
 
 declare continuous_map_id_subt [unfolded id_def, simp]
 
 
 lemma\<^marker>\<open>tag important\<close> continuous_map_alt:
    "continuous_map T1 T2 f 
     = ((\<forall>U. openin T2 U \<longrightarrow> openin T1 (f -` U \<inter> topspace T1)) \<and> f ` topspace T1 \<subseteq> topspace T2)"
   by (auto simp: continuous_map_def vimage_def image_def Collect_conj_eq inf_commute)
 
 lemma continuous_map_open [intro]:
   "continuous_map T1 T2 f \<Longrightarrow> openin T2 U \<Longrightarrow> openin T1 (f-`U \<inter> topspace(T1))"
   unfolding continuous_map_alt by auto
 
 lemma continuous_map_preimage_topspace [intro]:
   assumes "continuous_map T1 T2 f"
   shows "f-`(topspace T2) \<inter> topspace T1 = topspace T1"
 using assms unfolding continuous_map_def by auto
 
 
 
 subsection\<open>Open and closed maps (not a priori assumed continuous)\<close>
 
 definition open_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "open_map X1 X2 f \<equiv> \<forall>U. openin X1 U \<longrightarrow> openin X2 (f ` U)"
 
 definition closed_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "closed_map X1 X2 f \<equiv> \<forall>U. closedin X1 U \<longrightarrow> closedin X2 (f ` U)"
 
 lemma open_map_imp_subset_topspace:
      "open_map X1 X2 f \<Longrightarrow> f ` (topspace X1) \<subseteq> topspace X2"
   unfolding open_map_def by (simp add: openin_subset)
 
 lemma open_map_on_empty:
    "topspace X = {} \<Longrightarrow> open_map X Y f"
   by (metis empty_iff imageE in_mono open_map_def openin_subopen openin_subset)
 
 lemma closed_map_on_empty:
    "topspace X = {} \<Longrightarrow> closed_map X Y f"
   by (simp add: closed_map_def closedin_topspace_empty)
 
 lemma closed_map_const:
    "closed_map X Y (\<lambda>x. c) \<longleftrightarrow> topspace X = {} \<or> closedin Y {c}"
   by (metis closed_map_def closed_map_on_empty closedin_empty closedin_topspace image_constant_conv)
 
 lemma open_map_imp_subset:
     "\<lbrakk>open_map X1 X2 f; S \<subseteq> topspace X1\<rbrakk> \<Longrightarrow> f ` S \<subseteq> topspace X2"
   by (meson order_trans open_map_imp_subset_topspace subset_image_iff)
 
 lemma topology_finer_open_id:
      "(\<forall>S. openin X S \<longrightarrow> openin X' S) \<longleftrightarrow> open_map X X' id"
   unfolding open_map_def by auto
 
 lemma open_map_id: "open_map X X id"
   unfolding open_map_def by auto
 
 lemma open_map_eq:
      "\<lbrakk>open_map X X' f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> open_map X X' g"
   unfolding open_map_def
   by (metis image_cong openin_subset subset_iff)
 
 lemma open_map_inclusion_eq:
   "open_map (subtopology X S) X id \<longleftrightarrow> openin X (topspace X \<inter> S)"
   by (metis openin_topspace openin_trans_full subtopology_restrict topology_finer_open_id topspace_subtopology)
 
 lemma open_map_inclusion:
      "openin X S \<Longrightarrow> open_map (subtopology X S) X id"
   by (simp add: open_map_inclusion_eq openin_Int)
 
 lemma open_map_compose:
      "\<lbrakk>open_map X X' f; open_map X' X'' g\<rbrakk> \<Longrightarrow> open_map X X'' (g \<circ> f)"
   by (metis (no_types, lifting) image_comp open_map_def)
 
 lemma closed_map_imp_subset_topspace:
      "closed_map X1 X2 f \<Longrightarrow> f ` (topspace X1) \<subseteq> topspace X2"
   by (simp add: closed_map_def closedin_subset)
 
 lemma closed_map_imp_subset:
      "\<lbrakk>closed_map X1 X2 f; S \<subseteq> topspace X1\<rbrakk> \<Longrightarrow> f ` S \<subseteq> topspace X2"
   using closed_map_imp_subset_topspace by blast
 
 lemma topology_finer_closed_id:
     "(\<forall>S. closedin X S \<longrightarrow> closedin X' S) \<longleftrightarrow> closed_map X X' id"
   by (simp add: closed_map_def)
 
 lemma closed_map_id: "closed_map X X id"
   by (simp add: closed_map_def)
 
 lemma closed_map_eq:
    "\<lbrakk>closed_map X X' f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> closed_map X X' g"
   unfolding closed_map_def
   by (metis image_cong closedin_subset subset_iff)
 
 lemma closed_map_compose:
     "\<lbrakk>closed_map X X' f; closed_map X' X'' g\<rbrakk> \<Longrightarrow> closed_map X X'' (g \<circ> f)"
   by (metis (no_types, lifting) closed_map_def image_comp)
 
 lemma closed_map_inclusion_eq:
    "closed_map (subtopology X S) X id \<longleftrightarrow>
         closedin X (topspace X \<inter> S)"
 proof -
   have *: "closedin X (T \<inter> S)" if "closedin X (S \<inter> topspace X)" "closedin X T" for T
     by (smt (verit, best) closedin_Int closure_of_subset_eq inf_sup_aci le_iff_inf that)
   then show ?thesis
     by (fastforce simp add: closed_map_def Int_commute closedin_subtopology_alt intro: *)
 qed
 
 lemma closed_map_inclusion: "closedin X S \<Longrightarrow> closed_map (subtopology X S) X id"
   by (simp add: closed_map_inclusion_eq closedin_Int)
 
 lemma open_map_into_subtopology:
     "\<lbrakk>open_map X X' f; f ` topspace X \<subseteq> S\<rbrakk> \<Longrightarrow> open_map X (subtopology X' S) f"
   unfolding open_map_def openin_subtopology
   using openin_subset by fastforce
 
 lemma closed_map_into_subtopology:
     "\<lbrakk>closed_map X X' f; f ` topspace X \<subseteq> S\<rbrakk> \<Longrightarrow> closed_map X (subtopology X' S) f"
   unfolding closed_map_def closedin_subtopology
   using closedin_subset by fastforce
 
 lemma open_map_into_discrete_topology:
     "open_map X (discrete_topology U) f \<longleftrightarrow> f ` (topspace X) \<subseteq> U"
   unfolding open_map_def openin_discrete_topology using openin_subset by blast
 
 lemma closed_map_into_discrete_topology:
     "closed_map X (discrete_topology U) f \<longleftrightarrow> f ` (topspace X) \<subseteq> U"
   unfolding closed_map_def closedin_discrete_topology using closedin_subset by blast
 
 lemma bijective_open_imp_closed_map:
      "\<lbrakk>open_map X X' f; f ` (topspace X) = topspace X'; inj_on f (topspace X)\<rbrakk> \<Longrightarrow> closed_map X X' f"
   unfolding open_map_def closed_map_def closedin_def
   by auto (metis Diff_subset inj_on_image_set_diff)
 
 lemma bijective_closed_imp_open_map:
      "\<lbrakk>closed_map X X' f; f ` (topspace X) = topspace X'; inj_on f (topspace X)\<rbrakk> \<Longrightarrow> open_map X X' f"
   unfolding closed_map_def open_map_def openin_closedin_eq
   by auto (metis Diff_subset inj_on_image_set_diff)
 
 lemma open_map_from_subtopology:
      "\<lbrakk>open_map X X' f; openin X U\<rbrakk> \<Longrightarrow> open_map (subtopology X U) X' f"
   unfolding open_map_def openin_subtopology_alt by blast
 
 lemma closed_map_from_subtopology:
      "\<lbrakk>closed_map X X' f; closedin X U\<rbrakk> \<Longrightarrow> closed_map (subtopology X U) X' f"
   unfolding closed_map_def closedin_subtopology_alt by blast
 
 lemma open_map_restriction:
   assumes f: "open_map X X' f" and U: "{x \<in> topspace X. f x \<in> V} = U"
   shows "open_map (subtopology X U) (subtopology X' V) f"
   unfolding open_map_def
 proof clarsimp
   fix W
   assume "openin (subtopology X U) W"
   then obtain T where "openin X T" "W = T \<inter> U"
     by (meson openin_subtopology)
   with f U have "f ` W = (f ` T) \<inter> V"
     unfolding open_map_def openin_closedin_eq by auto
   then show "openin (subtopology X' V) (f ` W)"
     by (metis \<open>openin X T\<close> f open_map_def openin_subtopology_Int)
 qed
 
 lemma closed_map_restriction:
   assumes f: "closed_map X X' f" and U: "{x \<in> topspace X. f x \<in> V} = U"
   shows "closed_map (subtopology X U) (subtopology X' V) f"
   unfolding closed_map_def
 proof clarsimp
   fix W
   assume "closedin (subtopology X U) W"
   then obtain T where "closedin X T" "W = T \<inter> U"
     by (meson closedin_subtopology)
   with f U have "f ` W = (f ` T) \<inter> V"
     unfolding closed_map_def closedin_def by auto
   then show "closedin (subtopology X' V) (f ` W)"
     by (metis \<open>closedin X T\<close> closed_map_def closedin_subtopology f)
 qed
 
 lemma closed_map_closure_of_image:
    "closed_map X Y f \<longleftrightarrow>
         f ` topspace X \<subseteq> topspace Y \<and>
         (\<forall>S. S \<subseteq> topspace X \<longrightarrow> Y closure_of (f ` S) \<subseteq> image f (X closure_of S))" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (simp add: closed_map_def closed_map_imp_subset_topspace closure_of_minimal closure_of_subset image_mono)
 next
   assume ?rhs
   then show ?lhs
     by (metis closed_map_def closed_map_into_discrete_topology closure_of_eq 
         closure_of_subset_eq topspace_discrete_topology)
 qed
 
 lemma open_map_interior_of_image_subset:
   "open_map X Y f \<longleftrightarrow> (\<forall>S. image f (X interior_of S) \<subseteq> Y interior_of (f ` S))"
   by (metis image_mono interior_of_eq interior_of_maximal interior_of_subset open_map_def openin_interior_of subset_antisym)
 
 lemma open_map_interior_of_image_subset_alt:
   "open_map X Y f \<longleftrightarrow> (\<forall>S\<subseteq>topspace X. f ` (X interior_of S) \<subseteq> Y interior_of f ` S)"
   by (metis interior_of_eq open_map_def open_map_interior_of_image_subset openin_subset subset_interior_of_eq)
 
 lemma open_map_interior_of_image_subset_gen:
   "open_map X Y f \<longleftrightarrow>
        (f ` topspace X \<subseteq> topspace Y \<and> (\<forall>S. f ` (X interior_of S) \<subseteq> Y interior_of f ` S))"
   by (meson open_map_imp_subset_topspace open_map_interior_of_image_subset)
 
 lemma open_map_preimage_neighbourhood:
    "open_map X Y f \<longleftrightarrow>
     (f ` topspace X \<subseteq> topspace Y \<and>
      (\<forall>U T. closedin X U \<and> T \<subseteq> topspace Y \<and>
             {x \<in> topspace X. f x \<in> T} \<subseteq> U \<longrightarrow>
             (\<exists>V. closedin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U)))" (is "?lhs=?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof (intro conjI strip)
     show "f ` topspace X \<subseteq> topspace Y"
       by (simp add: \<open>open_map X Y f\<close> open_map_imp_subset_topspace)
   next
     fix U T
     assume UT: "closedin X U \<and> T \<subseteq> topspace Y \<and> {x \<in> topspace X. f x \<in> T} \<subseteq> U"
     have "closedin Y (topspace Y - f ` (topspace X - U))"
       by (meson UT L open_map_def openin_closedin_eq openin_diff openin_topspace)
     with UT
     show "\<exists>V. closedin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U"
       using image_iff by auto
   qed
 next
   assume R: ?rhs
   show ?lhs
     unfolding open_map_def
   proof (intro strip)
     fix U assume "openin X U"
     have "{x \<in> topspace X. f x \<in> topspace Y - f ` U} \<subseteq> topspace X - U"
       by blast
     then obtain V where V: "closedin Y V" 
       and sub: "topspace Y - f ` U \<subseteq> V" "{x \<in> topspace X. f x \<in> V} \<subseteq> topspace X - U"
       using R \<open>openin X U\<close> by (meson Diff_subset openin_closedin_eq) 
     then have "f ` U \<subseteq> topspace Y - V"
       using R \<open>openin X U\<close> openin_subset by fastforce
     with sub have "f ` U = topspace Y - V"
       by auto
     then show "openin Y (f ` U)"
       using V(1) by auto
   qed
 qed
 
 
 lemma closed_map_preimage_neighbourhood:
    "closed_map X Y f \<longleftrightarrow>
         image f (topspace X) \<subseteq> topspace Y \<and>
         (\<forall>U T. openin X U \<and> T \<subseteq> topspace Y \<and>
               {x \<in> topspace X. f x \<in> T} \<subseteq> U
               \<longrightarrow> (\<exists>V. openin Y V \<and> T \<subseteq> V \<and>
                       {x \<in> topspace X. f x \<in> V} \<subseteq> U))" (is "?lhs=?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof (intro conjI strip)
     show "f ` topspace X \<subseteq> topspace Y"
       by (simp add: L closed_map_imp_subset_topspace)
   next
     fix U T
     assume UT: "openin X U \<and> T \<subseteq> topspace Y \<and> {x \<in> topspace X. f x \<in> T} \<subseteq> U"
     then have "openin Y (topspace Y - f ` (topspace X - U))"
       by (meson L closed_map_def closedin_def closedin_diff closedin_topspace)
     then show "\<exists>V. openin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U"
       using UT image_iff by auto
   qed
 next
   assume R: ?rhs
   show ?lhs
     unfolding closed_map_def
   proof (intro strip)
     fix U assume "closedin X U"
     have "{x \<in> topspace X. f x \<in> topspace Y - f ` U} \<subseteq> topspace X - U"
       by blast
     then obtain V where V: "openin Y V" 
       and sub: "topspace Y - f ` U \<subseteq> V" "{x \<in> topspace X. f x \<in> V} \<subseteq> topspace X - U"
       using R Diff_subset \<open>closedin X U\<close> unfolding closedin_def
       by (smt (verit, ccfv_threshold) Collect_mem_eq Collect_mono_iff)
     then have "f ` U \<subseteq> topspace Y - V"
       using R \<open>closedin X U\<close> closedin_subset by fastforce
     with sub have "f ` U = topspace Y - V"
       by auto
     with V show "closedin Y (f ` U)"
       by auto
   qed
 qed
 
 lemma closed_map_fibre_neighbourhood:
   "closed_map X Y f \<longleftrightarrow>
      f ` (topspace X) \<subseteq> topspace Y \<and>
      (\<forall>U y. openin X U \<and> y \<in> topspace Y \<and> {x \<in> topspace X. f x = y} \<subseteq> U
      \<longrightarrow> (\<exists>V. openin Y V \<and> y \<in> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U))"
   unfolding closed_map_preimage_neighbourhood
 proof (intro conj_cong refl all_cong1)
   fix U
   assume "f ` topspace X \<subseteq> topspace Y"
   show "(\<forall>T. openin X U \<and> T \<subseteq> topspace Y \<and> {x \<in> topspace X. f x \<in> T} \<subseteq> U 
          \<longrightarrow> (\<exists>V. openin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U))
       = (\<forall>y. openin X U \<and> y \<in> topspace Y \<and> {x \<in> topspace X. f x = y} \<subseteq> U 
          \<longrightarrow> (\<exists>V. openin Y V \<and> y \<in> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U))" 
     (is "(\<forall>T. ?P T) \<longleftrightarrow> (\<forall>y. ?Q y)")
   proof
     assume L [rule_format]: "\<forall>T. ?P T"
     show "\<forall>y. ?Q y"
     proof
       fix y show "?Q y"
         using L [of "{y}"] by blast
     qed
   next
     assume R: "\<forall>y. ?Q y"
     show "\<forall>T. ?P T"
     proof (cases "openin X U")
       case True
       note [[unify_search_bound=3]]
       obtain V where V: "\<And>y. \<lbrakk>y \<in> topspace Y; {x \<in> topspace X. f x = y} \<subseteq> U\<rbrakk> \<Longrightarrow>
                        openin Y (V y) \<and> y \<in> V y \<and> {x \<in> topspace X. f x \<in> V y} \<subseteq> U"
         using R by (simp add: True) meson
       show ?thesis
       proof clarify
         fix T
         assume "openin X U" and "T \<subseteq> topspace Y" and "{x \<in> topspace X. f x \<in> T} \<subseteq> U"
         with V show "\<exists>V. openin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U"
           by (rule_tac x="\<Union>y\<in>T. V y" in exI) fastforce
       qed
     qed auto
   qed
 qed
 
 lemma open_map_in_subtopology:
    "openin Y S
         \<Longrightarrow> (open_map X (subtopology Y S) f \<longleftrightarrow> open_map X Y f \<and> f ` (topspace X) \<subseteq> S)"
   by (metis le_inf_iff open_map_def open_map_imp_subset_topspace open_map_into_subtopology openin_trans_full topspace_subtopology)
 
 lemma open_map_from_open_subtopology:
    "\<lbrakk>openin Y S; open_map X (subtopology Y S) f\<rbrakk> \<Longrightarrow> open_map X Y f"
   using open_map_in_subtopology by blast
 
 lemma closed_map_in_subtopology:
    "closedin Y S
         \<Longrightarrow> closed_map X (subtopology Y S) f \<longleftrightarrow> (closed_map X Y f \<and> f ` topspace X \<subseteq> S)"
   by (metis closed_map_def closed_map_imp_subset_topspace closed_map_into_subtopology 
         closedin_closed_subtopology closedin_subset topspace_subtopology_subset)
 
 lemma closed_map_from_closed_subtopology:
    "\<lbrakk>closedin Y S; closed_map X (subtopology Y S) f\<rbrakk> \<Longrightarrow> closed_map X Y f"
   using closed_map_in_subtopology by blast
 
 lemma closed_map_from_composition_left:
   assumes cmf: "closed_map X Z (g \<circ> f)" and contf: "continuous_map X Y f" and fim: "f ` topspace X = topspace Y"
   shows "closed_map Y Z g"
   unfolding closed_map_def
 proof (intro strip)
   fix U assume "closedin Y U"
   then have "closedin X {x \<in> topspace X. f x \<in> U}"
     using contf closedin_continuous_map_preimage by blast
   then have "closedin Z ((g \<circ> f) ` {x \<in> topspace X. f x \<in> U})"
     using cmf closed_map_def by blast
   moreover 
   have "\<And>y. y \<in> U \<Longrightarrow> \<exists>x \<in> topspace X. f x \<in> U \<and> g y = g (f x)"
     by (smt (verit, ccfv_SIG) \<open>closedin Y U\<close> closedin_subset fim image_iff subsetD)
   then have "(g \<circ> f) ` {x \<in> topspace X. f x \<in> U} = g`U" by auto
   ultimately show "closedin Z (g ` U)"
     by metis
 qed
 
 text \<open>identical proof as the above\<close>
 lemma open_map_from_composition_left:
   assumes cmf: "open_map X Z (g \<circ> f)" and contf: "continuous_map X Y f" and fim: "f ` topspace X = topspace Y"
   shows "open_map Y Z g"
   unfolding open_map_def
 proof (intro strip)
   fix U assume "openin Y U"
   then have "openin X {x \<in> topspace X. f x \<in> U}"
     using contf openin_continuous_map_preimage by blast
   then have "openin Z ((g \<circ> f) ` {x \<in> topspace X. f x \<in> U})"
     using cmf open_map_def by blast
   moreover 
   have "\<And>y. y \<in> U \<Longrightarrow> \<exists>x \<in> topspace X. f x \<in> U \<and> g y = g (f x)"
     by (smt (verit, ccfv_SIG) \<open>openin Y U\<close> openin_subset fim image_iff subsetD)
   then have "(g \<circ> f) ` {x \<in> topspace X. f x \<in> U} = g`U" by auto
   ultimately show "openin Z (g ` U)"
     by metis
 qed
 
 lemma closed_map_from_composition_right:
   assumes cmf: "closed_map X Z (g \<circ> f)" "f ` topspace X \<subseteq> topspace Y" "continuous_map Y Z g" "inj_on g (topspace Y)"
   shows "closed_map X Y f"
   unfolding closed_map_def
 proof (intro strip)
   fix C assume "closedin X C"
   have "\<And>y c. \<lbrakk>y \<in> topspace Y; g y = g (f c); c \<in> C\<rbrakk> \<Longrightarrow> y \<in> f ` C"
     using \<open>closedin X C\<close> assms closedin_subset inj_onD by fastforce
   then
   have "f ` C = {x \<in> topspace Y. g x \<in> (g \<circ> f) ` C}"
     using \<open>closedin X C\<close> assms(2) closedin_subset by fastforce
   moreover have "closedin Z ((g \<circ> f) ` C)"
     using \<open>closedin X C\<close> cmf closed_map_def by blast
   ultimately show "closedin Y (f ` C)"
     using assms(3) closedin_continuous_map_preimage by fastforce
 qed
 
 text \<open>identical proof as the above\<close>
 lemma open_map_from_composition_right:
   assumes "open_map X Z (g \<circ> f)" "f ` topspace X \<subseteq> topspace Y" "continuous_map Y Z g" "inj_on g (topspace Y)"
   shows "open_map X Y f"
   unfolding open_map_def
 proof (intro strip)
   fix C assume "openin X C"
   have "\<And>y c. \<lbrakk>y \<in> topspace Y; g y = g (f c); c \<in> C\<rbrakk> \<Longrightarrow> y \<in> f ` C"
     using \<open>openin X C\<close> assms openin_subset inj_onD by fastforce
   then
   have "f ` C = {x \<in> topspace Y. g x \<in> (g \<circ> f) ` C}"
     using \<open>openin X C\<close> assms(2) openin_subset by fastforce
   moreover have "openin Z ((g \<circ> f) ` C)"
     using \<open>openin X C\<close> assms(1) open_map_def by blast
   ultimately show "openin Y (f ` C)"
     using assms(3) openin_continuous_map_preimage by fastforce
 qed
 
 subsection\<open>Quotient maps\<close>
                                       
 definition quotient_map where
  "quotient_map X X' f \<longleftrightarrow>
         f ` (topspace X) = topspace X' \<and>
         (\<forall>U. U \<subseteq> topspace X' \<longrightarrow> (openin X {x. x \<in> topspace X \<and> f x \<in> U} \<longleftrightarrow> openin X' U))"
 
 lemma quotient_map_eq:
   assumes "quotient_map X X' f" "\<And>x. x \<in> topspace X \<Longrightarrow> f x = g x"
   shows "quotient_map X X' g"
   by (smt (verit) Collect_cong assms image_cong quotient_map_def)
 
 lemma quotient_map_compose:
   assumes f: "quotient_map X X' f" and g: "quotient_map X' X'' g"
   shows "quotient_map X X'' (g \<circ> f)"
   unfolding quotient_map_def
 proof (intro conjI allI impI)
   show "(g \<circ> f) ` topspace X = topspace X''"
     using assms by (simp only: image_comp [symmetric]) (simp add: quotient_map_def)
 next
   fix U''
   assume U'': "U'' \<subseteq> topspace X''"
   define U' where "U' \<equiv> {y \<in> topspace X'. g y \<in> U''}"
   have "U' \<subseteq> topspace X'"
     by (auto simp add: U'_def)
   then have U': "openin X {x \<in> topspace X. f x \<in> U'} = openin X' U'"
     using assms unfolding quotient_map_def by simp
   have "{x \<in> topspace X. f x \<in> topspace X' \<and> g (f x) \<in> U''} = {x \<in> topspace X. (g \<circ> f) x \<in> U''}"
     using f quotient_map_def by fastforce
   then show "openin X {x \<in> topspace X. (g \<circ> f) x \<in> U''} = openin X'' U''"
     by (smt (verit, best) Collect_cong U' U'_def U'' g mem_Collect_eq quotient_map_def)
 qed
 
 lemma quotient_map_from_composition:
   assumes f: "continuous_map X X' f" and g: "continuous_map X' X'' g" and gf: "quotient_map X X'' (g \<circ> f)"
   shows  "quotient_map X' X'' g"
   unfolding quotient_map_def
 proof (intro conjI allI impI)
   show "g ` topspace X' = topspace X''"
     using assms unfolding continuous_map_def quotient_map_def by fastforce
 next
   fix U'' :: "'c set"
   assume U'': "U'' \<subseteq> topspace X''"
   have eq: "{x \<in> topspace X. g (f x) \<in> U''} = {x \<in> topspace X. f x \<in> {y. y \<in> topspace X' \<and> g y \<in> U''}}"
     using continuous_map_def f by fastforce
   show "openin X' {x \<in> topspace X'. g x \<in> U''} = openin X'' U''"
     using assms unfolding continuous_map_def quotient_map_def
     by (metis (mono_tags, lifting) Collect_cong U'' comp_apply eq)
 qed
 
 lemma quotient_imp_continuous_map:
     "quotient_map X X' f \<Longrightarrow> continuous_map X X' f"
   by (simp add: continuous_map openin_subset quotient_map_def)
 
 lemma quotient_imp_surjective_map:
     "quotient_map X X' f \<Longrightarrow> f ` (topspace X) = topspace X'"
   by (simp add: quotient_map_def)
 
 lemma quotient_map_closedin:
   "quotient_map X X' f \<longleftrightarrow>
         f ` (topspace X) = topspace X' \<and>
         (\<forall>U. U \<subseteq> topspace X' \<longrightarrow> (closedin X {x. x \<in> topspace X \<and> f x \<in> U} \<longleftrightarrow> closedin X' U))"
 proof -
   have eq: "(topspace X - {x \<in> topspace X. f x \<in> U'}) = {x \<in> topspace X. f x \<in> topspace X' \<and> f x \<notin> U'}"
     if "f ` topspace X = topspace X'" "U' \<subseteq> topspace X'" for U'
       using that by auto
   have "(\<forall>U\<subseteq>topspace X'. openin X {x \<in> topspace X. f x \<in> U} = openin X' U) =
           (\<forall>U\<subseteq>topspace X'. closedin X {x \<in> topspace X. f x \<in> U} = closedin X' U)"
     if "f ` topspace X = topspace X'"
   proof (rule iffI; intro allI impI subsetI)
     fix U'
     assume *[rule_format]: "\<forall>U\<subseteq>topspace X'. openin X {x \<in> topspace X. f x \<in> U} = openin X' U"
       and U': "U' \<subseteq> topspace X'"
     show "closedin X {x \<in> topspace X. f x \<in> U'} = closedin X' U'"
       using U'  by (auto simp add: closedin_def simp flip: * [of "topspace X' - U'"] eq [OF that])
   next
     fix U' :: "'b set"
     assume *[rule_format]: "\<forall>U\<subseteq>topspace X'. closedin X {x \<in> topspace X. f x \<in> U} = closedin X' U"
       and U': "U' \<subseteq> topspace X'"
     show "openin X {x \<in> topspace X. f x \<in> U'} = openin X' U'"
       using U'  by (auto simp add: openin_closedin_eq simp flip: * [of "topspace X' - U'"] eq [OF that])
   qed
   then show ?thesis
     unfolding quotient_map_def by force
 qed
 
 lemma continuous_open_imp_quotient_map:
   assumes "continuous_map X X' f" and om: "open_map X X' f" and feq: "f ` (topspace X) = topspace X'"
   shows "quotient_map X X' f"
 proof -
   { fix U
     assume U: "U \<subseteq> topspace X'" and "openin X {x \<in> topspace X. f x \<in> U}"
     then have ope: "openin X' (f ` {x \<in> topspace X. f x \<in> U})"
       using om unfolding open_map_def by blast
     then have "openin X' U"
       using U feq by (subst openin_subopen) force
   }
   moreover have "openin X {x \<in> topspace X. f x \<in> U}" if "U \<subseteq> topspace X'" and "openin X' U" for U
     using that assms unfolding continuous_map_def by blast
   ultimately show ?thesis
     unfolding quotient_map_def using assms by blast
 qed
 
 lemma continuous_closed_imp_quotient_map:
   assumes "continuous_map X X' f" and om: "closed_map X X' f" and feq: "f ` (topspace X) = topspace X'"
   shows "quotient_map X X' f"
 proof -
   have "f ` {x \<in> topspace X. f x \<in> U} = U" if "U \<subseteq> topspace X'" for U
     using that feq by auto
   with assms show ?thesis
     unfolding quotient_map_closedin closed_map_def continuous_map_closedin by auto
 qed
 
 lemma continuous_open_quotient_map:
    "\<lbrakk>continuous_map X X' f; open_map X X' f\<rbrakk> \<Longrightarrow> quotient_map X X' f \<longleftrightarrow> f ` (topspace X) = topspace X'"
   by (meson continuous_open_imp_quotient_map quotient_map_def)
 
 lemma continuous_closed_quotient_map:
      "\<lbrakk>continuous_map X X' f; closed_map X X' f\<rbrakk> \<Longrightarrow> quotient_map X X' f \<longleftrightarrow> f ` (topspace X) = topspace X'"
   by (meson continuous_closed_imp_quotient_map quotient_map_def)
 
 lemma injective_quotient_map:
   assumes "inj_on f (topspace X)"
   shows "quotient_map X X' f \<longleftrightarrow>
          continuous_map X X' f \<and> open_map X X' f \<and> closed_map X X' f \<and> f ` (topspace X) = topspace X'"
          (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   have om: "open_map X X' f"
   proof (clarsimp simp add: open_map_def)
     fix U
     assume "openin X U"
     then have "U \<subseteq> topspace X"
       by (simp add: openin_subset)
     moreover have "{x \<in> topspace X. f x \<in> f ` U} = U"
       using \<open>U \<subseteq> topspace X\<close> assms inj_onD by fastforce
     ultimately show "openin X' (f ` U)"
       using L unfolding quotient_map_def
       by (metis (no_types, lifting) Collect_cong \<open>openin X U\<close> image_mono)
   qed
   then have "closed_map X X' f"
     by (simp add: L assms bijective_open_imp_closed_map quotient_imp_surjective_map)
   then show ?rhs
     using L om by (simp add: quotient_imp_continuous_map quotient_imp_surjective_map)
 next
   assume ?rhs
   then show ?lhs
     by (simp add: continuous_closed_imp_quotient_map)
 qed
 
 lemma continuous_compose_quotient_map:
   assumes f: "quotient_map X X' f" and g: "continuous_map X X'' (g \<circ> f)"
   shows "continuous_map X' X'' g"
   unfolding quotient_map_def continuous_map_def
 proof (intro conjI ballI allI impI)
   show "\<And>x'. x' \<in> topspace X' \<Longrightarrow> g x' \<in> topspace X''"
     using assms unfolding quotient_map_def
     by (metis (no_types, opaque_lifting) continuous_map_image_subset_topspace image_comp image_subset_iff)
 next
   fix U'' :: "'c set"
   assume U'': "openin X'' U''"
   have "f ` topspace X = topspace X'"
     by (simp add: f quotient_imp_surjective_map)
   then have eq: "{x \<in> topspace X. f x \<in> topspace X' \<and> g (f x) \<in> U} = {x \<in> topspace X. g (f x) \<in> U}" for U
     by auto
   have "openin X {x \<in> topspace X. f x \<in> topspace X' \<and> g (f x) \<in> U''}"
     unfolding eq using U'' g openin_continuous_map_preimage by fastforce
   then have *: "openin X {x \<in> topspace X. f x \<in> {x \<in> topspace X'. g x \<in> U''}}"
     by auto
   show "openin X' {x \<in> topspace X'. g x \<in> U''}"
     using f unfolding quotient_map_def
     by (metis (no_types) Collect_subset *)
 qed
 
 lemma continuous_compose_quotient_map_eq:
    "quotient_map X X' f \<Longrightarrow> continuous_map X X'' (g \<circ> f) \<longleftrightarrow> continuous_map X' X'' g"
   using continuous_compose_quotient_map continuous_map_compose quotient_imp_continuous_map by blast
 
 lemma quotient_map_compose_eq:
    "quotient_map X X' f \<Longrightarrow> quotient_map X X'' (g \<circ> f) \<longleftrightarrow> quotient_map X' X'' g"
   by (meson continuous_compose_quotient_map_eq quotient_imp_continuous_map quotient_map_compose quotient_map_from_composition)
 
 lemma quotient_map_restriction:
   assumes quo: "quotient_map X Y f" and U: "{x \<in> topspace X. f x \<in> V} = U" and disj: "openin Y V \<or> closedin Y V"
  shows "quotient_map (subtopology X U) (subtopology Y V) f"
   using disj
 proof
   assume V: "openin Y V"
   with U have sub: "U \<subseteq> topspace X" "V \<subseteq> topspace Y"
     by (auto simp: openin_subset)
   have fim: "f ` topspace X = topspace Y"
      and Y: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U} = openin Y U"
     using quo unfolding quotient_map_def by auto
   have "openin X U"
     using U V Y sub(2) by blast
   show ?thesis
     unfolding quotient_map_def
   proof (intro conjI allI impI)
     show "f ` topspace (subtopology X U) = topspace (subtopology Y V)"
       using sub U fim by (auto)
   next
     fix Y' :: "'b set"
     assume "Y' \<subseteq> topspace (subtopology Y V)"
     then have "Y' \<subseteq> topspace Y" "Y' \<subseteq> V"
       by (simp_all)
     then have eq: "{x \<in> topspace X. x \<in> U \<and> f x \<in> Y'} = {x \<in> topspace X. f x \<in> Y'}"
       using U by blast
     then show "openin (subtopology X U) {x \<in> topspace (subtopology X U). f x \<in> Y'} = openin (subtopology Y V) Y'"
       using U V Y \<open>openin X U\<close>  \<open>Y' \<subseteq> topspace Y\<close> \<open>Y' \<subseteq> V\<close>
       by (simp add: openin_open_subtopology eq) (auto simp: openin_closedin_eq)
   qed
 next
   assume V: "closedin Y V"
   with U have sub: "U \<subseteq> topspace X" "V \<subseteq> topspace Y"
     by (auto simp: closedin_subset)
   have fim: "f ` topspace X = topspace Y"
      and Y: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> closedin X {x \<in> topspace X. f x \<in> U} = closedin Y U"
     using quo unfolding quotient_map_closedin by auto
   have "closedin X U"
     using U V Y sub(2) by blast
   show ?thesis
     unfolding quotient_map_closedin
   proof (intro conjI allI impI)
     show "f ` topspace (subtopology X U) = topspace (subtopology Y V)"
       using sub U fim by (auto)
   next
     fix Y' :: "'b set"
     assume "Y' \<subseteq> topspace (subtopology Y V)"
     then have "Y' \<subseteq> topspace Y" "Y' \<subseteq> V"
       by (simp_all)
     then have eq: "{x \<in> topspace X. x \<in> U \<and> f x \<in> Y'} = {x \<in> topspace X. f x \<in> Y'}"
       using U by blast
     then show "closedin (subtopology X U) {x \<in> topspace (subtopology X U). f x \<in> Y'} = closedin (subtopology Y V) Y'"
       using U V Y \<open>closedin X U\<close>  \<open>Y' \<subseteq> topspace Y\<close> \<open>Y' \<subseteq> V\<close>
       by (simp add: closedin_closed_subtopology eq) (auto simp: closedin_def)
   qed
 qed
 
 lemma quotient_map_saturated_open:
      "quotient_map X Y f \<longleftrightarrow>
         continuous_map X Y f \<and> f ` (topspace X) = topspace Y \<and>
         (\<forall>U. openin X U \<and> {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U \<longrightarrow> openin Y (f ` U))"
      (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then have fim: "f ` topspace X = topspace Y"
     and Y: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> openin Y U = openin X {x \<in> topspace X. f x \<in> U}"
     unfolding quotient_map_def by auto
   show ?rhs
   proof (intro conjI allI impI)
     show "continuous_map X Y f"
       by (simp add: L quotient_imp_continuous_map)
     show "f ` topspace X = topspace Y"
       by (simp add: fim)
   next
     fix U :: "'a set"
     assume U: "openin X U \<and> {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U"
     then have sub:  "f ` U \<subseteq> topspace Y" and eq: "{x \<in> topspace X. f x \<in> f ` U} = U"
       using fim openin_subset by fastforce+
     show "openin Y (f ` U)"
       by (simp add: sub Y eq U)
   qed
 next
   assume ?rhs
   then have YX: "\<And>U. openin Y U \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
        and fim: "f ` topspace X = topspace Y"
        and XY: "\<And>U. \<lbrakk>openin X U; {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U\<rbrakk> \<Longrightarrow> openin Y (f ` U)"
     by (auto simp: quotient_map_def continuous_map_def)
   show ?lhs
   proof (simp add: quotient_map_def fim, intro allI impI iffI)
     fix U :: "'b set"
     assume "U \<subseteq> topspace Y" and X: "openin X {x \<in> topspace X. f x \<in> U}"
     have feq: "f ` {x \<in> topspace X. f x \<in> U} = U"
       using \<open>U \<subseteq> topspace Y\<close> fim by auto
     show "openin Y U"
       using XY [OF X] by (simp add: feq)
   next
     fix U :: "'b set"
     assume "U \<subseteq> topspace Y" and Y: "openin Y U"
     show "openin X {x \<in> topspace X. f x \<in> U}"
       by (metis YX [OF Y])
   qed
 qed
 
 lemma quotient_map_saturated_closed:
      "quotient_map X Y f \<longleftrightarrow>
         continuous_map X Y f \<and> f ` (topspace X) = topspace Y \<and>
         (\<forall>U. closedin X U \<and> {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U \<longrightarrow> closedin Y (f ` U))"
      (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then obtain fim: "f ` topspace X = topspace Y"
     and Y: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> closedin Y U = closedin X {x \<in> topspace X. f x \<in> U}"
     by (simp add: quotient_map_closedin)
   show ?rhs
   proof (intro conjI allI impI)
     show "continuous_map X Y f"
       by (simp add: L quotient_imp_continuous_map)
     show "f ` topspace X = topspace Y"
       by (simp add: fim)
   next
     fix U :: "'a set"
     assume U: "closedin X U \<and> {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U"
     then have sub:  "f ` U \<subseteq> topspace Y" and eq: "{x \<in> topspace X. f x \<in> f ` U} = U"
       using fim closedin_subset by fastforce+
     show "closedin Y (f ` U)"
       by (simp add: sub Y eq U)
   qed
 next
   assume ?rhs
   then obtain YX: "\<And>U. closedin Y U \<Longrightarrow> closedin X {x \<in> topspace X. f x \<in> U}"
     and fim: "f ` topspace X = topspace Y"
     and XY: "\<And>U. \<lbrakk>closedin X U; {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U\<rbrakk> \<Longrightarrow> closedin Y (f ` U)"
     by (simp add: continuous_map_closedin)
   show ?lhs
   proof (simp add: quotient_map_closedin fim, intro allI impI iffI)
     fix U :: "'b set"
     assume "U \<subseteq> topspace Y" and X: "closedin X {x \<in> topspace X. f x \<in> U}"
     have feq: "f ` {x \<in> topspace X. f x \<in> U} = U"
       using \<open>U \<subseteq> topspace Y\<close> fim by auto
     show "closedin Y U"
       using XY [OF X] by (simp add: feq)
   next
     fix U :: "'b set"
     assume "U \<subseteq> topspace Y" and Y: "closedin Y U"
     show "closedin X {x \<in> topspace X. f x \<in> U}"
       by (metis YX [OF Y])
   qed
 qed
 
 lemma quotient_map_onto_image:
   assumes "f ` topspace X \<subseteq> topspace Y" and U: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U} = openin Y U"
   shows "quotient_map X (subtopology Y (f ` topspace X)) f"
   unfolding quotient_map_def topspace_subtopology
 proof (intro conjI strip)
   fix U
   assume "U \<subseteq> topspace Y \<inter> f ` topspace X"
   with U have "openin X {x \<in> topspace X. f x \<in> U} \<Longrightarrow> \<exists>x. openin Y x \<and> U = f ` topspace X \<inter> x"
     by fastforce
   moreover have "\<exists>x. openin Y x \<and> U = f ` topspace X \<inter> x \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
     by (metis (mono_tags, lifting) Collect_cong IntE IntI U image_eqI openin_subset)
   ultimately show "openin X {x \<in> topspace X. f x \<in> U} = openin (subtopology Y (f ` topspace X)) U"
     by (force simp: openin_subtopology_alt image_iff)
 qed (use assms in auto)
 
 lemma quotient_map_lift_exists:
   assumes f: "quotient_map X Y f" and h: "continuous_map X Z h" 
     and "\<And>x y. \<lbrakk>x \<in> topspace X; y \<in> topspace X; f x = f y\<rbrakk> \<Longrightarrow> h x = h y"
   obtains g where "continuous_map Y Z g" "g ` topspace Y = h ` topspace X"
                   "\<And>x. x \<in> topspace X \<Longrightarrow> g(f x) = h x"
 proof -
   obtain g where g: "\<And>x. x \<in> topspace X \<Longrightarrow> h x = g(f x)"
     using function_factors_left_gen[of "\<lambda>x. x \<in> topspace X" f h] assms by blast
   show ?thesis
   proof
     show "g ` topspace Y = h ` topspace X"
       using f g by (force dest!: quotient_imp_surjective_map)
     show "continuous_map Y Z g"
       by (smt (verit)  f g h continuous_compose_quotient_map_eq continuous_map_eq o_def)
   qed (simp add: g)
 qed
 
 subsection\<open> Separated Sets\<close>
 
 definition separatedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> bool"
   where "separatedin X S T \<equiv>
            S \<subseteq> topspace X \<and> T \<subseteq> topspace X \<and>
            S \<inter> X closure_of T = {} \<and> T \<inter> X closure_of S = {}"
 
 lemma separatedin_empty [simp]:
      "separatedin X S {} \<longleftrightarrow> S \<subseteq> topspace X"
      "separatedin X {} S \<longleftrightarrow> S \<subseteq> topspace X"
   by (simp_all add: separatedin_def)
 
 lemma separatedin_refl [simp]:
      "separatedin X S S \<longleftrightarrow> S = {}"
   by (metis closure_of_subset empty_subsetI inf.orderE separatedin_def)
 
 lemma separatedin_sym:
      "separatedin X S T \<longleftrightarrow> separatedin X T S"
   by (auto simp: separatedin_def)
 
 lemma separatedin_imp_disjoint:
      "separatedin X S T \<Longrightarrow> disjnt S T"
   by (meson closure_of_subset disjnt_def disjnt_subset2 separatedin_def)
 
 lemma separatedin_mono:
    "\<lbrakk>separatedin X S T; S' \<subseteq> S; T' \<subseteq> T\<rbrakk> \<Longrightarrow> separatedin X S' T'"
   unfolding separatedin_def
   using closure_of_mono by blast
 
 lemma separatedin_open_sets:
      "\<lbrakk>openin X S; openin X T\<rbrakk> \<Longrightarrow> separatedin X S T \<longleftrightarrow> disjnt S T"
   unfolding disjnt_def separatedin_def
   by (auto simp: openin_Int_closure_of_eq_empty openin_subset)
 
 lemma separatedin_closed_sets:
      "\<lbrakk>closedin X S; closedin X T\<rbrakk> \<Longrightarrow> separatedin X S T \<longleftrightarrow> disjnt S T"
   unfolding closure_of_eq disjnt_def separatedin_def
   by (metis closedin_def closure_of_eq inf_commute)
 
 lemma separatedin_subtopology:
      "separatedin (subtopology X U) S T \<longleftrightarrow> S \<subseteq> U \<and> T \<subseteq> U \<and> separatedin X S T"
   by (auto simp: separatedin_def closure_of_subtopology Int_ac disjoint_iff elim!: inf.orderE)
 
 lemma separatedin_discrete_topology:
      "separatedin (discrete_topology U) S T \<longleftrightarrow> S \<subseteq> U \<and> T \<subseteq> U \<and> disjnt S T"
   by (metis openin_discrete_topology separatedin_def separatedin_open_sets topspace_discrete_topology)
 
 lemma separated_eq_distinguishable:
    "separatedin X {x} {y} \<longleftrightarrow>
         x \<in> topspace X \<and> y \<in> topspace X \<and>
         (\<exists>U. openin X U \<and> x \<in> U \<and> (y \<notin> U)) \<and>
         (\<exists>v. openin X v \<and> y \<in> v \<and> (x \<notin> v))"
   by (force simp: separatedin_def closure_of_def)
 
 lemma separatedin_Un [simp]:
    "separatedin X S (T \<union> U) \<longleftrightarrow> separatedin X S T \<and> separatedin X S U"
    "separatedin X (S \<union> T) U \<longleftrightarrow> separatedin X S U \<and> separatedin X T U"
   by (auto simp: separatedin_def)
 
 lemma separatedin_Union:
   "finite \<F> \<Longrightarrow> separatedin X S (\<Union>\<F>) \<longleftrightarrow> S \<subseteq> topspace X \<and> (\<forall>T \<in> \<F>. separatedin X S T)"
   "finite \<F> \<Longrightarrow> separatedin X (\<Union>\<F>) S \<longleftrightarrow> (\<forall>T \<in> \<F>. separatedin X S T) \<and> S \<subseteq> topspace X"
   by (auto simp: separatedin_def closure_of_Union)
 
 lemma separatedin_openin_diff:
    "\<lbrakk>openin X S; openin X T\<rbrakk> \<Longrightarrow> separatedin X (S - T) (T - S)"
   unfolding separatedin_def
   by (metis Diff_Int_distrib2 Diff_disjoint Diff_empty Diff_mono empty_Diff empty_subsetI openin_Int_closure_of_eq_empty openin_subset)
 
 lemma separatedin_closedin_diff:
   assumes "closedin X S" "closedin X T"
   shows "separatedin X (S - T) (T - S)"
 proof -
   have "S - T \<subseteq> topspace X" "T - S \<subseteq> topspace X"
     using assms closedin_subset by auto
   with assms show ?thesis
     by (simp add: separatedin_def Diff_Int_distrib2 closure_of_minimal inf_absorb2)
 qed
 
 lemma separation_closedin_Un_gen:
      "separatedin X S T \<longleftrightarrow>
         S \<subseteq> topspace X \<and> T \<subseteq> topspace X \<and> disjnt S T \<and>
         closedin (subtopology X (S \<union> T)) S \<and>
         closedin (subtopology X (S \<union> T)) T"
   by (auto simp add: separatedin_def closedin_Int_closure_of disjnt_iff dest: closure_of_subset)
 
 lemma separation_openin_Un_gen:
      "separatedin X S T \<longleftrightarrow>
         S \<subseteq> topspace X \<and> T \<subseteq> topspace X \<and> disjnt S T \<and>
         openin (subtopology X (S \<union> T)) S \<and>
         openin (subtopology X (S \<union> T)) T"
   unfolding openin_closedin_eq topspace_subtopology separation_closedin_Un_gen disjnt_def
   by (auto simp: Diff_triv Int_commute Un_Diff inf_absorb1 topspace_def)
 
 lemma separatedin_full:
    "S \<union> T = topspace X
    \<Longrightarrow> separatedin X S T \<longleftrightarrow> disjnt S T \<and> closedin X S \<and> openin X S \<and> closedin X T \<and> openin X T"
   by (metis separatedin_open_sets separation_closedin_Un_gen separation_openin_Un_gen subtopology_topspace)
 
 
 subsection\<open>Homeomorphisms\<close>
 text\<open>(1-way and 2-way versions may be useful in places)\<close>
 
 definition homeomorphic_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where
  "homeomorphic_map X Y f \<equiv> quotient_map X Y f \<and> inj_on f (topspace X)"
 
 definition homeomorphic_maps :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> bool"
   where
  "homeomorphic_maps X Y f g \<equiv>
     continuous_map X Y f \<and> continuous_map Y X g \<and>
      (\<forall>x \<in> topspace X. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
 
 
 lemma homeomorphic_map_eq:
    "\<lbrakk>homeomorphic_map X Y f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> homeomorphic_map X Y g"
   by (meson homeomorphic_map_def inj_on_cong quotient_map_eq)
 
 lemma homeomorphic_maps_eq:
      "\<lbrakk>homeomorphic_maps X Y f g;
        \<And>x. x \<in> topspace X \<Longrightarrow> f x = f' x; \<And>y. y \<in> topspace Y \<Longrightarrow> g y = g' y\<rbrakk>
       \<Longrightarrow> homeomorphic_maps X Y f' g'"
   unfolding homeomorphic_maps_def
   by (metis continuous_map_eq continuous_map_eq_image_closure_subset_gen image_subset_iff)
 
 lemma homeomorphic_maps_sym:
      "homeomorphic_maps X Y f g \<longleftrightarrow> homeomorphic_maps Y X g f"
   by (auto simp: homeomorphic_maps_def)
 
 lemma homeomorphic_maps_id:
      "homeomorphic_maps X Y id id \<longleftrightarrow> Y = X"  (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then have "topspace X = topspace Y"
     by (auto simp: homeomorphic_maps_def continuous_map_def)
   with L show ?rhs
     unfolding homeomorphic_maps_def
     by (metis topology_finer_continuous_id topology_eq)
 next
   assume ?rhs
   then show ?lhs
     unfolding homeomorphic_maps_def by auto
 qed
 
 lemma homeomorphic_map_id [simp]: "homeomorphic_map X Y id \<longleftrightarrow> Y = X"
        (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then have eq: "topspace X = topspace Y"
     by (auto simp: homeomorphic_map_def continuous_map_def quotient_map_def)
   then have "\<And>S. openin X S \<longrightarrow> openin Y S"
     by (meson L homeomorphic_map_def injective_quotient_map topology_finer_open_id)
   then show ?rhs
     using L unfolding homeomorphic_map_def
     by (metis eq quotient_imp_continuous_map topology_eq topology_finer_continuous_id)
 next
   assume ?rhs
   then show ?lhs
     unfolding homeomorphic_map_def
     by (simp add: closed_map_id continuous_closed_imp_quotient_map)
 qed
 
 lemma homeomorphic_map_compose:
   assumes "homeomorphic_map X Y f" "homeomorphic_map Y X'' g"
   shows "homeomorphic_map X X'' (g \<circ> f)"
 proof -
   have "inj_on g (f ` topspace X)"
     by (metis (no_types) assms homeomorphic_map_def quotient_imp_surjective_map)
   then show ?thesis
     using assms by (meson comp_inj_on homeomorphic_map_def quotient_map_compose_eq)
 qed
 
 lemma homeomorphic_maps_compose:
    "homeomorphic_maps X Y f h \<and>
         homeomorphic_maps Y X'' g k
         \<Longrightarrow> homeomorphic_maps X X'' (g \<circ> f) (h \<circ> k)"
   unfolding homeomorphic_maps_def
   by (auto simp: continuous_map_compose; simp add: continuous_map_def)
 
 lemma homeomorphic_eq_everything_map:
    "homeomorphic_map X Y f \<longleftrightarrow>
         continuous_map X Y f \<and> open_map X Y f \<and> closed_map X Y f \<and>
         f ` (topspace X) = topspace Y \<and> inj_on f (topspace X)"
   unfolding homeomorphic_map_def
   by (force simp: injective_quotient_map intro: injective_quotient_map)
 
 lemma homeomorphic_imp_continuous_map:
      "homeomorphic_map X Y f \<Longrightarrow> continuous_map X Y f"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma homeomorphic_imp_open_map:
    "homeomorphic_map X Y f \<Longrightarrow> open_map X Y f"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma homeomorphic_imp_closed_map:
    "homeomorphic_map X Y f \<Longrightarrow> closed_map X Y f"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma homeomorphic_imp_surjective_map:
    "homeomorphic_map X Y f \<Longrightarrow> f ` (topspace X) = topspace Y"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma homeomorphic_imp_injective_map:
     "homeomorphic_map X Y f \<Longrightarrow> inj_on f (topspace X)"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma bijective_open_imp_homeomorphic_map:
    "\<lbrakk>continuous_map X Y f; open_map X Y f; f ` (topspace X) = topspace Y; inj_on f (topspace X)\<rbrakk>
         \<Longrightarrow> homeomorphic_map X Y f"
   by (simp add: homeomorphic_map_def continuous_open_imp_quotient_map)
 
 lemma bijective_closed_imp_homeomorphic_map:
    "\<lbrakk>continuous_map X Y f; closed_map X Y f; f ` (topspace X) = topspace Y; inj_on f (topspace X)\<rbrakk>
         \<Longrightarrow> homeomorphic_map X Y f"
   by (simp add: continuous_closed_quotient_map homeomorphic_map_def)
 
 lemma open_eq_continuous_inverse_map:
   assumes X: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y \<and> g(f x) = x"
     and Y: "\<And>y. y \<in> topspace Y \<Longrightarrow> g y \<in> topspace X \<and> f(g y) = y"
   shows "open_map X Y f \<longleftrightarrow> continuous_map Y X g"
 proof -
   have eq: "{x \<in> topspace Y. g x \<in> U} = f ` U" if "openin X U" for U
     using openin_subset [OF that] by (force simp: X Y image_iff)
   show ?thesis
     by (auto simp: Y open_map_def continuous_map_def eq)
 qed
 
 lemma closed_eq_continuous_inverse_map:
   assumes X: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y \<and> g(f x) = x"
     and Y: "\<And>y. y \<in> topspace Y \<Longrightarrow> g y \<in> topspace X \<and> f(g y) = y"
   shows "closed_map X Y f \<longleftrightarrow> continuous_map Y X g"
 proof -
   have eq: "{x \<in> topspace Y. g x \<in> U} = f ` U" if "closedin X U" for U
     using closedin_subset [OF that] by (force simp: X Y image_iff)
   show ?thesis
     by (auto simp: Y closed_map_def continuous_map_closedin eq)
 qed
 
 lemma homeomorphic_maps_map:
   "homeomorphic_maps X Y f g \<longleftrightarrow>
         homeomorphic_map X Y f \<and> homeomorphic_map Y X g \<and>
         (\<forall>x \<in> topspace X. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have L: "continuous_map X Y f" "continuous_map Y X g" "\<forall>x\<in>topspace X. g (f x) = x" "\<forall>x'\<in>topspace Y. f (g x') = x'"
     by (auto simp: homeomorphic_maps_def)
   show ?rhs
   proof (intro conjI bijective_open_imp_homeomorphic_map L)
     show "open_map X Y f"
       using L using open_eq_continuous_inverse_map [of concl: X Y f g] by (simp add: continuous_map_def)
     show "open_map Y X g"
       using L using open_eq_continuous_inverse_map [of concl: Y X g f] by (simp add: continuous_map_def)
     show "f ` topspace X = topspace Y" "g ` topspace Y = topspace X"
       using L by (force simp: continuous_map_closedin)+
     show "inj_on f (topspace X)" "inj_on g (topspace Y)"
       using L unfolding inj_on_def by metis+
   qed
 next
   assume ?rhs
   then show ?lhs
     by (auto simp: homeomorphic_maps_def homeomorphic_imp_continuous_map)
 qed
 
 lemma homeomorphic_maps_imp_map:
     "homeomorphic_maps X Y f g \<Longrightarrow> homeomorphic_map X Y f"
   using homeomorphic_maps_map by blast
 
 lemma homeomorphic_map_maps:
      "homeomorphic_map X Y f \<longleftrightarrow> (\<exists>g. homeomorphic_maps X Y f g)"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have L: "continuous_map X Y f" "open_map X Y f" "closed_map X Y f"
     "f ` (topspace X) = topspace Y" "inj_on f (topspace X)"
     by (auto simp: homeomorphic_eq_everything_map)
   have X: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y \<and> inv_into (topspace X) f (f x) = x"
     using L by auto
   have Y: "\<And>y. y \<in> topspace Y \<Longrightarrow> inv_into (topspace X) f y \<in> topspace X \<and> f (inv_into (topspace X) f y) = y"
     by (simp add: L f_inv_into_f inv_into_into)
   have "homeomorphic_maps X Y f (inv_into (topspace X) f)"
     unfolding homeomorphic_maps_def
   proof (intro conjI L)
     show "continuous_map Y X (inv_into (topspace X) f)"
       by (simp add: L X Y flip: open_eq_continuous_inverse_map [where f=f])
   next
     show "\<forall>x\<in>topspace X. inv_into (topspace X) f (f x) = x"
          "\<forall>y\<in>topspace Y. f (inv_into (topspace X) f y) = y"
       using X Y by auto
   qed
   then show ?rhs
     by metis
 next
   assume ?rhs
   then show ?lhs
     using homeomorphic_maps_map by blast
 qed
 
 lemma homeomorphic_maps_involution:
    "\<lbrakk>continuous_map X X f; \<And>x. x \<in> topspace X \<Longrightarrow> f(f x) = x\<rbrakk> \<Longrightarrow> homeomorphic_maps X X f f"
   by (auto simp: homeomorphic_maps_def)
 
 lemma homeomorphic_map_involution:
    "\<lbrakk>continuous_map X X f; \<And>x. x \<in> topspace X \<Longrightarrow> f(f x) = x\<rbrakk> \<Longrightarrow> homeomorphic_map X X f"
   using homeomorphic_maps_involution homeomorphic_maps_map by blast
 
 lemma homeomorphic_map_openness:
   assumes hom: "homeomorphic_map X Y f" and U: "U \<subseteq> topspace X"
   shows "openin Y (f ` U) \<longleftrightarrow> openin X U"
 proof -
   obtain g where "homeomorphic_maps X Y f g"
     using assms by (auto simp: homeomorphic_map_maps)
   then have g: "homeomorphic_map Y X g" and gf: "\<And>x. x \<in> topspace X \<Longrightarrow> g(f x) = x"
     by (auto simp: homeomorphic_maps_map)
   then have "openin X U \<Longrightarrow> openin Y (f ` U)"
     using hom homeomorphic_imp_open_map open_map_def by blast
   show "openin Y (f ` U) = openin X U"
   proof
     assume L: "openin Y (f ` U)"
     have "U = g ` (f ` U)"
       using U gf by force
     then show "openin X U"
       by (metis L homeomorphic_imp_open_map open_map_def g)
   next
     assume "openin X U"
     then show "openin Y (f ` U)"
       using hom homeomorphic_imp_open_map open_map_def by blast
   qed
 qed
 
 
 lemma homeomorphic_map_closedness:
   assumes hom: "homeomorphic_map X Y f" and U: "U \<subseteq> topspace X"
   shows "closedin Y (f ` U) \<longleftrightarrow> closedin X U"
 proof -
   obtain g where "homeomorphic_maps X Y f g"
     using assms by (auto simp: homeomorphic_map_maps)
   then have g: "homeomorphic_map Y X g" and gf: "\<And>x. x \<in> topspace X \<Longrightarrow> g(f x) = x"
     by (auto simp: homeomorphic_maps_map)
   then have "closedin X U \<Longrightarrow> closedin Y (f ` U)"
     using hom homeomorphic_imp_closed_map closed_map_def by blast
   show "closedin Y (f ` U) = closedin X U"
   proof
     assume L: "closedin Y (f ` U)"
     have "U = g ` (f ` U)"
       using U gf by force
     then show "closedin X U"
       by (metis L homeomorphic_imp_closed_map closed_map_def g)
   next
     assume "closedin X U"
     then show "closedin Y (f ` U)"
       using hom homeomorphic_imp_closed_map closed_map_def by blast
   qed
 qed
 
 lemma homeomorphic_map_openness_eq:
      "homeomorphic_map X Y f \<Longrightarrow> openin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> openin Y (f ` U)"
   by (meson homeomorphic_map_openness openin_closedin_eq)
 
 lemma homeomorphic_map_closedness_eq:
     "homeomorphic_map X Y f \<Longrightarrow> closedin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> closedin Y (f ` U)"
   by (meson closedin_subset homeomorphic_map_closedness)
 
 lemma all_openin_homeomorphic_image:
   assumes "homeomorphic_map X Y f"
   shows "(\<forall>V. openin Y V \<longrightarrow> P V) \<longleftrightarrow> (\<forall>U. openin X U \<longrightarrow> P(f ` U))" 
   by (metis (no_types, lifting) assms homeomorphic_imp_surjective_map homeomorphic_map_openness openin_subset subset_image_iff)
 
 lemma all_closedin_homeomorphic_image:
   assumes "homeomorphic_map X Y f"
   shows "(\<forall>V. closedin Y V \<longrightarrow> P V) \<longleftrightarrow> (\<forall>U. closedin X U \<longrightarrow> P(f ` U))"  (is "?lhs = ?rhs")
   by (metis (no_types, lifting) assms homeomorphic_imp_surjective_map homeomorphic_map_closedness closedin_subset subset_image_iff)
 
 
 lemma homeomorphic_map_derived_set_of:
   assumes hom: "homeomorphic_map X Y f" and S: "S \<subseteq> topspace X"
   shows "Y derived_set_of (f ` S) = f ` (X derived_set_of S)"
 proof -
   have fim: "f ` (topspace X) = topspace Y" and inj: "inj_on f (topspace X)"
     using hom by (auto simp: homeomorphic_eq_everything_map)
   have iff: "(\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y. y \<noteq> x \<and> y \<in> S \<and> y \<in> T)) =
             (\<forall>T. T \<subseteq> topspace Y \<longrightarrow> f x \<in> T \<longrightarrow> openin Y T \<longrightarrow> (\<exists>y. y \<noteq> f x \<and> y \<in> f ` S \<and> y \<in> T))"
     if "x \<in> topspace X" for x
   proof -
     have \<section>: "(x \<in> T \<and> openin X T) = (T \<subseteq> topspace X \<and> f x \<in> f ` T \<and> openin Y (f ` T))" for T
       by (meson hom homeomorphic_map_openness_eq inj inj_on_image_mem_iff that)
     moreover have "(\<exists>y. y \<noteq> x \<and> y \<in> S \<and> y \<in> T) = (\<exists>y. y \<noteq> f x \<and> y \<in> f ` S \<and> y \<in> f ` T)"  (is "?lhs = ?rhs")
       if "T \<subseteq> topspace X \<and> f x \<in> f ` T \<and> openin Y (f ` T)" for T
       by (smt (verit, del_insts) S \<open>x \<in> topspace X\<close> image_iff inj inj_on_def subsetD that)
     ultimately show ?thesis
       by (auto simp flip: fim simp: all_subset_image)
   qed
   have *: "\<lbrakk>T = f ` S; \<And>x. x \<in> S \<Longrightarrow> P x \<longleftrightarrow> Q(f x)\<rbrakk> \<Longrightarrow> {y. y \<in> T \<and> Q y} = f ` {x \<in> S. P x}" for T S P Q
     by auto
   show ?thesis
     unfolding derived_set_of_def
     by (rule *) (use fim iff openin_subset in force)+
 qed
 
 
 lemma homeomorphic_map_closure_of:
   assumes hom: "homeomorphic_map X Y f" and S: "S \<subseteq> topspace X"
   shows "Y closure_of (f ` S) = f ` (X closure_of S)"
   unfolding closure_of
   using homeomorphic_imp_surjective_map [OF hom] S
   by (auto simp: in_derived_set_of homeomorphic_map_derived_set_of [OF assms])
 
 lemma homeomorphic_map_interior_of:
   assumes hom: "homeomorphic_map X Y f" and S: "S \<subseteq> topspace X"
   shows "Y interior_of (f ` S) = f ` (X interior_of S)"
 proof -
   { fix y
     assume "y \<in> topspace Y" and "y \<notin> Y closure_of (topspace Y - f ` S)"
     then have "y \<in> f ` (topspace X - X closure_of (topspace X - S))"
       using homeomorphic_eq_everything_map [THEN iffD1, OF hom] homeomorphic_map_closure_of [OF hom]
       by (metis DiffI Diff_subset S closure_of_subset_topspace inj_on_image_set_diff) }
   moreover
   { fix x
     assume "x \<in> topspace X"
     then have "f x \<in> topspace Y"
       using hom homeomorphic_imp_surjective_map by blast }
   moreover
   { fix x
     assume "x \<in> topspace X" and "x \<notin> X closure_of (topspace X - S)" and "f x \<in> Y closure_of (topspace Y - f ` S)"
     then have "False"
       using homeomorphic_map_closure_of [OF hom] hom
       unfolding homeomorphic_eq_everything_map
       by (metis Diff_subset S closure_of_subset_topspace inj_on_image_mem_iff inj_on_image_set_diff)
   }
   ultimately  show ?thesis
     by (auto simp: interior_of_closure_of)
 qed
 
 lemma homeomorphic_map_frontier_of:
   assumes hom: "homeomorphic_map X Y f" and S: "S \<subseteq> topspace X"
   shows "Y frontier_of (f ` S) = f ` (X frontier_of S)"
   unfolding frontier_of_def
 proof (intro equalityI subsetI DiffI)
   fix y
   assume "y \<in> Y closure_of f ` S - Y interior_of f ` S"
   then show "y \<in> f ` (X closure_of S - X interior_of S)"
     using S hom homeomorphic_map_closure_of homeomorphic_map_interior_of by fastforce
 next
   fix y
   assume "y \<in> f ` (X closure_of S - X interior_of S)"
   then show "y \<in> Y closure_of f ` S"
     using S hom homeomorphic_map_closure_of by fastforce
 next
   fix x
   assume "x \<in> f ` (X closure_of S - X interior_of S)"
   then obtain y where y: "x = f y" "y \<in> X closure_of S" "y \<notin> X interior_of S"
     by blast
   then show "x \<notin> Y interior_of f ` S"
     using S hom homeomorphic_map_interior_of y(1)
     unfolding homeomorphic_map_def
     by (smt (verit, ccfv_SIG) in_closure_of inj_on_image_mem_iff interior_of_subset_topspace) 
 qed
 
 lemma homeomorphic_maps_subtopologies:
    "\<lbrakk>homeomorphic_maps X Y f g;  f ` (topspace X \<inter> S) = topspace Y \<inter> T\<rbrakk>
         \<Longrightarrow> homeomorphic_maps (subtopology X S) (subtopology Y T) f g"
   unfolding homeomorphic_maps_def
   by (force simp: continuous_map_from_subtopology continuous_map_in_subtopology)
 
 lemma homeomorphic_maps_subtopologies_alt:
      "\<lbrakk>homeomorphic_maps X Y f g; f ` (topspace X \<inter> S) \<subseteq> T; g ` (topspace Y \<inter> T) \<subseteq> S\<rbrakk>
       \<Longrightarrow> homeomorphic_maps (subtopology X S) (subtopology Y T) f g"
   unfolding homeomorphic_maps_def
   by (force simp: continuous_map_from_subtopology continuous_map_in_subtopology)
 
 lemma homeomorphic_map_subtopologies:
    "\<lbrakk>homeomorphic_map X Y f; f ` (topspace X \<inter> S) = topspace Y \<inter> T\<rbrakk>
         \<Longrightarrow> homeomorphic_map (subtopology X S) (subtopology Y T) f"
   by (meson homeomorphic_map_maps homeomorphic_maps_subtopologies)
 
 lemma homeomorphic_map_subtopologies_alt:
   assumes hom: "homeomorphic_map X Y f" 
       and S: "\<And>x. \<lbrakk>x \<in> topspace X; f x \<in> topspace Y\<rbrakk> \<Longrightarrow> f x \<in> T \<longleftrightarrow> x \<in> S"
     shows "homeomorphic_map (subtopology X S) (subtopology Y T) f"
 proof -
   have "homeomorphic_maps (subtopology X S) (subtopology Y T) f g" 
     if "homeomorphic_maps X Y f g" for g
   proof (rule homeomorphic_maps_subtopologies [OF that])
     have "f ` (topspace X \<inter> S) \<subseteq> topspace Y \<inter> T"
       using S hom homeomorphic_imp_surjective_map by fastforce
     then show "f ` (topspace X \<inter> S) = topspace Y \<inter> T"
       using that unfolding homeomorphic_maps_def continuous_map_def
       by (smt (verit, del_insts) Int_iff S image_iff subsetI subset_antisym)
   qed
   then show ?thesis
     using hom by (meson homeomorphic_map_maps)
 qed
 
 
 subsection\<open>Relation of homeomorphism between topological spaces\<close>
 
 definition homeomorphic_space (infixr "homeomorphic'_space" 50)
   where "X homeomorphic_space Y \<equiv> \<exists>f g. homeomorphic_maps X Y f g"
 
 lemma homeomorphic_space_refl: "X homeomorphic_space X"
   by (meson homeomorphic_maps_id homeomorphic_space_def)
 
 lemma homeomorphic_space_sym:
    "X homeomorphic_space Y \<longleftrightarrow> Y homeomorphic_space X"
   unfolding homeomorphic_space_def by (metis homeomorphic_maps_sym)
 
 lemma homeomorphic_space_trans [trans]:
      "\<lbrakk>X1 homeomorphic_space X2; X2 homeomorphic_space X3\<rbrakk> \<Longrightarrow> X1 homeomorphic_space X3"
   unfolding homeomorphic_space_def by (metis homeomorphic_maps_compose)
 
 lemma homeomorphic_space:
      "X homeomorphic_space Y \<longleftrightarrow> (\<exists>f. homeomorphic_map X Y f)"
   by (simp add: homeomorphic_map_maps homeomorphic_space_def)
 
 lemma homeomorphic_maps_imp_homeomorphic_space:
      "homeomorphic_maps X Y f g \<Longrightarrow> X homeomorphic_space Y"
   unfolding homeomorphic_space_def by metis
 
 lemma homeomorphic_map_imp_homeomorphic_space:
      "homeomorphic_map X Y f \<Longrightarrow> X homeomorphic_space Y"
   unfolding homeomorphic_map_maps
   using homeomorphic_space_def by blast
 
 lemma homeomorphic_empty_space:
      "X homeomorphic_space Y \<Longrightarrow> topspace X = {} \<longleftrightarrow> topspace Y = {}"
   by (metis homeomorphic_imp_surjective_map homeomorphic_space image_is_empty)
 
 lemma homeomorphic_empty_space_eq:
   assumes "topspace X = {}"
   shows "X homeomorphic_space Y \<longleftrightarrow> topspace Y = {}"
   unfolding homeomorphic_maps_def homeomorphic_space_def
   by (metis assms continuous_map_on_empty continuous_map_closedin ex_in_conv)
 
 subsection\<open>Connected topological spaces\<close>
 
 definition connected_space :: "'a topology \<Rightarrow> bool" where
   "connected_space X \<equiv>
         \<not>(\<exists>E1 E2. openin X E1 \<and> openin X E2 \<and>
                   topspace X \<subseteq> E1 \<union> E2 \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
 
 definition connectedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> bool" where
   "connectedin X S \<equiv> S \<subseteq> topspace X \<and> connected_space (subtopology X S)"
 
 lemma connected_spaceD:
   "\<lbrakk>connected_space X;
     openin X U; openin X V; topspace X \<subseteq> U \<union> V; U \<inter> V = {}; U \<noteq> {}; V \<noteq> {}\<rbrakk> \<Longrightarrow> False"
   by (auto simp: connected_space_def)
 
 lemma connectedin_subset_topspace: "connectedin X S \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: connectedin_def)
 
 lemma connectedin_topspace:
      "connectedin X (topspace X) \<longleftrightarrow> connected_space X"
   by (simp add: connectedin_def)
 
 lemma connected_space_subtopology:
      "connectedin X S \<Longrightarrow> connected_space (subtopology X S)"
   by (simp add: connectedin_def)
 
 lemma connectedin_subtopology:
      "connectedin (subtopology X S) T \<longleftrightarrow> connectedin X T \<and> T \<subseteq> S"
   by (force simp: connectedin_def subtopology_subtopology inf_absorb2)
 
 lemma connected_space_eq:
      "connected_space X \<longleftrightarrow>
       (\<nexists>E1 E2. openin X E1 \<and> openin X E2 \<and> E1 \<union> E2 = topspace X \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
   unfolding connected_space_def
   by (metis openin_Un openin_subset subset_antisym)
 
 lemma connected_space_closedin:
      "connected_space X \<longleftrightarrow>
       (\<nexists>E1 E2. closedin X E1 \<and> closedin X E2 \<and> topspace X \<subseteq> E1 \<union> E2 \<and>
                E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "\<And>E1 E2. \<lbrakk>openin X E1; E1 \<inter> E2 = {}; topspace X \<subseteq> E1 \<union> E2; openin X E2\<rbrakk> \<Longrightarrow> E1 = {} \<or> E2 = {}"
     by (simp add: connected_space_def)
   then show ?rhs
     unfolding connected_space_def
     by (metis disjnt_def separatedin_closed_sets separation_openin_Un_gen subtopology_superset)
 next
   assume R: ?rhs
   then show ?lhs
     unfolding connected_space_def
     by (metis Diff_triv Int_commute separatedin_openin_diff separation_closedin_Un_gen subtopology_superset)
 qed
 
 lemma connected_space_closedin_eq:
      "connected_space X \<longleftrightarrow>
        (\<nexists>E1 E2. closedin X E1 \<and> closedin X E2 \<and>
                 E1 \<union> E2 = topspace X \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
   by (metis closedin_Un closedin_def connected_space_closedin subset_antisym)
 
 lemma connected_space_clopen_in:
      "connected_space X \<longleftrightarrow>
         (\<forall>T. openin X T \<and> closedin X T \<longrightarrow> T = {} \<or> T = topspace X)"
 proof -
   have eq: "openin X E1 \<and> openin X E2 \<and> E1 \<union> E2 = topspace X \<and> E1 \<inter> E2 = {} \<and> P
         \<longleftrightarrow> E2 = topspace X - E1 \<and> openin X E1 \<and> openin X E2 \<and> P" for E1 E2 P
     using openin_subset by blast
   show ?thesis
     unfolding connected_space_eq eq closedin_def
     by (auto simp: openin_closedin_eq)
 qed
 
 lemma connectedin:
      "connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
          (\<nexists>E1 E2.
              openin X E1 \<and> openin X E2 \<and>
              S \<subseteq> E1 \<union> E2 \<and> E1 \<inter> E2 \<inter> S = {} \<and> E1 \<inter> S \<noteq> {} \<and> E2 \<inter> S \<noteq> {})"  (is "?lhs = ?rhs")
 proof -
   have *: "(\<exists>E1:: 'a set. \<exists>E2:: 'a set. (\<exists>T1:: 'a set. P1 T1 \<and> E1 = f1 T1) \<and> (\<exists>T2:: 'a set. P2 T2 \<and> E2 = f2 T2) \<and>
              R E1 E2) \<longleftrightarrow> (\<exists>T1 T2. P1 T1 \<and> P2 T2 \<and> R(f1 T1) (f2 T2))" for P1 f1 P2 f2 R
     by auto
   show ?thesis 
     unfolding connectedin_def connected_space_def openin_subtopology topspace_subtopology *
     by (intro conj_cong arg_cong [where f=Not] ex_cong1; blast dest!: openin_subset)
 qed
 
 lemma connectedinD:
      "\<lbrakk>connectedin X S; openin X E1; openin X E2; S \<subseteq> E1 \<union> E2; E1 \<inter> E2 \<inter> S = {}; E1 \<inter> S \<noteq> {}; E2 \<inter> S \<noteq> {}\<rbrakk> \<Longrightarrow> False"
   by (meson connectedin)
 
 lemma connectedin_iff_connected [simp]: "connectedin euclidean S \<longleftrightarrow> connected S"
   by (simp add: connected_def connectedin)
 
 lemma connectedin_closedin:
    "connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
         \<not>(\<exists>E1 E2. closedin X E1 \<and> closedin X E2 \<and>
                   S \<subseteq> (E1 \<union> E2) \<and>
                   (E1 \<inter> E2 \<inter> S = {}) \<and>
                   \<not>(E1 \<inter> S = {}) \<and> \<not>(E2 \<inter> S = {}))"
 proof -
   have *: "(\<exists>E1:: 'a set. \<exists>E2:: 'a set. (\<exists>T1:: 'a set. P1 T1 \<and> E1 = f1 T1) \<and> (\<exists>T2:: 'a set. P2 T2 \<and> E2 = f2 T2) \<and>
              R E1 E2) \<longleftrightarrow> (\<exists>T1 T2. P1 T1 \<and> P2 T2 \<and> R(f1 T1) (f2 T2))" for P1 f1 P2 f2 R
     by auto
   show ?thesis
     unfolding connectedin_def connected_space_closedin closedin_subtopology topspace_subtopology *
     by (intro conj_cong arg_cong [where f=Not] ex_cong1; blast dest!: openin_subset)
 qed
 
 lemma connectedin_empty [simp]: "connectedin X {}"
   by (simp add: connectedin)
 
 lemma connected_space_topspace_empty:
      "topspace X = {} \<Longrightarrow> connected_space X"
   using connectedin_topspace by fastforce
 
 lemma connectedin_sing [simp]: "connectedin X {a} \<longleftrightarrow> a \<in> topspace X"
   by (simp add: connectedin)
 
 lemma connectedin_absolute [simp]:
   "connectedin (subtopology X S) S \<longleftrightarrow> connectedin X S"
   by (simp add: connectedin_subtopology)
 
 lemma connectedin_Union:
   assumes \<U>: "\<And>S. S \<in> \<U> \<Longrightarrow> connectedin X S" and ne: "\<Inter>\<U> \<noteq> {}"
   shows "connectedin X (\<Union>\<U>)"
 proof -
   have "\<Union>\<U> \<subseteq> topspace X"
     using \<U> by (simp add: Union_least connectedin_def)
   moreover have False
     if "openin X E1" "openin X E2" and cover: "\<Union>\<U> \<subseteq> E1 \<union> E2" and disj: "E1 \<inter> E2 \<inter> \<Union>\<U> = {}"
        and overlap1: "E1 \<inter> \<Union>\<U> \<noteq> {}" and overlap2: "E2 \<inter> \<Union>\<U> \<noteq> {}"
       for E1 E2
   proof -
     have disjS: "E1 \<inter> E2 \<inter> S = {}" if "S \<in> \<U>" for S
       using Diff_triv that disj by auto
     have coverS: "S \<subseteq> E1 \<union> E2" if "S \<in> \<U>" for S
       using that cover by blast
     have "\<U> \<noteq> {}"
       using overlap1 by blast
     obtain a where a: "\<And>U. U \<in> \<U> \<Longrightarrow> a \<in> U"
       using ne by force
     with \<open>\<U> \<noteq> {}\<close> have "a \<in> \<Union>\<U>"
       by blast
     then consider "a \<in> E1" | "a \<in> E2"
       using \<open>\<Union>\<U> \<subseteq> E1 \<union> E2\<close> by auto
     then show False
     proof cases
       case 1
       then obtain b S where "b \<in> E2" "b \<in> S" "S \<in> \<U>"
         using overlap2 by blast
       then show ?thesis
         using "1" \<open>openin X E1\<close> \<open>openin X E2\<close> disjS coverS a [OF \<open>S \<in> \<U>\<close>]  \<U>[OF \<open>S \<in> \<U>\<close>]
         unfolding connectedin
         by (meson disjoint_iff_not_equal)
     next
       case 2
       then obtain b S where "b \<in> E1" "b \<in> S" "S \<in> \<U>"
         using overlap1 by blast
       then show ?thesis
         using "2" \<open>openin X E1\<close> \<open>openin X E2\<close> disjS coverS a [OF \<open>S \<in> \<U>\<close>]  \<U>[OF \<open>S \<in> \<U>\<close>]
         unfolding connectedin
         by (meson disjoint_iff_not_equal)
     qed
   qed
   ultimately show ?thesis
     unfolding connectedin by blast
 qed
 
 lemma connectedin_Un:
      "\<lbrakk>connectedin X S; connectedin X T; S \<inter> T \<noteq> {}\<rbrakk> \<Longrightarrow> connectedin X (S \<union> T)"
   using connectedin_Union [of "{S,T}"] by auto
 
 lemma connected_space_subconnected:
   "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. \<exists>S. connectedin X S \<and> x \<in> S \<and> y \<in> S)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     using connectedin_topspace by blast
 next
   assume R [rule_format]: ?rhs
   have False if "openin X U" "openin X V" and disj: "U \<inter> V = {}" and cover: "topspace X \<subseteq> U \<union> V"
     and "U \<noteq> {}" "V \<noteq> {}" for U V
   proof -
     obtain u v where "u \<in> U" "v \<in> V"
       using \<open>U \<noteq> {}\<close> \<open>V \<noteq> {}\<close> by auto
     then obtain T where "u \<in> T" "v \<in> T" and T: "connectedin X T"
       using R [of u v] that
       by (meson \<open>openin X U\<close> \<open>openin X V\<close> subsetD openin_subset)
     then show False
       using that unfolding connectedin
       by (metis IntI \<open>u \<in> U\<close> \<open>v \<in> V\<close> empty_iff inf_bot_left subset_trans)
   qed
   then show ?lhs
     by (auto simp: connected_space_def)
 qed
 
 lemma connectedin_intermediate_closure_of:
   assumes "connectedin X S" "S \<subseteq> T" "T \<subseteq> X closure_of S"
   shows "connectedin X T"
 proof -
   have S: "S \<subseteq> topspace X" and T: "T \<subseteq> topspace X"
     using assms by (meson closure_of_subset_topspace dual_order.trans)+
   have \<section>: "\<And>E1 E2. \<lbrakk>openin X E1; openin X E2; E1 \<inter> S = {} \<or> E2 \<inter> S = {}\<rbrakk> \<Longrightarrow> E1 \<inter> T = {} \<or> E2 \<inter> T = {}"
     using assms unfolding disjoint_iff by (meson in_closure_of subsetD)
   then show ?thesis
     using assms
     unfolding connectedin closure_of_subset_topspace S T
     by (metis Int_empty_right T dual_order.trans inf.orderE inf_left_commute)
 qed
 
 lemma connectedin_closure_of:
      "connectedin X S \<Longrightarrow> connectedin X (X closure_of S)"
   by (meson closure_of_subset connectedin_def connectedin_intermediate_closure_of subset_refl)
 
 lemma connectedin_separation:
   "connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
         (\<nexists>C1 C2. C1 \<union> C2 = S \<and> C1 \<noteq> {} \<and> C2 \<noteq> {} \<and> C1 \<inter> X closure_of C2 = {} \<and> C2 \<inter> X closure_of C1 = {})" 
   unfolding connectedin_def connected_space_closedin_eq closedin_Int_closure_of topspace_subtopology
   apply (intro conj_cong refl arg_cong [where f=Not])
   apply (intro ex_cong1 iffI, blast)
   using closure_of_subset_Int by force
 
 lemma connectedin_eq_not_separated:
    "connectedin X S \<longleftrightarrow>
          S \<subseteq> topspace X \<and>
          (\<nexists>C1 C2. C1 \<union> C2 = S \<and> C1 \<noteq> {} \<and> C2 \<noteq> {} \<and> separatedin X C1 C2)"
   unfolding separatedin_def by (metis connectedin_separation sup.boundedE)
 
 lemma connectedin_eq_not_separated_subset:
   "connectedin X S \<longleftrightarrow>
       S \<subseteq> topspace X \<and> (\<nexists>C1 C2. S \<subseteq> C1 \<union> C2 \<and> S \<inter> C1 \<noteq> {} \<and> S \<inter> C2 \<noteq> {} \<and> separatedin X C1 C2)"
 proof -
   have "\<forall>C1 C2. S \<subseteq> C1 \<union> C2 \<longrightarrow> S \<inter> C1 = {} \<or> S \<inter> C2 = {} \<or> \<not> separatedin X C1 C2"
     if "\<And>C1 C2. C1 \<union> C2 = S \<longrightarrow> C1 = {} \<or> C2 = {} \<or> \<not> separatedin X C1 C2"
   proof (intro allI)
     fix C1 C2
     show "S \<subseteq> C1 \<union> C2 \<longrightarrow> S \<inter> C1 = {} \<or> S \<inter> C2 = {} \<or> \<not> separatedin X C1 C2"
       using that [of "S \<inter> C1" "S \<inter> C2"]
       by (auto simp: separatedin_mono)
   qed
   then show ?thesis
     by (metis Un_Int_eq(1) Un_Int_eq(2) connectedin_eq_not_separated order_refl)
 qed
 
 lemma connected_space_eq_not_separated:
      "connected_space X \<longleftrightarrow>
       (\<nexists>C1 C2. C1 \<union> C2 = topspace X \<and> C1 \<noteq> {} \<and> C2 \<noteq> {} \<and> separatedin X C1 C2)"
   by (simp add: connectedin_eq_not_separated flip: connectedin_topspace)
 
 lemma connected_space_eq_not_separated_subset:
   "connected_space X \<longleftrightarrow>
     (\<nexists>C1 C2. topspace X \<subseteq> C1 \<union> C2 \<and> C1 \<noteq> {} \<and> C2 \<noteq> {} \<and> separatedin X C1 C2)"
   by (metis connected_space_eq_not_separated le_sup_iff separatedin_def subset_antisym)
 
 lemma connectedin_subset_separated_union:
      "\<lbrakk>connectedin X C; separatedin X S T; C \<subseteq> S \<union> T\<rbrakk> \<Longrightarrow> C \<subseteq> S \<or> C \<subseteq> T"
   unfolding connectedin_eq_not_separated_subset  by blast
 
 lemma connectedin_nonseparated_union:
   assumes "connectedin X S" "connectedin X T" "\<not>separatedin X S T"
   shows "connectedin X (S \<union> T)"
 proof -
   have "\<And>C1 C2. \<lbrakk>T \<subseteq> C1 \<union> C2; S \<subseteq> C1 \<union> C2\<rbrakk> \<Longrightarrow>
            S \<inter> C1 = {} \<and> T \<inter> C1 = {} \<or> S \<inter> C2 = {} \<and> T \<inter> C2 = {} \<or> \<not> separatedin X C1 C2"
     using assms
     unfolding connectedin_eq_not_separated_subset
     by (metis (no_types, lifting) assms connectedin_subset_separated_union inf.orderE separatedin_empty(1) separatedin_mono separatedin_sym)
   then show ?thesis
     unfolding connectedin_eq_not_separated_subset
     by (simp add: assms connectedin_subset_topspace Int_Un_distrib2)
 qed
 
 lemma connected_space_closures:
      "connected_space X \<longleftrightarrow>
         (\<nexists>e1 e2. e1 \<union> e2 = topspace X \<and> X closure_of e1 \<inter> X closure_of e2 = {} \<and> e1 \<noteq> {} \<and> e2 \<noteq> {})"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding connected_space_closedin_eq
     by (metis Un_upper1 Un_upper2 closedin_closure_of closure_of_Un closure_of_eq_empty closure_of_topspace)
 next
   assume ?rhs
   then show ?lhs
     unfolding connected_space_closedin_eq
     by (metis closure_of_eq)
 qed
 
 lemma connectedin_Int_frontier_of:
   assumes "connectedin X S" "S \<inter> T \<noteq> {}" "S - T \<noteq> {}"
   shows "S \<inter> X frontier_of T \<noteq> {}"
 proof -
   have "S \<subseteq> topspace X" and *:
     "\<And>E1 E2. openin X E1 \<longrightarrow> openin X E2 \<longrightarrow> E1 \<inter> E2 \<inter> S = {} \<longrightarrow> S \<subseteq> E1 \<union> E2 \<longrightarrow> E1 \<inter> S = {} \<or> E2 \<inter> S = {}"
     using \<open>connectedin X S\<close> by (auto simp: connectedin)
   moreover
   have "S - (topspace X \<inter> T) \<noteq> {}"
     using assms(3) by blast
   moreover
   have "S \<inter> topspace X \<inter> T \<noteq> {}"
     using assms connectedin by fastforce
   moreover
   have False if "S \<inter> T \<noteq> {}" "S - T \<noteq> {}" "T \<subseteq> topspace X" "S \<inter> X frontier_of T = {}" for T
   proof -
     have null: "S \<inter> (X closure_of T - X interior_of T) = {}"
       using that unfolding frontier_of_def by blast
     have "X interior_of T \<inter> (topspace X - X closure_of T) \<inter> S = {}"
       by (metis Diff_disjoint inf_bot_left interior_of_Int interior_of_complement interior_of_empty)
     moreover have "S \<subseteq> X interior_of T \<union> (topspace X - X closure_of T)"
       using that \<open>S \<subseteq> topspace X\<close> null by auto
     moreover have "S \<inter> X interior_of T \<noteq> {}"
       using closure_of_subset that(1) that(3) null by fastforce
     ultimately have "S \<inter> X interior_of (topspace X - T) = {}"
       by (metis "*" inf_commute interior_of_complement openin_interior_of)
     then have "topspace (subtopology X S) \<inter> X interior_of T = S"
       using \<open>S \<subseteq> topspace X\<close> interior_of_complement null by fastforce
     then show ?thesis
       using that by (metis Diff_eq_empty_iff inf_le2 interior_of_subset subset_trans)
   qed
   ultimately show ?thesis
     by (metis Int_lower1 frontier_of_restrict inf_assoc)
 qed
 
 lemma connectedin_continuous_map_image:
   assumes f: "continuous_map X Y f" and "connectedin X S"
   shows "connectedin Y (f ` S)"
 proof -
   have "S \<subseteq> topspace X" and *:
     "\<And>E1 E2. openin X E1 \<longrightarrow> openin X E2 \<longrightarrow> E1 \<inter> E2 \<inter> S = {} \<longrightarrow> S \<subseteq> E1 \<union> E2 \<longrightarrow> E1 \<inter> S = {} \<or> E2 \<inter> S = {}"
     using \<open>connectedin X S\<close> by (auto simp: connectedin)
   show ?thesis
     unfolding connectedin connected_space_def
   proof (intro conjI notI; clarify)
     show "f x \<in> topspace Y" if  "x \<in> S" for x
       using \<open>S \<subseteq> topspace X\<close> continuous_map_image_subset_topspace f that by blast
   next
     fix U V
     let ?U = "{x \<in> topspace X. f x \<in> U}"
     let ?V = "{x \<in> topspace X. f x \<in> V}"
     assume UV: "openin Y U" "openin Y V" "f ` S \<subseteq> U \<union> V" "U \<inter> V \<inter> f ` S = {}" "U \<inter> f ` S \<noteq> {}" "V \<inter> f ` S \<noteq> {}"
     then have 1: "?U \<inter> ?V \<inter> S = {}"
       by auto
     have 2: "openin X ?U" "openin X ?V"
       using \<open>openin Y U\<close> \<open>openin Y V\<close> continuous_map f by fastforce+
     show "False"
       using * [of ?U ?V] UV \<open>S \<subseteq> topspace X\<close>
       by (auto simp: 1 2)
   qed
 qed
 
 lemma connected_space_quotient_map_image:
    "\<lbrakk>quotient_map X X' q; connected_space X\<rbrakk> \<Longrightarrow> connected_space X'"
   by (metis connectedin_continuous_map_image connectedin_topspace quotient_imp_continuous_map quotient_imp_surjective_map)
 
 lemma homeomorphic_connected_space:
      "X homeomorphic_space Y \<Longrightarrow> connected_space X \<longleftrightarrow> connected_space Y"
   unfolding homeomorphic_space_def homeomorphic_maps_def
   by (metis connected_space_subconnected connectedin_continuous_map_image connectedin_topspace continuous_map_image_subset_topspace image_eqI image_subset_iff)
 
 lemma homeomorphic_map_connectedness:
   assumes f: "homeomorphic_map X Y f" and U: "U \<subseteq> topspace X"
   shows "connectedin Y (f ` U) \<longleftrightarrow> connectedin X U"
 proof -
   have 1: "f ` U \<subseteq> topspace Y \<longleftrightarrow> U \<subseteq> topspace X"
     using U f homeomorphic_imp_surjective_map by blast
   moreover have "connected_space (subtopology Y (f ` U)) \<longleftrightarrow> connected_space (subtopology X U)"
   proof (rule homeomorphic_connected_space)
     have "f ` U \<subseteq> topspace Y"
       by (simp add: U 1)
     then have "topspace Y \<inter> f ` U = f ` U"
       by (simp add: subset_antisym)
     then show "subtopology Y (f ` U) homeomorphic_space subtopology X U"
       by (metis U f homeomorphic_map_imp_homeomorphic_space homeomorphic_map_subtopologies homeomorphic_space_sym inf.absorb_iff2)
   qed
   ultimately show ?thesis
     by (auto simp: connectedin_def)
 qed
 
 lemma homeomorphic_map_connectedness_eq:
    "homeomorphic_map X Y f
         \<Longrightarrow> connectedin X U \<longleftrightarrow>
              U \<subseteq> topspace X \<and> connectedin Y (f ` U)"
   using homeomorphic_map_connectedness connectedin_subset_topspace by metis
 
 lemma connectedin_discrete_topology:
    "connectedin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U \<and> (\<exists>a. S \<subseteq> {a})"
 proof (cases "S \<subseteq> U")
   case True
   show ?thesis
   proof (cases "S = {}")
     case False
     moreover have "connectedin (discrete_topology U) S \<longleftrightarrow> (\<exists>a. S = {a})"
     proof
       show "connectedin (discrete_topology U) S \<Longrightarrow> \<exists>a. S = {a}"
         using False connectedin_Int_frontier_of insert_Diff by fastforce
     qed (use True in auto)
     ultimately show ?thesis
       by auto
   qed simp
 next
   case False
   then show ?thesis
     by (simp add: connectedin_def)
 qed
 
 lemma connected_space_discrete_topology:
      "connected_space (discrete_topology U) \<longleftrightarrow> (\<exists>a. U \<subseteq> {a})"
   by (metis connectedin_discrete_topology connectedin_topspace order_refl topspace_discrete_topology)
 
 
 subsection\<open>Compact sets\<close>
 
 definition compactin where
  "compactin X S \<longleftrightarrow>
      S \<subseteq> topspace X \<and>
      (\<forall>\<U>. (\<forall>U \<in> \<U>. openin X U) \<and> S \<subseteq> \<Union>\<U>
           \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>))"
 
 definition compact_space where
    "compact_space X \<equiv> compactin X (topspace X)"
 
 lemma compact_space_alt:
    "compact_space X \<longleftrightarrow>
         (\<forall>\<U>. (\<forall>U \<in> \<U>. openin X U) \<and> topspace X \<subseteq> \<Union>\<U>
             \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> topspace X \<subseteq> \<Union>\<F>))"
   by (simp add: compact_space_def compactin_def)
 
 lemma compact_space:
    "compact_space X \<longleftrightarrow>
         (\<forall>\<U>. (\<forall>U \<in> \<U>. openin X U) \<and> \<Union>\<U> = topspace X
             \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> \<Union>\<F> = topspace X))"
   unfolding compact_space_alt
   using openin_subset by fastforce
 
 lemma compactinD:
   "\<lbrakk>compactin X S; \<And>U. U \<in> \<U> \<Longrightarrow> openin X U; S \<subseteq> \<Union>\<U>\<rbrakk> \<Longrightarrow> \<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>"
   by (auto simp: compactin_def)
 
 lemma compactin_euclidean_iff [simp]: "compactin euclidean S \<longleftrightarrow> compact S"
   by (simp add: compact_eq_Heine_Borel compactin_def) meson
 
 lemma compactin_absolute [simp]:
    "compactin (subtopology X S) S \<longleftrightarrow> compactin X S"
 proof -
   have eq: "(\<forall>U \<in> \<U>. \<exists>Y. openin X Y \<and> U = Y \<inter> S) \<longleftrightarrow> \<U> \<subseteq> (\<lambda>Y. Y \<inter> S) ` {y. openin X y}" for \<U>
     by auto
   show ?thesis
     by (auto simp: compactin_def openin_subtopology eq imp_conjL all_subset_image ex_finite_subset_image)
 qed
 
 lemma compactin_subspace: "compactin X S \<longleftrightarrow> S \<subseteq> topspace X \<and> compact_space (subtopology X S)"
   unfolding compact_space_def topspace_subtopology
   by (metis compactin_absolute compactin_def inf.absorb2)
 
 lemma compact_space_subtopology: "compactin X S \<Longrightarrow> compact_space (subtopology X S)"
   by (simp add: compactin_subspace)
 
 lemma compactin_subtopology: "compactin (subtopology X S) T \<longleftrightarrow> compactin X T \<and> T \<subseteq> S"
   by (metis compactin_subspace inf.absorb_iff2 le_inf_iff subtopology_subtopology topspace_subtopology)
 
 lemma compactin_subset_topspace: "compactin X S \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: compactin_subspace)
 
 lemma compactin_contractive:
    "\<lbrakk>compactin X' S; topspace X' = topspace X;
      \<And>U. openin X U \<Longrightarrow> openin X' U\<rbrakk> \<Longrightarrow> compactin X S"
   by (simp add: compactin_def)
 
 lemma finite_imp_compactin:
    "\<lbrakk>S \<subseteq> topspace X; finite S\<rbrakk> \<Longrightarrow> compactin X S"
   by (metis compactin_subspace compact_space finite_UnionD inf.absorb_iff2 order_refl topspace_subtopology)
 
 lemma compactin_empty [iff]: "compactin X {}"
   by (simp add: finite_imp_compactin)
 
 lemma compact_space_topspace_empty:
    "topspace X = {} \<Longrightarrow> compact_space X"
   by (simp add: compact_space_def)
 
 lemma finite_imp_compactin_eq:
    "finite S \<Longrightarrow> (compactin X S \<longleftrightarrow> S \<subseteq> topspace X)"
   using compactin_subset_topspace finite_imp_compactin by blast
 
 lemma compactin_sing [simp]: "compactin X {a} \<longleftrightarrow> a \<in> topspace X"
   by (simp add: finite_imp_compactin_eq)
 
 lemma closed_compactin:
   assumes XK: "compactin X K" and "C \<subseteq> K" and XC: "closedin X C"
   shows "compactin X C"
   unfolding compactin_def
 proof (intro conjI allI impI)
   show "C \<subseteq> topspace X"
     by (simp add: XC closedin_subset)
 next
   fix \<U> :: "'a set set"
   assume \<U>: "Ball \<U> (openin X) \<and> C \<subseteq> \<Union>\<U>"
   have "(\<forall>U\<in>insert (topspace X - C) \<U>. openin X U)"
     using XC \<U> by blast
   moreover have "K \<subseteq> \<Union>(insert (topspace X - C) \<U>)"
     using \<U> XK compactin_subset_topspace by fastforce
   ultimately obtain \<F> where "finite \<F>" "\<F> \<subseteq> insert (topspace X - C) \<U>" "K \<subseteq> \<Union>\<F>"
     using assms unfolding compactin_def by metis
   moreover have "openin X (topspace X - C)"
     using XC by auto
   ultimately show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> C \<subseteq> \<Union>\<F>"
     using \<open>C \<subseteq> K\<close>
     by (rule_tac x="\<F> - {topspace X - C}" in exI) auto
 qed
 
+lemma closed_compactin_Inter:
+  "\<lbrakk>compactin X K; K \<in> \<K>; \<And>K. K \<in> \<K> \<Longrightarrow> closedin X K\<rbrakk> \<Longrightarrow> compactin X (\<Inter>\<K>)"
+  by (metis Inf_lower closed_compactin closedin_Inter empty_iff)
+
+lemma closedin_subtopology_Int_subset:
+   "\<lbrakk>closedin (subtopology X U) (U \<inter> S); V \<subseteq> U\<rbrakk> \<Longrightarrow> closedin (subtopology X V) (V \<inter> S)"
+  by (smt (verit, ccfv_SIG) closedin_subtopology inf.left_commute inf.orderE inf_commute)
+
+lemma closedin_subtopology_Int_closedin:
+   "\<lbrakk>closedin (subtopology X U) S; closedin X T\<rbrakk> \<Longrightarrow> closedin (subtopology X U) (S \<inter> T)"
+  by (smt (verit, best) closedin_Int closedin_subtopology inf_assoc inf_commute)
+
 lemma closedin_compact_space:
    "\<lbrakk>compact_space X; closedin X S\<rbrakk> \<Longrightarrow> compactin X S"
   by (simp add: closed_compactin closedin_subset compact_space_def)
 
 lemma compact_Int_closedin:
   assumes "compactin X S" "closedin X T" shows "compactin X (S \<inter> T)"
 proof -
   have "compactin (subtopology X S) (S \<inter> T)"
     by (metis assms closedin_compact_space closedin_subtopology compactin_subspace inf_commute)
   then show ?thesis
     by (simp add: compactin_subtopology)
 qed
 
 lemma closed_Int_compactin: "\<lbrakk>closedin X S; compactin X T\<rbrakk> \<Longrightarrow> compactin X (S \<inter> T)"
   by (metis compact_Int_closedin inf_commute)
 
 lemma compactin_Un:
   assumes S: "compactin X S" and T: "compactin X T" shows "compactin X (S \<union> T)"
   unfolding compactin_def
 proof (intro conjI allI impI)
   show "S \<union> T \<subseteq> topspace X"
     using assms by (auto simp: compactin_def)
 next
   fix \<U> :: "'a set set"
   assume \<U>: "Ball \<U> (openin X) \<and> S \<union> T \<subseteq> \<Union>\<U>"
   with S obtain \<F> where \<V>: "finite \<F>" "\<F> \<subseteq> \<U>" "S \<subseteq> \<Union>\<F>"
     unfolding compactin_def by (meson sup.bounded_iff)
   obtain \<W> where "finite \<W>" "\<W> \<subseteq> \<U>" "T \<subseteq> \<Union>\<W>"
     using \<U> T
     unfolding compactin_def by (meson sup.bounded_iff)
   with \<V> show "\<exists>\<V>. finite \<V> \<and> \<V> \<subseteq> \<U> \<and> S \<union> T \<subseteq> \<Union>\<V>"
     by (rule_tac x="\<F> \<union> \<W>" in exI) auto
 qed
 
 lemma compactin_Union:
    "\<lbrakk>finite \<F>; \<And>S. S \<in> \<F> \<Longrightarrow> compactin X S\<rbrakk> \<Longrightarrow> compactin X (\<Union>\<F>)"
 by (induction rule: finite_induct) (simp_all add: compactin_Un)
 
 lemma compactin_subtopology_imp_compact:
   assumes "compactin (subtopology X S) K" shows "compactin X K"
   using assms
 proof (clarsimp simp add: compactin_def)
   fix \<U>
   define \<V> where "\<V> \<equiv> (\<lambda>U. U \<inter> S) ` \<U>"
   assume "K \<subseteq> topspace X" and "K \<subseteq> S" and "\<forall>x\<in>\<U>. openin X x" and "K \<subseteq> \<Union>\<U>"
   then have "\<forall>V \<in> \<V>. openin (subtopology X S) V" "K \<subseteq> \<Union>\<V>"
     unfolding \<V>_def by (auto simp: openin_subtopology)
   moreover
   assume "\<forall>\<U>. (\<forall>x\<in>\<U>. openin (subtopology X S) x) \<and> K \<subseteq> \<Union>\<U> \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union>\<F>)"
   ultimately obtain \<F> where "finite \<F>" "\<F> \<subseteq> \<V>" "K \<subseteq> \<Union>\<F>"
     by meson
   then have \<F>: "\<exists>U. U \<in> \<U> \<and> V = U \<inter> S" if "V \<in> \<F>" for V
     unfolding \<V>_def using that by blast
   let ?\<F> = "(\<lambda>F. @U. U \<in> \<U> \<and> F = U \<inter> S) ` \<F>"
   show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union>\<F>"
   proof (intro exI conjI)
     show "finite ?\<F>"
       using \<open>finite \<F>\<close> by blast
     show "?\<F> \<subseteq> \<U>"
       using someI_ex [OF \<F>] by blast
     show "K \<subseteq> \<Union>?\<F>"
     proof clarsimp
       fix x
       assume "x \<in> K"
       then show "\<exists>V \<in> \<F>. x \<in> (SOME U. U \<in> \<U> \<and> V = U \<inter> S)"
         using \<open>K \<subseteq> \<Union>\<F>\<close> someI_ex [OF \<F>]
         by (metis (no_types, lifting) IntD1 Union_iff subsetCE)
     qed
   qed
 qed
 
 lemma compact_imp_compactin_subtopology:
   assumes "compactin X K" "K \<subseteq> S" shows "compactin (subtopology X S) K"
   using assms
 proof (clarsimp simp add: compactin_def)
   fix \<U> :: "'a set set"
   define \<V> where "\<V> \<equiv> {V. openin X V \<and> (\<exists>U \<in> \<U>. U = V \<inter> S)}"
   assume "K \<subseteq> S" and "K \<subseteq> topspace X" and "\<forall>U\<in>\<U>. openin (subtopology X S) U" and "K \<subseteq> \<Union>\<U>"
   then have "\<forall>V \<in> \<V>. openin X V" "K \<subseteq> \<Union>\<V>"
     unfolding \<V>_def by (fastforce simp: subset_eq openin_subtopology)+
   moreover
   assume "\<forall>\<U>. (\<forall>U\<in>\<U>. openin X U) \<and> K \<subseteq> \<Union>\<U> \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union>\<F>)"
   ultimately obtain \<F> where "finite \<F>" "\<F> \<subseteq> \<V>" "K \<subseteq> \<Union>\<F>"
     by meson
   let ?\<F> = "(\<lambda>F. F \<inter> S) ` \<F>"
   show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union>\<F>"
   proof (intro exI conjI)
     show "finite ?\<F>"
       using \<open>finite \<F>\<close> by blast
     show "?\<F> \<subseteq> \<U>"
       using \<V>_def \<open>\<F> \<subseteq> \<V>\<close> by blast
     show "K \<subseteq> \<Union>?\<F>"
       using \<open>K \<subseteq> \<Union>\<F>\<close> assms(2) by auto
   qed
 qed
 
 
 proposition compact_space_fip:
    "compact_space X \<longleftrightarrow>
     (\<forall>\<U>. (\<forall>C\<in>\<U>. closedin X C) \<and> (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> \<Inter>\<F> \<noteq> {}) \<longrightarrow> \<Inter>\<U> \<noteq> {})"
    (is "_ = ?rhs")
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     unfolding compact_space_def
     by (metis Sup_bot_conv(1) closedin_topspace_empty compactin_empty finite.emptyI finite_UnionD order_refl)
 next
   case False
   show ?thesis
   proof safe
     fix \<U> :: "'a set set"
     assume * [rule_format]: "\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> \<Inter>\<F> \<noteq> {}"
     define \<V> where "\<V> \<equiv> (\<lambda>S. topspace X - S) ` \<U>"
     assume clo: "\<forall>C\<in>\<U>. closedin X C" and [simp]: "\<Inter>\<U> = {}"
     then have "\<forall>V \<in> \<V>. openin X V" "topspace X \<subseteq> \<Union>\<V>"
       by (auto simp: \<V>_def)
     moreover assume [unfolded compact_space_alt, rule_format, of \<V>]: "compact_space X"
     ultimately obtain \<F> where \<F>: "finite \<F>" "\<F> \<subseteq> \<U>" "topspace X \<subseteq> topspace X - \<Inter>\<F>"
       by (auto simp: ex_finite_subset_image \<V>_def)
     moreover have "\<F> \<noteq> {}"
       using \<F> \<open>topspace X \<noteq> {}\<close> by blast
     ultimately show "False"
       using * [of \<F>]
       by auto (metis Diff_iff Inter_iff clo closedin_def subsetD)
   next
     assume R [rule_format]: ?rhs
     show "compact_space X"
       unfolding compact_space_alt
     proof clarify
       fix \<U> :: "'a set set"
       define \<V> where "\<V> \<equiv> (\<lambda>S. topspace X - S) ` \<U>"
       assume "\<forall>C\<in>\<U>. openin X C" and "topspace X \<subseteq> \<Union>\<U>"
       with \<open>topspace X \<noteq> {}\<close> have *: "\<forall>V \<in> \<V>. closedin X V" "\<U> \<noteq> {}"
         by (auto simp: \<V>_def)
       show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> topspace X \<subseteq> \<Union>\<F>"
       proof (rule ccontr; simp)
         assume "\<forall>\<F>\<subseteq>\<U>. finite \<F> \<longrightarrow> \<not> topspace X \<subseteq> \<Union>\<F>"
         then have "\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<V> \<longrightarrow> \<Inter>\<F> \<noteq> {}"
           by (simp add: \<V>_def all_finite_subset_image)
         with \<open>topspace X \<subseteq> \<Union>\<U>\<close> show False
           using R [of \<V>] * by (simp add: \<V>_def)
       qed
     qed
   qed
 qed
 
 corollary compactin_fip:
   "compactin X S \<longleftrightarrow>
     S \<subseteq> topspace X \<and>
     (\<forall>\<U>. (\<forall>C\<in>\<U>. closedin X C) \<and> (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> S \<inter> \<Inter>\<F> \<noteq> {}) \<longrightarrow> S \<inter> \<Inter>\<U> \<noteq> {})"
 proof (cases "S = {}")
   case False
   show ?thesis
   proof (cases "S \<subseteq> topspace X")
     case True
     then have "compactin X S \<longleftrightarrow>
           (\<forall>\<U>. \<U> \<subseteq> (\<lambda>T. S \<inter> T) ` {T. closedin X T} \<longrightarrow>
            (\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> \<U> \<longrightarrow> \<Inter>\<F> \<noteq> {}) \<longrightarrow> \<Inter>\<U> \<noteq> {})"
       by (simp add: compact_space_fip compactin_subspace closedin_subtopology image_def subset_eq Int_commute imp_conjL)
     also have "\<dots> = (\<forall>\<U>\<subseteq>Collect (closedin X). (\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> (\<inter>) S ` \<U> \<longrightarrow> \<Inter>\<F> \<noteq> {}) \<longrightarrow> \<Inter> ((\<inter>) S ` \<U>) \<noteq> {})"
       by (simp add: all_subset_image)
     also have "\<dots> = (\<forall>\<U>. (\<forall>C\<in>\<U>. closedin X C) \<and> (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> S \<inter> \<Inter>\<F> \<noteq> {}) \<longrightarrow> S \<inter> \<Inter>\<U> \<noteq> {})"
     proof -
       have eq: "((\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> \<Inter> ((\<inter>) S ` \<F>) \<noteq> {}) \<longrightarrow> \<Inter> ((\<inter>) S ` \<U>) \<noteq> {}) \<longleftrightarrow>
                 ((\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> S \<inter> \<Inter>\<F> \<noteq> {}) \<longrightarrow> S \<inter> \<Inter>\<U> \<noteq> {})"  for \<U>
         by simp (use \<open>S \<noteq> {}\<close> in blast)
       show ?thesis
         unfolding imp_conjL [symmetric] all_finite_subset_image eq by blast
     qed
     finally show ?thesis
       using True by simp
   qed (simp add: compactin_subspace)
 qed force
 
 corollary compact_space_imp_nest:
   fixes C :: "nat \<Rightarrow> 'a set"
   assumes "compact_space X" and clo: "\<And>n. closedin X (C n)"
     and ne: "\<And>n. C n \<noteq> {}" and dec: "decseq C"
   shows "(\<Inter>n. C n) \<noteq> {}"
 proof -
   let ?\<U> = "range (\<lambda>n. \<Inter>m \<le> n. C m)"
   have "closedin X A" if "A \<in> ?\<U>" for A
     using that clo by auto
   moreover have "(\<Inter>n\<in>K. \<Inter>m \<le> n. C m) \<noteq> {}" if "finite K" for K
   proof -
     obtain n where "\<And>k. k \<in> K \<Longrightarrow> k \<le> n"
       using Max.coboundedI \<open>finite K\<close> by blast
     with dec have "C n \<subseteq> (\<Inter>n\<in>K. \<Inter>m \<le> n. C m)"
       unfolding decseq_def by blast
   with ne [of n] show ?thesis
     by blast
   qed
   ultimately show ?thesis
     using \<open>compact_space X\<close> [unfolded compact_space_fip, rule_format, of ?\<U>]
     by (simp add: all_finite_subset_image INT_extend_simps UN_atMost_UNIV del: INT_simps)
 qed
 
 lemma compactin_discrete_topology:
    "compactin (discrete_topology X) S \<longleftrightarrow> S \<subseteq> X \<and> finite S" (is "?lhs = ?rhs")
 proof (intro iffI conjI)
   assume L: ?lhs
   then show "S \<subseteq> X"
     by (auto simp: compactin_def)
   have *: "\<And>\<U>. Ball \<U> (openin (discrete_topology X)) \<and> S \<subseteq> \<Union>\<U> \<Longrightarrow>
         (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>)"
     using L by (auto simp: compactin_def)
   show "finite S"
     using * [of "(\<lambda>x. {x}) ` X"] \<open>S \<subseteq> X\<close>
     by clarsimp (metis UN_singleton finite_subset_image infinite_super)
 next
   assume ?rhs
   then show ?lhs
     by (simp add: finite_imp_compactin)
 qed
 
 lemma compact_space_discrete_topology: "compact_space(discrete_topology X) \<longleftrightarrow> finite X"
   by (simp add: compactin_discrete_topology compact_space_def)
 
 lemma compact_space_imp_Bolzano_Weierstrass:
   assumes "compact_space X" "infinite S" "S \<subseteq> topspace X"
   shows "X derived_set_of S \<noteq> {}"
 proof
   assume X: "X derived_set_of S = {}"
   then have "closedin X S"
     by (simp add: closedin_contains_derived_set assms)
   then have "compactin X S"
     by (rule closedin_compact_space [OF \<open>compact_space X\<close>])
   with X show False
     by (metis \<open>infinite S\<close> compactin_subspace compact_space_discrete_topology inf_bot_right subtopology_eq_discrete_topology_eq)
 qed
 
 lemma compactin_imp_Bolzano_Weierstrass:
    "\<lbrakk>compactin X S; infinite T \<and> T \<subseteq> S\<rbrakk> \<Longrightarrow> S \<inter> X derived_set_of T \<noteq> {}"
   using compact_space_imp_Bolzano_Weierstrass [of "subtopology X S"]
   by (simp add: compactin_subspace derived_set_of_subtopology inf_absorb2)
 
 lemma compact_closure_of_imp_Bolzano_Weierstrass:
    "\<lbrakk>compactin X (X closure_of S); infinite T; T \<subseteq> S; T \<subseteq> topspace X\<rbrakk> \<Longrightarrow> X derived_set_of T \<noteq> {}"
   using closure_of_mono closure_of_subset compactin_imp_Bolzano_Weierstrass by fastforce
 
 lemma discrete_compactin_eq_finite:
    "S \<inter> X derived_set_of S = {} \<Longrightarrow> compactin X S \<longleftrightarrow> S \<subseteq> topspace X \<and> finite S"
   by (meson compactin_imp_Bolzano_Weierstrass finite_imp_compactin_eq order_refl)
 
 lemma discrete_compact_space_eq_finite:
    "X derived_set_of (topspace X) = {} \<Longrightarrow> (compact_space X \<longleftrightarrow> finite(topspace X))"
   by (metis compact_space_discrete_topology discrete_topology_unique_derived_set)
 
 lemma image_compactin:
   assumes cpt: "compactin X S" and cont: "continuous_map X Y f"
   shows "compactin Y (f ` S)"
   unfolding compactin_def
 proof (intro conjI allI impI)
   show "f ` S \<subseteq> topspace Y"
     using compactin_subset_topspace cont continuous_map_image_subset_topspace cpt by blast
 next
   fix \<U> :: "'b set set"
   assume \<U>: "Ball \<U> (openin Y) \<and> f ` S \<subseteq> \<Union>\<U>"
   define \<V> where "\<V> \<equiv> (\<lambda>U. {x \<in> topspace X. f x \<in> U}) ` \<U>"
   have "S \<subseteq> topspace X"
     and *: "\<And>\<U>. \<lbrakk>\<forall>U\<in>\<U>. openin X U; S \<subseteq> \<Union>\<U>\<rbrakk> \<Longrightarrow> \<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>"
     using cpt by (auto simp: compactin_def)
   obtain \<F> where \<F>: "finite \<F>" "\<F> \<subseteq> \<V>" "S \<subseteq> \<Union>\<F>"
   proof -
     have 1: "\<forall>U\<in>\<V>. openin X U"
       unfolding \<V>_def using \<U> cont[unfolded continuous_map] by blast
     have 2: "S \<subseteq> \<Union>\<V>"
       unfolding \<V>_def using compactin_subset_topspace cpt \<U> by fastforce
     show thesis
       using * [OF 1 2] that by metis
   qed
   have "\<forall>v \<in> \<V>. \<exists>U. U \<in> \<U> \<and> v = {x \<in> topspace X. f x \<in> U}"
     using \<V>_def by blast
   then obtain U where U: "\<forall>v \<in> \<V>. U v \<in> \<U> \<and> v = {x \<in> topspace X. f x \<in> U v}"
     by metis
   show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> f ` S \<subseteq> \<Union>\<F>"
   proof (intro conjI exI)
     show "finite (U ` \<F>)"
       by (simp add: \<open>finite \<F>\<close>)
   next
     show "U ` \<F> \<subseteq> \<U>"
       using \<open>\<F> \<subseteq> \<V>\<close> U by auto
   next
     show "f ` S \<subseteq> \<Union> (U ` \<F>)"
       using \<F>(2-3) U UnionE subset_eq U by fastforce
   qed
 qed
 
 
 lemma homeomorphic_compact_space:
   assumes "X homeomorphic_space Y"
   shows "compact_space X \<longleftrightarrow> compact_space Y"
     using homeomorphic_space_sym
     by (metis assms compact_space_def homeomorphic_eq_everything_map homeomorphic_space image_compactin)
 
 lemma homeomorphic_map_compactness:
   assumes hom: "homeomorphic_map X Y f" and U: "U \<subseteq> topspace X"
   shows "compactin Y (f ` U) \<longleftrightarrow> compactin X U"
 proof -
   have "f ` U \<subseteq> topspace Y"
     using hom U homeomorphic_imp_surjective_map by blast
   moreover have "homeomorphic_map (subtopology X U) (subtopology Y (f ` U)) f"
     using U hom homeomorphic_imp_surjective_map by (blast intro: homeomorphic_map_subtopologies)
   then have "compact_space (subtopology Y (f ` U)) = compact_space (subtopology X U)"
     using homeomorphic_compact_space homeomorphic_map_imp_homeomorphic_space by blast
   ultimately show ?thesis
     by (simp add: compactin_subspace U)
 qed
 
 lemma homeomorphic_map_compactness_eq:
    "homeomorphic_map X Y f
         \<Longrightarrow> compactin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> compactin Y (f ` U)"
   by (meson compactin_subset_topspace homeomorphic_map_compactness)
 
 
 subsection\<open>Embedding maps\<close>
 
 definition embedding_map
   where "embedding_map X Y f \<equiv> homeomorphic_map X (subtopology Y (f ` (topspace X))) f"
 
 lemma embedding_map_eq:
    "\<lbrakk>embedding_map X Y f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> embedding_map X Y g"
   unfolding embedding_map_def
   by (metis homeomorphic_map_eq image_cong)
 
 lemma embedding_map_compose:
   assumes "embedding_map X X' f" "embedding_map X' X'' g"
   shows "embedding_map X X'' (g \<circ> f)"
 proof -
   have hm: "homeomorphic_map X (subtopology X' (f ` topspace X)) f" "homeomorphic_map X' (subtopology X'' (g ` topspace X')) g"
     using assms by (auto simp: embedding_map_def)
   then obtain C where "g ` topspace X' \<inter> C = (g \<circ> f) ` topspace X"
     by (metis homeomorphic_imp_surjective_map image_comp image_mono inf.absorb_iff2 topspace_subtopology)
   then have "homeomorphic_map (subtopology X' (f ` topspace X)) (subtopology X'' ((g \<circ> f) ` topspace X)) g"
     by (metis hm homeomorphic_imp_surjective_map homeomorphic_map_subtopologies image_comp subtopology_subtopology topspace_subtopology)
   then show ?thesis
   unfolding embedding_map_def
   using hm(1) homeomorphic_map_compose by blast
 qed
 
 lemma surjective_embedding_map:
    "embedding_map X Y f \<and> f ` (topspace X) = topspace Y \<longleftrightarrow> homeomorphic_map X Y f"
   by (force simp: embedding_map_def homeomorphic_eq_everything_map)
 
 lemma embedding_map_in_subtopology:
    "embedding_map X (subtopology Y S) f \<longleftrightarrow> embedding_map X Y f \<and> f ` (topspace X) \<subseteq> S"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding embedding_map_def
     by (metis continuous_map_in_subtopology homeomorphic_imp_continuous_map inf_absorb2 subtopology_subtopology)
 qed (simp add: embedding_map_def inf.absorb_iff2 subtopology_subtopology)
 
 lemma injective_open_imp_embedding_map:
    "\<lbrakk>continuous_map X Y f; open_map X Y f; inj_on f (topspace X)\<rbrakk> \<Longrightarrow> embedding_map X Y f"
   unfolding embedding_map_def
   by (simp add: continuous_map_in_subtopology continuous_open_quotient_map eq_iff homeomorphic_map_def open_map_imp_subset open_map_into_subtopology)
 
 lemma injective_closed_imp_embedding_map:
   "\<lbrakk>continuous_map X Y f; closed_map X Y f; inj_on f (topspace X)\<rbrakk> \<Longrightarrow> embedding_map X Y f"
   unfolding embedding_map_def
   by (simp add: closed_map_imp_subset closed_map_into_subtopology continuous_closed_quotient_map 
                 continuous_map_in_subtopology dual_order.eq_iff homeomorphic_map_def)
 
 lemma embedding_map_imp_homeomorphic_space:
    "embedding_map X Y f \<Longrightarrow> X homeomorphic_space (subtopology Y (f ` (topspace X)))"
   unfolding embedding_map_def
   using homeomorphic_space by blast
 
 lemma embedding_imp_closed_map:
    "\<lbrakk>embedding_map X Y f; closedin Y (f ` topspace X)\<rbrakk> \<Longrightarrow> closed_map X Y f"
   unfolding closed_map_def
   by (auto simp: closedin_closed_subtopology embedding_map_def homeomorphic_map_closedness_eq)
 
 lemma embedding_imp_closed_map_eq:
    "embedding_map X Y f \<Longrightarrow> (closed_map X Y f \<longleftrightarrow> closedin Y (f ` topspace X))"
   using closed_map_def embedding_imp_closed_map by blast
 
 
 subsection\<open>Retraction and section maps\<close>
 
 definition retraction_maps :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> bool"
   where "retraction_maps X Y f g \<equiv>
            continuous_map X Y f \<and> continuous_map Y X g \<and> (\<forall>x \<in> topspace Y. f(g x) = x)"
 
 definition section_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "section_map X Y f \<equiv> \<exists>g. retraction_maps Y X g f"
 
 definition retraction_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "retraction_map X Y f \<equiv> \<exists>g. retraction_maps X Y f g"
 
 lemma retraction_maps_eq:
    "\<lbrakk>retraction_maps X Y f g; \<And>x. x \<in> topspace X \<Longrightarrow> f x = f' x; \<And>x. x \<in> topspace Y \<Longrightarrow> g x = g' x\<rbrakk>
         \<Longrightarrow> retraction_maps X Y f' g'"
   unfolding retraction_maps_def by (metis (no_types, lifting) continuous_map_def continuous_map_eq)
 
 lemma section_map_eq:
    "\<lbrakk>section_map X Y f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> section_map X Y g"
   unfolding section_map_def using retraction_maps_eq by blast
 
 lemma retraction_map_eq:
    "\<lbrakk>retraction_map X Y f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> retraction_map X Y g"
   unfolding retraction_map_def using retraction_maps_eq by blast
 
 lemma homeomorphic_imp_retraction_maps:
    "homeomorphic_maps X Y f g \<Longrightarrow> retraction_maps X Y f g"
   by (simp add: homeomorphic_maps_def retraction_maps_def)
 
 lemma section_and_retraction_eq_homeomorphic_map:
    "section_map X Y f \<and> retraction_map X Y f \<longleftrightarrow> homeomorphic_map X Y f"  (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain g where "homeomorphic_maps X Y f g"
     unfolding homeomorphic_maps_def retraction_map_def section_map_def
     by (smt (verit, best) continuous_map_def retraction_maps_def)
   then show ?rhs
     using homeomorphic_map_maps by blast
 next
   assume ?rhs
   then show ?lhs
     unfolding retraction_map_def section_map_def
     by (meson homeomorphic_imp_retraction_maps homeomorphic_map_maps homeomorphic_maps_sym)
 qed
 
 lemma section_imp_embedding_map:
    "section_map X Y f \<Longrightarrow> embedding_map X Y f"
   unfolding section_map_def embedding_map_def homeomorphic_map_maps retraction_maps_def homeomorphic_maps_def
   by (force simp: continuous_map_in_subtopology continuous_map_from_subtopology)
 
 lemma retraction_imp_quotient_map:
   assumes "retraction_map X Y f"
   shows "quotient_map X Y f"
   unfolding quotient_map_def
 proof (intro conjI subsetI allI impI)
   show "f ` topspace X = topspace Y"
     using assms by (force simp: retraction_map_def retraction_maps_def continuous_map_def)
 next
   fix U
   assume U: "U \<subseteq> topspace Y"
   have "openin Y U"
     if "\<forall>x\<in>topspace Y. g x \<in> topspace X" "\<forall>x\<in>topspace Y. f (g x) = x"
        "openin Y {x \<in> topspace Y. g x \<in> {x \<in> topspace X. f x \<in> U}}" for g
     using openin_subopen U that by fastforce
   then show "openin X {x \<in> topspace X. f x \<in> U} = openin Y U"
     using assms by (auto simp: retraction_map_def retraction_maps_def continuous_map_def)
 qed
 
 lemma retraction_maps_compose:
    "\<lbrakk>retraction_maps X Y f f'; retraction_maps Y Z g g'\<rbrakk> \<Longrightarrow> retraction_maps X Z (g \<circ> f) (f' \<circ> g')"
   by (clarsimp simp: retraction_maps_def continuous_map_compose) (simp add: continuous_map_def)
 
 lemma retraction_map_compose:
    "\<lbrakk>retraction_map X Y f; retraction_map Y Z g\<rbrakk> \<Longrightarrow> retraction_map X Z (g \<circ> f)"
   by (meson retraction_map_def retraction_maps_compose)
 
 lemma section_map_compose:
    "\<lbrakk>section_map X Y f; section_map Y Z g\<rbrakk> \<Longrightarrow> section_map X Z (g \<circ> f)"
   by (meson retraction_maps_compose section_map_def)
 
 lemma surjective_section_eq_homeomorphic_map:
    "section_map X Y f \<and> f ` (topspace X) = topspace Y \<longleftrightarrow> homeomorphic_map X Y f"
   by (meson section_and_retraction_eq_homeomorphic_map section_imp_embedding_map surjective_embedding_map)
 
 lemma surjective_retraction_or_section_map:
    "f ` (topspace X) = topspace Y \<Longrightarrow> retraction_map X Y f \<or> section_map X Y f \<longleftrightarrow> retraction_map X Y f"
   using section_and_retraction_eq_homeomorphic_map surjective_section_eq_homeomorphic_map by fastforce
 
 lemma retraction_imp_surjective_map:
    "retraction_map X Y f \<Longrightarrow> f ` (topspace X) = topspace Y"
   by (simp add: retraction_imp_quotient_map quotient_imp_surjective_map)
 
 lemma section_imp_injective_map:
    "\<lbrakk>section_map X Y f; x \<in> topspace X; y \<in> topspace X\<rbrakk> \<Longrightarrow> f x = f y \<longleftrightarrow> x = y"
   by (metis (mono_tags, opaque_lifting) retraction_maps_def section_map_def)
 
 lemma retraction_maps_to_retract_maps:
    "retraction_maps X Y r s
         \<Longrightarrow> retraction_maps X (subtopology X (s ` (topspace Y))) (s \<circ> r) id"
   unfolding retraction_maps_def
   by (auto simp: continuous_map_compose continuous_map_into_subtopology continuous_map_from_subtopology)
 subsection \<open>Continuity\<close>
 
 lemma continuous_on_open:
   "continuous_on S f \<longleftrightarrow>
     (\<forall>T. openin (top_of_set (f ` S)) T \<longrightarrow>
       openin (top_of_set S) (S \<inter> f -` T))"
   unfolding continuous_on_open_invariant openin_open Int_def vimage_def Int_commute
   by (simp add: imp_ex imageI conj_commute eq_commute cong: conj_cong)
 
 lemma continuous_on_closed:
   "continuous_on S f \<longleftrightarrow>
     (\<forall>T. closedin (top_of_set (f ` S)) T \<longrightarrow>
       closedin (top_of_set S) (S \<inter> f -` T))"
   unfolding continuous_on_closed_invariant closedin_closed Int_def vimage_def Int_commute
   by (simp add: imp_ex imageI conj_commute eq_commute cong: conj_cong)
 
 lemma continuous_on_imp_closedin:
   assumes "continuous_on S f" "closedin (top_of_set (f ` S)) T"
   shows "closedin (top_of_set S) (S \<inter> f -` T)"
   using assms continuous_on_closed by blast
 
 lemma continuous_map_subtopology_eu [simp]:
   "continuous_map (top_of_set S) (subtopology euclidean T) h \<longleftrightarrow> continuous_on S h \<and> h ` S \<subseteq> T"
   by (simp add: continuous_map_in_subtopology)
 
 lemma continuous_map_euclidean_top_of_set:
   assumes eq: "f -` S = UNIV" and cont: "continuous_on UNIV f"
   shows "continuous_map euclidean (top_of_set S) f"
   by (simp add: cont continuous_map_into_subtopology eq image_subset_iff_subset_vimage)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Half-global and completely global cases\<close>
 
 lemma continuous_openin_preimage_gen:
   assumes "continuous_on S f"  "open T"
   shows "openin (top_of_set S) (S \<inter> f -` T)"
 proof -
   have *: "(S \<inter> f -` T) = (S \<inter> f -` (T \<inter> f ` S))"
     by auto
   have "openin (top_of_set (f ` S)) (T \<inter> f ` S)"
     using openin_open_Int[of T "f ` S", OF assms(2)] unfolding openin_open by auto
   then show ?thesis
     using assms(1)[unfolded continuous_on_open, THEN spec[where x="T \<inter> f ` S"]]
     using * by auto
 qed
 
 lemma continuous_closedin_preimage:
   assumes "continuous_on S f" and "closed T"
   shows "closedin (top_of_set S) (S \<inter> f -` T)"
 proof -
   have *: "(S \<inter> f -` T) = (S \<inter> f -` (T \<inter> f ` S))"
     by auto
   have "closedin (top_of_set (f ` S)) (T \<inter> f ` S)"
     using closedin_closed_Int[of T "f ` S", OF assms(2)]
     by (simp add: Int_commute)
   then show ?thesis
     using assms(1)[unfolded continuous_on_closed, THEN spec[where x="T \<inter> f ` S"]]
     using * by auto
 qed
 
 lemma continuous_openin_preimage_eq:
    "continuous_on S f \<longleftrightarrow> (\<forall>T. open T \<longrightarrow> openin (top_of_set S) (S \<inter> f -` T))"
   by (metis Int_commute continuous_on_open_invariant open_openin openin_subtopology)
 
 lemma continuous_closedin_preimage_eq:
    "continuous_on S f \<longleftrightarrow>
     (\<forall>T. closed T \<longrightarrow> closedin (top_of_set S) (S \<inter> f -` T))"
   by (metis Int_commute closedin_closed continuous_on_closed_invariant)
 
 lemma continuous_open_preimage:
   assumes contf: "continuous_on S f" and "open S" "open T"
   shows "open (S \<inter> f -` T)"
 proof-
   obtain U where "open U" "(S \<inter> f -` T) = S \<inter> U"
     using continuous_openin_preimage_gen[OF contf \<open>open T\<close>]
     unfolding openin_open by auto
   then show ?thesis
     using open_Int[of S U, OF \<open>open S\<close>] by auto
 qed
 
 lemma continuous_closed_preimage:
   assumes contf: "continuous_on S f" and "closed S" "closed T"
   shows "closed (S \<inter> f -` T)"
 proof-
   obtain U where "closed U" "(S \<inter> f -` T) = S \<inter> U"
     using continuous_closedin_preimage[OF contf \<open>closed T\<close>]
     unfolding closedin_closed by auto
   then show ?thesis using closed_Int[of S U, OF \<open>closed S\<close>] by auto
 qed
 
 lemma continuous_open_vimage: "open S \<Longrightarrow> (\<And>x. continuous (at x) f) \<Longrightarrow> open (f -` S)"
   by (metis continuous_on_eq_continuous_within open_vimage) 
  
 lemma continuous_closed_vimage: "closed S \<Longrightarrow> (\<And>x. continuous (at x) f) \<Longrightarrow> closed (f -` S)"
   by (simp add: closed_vimage continuous_on_eq_continuous_within)
 
 lemma Times_in_interior_subtopology:
   assumes "(x, y) \<in> U" "openin (top_of_set (S \<times> T)) U"
   obtains V W where "openin (top_of_set S) V" "x \<in> V"
                     "openin (top_of_set T) W" "y \<in> W" "(V \<times> W) \<subseteq> U"
 proof -
   from assms obtain E where "open E" "U = S \<times> T \<inter> E" "(x, y) \<in> E" "x \<in> S" "y \<in> T"
     by (auto simp: openin_open)
   from open_prod_elim[OF \<open>open E\<close> \<open>(x, y) \<in> E\<close>]
   obtain E1 E2 where "open E1" "open E2" "(x, y) \<in> E1 \<times> E2" "E1 \<times> E2 \<subseteq> E"
     by blast
   show ?thesis
   proof
     show "openin (top_of_set S) (E1 \<inter> S)" "openin (top_of_set T) (E2 \<inter> T)"
       using \<open>open E1\<close> \<open>open E2\<close> by (auto simp: openin_open)
     show "x \<in> E1 \<inter> S" "y \<in> E2 \<inter> T"
       using \<open>(x, y) \<in> E1 \<times> E2\<close> \<open>x \<in> S\<close> \<open>y \<in> T\<close> by auto
     show "(E1 \<inter> S) \<times> (E2 \<inter> T) \<subseteq> U"
       using \<open>E1 \<times> E2 \<subseteq> E\<close> \<open>U = _\<close> by auto
   qed
 qed
 
 lemma closedin_Times:
   "closedin (top_of_set S) S' \<Longrightarrow> closedin (top_of_set T) T' \<Longrightarrow>
     closedin (top_of_set (S \<times> T)) (S' \<times> T')"
   unfolding closedin_closed using closed_Times by blast
 
 lemma openin_Times:
   "openin (top_of_set S) S' \<Longrightarrow> openin (top_of_set T) T' \<Longrightarrow>
     openin (top_of_set (S \<times> T)) (S' \<times> T')"
   unfolding openin_open using open_Times by blast
 
 lemma openin_Times_eq:
   fixes S :: "'a::topological_space set" and T :: "'b::topological_space set"
   shows
     "openin (top_of_set (S \<times> T)) (S' \<times> T') \<longleftrightarrow>
       S' = {} \<or> T' = {} \<or> openin (top_of_set S) S' \<and> openin (top_of_set T) T'"
     (is "?lhs = ?rhs")
 proof (cases "S' = {} \<or> T' = {}")
   case True
   then show ?thesis by auto
 next
   case False
   then obtain x y where "x \<in> S'" "y \<in> T'"
     by blast
   show ?thesis
   proof
     assume ?lhs
     have "openin (top_of_set S) S'"
     proof (subst openin_subopen, clarify)
       show "\<exists>U. openin (top_of_set S) U \<and> x \<in> U \<and> U \<subseteq> S'" if "x \<in> S'" for x
         using that \<open>y \<in> T'\<close> Times_in_interior_subtopology [OF _ \<open>?lhs\<close>, of x y]
         by simp (metis mem_Sigma_iff subsetD subsetI)
     qed
     moreover have "openin (top_of_set T) T'"
     proof (subst openin_subopen, clarify)
       show "\<exists>U. openin (top_of_set T) U \<and> y \<in> U \<and> U \<subseteq> T'" if "y \<in> T'" for y
         using that \<open>x \<in> S'\<close> Times_in_interior_subtopology [OF _ \<open>?lhs\<close>, of x y]
         by simp (metis mem_Sigma_iff subsetD subsetI)
     qed
     ultimately show ?rhs
       by simp
   next
     assume ?rhs
     with False show ?lhs
       by (simp add: openin_Times)
   qed
 qed
 
 lemma Lim_transform_within_openin:
   assumes f: "(f \<longlongrightarrow> l) (at a within T)"
     and "openin (top_of_set T) S" "a \<in> S"
     and eq: "\<And>x. \<lbrakk>x \<in> S; x \<noteq> a\<rbrakk> \<Longrightarrow> f x = g x"
   shows "(g \<longlongrightarrow> l) (at a within T)"
 proof -
   have "\<forall>\<^sub>F x in at a within T. x \<in> T \<and> x \<noteq> a"
     by (simp add: eventually_at_filter)
   moreover
   from \<open>openin _ _\<close> obtain U where "open U" "S = T \<inter> U"
     by (auto simp: openin_open)
   then have "a \<in> U" using \<open>a \<in> S\<close> by auto
   from topological_tendstoD[OF tendsto_ident_at \<open>open U\<close> \<open>a \<in> U\<close>]
   have "\<forall>\<^sub>F x in at a within T. x \<in> U" by auto
   ultimately
   have "\<forall>\<^sub>F x in at a within T. f x = g x"
     by eventually_elim (auto simp: \<open>S = _\<close> eq)
   with f show ?thesis
     by (rule Lim_transform_eventually)
 qed
 
 lemma continuous_on_open_gen:
   assumes "f ` S \<subseteq> T"
     shows "continuous_on S f \<longleftrightarrow>
              (\<forall>U. openin (top_of_set T) U
                   \<longrightarrow> openin (top_of_set S) (S \<inter> f -` U))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (clarsimp simp add: continuous_openin_preimage_eq openin_open)
       (metis Int_assoc assms image_subset_iff_subset_vimage inf.absorb_iff1)
 next
   assume R [rule_format]: ?rhs
   show ?lhs
   proof (clarsimp simp add: continuous_openin_preimage_eq)
     fix U::"'a set"
     assume "open U"
     then have "openin (top_of_set S) (S \<inter> f -` (U \<inter> T))"
       by (metis R inf_commute openin_open)
     then show "openin (top_of_set S) (S \<inter> f -` U)"
       by (metis Int_assoc Int_commute assms image_subset_iff_subset_vimage inf.absorb_iff2 vimage_Int)
   qed
 qed
 
 lemma continuous_openin_preimage:
   "\<lbrakk>continuous_on S f; f ` S \<subseteq> T; openin (top_of_set T) U\<rbrakk>
         \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` U)"
   by (simp add: continuous_on_open_gen)
 
 lemma continuous_on_closed_gen:
   assumes "f ` S \<subseteq> T"
   shows "continuous_on S f \<longleftrightarrow>
              (\<forall>U. closedin (top_of_set T) U
                   \<longrightarrow> closedin (top_of_set S) (S \<inter> f -` U))"
 proof -
   have *: "U \<subseteq> T \<Longrightarrow> S \<inter> f -` (T - U) = S - (S \<inter> f -` U)" for U
     using assms by blast
   then show ?thesis
       unfolding continuous_on_open_gen [OF assms]
       by (metis closedin_def inf.cobounded1 openin_closedin_eq topspace_euclidean_subtopology)
 qed
 
 lemma continuous_closedin_preimage_gen:
   assumes "continuous_on S f" "f ` S \<subseteq> T" "closedin (top_of_set T) U"
     shows "closedin (top_of_set S) (S \<inter> f -` U)"
 using assms continuous_on_closed_gen by blast
 
 lemma continuous_transform_within_openin:
   assumes "continuous (at a within T) f"
     and "openin (top_of_set T) S" "a \<in> S"
     and eq: "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   shows "continuous (at a within T) g"
   using assms by (simp add: Lim_transform_within_openin continuous_within)
 
 
 subsection\<^marker>\<open>tag important\<close> \<open>The topology generated by some (open) subsets\<close>
 
 text \<open>In the definition below of a generated topology, the \<open>Empty\<close> case is not necessary,
 as it follows from \<open>UN\<close> taking for \<open>K\<close> the empty set. However, it is convenient to have,
 and is never a problem in proofs, so I prefer to write it down explicitly.
 
 We do not require \<open>UNIV\<close> to be an open set, as this will not be the case in applications. (We are
 thinking of a topology on a subset of \<open>UNIV\<close>, the remaining part of \<open>UNIV\<close> being irrelevant.)\<close>
 
 inductive generate_topology_on for S where
   Empty: "generate_topology_on S {}"
 | Int: "generate_topology_on S a \<Longrightarrow> generate_topology_on S b \<Longrightarrow> generate_topology_on S (a \<inter> b)"
 | UN: "(\<And>k. k \<in> K \<Longrightarrow> generate_topology_on S k) \<Longrightarrow> generate_topology_on S (\<Union>K)"
 | Basis: "s \<in> S \<Longrightarrow> generate_topology_on S s"
 
 lemma istopology_generate_topology_on:
   "istopology (generate_topology_on S)"
 unfolding istopology_def by (auto intro: generate_topology_on.intros)
 
 text \<open>The basic property of the topology generated by a set \<open>S\<close> is that it is the
 smallest topology containing all the elements of \<open>S\<close>:\<close>
 
 lemma generate_topology_on_coarsest:
   assumes T: "istopology T" "\<And>s. s \<in> S \<Longrightarrow> T s"
           and gen: "generate_topology_on S s0"
   shows "T s0"
   using gen 
 by (induct rule: generate_topology_on.induct) (use T in \<open>auto simp: istopology_def\<close>)
 
 abbreviation\<^marker>\<open>tag unimportant\<close> topology_generated_by::"('a set set) \<Rightarrow> ('a topology)"
   where "topology_generated_by S \<equiv> topology (generate_topology_on S)"
 
 lemma openin_topology_generated_by_iff:
   "openin (topology_generated_by S) s \<longleftrightarrow> generate_topology_on S s"
   using topology_inverse'[OF istopology_generate_topology_on[of S]] by simp
 
 lemma openin_topology_generated_by:
   "openin (topology_generated_by S) s \<Longrightarrow> generate_topology_on S s"
 using openin_topology_generated_by_iff by auto
 
 lemma topology_generated_by_topspace [simp]:
   "topspace (topology_generated_by S) = (\<Union>S)"
 proof
   {
     fix s assume "openin (topology_generated_by S) s"
     then have "generate_topology_on S s" by (rule openin_topology_generated_by)
     then have "s \<subseteq> (\<Union>S)" by (induct, auto)
   }
   then show "topspace (topology_generated_by S) \<subseteq> (\<Union>S)"
     unfolding topspace_def by auto
 next
   have "generate_topology_on S (\<Union>S)"
     using generate_topology_on.UN[OF generate_topology_on.Basis, of S S] by simp
   then show "(\<Union>S) \<subseteq> topspace (topology_generated_by S)"
     unfolding topspace_def using openin_topology_generated_by_iff by auto
 qed
 
 lemma topology_generated_by_Basis:
   "s \<in> S \<Longrightarrow> openin (topology_generated_by S) s"
   by (simp add: Basis openin_topology_generated_by_iff)
 
 lemma generate_topology_on_Inter:
   "\<lbrakk>finite \<F>; \<And>K. K \<in> \<F> \<Longrightarrow> generate_topology_on \<S> K; \<F> \<noteq> {}\<rbrakk> \<Longrightarrow> generate_topology_on \<S> (\<Inter>\<F>)"
   by (induction \<F> rule: finite_induct; force intro: generate_topology_on.intros)
 
 subsection\<open>Topology bases and sub-bases\<close>
 
 lemma istopology_base_alt:
    "istopology (arbitrary union_of P) \<longleftrightarrow>
     (\<forall>S T. (arbitrary union_of P) S \<and> (arbitrary union_of P) T
            \<longrightarrow> (arbitrary union_of P) (S \<inter> T))"
   by (simp add: istopology_def) (blast intro: arbitrary_union_of_Union)
 
 lemma istopology_base_eq:
    "istopology (arbitrary union_of P) \<longleftrightarrow>
     (\<forall>S T. P S \<and> P T \<longrightarrow> (arbitrary union_of P) (S \<inter> T))"
   by (simp add: istopology_base_alt arbitrary_union_of_Int_eq)
 
 lemma istopology_base:
    "(\<And>S T. \<lbrakk>P S; P T\<rbrakk> \<Longrightarrow> P(S \<inter> T)) \<Longrightarrow> istopology (arbitrary union_of P)"
   by (simp add: arbitrary_def istopology_base_eq union_of_inc)
 
 lemma openin_topology_base_unique:
    "openin X = arbitrary union_of P \<longleftrightarrow>
         (\<forall>V. P V \<longrightarrow> openin X V) \<and> (\<forall>U x. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V. P V \<and> x \<in> V \<and> V \<subseteq> U))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (auto simp: union_of_def arbitrary_def)
 next
   assume R: ?rhs
   then have *: "\<exists>\<U>\<subseteq>Collect P. \<Union>\<U> = S" if "openin X S" for S
     using that by (rule_tac x="{V. P V \<and> V \<subseteq> S}" in exI) fastforce
   from R show ?lhs
     by (fastforce simp add: union_of_def arbitrary_def intro: *)
 qed
 
 lemma topology_base_unique:
   assumes "\<And>S. P S \<Longrightarrow> openin X S"
           "\<And>U x. \<lbrakk>openin X U; x \<in> U\<rbrakk> \<Longrightarrow> \<exists>B. P B \<and> x \<in> B \<and> B \<subseteq> U"
   shows   "topology (arbitrary union_of P) = X"
 proof -
   have "X = topology (openin X)"
     by (simp add: openin_inverse)
   also from assms have "openin X = arbitrary union_of P"
     by (subst openin_topology_base_unique) auto
   finally show ?thesis ..
 qed
 
 lemma topology_bases_eq_aux:
    "\<lbrakk>(arbitrary union_of P) S;
      \<And>U x. \<lbrakk>P U; x \<in> U\<rbrakk> \<Longrightarrow> \<exists>V. Q V \<and> x \<in> V \<and> V \<subseteq> U\<rbrakk>
         \<Longrightarrow> (arbitrary union_of Q) S"
   by (metis arbitrary_union_of_alt arbitrary_union_of_idempot)
 
 lemma topology_bases_eq:
    "\<lbrakk>\<And>U x. \<lbrakk>P U; x \<in> U\<rbrakk> \<Longrightarrow> \<exists>V. Q V \<and> x \<in> V \<and> V \<subseteq> U;
     \<And>V x. \<lbrakk>Q V; x \<in> V\<rbrakk> \<Longrightarrow> \<exists>U. P U \<and> x \<in> U \<and> U \<subseteq> V\<rbrakk>
         \<Longrightarrow> topology (arbitrary union_of P) =
             topology (arbitrary union_of Q)"
   by (fastforce intro:  arg_cong [where f=topology]  elim: topology_bases_eq_aux)
 
 lemma istopology_subbase:
    "istopology (arbitrary union_of (finite intersection_of P relative_to S))"
   by (simp add: finite_intersection_of_Int istopology_base relative_to_Int)
 
 lemma openin_subbase:
   "openin (topology (arbitrary union_of (finite intersection_of B relative_to U))) S
    \<longleftrightarrow> (arbitrary union_of (finite intersection_of B relative_to U)) S"
   by (simp add: istopology_subbase topology_inverse')
 
 lemma topspace_subbase [simp]:
    "topspace(topology (arbitrary union_of (finite intersection_of B relative_to U))) = U" (is "?lhs = _")
 proof
   show "?lhs \<subseteq> U"
     by (metis arbitrary_union_of_relative_to openin_subbase openin_topspace relative_to_imp_subset)
   show "U \<subseteq> ?lhs"
     by (metis arbitrary_union_of_inc finite_intersection_of_empty inf.orderE istopology_subbase 
               openin_subset relative_to_inc subset_UNIV topology_inverse')
 qed
 
 lemma minimal_topology_subbase:
   assumes X: "\<And>S. P S \<Longrightarrow> openin X S" and "openin X U"
   and S: "openin(topology(arbitrary union_of (finite intersection_of P relative_to U))) S"
 shows "openin X S"
 proof -
   have "(arbitrary union_of (finite intersection_of P relative_to U)) S"
     using S openin_subbase by blast
   with X \<open>openin X U\<close> show ?thesis
     by (force simp add: union_of_def intersection_of_def relative_to_def intro: openin_Int_Inter)
 qed
 
 lemma istopology_subbase_UNIV:
    "istopology (arbitrary union_of (finite intersection_of P))"
   by (simp add: istopology_base finite_intersection_of_Int)
 
 
 lemma generate_topology_on_eq:
   "generate_topology_on S = arbitrary union_of finite' intersection_of (\<lambda>x. x \<in> S)" (is "?lhs = ?rhs")
 proof (intro ext iffI)
   fix A
   assume "?lhs A"
   then show "?rhs A"
   proof induction
     case (Int a b)
     then show ?case
       by (metis (mono_tags, lifting) istopology_base_alt finite'_intersection_of_Int istopology_base)
   next
     case (UN K)
     then show ?case
       by (simp add: arbitrary_union_of_Union)
   next
     case (Basis s)
     then show ?case
       by (simp add: Sup_upper arbitrary_union_of_inc finite'_intersection_of_inc relative_to_subset)
   qed auto
 next
   fix A
   assume "?rhs A"
   then obtain \<U> where \<U>: "\<And>T. T \<in> \<U> \<Longrightarrow> \<exists>\<F>. finite' \<F> \<and> \<F> \<subseteq> S \<and> \<Inter>\<F> = T" and eq: "A = \<Union>\<U>"
     unfolding union_of_def intersection_of_def by auto
   show "?lhs A"
     unfolding eq
   proof (rule generate_topology_on.UN)
     fix T
     assume "T \<in> \<U>"
     with \<U> obtain \<F> where "finite' \<F>" "\<F> \<subseteq> S" "\<Inter>\<F> = T"
       by blast
     have "generate_topology_on S (\<Inter>\<F>)"
     proof (rule generate_topology_on_Inter)
       show "finite \<F>" "\<F> \<noteq> {}"
         by (auto simp: \<open>finite' \<F>\<close>)
       show "\<And>K. K \<in> \<F> \<Longrightarrow> generate_topology_on S K"
         by (metis \<open>\<F> \<subseteq> S\<close> generate_topology_on.simps subset_iff)
     qed
     then show "generate_topology_on S T"
       using \<open>\<Inter>\<F> = T\<close> by blast
   qed
 qed
 
 lemma continuous_on_generated_topo_iff:
   "continuous_map T1 (topology_generated_by S) f \<longleftrightarrow>
       ((\<forall>U. U \<in> S \<longrightarrow> openin T1 (f-`U \<inter> topspace(T1))) \<and> (f`(topspace T1) \<subseteq> (\<Union> S)))"
 unfolding continuous_map_alt topology_generated_by_topspace
 proof (auto simp add: topology_generated_by_Basis)
   assume H: "\<forall>U. U \<in> S \<longrightarrow> openin T1 (f -` U \<inter> topspace T1)"
   fix U assume "openin (topology_generated_by S) U"
   then have "generate_topology_on S U" by (rule openin_topology_generated_by)
   then show "openin T1 (f -` U \<inter> topspace T1)"
   proof (induct)
     fix a b
     assume H: "openin T1 (f -` a \<inter> topspace T1)" "openin T1 (f -` b \<inter> topspace T1)"
     have "f -` (a \<inter> b) \<inter> topspace T1 = (f-`a \<inter> topspace T1) \<inter> (f-`b \<inter> topspace T1)"
       by auto
     then show "openin T1 (f -` (a \<inter> b) \<inter> topspace T1)" using H by auto
   next
     fix K
     assume H: "openin T1 (f -` k \<inter> topspace T1)" if "k\<in> K" for k
     define L where "L = {f -` k \<inter> topspace T1|k. k \<in> K}"
     have *: "openin T1 l" if "l \<in>L" for l using that H unfolding L_def by auto
     have "openin T1 (\<Union>L)" using openin_Union[OF *] by simp
     moreover have "(\<Union>L) = (f -` \<Union>K \<inter> topspace T1)" unfolding L_def by auto
     ultimately show "openin T1 (f -` \<Union>K \<inter> topspace T1)" by simp
   qed (auto simp add: H)
 qed
 
 lemma continuous_on_generated_topo:
   assumes "\<And>U. U \<in>S \<Longrightarrow> openin T1 (f-`U \<inter> topspace(T1))"
           "f`(topspace T1) \<subseteq> (\<Union> S)"
   shows "continuous_map T1 (topology_generated_by S) f"
   using assms continuous_on_generated_topo_iff by blast
 
 
 subsection\<open>Continuity via bases/subbases, hence upper and lower semicontinuity\<close>
 
 lemma continuous_map_into_topology_base:
   assumes P: "openin Y = arbitrary union_of P"
     and f: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
     and ope: "\<And>U. P U \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
   shows "continuous_map X Y f"
 proof -
   have *: "\<And>\<U>. (\<And>t. t \<in> \<U> \<Longrightarrow> P t) \<Longrightarrow> openin X {x \<in> topspace X. \<exists>U\<in>\<U>. f x \<in> U}"
     by (smt (verit) Ball_Collect ope mem_Collect_eq openin_subopen)
   show ?thesis
     using P by (auto simp: continuous_map_def arbitrary_def union_of_def intro!: f *)
 qed
 
 lemma continuous_map_into_topology_base_eq:
   assumes P: "openin Y = arbitrary union_of P"
   shows
    "continuous_map X Y f \<longleftrightarrow>
     (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and> (\<forall>U. P U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U})"
  (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then have "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
     by (meson continuous_map_def)
   moreover have "\<And>U. P U \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
     using L assms continuous_map openin_topology_base_unique by fastforce
   ultimately show ?rhs by auto
 qed (simp add: assms continuous_map_into_topology_base)
 
 lemma continuous_map_into_topology_subbase:
   fixes U P
   defines "Y \<equiv> topology(arbitrary union_of (finite intersection_of P relative_to U))"
   assumes f: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
     and ope: "\<And>U. P U \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
   shows "continuous_map X Y f"
 proof (intro continuous_map_into_topology_base)
   show "openin Y = arbitrary union_of (finite intersection_of P relative_to U)"
     unfolding Y_def using istopology_subbase topology_inverse' by blast
   show "openin X {x \<in> topspace X. f x \<in> V}"
     if \<section>: "(finite intersection_of P relative_to U) V" for V 
   proof -
     define finv where "finv \<equiv> \<lambda>V. {x \<in> topspace X. f x \<in> V}"
     obtain \<U> where \<U>: "finite \<U>" "\<And>V. V \<in> \<U> \<Longrightarrow> P V"
                       "{x \<in> topspace X. f x \<in> V} = (\<Inter>V \<in> insert U \<U>. finv V)"
       using \<section> by (fastforce simp: finv_def intersection_of_def relative_to_def)
     show ?thesis
       unfolding \<U>
     proof (intro openin_Inter ope)
       have U: "U = topspace Y"
         unfolding Y_def using topspace_subbase by fastforce
       fix V
       assume V: "V \<in> finv ` insert U \<U>"
       with U f have "openin X {x \<in> topspace X. f x \<in> U}"
         by (auto simp: openin_subopen [of X "Collect _"])
       then show "openin X V"
         using V \<U>(2) ope by (fastforce simp: finv_def)
     qed (use \<open>finite \<U>\<close> in auto)
   qed
 qed (use f in auto)
 
 lemma continuous_map_into_topology_subbase_eq:
   assumes "Y = topology(arbitrary union_of (finite intersection_of P relative_to U))"
   shows
    "continuous_map X Y f \<longleftrightarrow>
     (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and> (\<forall>U. P U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U})"
    (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
   proof (intro conjI strip)
     show "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
       using L continuous_map_def by fastforce
     fix V
     assume "P V"
     have "U = topspace Y"
       unfolding assms using topspace_subbase by fastforce
     then have eq: "{x \<in> topspace X. f x \<in> V} = {x \<in> topspace X. f x \<in> U \<inter> V}"
       using L by (auto simp: continuous_map)
     have "openin Y (U \<inter> V)"
       unfolding assms openin_subbase
       by (meson \<open>P V\<close> arbitrary_union_of_inc finite_intersection_of_inc relative_to_inc)
     show "openin X {x \<in> topspace X. f x \<in> V}"
       using L \<open>openin Y (U \<inter> V)\<close> continuous_map eq by fastforce
   qed
 next
   show "?rhs \<Longrightarrow> ?lhs"
     unfolding assms
     by (intro continuous_map_into_topology_subbase) auto
 qed 
 
 lemma subbase_subtopology_euclidean:
   fixes U :: "'a::order_topology set"
   shows
   "topology
     (arbitrary union_of
       (finite intersection_of (\<lambda>x. x \<in> range greaterThan \<union> range lessThan) relative_to U))
  = subtopology euclidean U"
 proof -
   have "\<exists>V. (finite intersection_of (\<lambda>x. x \<in> range greaterThan \<or> x \<in> range lessThan)) V \<and> x \<in> V \<and> V \<subseteq> W"
     if "open W" "x \<in> W" for W and x::'a
     using \<open>open W\<close> [unfolded open_generated_order] \<open>x \<in> W\<close>
   proof (induct rule: generate_topology.induct)
     case UNIV
     then show ?case
       using finite_intersection_of_empty by blast
   next
     case (Int a b)
     then show ?case 
         by (meson Int_iff finite_intersection_of_Int inf_mono)
   next
     case (UN K)
     then show ?case
       by (meson Union_iff subset_iff)
   next
     case (Basis s)
     then show ?case
       by (metis (no_types, lifting) Un_iff finite_intersection_of_inc order_refl)
   qed
   moreover 
   have "\<And>V::'a set. (finite intersection_of (\<lambda>x. x \<in> range greaterThan \<or> x \<in> range lessThan)) V \<Longrightarrow> open V"
     by (force simp: intersection_of_def subset_iff)
   ultimately have *: "openin (euclidean::'a topology) = 
            (arbitrary union_of (finite intersection_of (\<lambda>x. x \<in> range greaterThan \<or> x \<in> range lessThan)))" 
     by (smt (verit, best) openin_topology_base_unique open_openin)
   show ?thesis
     unfolding subtopology_def arbitrary_union_of_relative_to [symmetric] 
     apply (simp add: relative_to_def flip: *)
     by (metis Int_commute)
 qed
 
 lemma continuous_map_upper_lower_semicontinuous_lt_gen:
   fixes U :: "'a::order_topology set"
   shows "continuous_map X (subtopology euclidean U) f \<longleftrightarrow>
          (\<forall>x \<in> topspace X. f x \<in> U) \<and>
          (\<forall>a. openin X {x \<in> topspace X. f x > a}) \<and>
          (\<forall>a. openin X {x \<in> topspace X. f x < a})"
   by (auto simp: continuous_map_into_topology_subbase_eq [OF subbase_subtopology_euclidean [symmetric, of U]] 
            greaterThan_def lessThan_def image_iff   simp flip: all_simps)
 
 lemma continuous_map_upper_lower_semicontinuous_lt:
   fixes f :: "'a \<Rightarrow> 'b::order_topology"
   shows "continuous_map X euclidean f \<longleftrightarrow>
          (\<forall>a. openin X {x \<in> topspace X. f x > a}) \<and>
          (\<forall>a. openin X {x \<in> topspace X. f x < a})"
   using continuous_map_upper_lower_semicontinuous_lt_gen [where U=UNIV]
   by auto
 
 lemma Int_Collect_imp_eq: "A \<inter> {x. x\<in>A \<longrightarrow> P x} = {x\<in>A. P x}"
   by blast
 
 lemma continuous_map_upper_lower_semicontinuous_le_gen:
   shows
     "continuous_map X (subtopology euclideanreal U) f \<longleftrightarrow>
          (\<forall>x \<in> topspace X. f x \<in> U) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<ge> a}) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<le> a})"
   unfolding continuous_map_upper_lower_semicontinuous_lt_gen
   by (auto simp: closedin_def Diff_eq Compl_eq not_le Int_Collect_imp_eq)
 
 lemma continuous_map_upper_lower_semicontinuous_le:
    "continuous_map X euclideanreal f \<longleftrightarrow>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<ge> a}) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<le> a})"
   using continuous_map_upper_lower_semicontinuous_le_gen [where U=UNIV]
   by auto
 
 lemma continuous_map_upper_lower_semicontinuous_lte_gen:
    "continuous_map X (subtopology euclideanreal U) f \<longleftrightarrow>
          (\<forall>x \<in> topspace X. f x \<in> U) \<and>
          (\<forall>a. openin X {x \<in> topspace X. f x < a}) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<le> a})"
   unfolding continuous_map_upper_lower_semicontinuous_lt_gen
   by (auto simp: closedin_def Diff_eq Compl_eq not_le Int_Collect_imp_eq)
 
 lemma continuous_map_upper_lower_semicontinuous_lte:
    "continuous_map X euclideanreal f \<longleftrightarrow>
          (\<forall>a. openin X {x \<in> topspace X. f x < a}) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<le> a})"
   using continuous_map_upper_lower_semicontinuous_lte_gen [where U=UNIV]
   by auto
 
 
 subsection\<^marker>\<open>tag important\<close> \<open>Pullback topology\<close>
 
 text \<open>Pulling back a topology by map gives again a topology. \<open>subtopology\<close> is
 a special case of this notion, pulling back by the identity. We introduce the general notion as
 we will need it to define the strong operator topology on the space of continuous linear operators,
 by pulling back the product topology on the space of all functions.\<close>
 
 text \<open>\<open>pullback_topology A f T\<close> is the pullback of the topology \<open>T\<close> by the map \<open>f\<close> on
 the set \<open>A\<close>.\<close>
 
 definition\<^marker>\<open>tag important\<close> pullback_topology::"('a set) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b topology) \<Rightarrow> ('a topology)"
   where "pullback_topology A f T = topology (\<lambda>S. \<exists>U. openin T U \<and> S = f-`U \<inter> A)"
 
 lemma istopology_pullback_topology:
   "istopology (\<lambda>S. \<exists>U. openin T U \<and> S = f-`U \<inter> A)"
   unfolding istopology_def proof (auto)
   fix K assume "\<forall>S\<in>K. \<exists>U. openin T U \<and> S = f -` U \<inter> A"
   then have "\<exists>U. \<forall>S\<in>K. openin T (U S) \<and> S = f-`(U S) \<inter> A"
     by (rule bchoice)
   then obtain U where U: "\<forall>S\<in>K. openin T (U S) \<and> S = f-`(U S) \<inter> A"
     by blast
   define V where "V = (\<Union>S\<in>K. U S)"
   have "openin T V" "\<Union>K = f -` V \<inter> A" unfolding V_def using U by auto
   then show "\<exists>V. openin T V \<and> \<Union>K = f -` V \<inter> A" by auto
 qed
 
 lemma openin_pullback_topology:
   "openin (pullback_topology A f T) S \<longleftrightarrow> (\<exists>U. openin T U \<and> S = f-`U \<inter> A)"
 unfolding pullback_topology_def topology_inverse'[OF istopology_pullback_topology] by auto
 
 lemma topspace_pullback_topology:
   "topspace (pullback_topology A f T) = f-`(topspace T) \<inter> A"
 by (auto simp add: topspace_def openin_pullback_topology)
 
 proposition continuous_map_pullback [intro]:
   assumes "continuous_map T1 T2 g"
   shows "continuous_map (pullback_topology A f T1) T2 (g o f)"
 unfolding continuous_map_alt
 proof (auto)
   fix U::"'b set" assume "openin T2 U"
   then have "openin T1 (g-`U \<inter> topspace T1)"
     using assms unfolding continuous_map_alt by auto
   have "(g o f)-`U \<inter> topspace (pullback_topology A f T1) = (g o f)-`U \<inter> A \<inter> f-`(topspace T1)"
     unfolding topspace_pullback_topology by auto
   also have "... = f-`(g-`U \<inter> topspace T1) \<inter> A "
     by auto
   also have "openin (pullback_topology A f T1) (...)"
     unfolding openin_pullback_topology using \<open>openin T1 (g-`U \<inter> topspace T1)\<close> by auto
   finally show "openin (pullback_topology A f T1) ((g \<circ> f) -` U \<inter> topspace (pullback_topology A f T1))"
     by auto
 next
   fix x assume "x \<in> topspace (pullback_topology A f T1)"
   then have "f x \<in> topspace T1"
     unfolding topspace_pullback_topology by auto
   then show "g (f x) \<in> topspace T2"
     using assms unfolding continuous_map_def by auto
 qed
 
 proposition continuous_map_pullback' [intro]:
   assumes "continuous_map T1 T2 (f o g)" "topspace T1 \<subseteq> g-`A"
   shows "continuous_map T1 (pullback_topology A f T2) g"
 unfolding continuous_map_alt
 proof (auto)
   fix U assume "openin (pullback_topology A f T2) U"
   then have "\<exists>V. openin T2 V \<and> U = f-`V \<inter> A"
     unfolding openin_pullback_topology by auto
   then obtain V where "openin T2 V" "U = f-`V \<inter> A"
     by blast
   then have "g -` U \<inter> topspace T1 = g-`(f-`V \<inter> A) \<inter> topspace T1"
     by blast
   also have "... = (f o g)-`V \<inter> (g-`A \<inter> topspace T1)"
     by auto
   also have "... = (f o g)-`V \<inter> topspace T1"
     using assms(2) by auto
   also have "openin T1 (...)"
     using assms(1) \<open>openin T2 V\<close> by auto
   finally show "openin T1 (g -` U \<inter> topspace T1)" by simp
 next
   fix x assume "x \<in> topspace T1"
   have "(f o g) x \<in> topspace T2"
     using assms(1) \<open>x \<in> topspace T1\<close> unfolding continuous_map_def by auto
   then have "g x \<in> f-`(topspace T2)"
     unfolding comp_def by blast
   moreover have "g x \<in> A" using assms(2) \<open>x \<in> topspace T1\<close> by blast
   ultimately show "g x \<in> topspace (pullback_topology A f T2)"
     unfolding topspace_pullback_topology by blast
 qed
 subsection\<open>Proper maps (not a priori assumed continuous) \<close>
 
 definition proper_map
   where
  "proper_map X Y f \<equiv>
         closed_map X Y f \<and> (\<forall>y \<in> topspace Y. compactin X {x \<in> topspace X. f x = y})"
 
 lemma proper_imp_closed_map:
    "proper_map X Y f \<Longrightarrow> closed_map X Y f"
   by (simp add: proper_map_def)
 
 lemma proper_map_imp_subset_topspace:
    "proper_map X Y f \<Longrightarrow> f ` (topspace X) \<subseteq> topspace Y"
   by (simp add: closed_map_imp_subset_topspace proper_map_def)
 
 lemma proper_map_restriction:
   assumes "proper_map X Y f" "{x \<in> topspace X. f x \<in> V} = U"
   shows "proper_map (subtopology X U) (subtopology Y V) f"
 proof -
   have [simp]: "{x \<in> topspace X. f x \<in> V \<and> f x = y} = {x \<in> topspace X. f x = y}" 
     if "y \<in> V" for y
     using that by auto
   show ?thesis
     using assms unfolding proper_map_def using closed_map_restriction
     by (force simp: compactin_subtopology)
 qed
 
 lemma closed_injective_imp_proper_map:
   assumes f: "closed_map X Y f" and inj: "inj_on f (topspace X)"
   shows "proper_map X Y f"
   unfolding proper_map_def
 proof (clarsimp simp: f)
   show "compactin X {x \<in> topspace X. f x = y}"
     if "y \<in> topspace Y" for y
 using inj_on_eq_iff [OF inj] that
   proof -
     have "{x \<in> topspace X. f x = y} = {} \<or> (\<exists>a \<in> topspace X. {x \<in> topspace X. f x = y} = {a})"
       using inj_on_eq_iff [OF inj] by auto
     then show ?thesis
       using that by (metis (no_types, lifting) compactin_empty compactin_sing)
   qed
 qed
 
 lemma injective_imp_proper_eq_closed_map:
    "inj_on f (topspace X) \<Longrightarrow> (proper_map X Y f \<longleftrightarrow> closed_map X Y f)"
   using closed_injective_imp_proper_map proper_imp_closed_map by blast
 
 lemma homeomorphic_imp_proper_map:
    "homeomorphic_map X Y f \<Longrightarrow> proper_map X Y f"
   by (simp add: closed_injective_imp_proper_map homeomorphic_eq_everything_map)
 
 lemma compactin_proper_map_preimage:
   assumes f: "proper_map X Y f" and "compactin Y K"
   shows "compactin X {x. x \<in> topspace X \<and> f x \<in> K}"
 proof -
   have "f ` (topspace X) \<subseteq> topspace Y"
     by (simp add: f proper_map_imp_subset_topspace)
   have *: "\<And>y. y \<in> topspace Y \<Longrightarrow> compactin X {x \<in> topspace X. f x = y}"
     using f by (auto simp: proper_map_def)
   show ?thesis
     unfolding compactin_def
   proof clarsimp
     show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> {x \<in> topspace X. f x \<in> K} \<subseteq> \<Union>\<F>"
       if \<U>: "\<forall>U\<in>\<U>. openin X U" and sub: "{x \<in> topspace X. f x \<in> K} \<subseteq> \<Union>\<U>"
       for \<U>
     proof -
       have "\<forall>y \<in> K. \<exists>\<V>. finite \<V> \<and> \<V> \<subseteq> \<U>  \<and> {x \<in> topspace X. f x = y} \<subseteq> \<Union>\<V>"
       proof
         fix y
         assume "y \<in> K"
         then have "compactin X {x \<in> topspace X. f x = y}"
           by (metis "*" \<open>compactin Y K\<close> compactin_subspace subsetD)
         with \<open>y \<in> K\<close> show "\<exists>\<V>. finite \<V> \<and> \<V> \<subseteq> \<U>  \<and> {x \<in> topspace X. f x = y} \<subseteq> \<Union>\<V>"
           unfolding compactin_def using \<U> sub by fastforce
       qed
       then obtain \<V> where \<V>: "\<And>y. y \<in> K \<Longrightarrow> finite (\<V> y) \<and> \<V> y \<subseteq> \<U>  \<and> {x \<in> topspace X. f x = y} \<subseteq> \<Union>(\<V> y)"
         by (metis (full_types))
       define F where "F \<equiv> \<lambda>y. topspace Y - f ` (topspace X - \<Union>(\<V> y))"
       have "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> F ` K \<and> K \<subseteq> \<Union>\<F>"
       proof (rule compactinD [OF \<open>compactin Y K\<close>])
         have "\<And>x. x \<in> K \<Longrightarrow> closedin Y (f ` (topspace X - \<Union>(\<V> x)))"
           using f unfolding proper_map_def closed_map_def
           by (meson \<U> \<V> openin_Union openin_closedin_eq subsetD)
         then show "openin Y U" if "U \<in> F ` K" for U
           using that by (auto simp: F_def)
         show "K \<subseteq> \<Union>(F ` K)"
           using \<V> \<open>compactin Y K\<close> unfolding F_def compactin_def by fastforce
       qed
       then obtain J where "finite J" "J \<subseteq> K" and J: "K \<subseteq> \<Union>(F ` J)"
         by (auto simp: ex_finite_subset_image)
       show ?thesis
         unfolding F_def
       proof (intro exI conjI)
         show "finite (\<Union>(\<V> ` J))"
           using \<V> \<open>J \<subseteq> K\<close> \<open>finite J\<close> by blast
         show "\<Union>(\<V> ` J) \<subseteq> \<U>"
           using \<V> \<open>J \<subseteq> K\<close> by blast
         show "{x \<in> topspace X. f x \<in> K} \<subseteq> \<Union>(\<Union>(\<V> ` J))"
           using J \<open>J \<subseteq> K\<close> unfolding F_def by auto
       qed
     qed
   qed
 qed
 
 
 lemma compact_space_proper_map_preimage:
   assumes f: "proper_map X Y f" and fim: "f ` (topspace X) = topspace Y" and "compact_space Y"
   shows "compact_space X"
 proof -
   have eq: "topspace X = {x \<in> topspace X. f x \<in> topspace Y}"
     using fim by blast
   moreover have "compactin Y (topspace Y)"
     using \<open>compact_space Y\<close> compact_space_def by auto
   ultimately show ?thesis
     unfolding compact_space_def
     using eq f compactin_proper_map_preimage by fastforce
 qed
 
 lemma proper_map_alt:
    "proper_map X Y f \<longleftrightarrow>
     closed_map X Y f \<and> (\<forall>K. compactin Y K \<longrightarrow> compactin X {x. x \<in> topspace X \<and> f x \<in> K})"
   proof (intro iffI conjI allI impI)
   show "compactin X {x \<in> topspace X. f x \<in> K}"
     if "proper_map X Y f" and "compactin Y K" for K
     using that by (simp add: compactin_proper_map_preimage)
   show "proper_map X Y f"
     if f: "closed_map X Y f \<and> (\<forall>K. compactin Y K \<longrightarrow> compactin X {x \<in> topspace X. f x \<in> K})"
   proof -
     have "compactin X {x \<in> topspace X. f x = y}" if "y \<in> topspace Y" for y
     proof -
       have "compactin X {x \<in> topspace X. f x \<in> {y}}"
         using f compactin_sing that by fastforce
       then show ?thesis
         by auto
     qed
     with f show ?thesis
       by (auto simp: proper_map_def)
   qed
 qed (simp add: proper_imp_closed_map)
 
 lemma proper_map_on_empty:
    "topspace X = {} \<Longrightarrow> proper_map X Y f"
   by (auto simp: proper_map_def closed_map_on_empty)
 
 lemma proper_map_id [simp]:
    "proper_map X X id"
 proof (clarsimp simp: proper_map_alt closed_map_id)
   fix K
   assume K: "compactin X K"
   then have "{a \<in> topspace X. a \<in> K} = K"
     by (simp add: compactin_subspace subset_antisym subset_iff)
   then show "compactin X {a \<in> topspace X. a \<in> K}"
     using K by auto
 qed
 
 lemma proper_map_compose:
   assumes "proper_map X Y f" "proper_map Y Z g"
   shows "proper_map X Z (g \<circ> f)"
 proof -
   have "closed_map X Y f" and f: "\<And>K. compactin Y K \<Longrightarrow> compactin X {x \<in> topspace X. f x \<in> K}"
     and "closed_map Y Z g" and g: "\<And>K. compactin Z K \<Longrightarrow> compactin Y {x \<in> topspace Y. g x \<in> K}"
     using assms by (auto simp: proper_map_alt)
   show ?thesis
     unfolding proper_map_alt
   proof (intro conjI allI impI)
     show "closed_map X Z (g \<circ> f)"
       using \<open>closed_map X Y f\<close> \<open>closed_map Y Z g\<close> closed_map_compose by blast
     have "{x \<in> topspace X. g (f x) \<in> K} = {x \<in> topspace X. f x \<in> {b \<in> topspace Y. g b \<in> K}}" for K
       using \<open>closed_map X Y f\<close> closed_map_imp_subset_topspace by blast
     then show "compactin X {x \<in> topspace X. (g \<circ> f) x \<in> K}"
       if "compactin Z K" for K
       using f [OF g [OF that]] by auto
   qed
 qed
 
 lemma proper_map_const:
    "proper_map X Y (\<lambda>x. c) \<longleftrightarrow> compact_space X \<and> (topspace X = {} \<or> closedin Y {c})"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (simp add: compact_space_topspace_empty proper_map_on_empty)
 next
   case False
   have *: "compactin X {x \<in> topspace X. c = y}" if "compact_space X" for y
     using that unfolding compact_space_def
     by (metis (mono_tags, lifting) compactin_empty empty_subsetI mem_Collect_eq subsetI subset_antisym)
   then show ?thesis
     using closed_compactin closedin_subset
     by (force simp: False proper_map_def closed_map_const compact_space_def)
 qed
 
 lemma proper_map_inclusion:
    "S \<subseteq> topspace X \<Longrightarrow> proper_map (subtopology X S) X id \<longleftrightarrow> closedin X S \<and> (\<forall>k. compactin X k \<longrightarrow> compactin X (S \<inter> k))"
   by (metis closed_Int_compactin closed_map_inclusion_eq inf.absorb_iff2 inj_on_id injective_imp_proper_eq_closed_map)
 
 lemma proper_map_into_subtopology:
    "\<lbrakk>proper_map X Y f; f ` topspace X \<subseteq> C\<rbrakk> \<Longrightarrow> proper_map X (subtopology Y C) f"
   by (simp add: closed_map_into_subtopology compactin_subtopology proper_map_alt)
 
 lemma proper_map_from_composition_left:
   assumes gf: "proper_map X Z (g \<circ> f)" and contf: "continuous_map X Y f" and fim: "f ` topspace X = topspace Y"
   shows "proper_map Y Z g"
   unfolding proper_map_def
 proof (intro strip conjI)
   show "closed_map Y Z g"
     by (meson closed_map_from_composition_left gf contf fim proper_imp_closed_map)
   fix z assume "z \<in> topspace Z"
   have eq: "{y \<in> topspace Y. g y = z} = f ` {x \<in> topspace X. (g \<circ> f) x = z}"
     using fim by force
   show "compactin Y {x \<in> topspace Y. g x = z}"
     unfolding eq
   proof (rule image_compactin [OF _ contf])
     show "compactin X {x \<in> topspace X. (g \<circ> f) x = z}"
       using \<open>z \<in> topspace Z\<close> gf proper_map_def by fastforce
   qed
 qed
 
 lemma proper_map_from_composition_right_inj:
   assumes gf: "proper_map X Z (g \<circ> f)" and fim: "f ` topspace X \<subseteq> topspace Y" 
     and contf: "continuous_map Y Z g" and inj: "inj_on g (topspace Y)"
   shows "proper_map X Y f"
   unfolding proper_map_def
 proof (intro strip conjI)
   show "closed_map X Y f"
     by (meson closed_map_from_composition_right assms proper_imp_closed_map)
   fix y
   assume "y \<in> topspace Y"
   with fim inj have eq: "{x \<in> topspace X. f x = y} = {x \<in> topspace X. (g \<circ> f) x = g y}"
     by (auto simp: image_subset_iff inj_onD)
   show "compactin X {x \<in> topspace X. f x = y}"
     unfolding eq
     by (smt (verit) Collect_cong \<open>y \<in> topspace Y\<close> contf continuous_map_closedin gf proper_map_def)
 qed
 
 
 subsection\<open>Perfect maps (proper, continuous and surjective)\<close>
 
 definition perfect_map 
   where "perfect_map X Y f \<equiv> continuous_map X Y f \<and> proper_map X Y f \<and> f ` (topspace X) = topspace Y"
 
 lemma homeomorphic_imp_perfect_map:
    "homeomorphic_map X Y f \<Longrightarrow> perfect_map X Y f"
   by (simp add: homeomorphic_eq_everything_map homeomorphic_imp_proper_map perfect_map_def)
 
 lemma perfect_imp_quotient_map:
    "perfect_map X Y f \<Longrightarrow> quotient_map X Y f"
   by (simp add: continuous_closed_imp_quotient_map perfect_map_def proper_map_def)
 
 lemma homeomorphic_eq_injective_perfect_map:
    "homeomorphic_map X Y f \<longleftrightarrow> perfect_map X Y f \<and> inj_on f (topspace X)"
   using homeomorphic_imp_perfect_map homeomorphic_map_def perfect_imp_quotient_map by blast
 
 lemma perfect_injective_eq_homeomorphic_map:
    "perfect_map X Y f \<and> inj_on f (topspace X) \<longleftrightarrow> homeomorphic_map X Y f"
   by (simp add: homeomorphic_eq_injective_perfect_map)
 
 lemma perfect_map_id [simp]: "perfect_map X X id"
   by (simp add: homeomorphic_imp_perfect_map)
 
 lemma perfect_map_compose:
    "\<lbrakk>perfect_map X Y f; perfect_map Y Z g\<rbrakk> \<Longrightarrow> perfect_map X Z (g \<circ> f)"
   by (meson continuous_map_compose perfect_imp_quotient_map perfect_map_def proper_map_compose quotient_map_compose_eq quotient_map_def)
 
 lemma perfect_imp_continuous_map:
    "perfect_map X Y f \<Longrightarrow> continuous_map X Y f"
   using perfect_map_def by blast
 
 lemma perfect_imp_closed_map:
    "perfect_map X Y f \<Longrightarrow> closed_map X Y f"
   by (simp add: perfect_map_def proper_map_def)
 
 lemma perfect_imp_proper_map:
    "perfect_map X Y f \<Longrightarrow> proper_map X Y f"
   by (simp add: perfect_map_def)
 
 lemma perfect_imp_surjective_map:
    "perfect_map X Y f \<Longrightarrow> f ` (topspace X) = topspace Y"
   by (simp add: perfect_map_def)
 
 lemma perfect_map_from_composition_left:
   assumes "perfect_map X Z (g \<circ> f)" and "continuous_map X Y f"
     and "continuous_map Y Z g" and "f ` topspace X = topspace Y"
   shows "perfect_map Y Z g"
   using assms unfolding perfect_map_def
   by (metis image_comp proper_map_from_composition_left)
 
 end
diff --git a/src/HOL/Analysis/Analysis.thy b/src/HOL/Analysis/Analysis.thy
--- a/src/HOL/Analysis/Analysis.thy
+++ b/src/HOL/Analysis/Analysis.thy
@@ -1,58 +1,59 @@
 theory Analysis
   imports
   (* Linear Algebra *)
   Convex
   Determinants
   (* Topology *)
   FSigma
   Sum_Topology
   Abstract_Topological_Spaces
   Abstract_Metric_Spaces
+  Urysohn
   Connected
   Abstract_Limits
   Isolated
   (* Functional Analysis *)
   Elementary_Normed_Spaces
   Norm_Arith
   (* Vector Analysis *)
   Convex_Euclidean_Space
   Operator_Norm
   (* Unsorted *)
   Line_Segment
   Derivative
   Cartesian_Euclidean_Space
   Weierstrass_Theorems
   (* Measure and Integration Theory *)
   Ball_Volume
   Integral_Test
   Improper_Integral
   Equivalence_Measurable_On_Borel
   Lebesgue_Integral_Substitution
   Embed_Measure
   Complete_Measure
   Radon_Nikodym
   Fashoda_Theorem
   Cross3
   Homeomorphism
   Bounded_Continuous_Function
   Abstract_Topology
   Product_Topology
   Lindelof_Spaces
   Infinite_Products
   Infinite_Sum
   Infinite_Set_Sum
   Polytope
   Jordan_Curve
   Poly_Roots
   Generalised_Binomial_Theorem
   Gamma_Function
   Change_Of_Vars
   Multivariate_Analysis
   Simplex_Content
   FPS_Convergence
   Smooth_Paths
   Abstract_Euclidean_Space
   Function_Metric
 begin
 
 end
diff --git a/src/HOL/Analysis/Homotopy.thy b/src/HOL/Analysis/Homotopy.thy
--- a/src/HOL/Analysis/Homotopy.thy
+++ b/src/HOL/Analysis/Homotopy.thy
@@ -1,5379 +1,5403 @@
 (*  Title:      HOL/Analysis/Path_Connected.thy
     Authors:    LC Paulson and Robert Himmelmann (TU Muenchen), based on material from HOL Light
 *)
 
 section \<open>Homotopy of Maps\<close>
 
 theory Homotopy
   imports Path_Connected Product_Topology Uncountable_Sets
 begin
 
 definition\<^marker>\<open>tag important\<close> homotopic_with
 where
  "homotopic_with P X Y f g \<equiv>
    (\<exists>h. continuous_map (prod_topology (top_of_set {0..1::real}) X) Y h \<and>
        (\<forall>x. h(0, x) = f x) \<and>
        (\<forall>x. h(1, x) = g x) \<and>
        (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t,x))))"
 
 text\<open>\<open>p\<close>, \<open>q\<close> are functions \<open>X \<rightarrow> Y\<close>, and the property \<open>P\<close> restricts all intermediate maps.
 We often just want to require that \<open>P\<close> fixes some subset, but to include the case of a loop homotopy,
 it is convenient to have a general property \<open>P\<close>.\<close>
 
 abbreviation homotopic_with_canon ::
   "[('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> bool, 'a set, 'b set, 'a \<Rightarrow> 'b, 'a \<Rightarrow> 'b] \<Rightarrow> bool"
 where
  "homotopic_with_canon P S T p q \<equiv> homotopic_with P (top_of_set S) (top_of_set T) p q"
 
 lemma split_01: "{0..1::real} = {0..1/2} \<union> {1/2..1}"
   by force
 
 lemma split_01_prod: "{0..1::real} \<times> X = ({0..1/2} \<times> X) \<union> ({1/2..1} \<times> X)"
   by force
 
 lemma image_Pair_const: "(\<lambda>x. (x, c)) ` A = A \<times> {c}"
   by auto
 
 lemma fst_o_paired [simp]: "fst \<circ> (\<lambda>(x,y). (f x y, g x y)) = (\<lambda>(x,y). f x y)"
   by auto
 
 lemma snd_o_paired [simp]: "snd \<circ> (\<lambda>(x,y). (f x y, g x y)) = (\<lambda>(x,y). g x y)"
   by auto
 
 lemma continuous_on_o_Pair: "\<lbrakk>continuous_on (T \<times> X) h; t \<in> T\<rbrakk> \<Longrightarrow> continuous_on X (h \<circ> Pair t)"
   by (fast intro: continuous_intros elim!: continuous_on_subset)
 
 lemma continuous_map_o_Pair: 
   assumes h: "continuous_map (prod_topology X Y) Z h" and t: "t \<in> topspace X"
   shows "continuous_map Y Z (h \<circ> Pair t)"
   by (intro continuous_map_compose [OF _ h] continuous_intros; simp add: t)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Trivial properties\<close>
 
 text \<open>We often want to just localize the ending function equality or whatever.\<close>
 text\<^marker>\<open>tag important\<close> \<open>%whitespace\<close>
 proposition homotopic_with:
   assumes "\<And>h k. (\<And>x. x \<in> topspace X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k)"
   shows "homotopic_with P X Y p q \<longleftrightarrow>
            (\<exists>h. continuous_map (prod_topology (subtopology euclideanreal {0..1}) X) Y h \<and>
               (\<forall>x \<in> topspace X. h(0,x) = p x) \<and>
               (\<forall>x \<in> topspace X. h(1,x) = q x) \<and>
               (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
   unfolding homotopic_with_def
   apply (rule iffI, blast, clarify)
   apply (rule_tac x="\<lambda>(u,v). if v \<in> topspace X then h(u,v) else if u = 0 then p v else q v" in exI)
   apply simp
   by (smt (verit, best) SigmaE assms case_prod_conv continuous_map_eq topspace_prod_topology)
 
 lemma homotopic_with_mono:
   assumes hom: "homotopic_with P X Y f g"
     and Q: "\<And>h. \<lbrakk>continuous_map X Y h; P h\<rbrakk> \<Longrightarrow> Q h"
   shows "homotopic_with Q X Y f g"
   using hom unfolding homotopic_with_def
   by (force simp: o_def dest: continuous_map_o_Pair intro: Q)
 
 lemma homotopic_with_imp_continuous_maps:
     assumes "homotopic_with P X Y f g"
     shows "continuous_map X Y f \<and> continuous_map X Y g"
 proof -
   obtain h :: "real \<times> 'a \<Rightarrow> 'b"
     where conth: "continuous_map (prod_topology (top_of_set {0..1}) X) Y h"
       and h: "\<forall>x. h (0, x) = f x" "\<forall>x. h (1, x) = g x"
     using assms by (auto simp: homotopic_with_def)
   have *: "t \<in> {0..1} \<Longrightarrow> continuous_map X Y (h \<circ> (\<lambda>x. (t,x)))" for t
     by (rule continuous_map_compose [OF _ conth]) (simp add: o_def continuous_map_pairwise)
   show ?thesis
     using h *[of 0] *[of 1] by (simp add: continuous_map_eq)
 qed
 
 lemma homotopic_with_imp_continuous:
     assumes "homotopic_with_canon P X Y f g"
     shows "continuous_on X f \<and> continuous_on X g"
   by (meson assms continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 lemma homotopic_with_imp_property:
   assumes "homotopic_with P X Y f g"
   shows "P f \<and> P g"
 proof
   obtain h where h: "\<And>x. h(0, x) = f x" "\<And>x. h(1, x) = g x" and P: "\<And>t. t \<in> {0..1::real} \<Longrightarrow> P(\<lambda>x. h(t,x))"
     using assms by (force simp: homotopic_with_def)
   show "P f" "P g"
     using P [of 0] P [of 1] by (force simp: h)+
 qed
 
 lemma homotopic_with_equal:
   assumes "P f" "P g" and contf: "continuous_map X Y f" and fg: "\<And>x. x \<in> topspace X \<Longrightarrow> f x = g x"
   shows "homotopic_with P X Y f g"
   unfolding homotopic_with_def
 proof (intro exI conjI allI ballI)
   let ?h = "\<lambda>(t::real,x). if t = 1 then g x else f x"
   show "continuous_map (prod_topology (top_of_set {0..1}) X) Y ?h"
   proof (rule continuous_map_eq)
     show "continuous_map (prod_topology (top_of_set {0..1}) X) Y (f \<circ> snd)"
       by (simp add: contf continuous_map_of_snd)
   qed (auto simp: fg)
   show "P (\<lambda>x. ?h (t, x))" if "t \<in> {0..1}" for t
     by (cases "t = 1") (simp_all add: assms)
 qed auto
 
 lemma homotopic_with_imp_subset1:
      "homotopic_with_canon P X Y f g \<Longrightarrow> f ` X \<subseteq> Y"
   by (meson continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 lemma homotopic_with_imp_subset2:
      "homotopic_with_canon P X Y f g \<Longrightarrow> g ` X \<subseteq> Y"
   by (meson continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 lemma homotopic_with_subset_left:
      "\<lbrakk>homotopic_with_canon P X Y f g; Z \<subseteq> X\<rbrakk> \<Longrightarrow> homotopic_with_canon P Z Y f g"
   unfolding homotopic_with_def by (auto elim!: continuous_on_subset ex_forward)
 
 lemma homotopic_with_subset_right:
      "\<lbrakk>homotopic_with_canon P X Y f g; Y \<subseteq> Z\<rbrakk> \<Longrightarrow> homotopic_with_canon P X Z f g"
   unfolding homotopic_with_def by (auto elim!: continuous_on_subset ex_forward)
 
 subsection\<open>Homotopy with P is an equivalence relation\<close>
 
 text \<open>(on continuous functions mapping X into Y that satisfy P, though this only affects reflexivity)\<close>
 
 lemma homotopic_with_refl [simp]: "homotopic_with P X Y f f \<longleftrightarrow> continuous_map X Y f \<and> P f"
   by (metis homotopic_with_equal homotopic_with_imp_continuous_maps homotopic_with_imp_property)
 
 lemma homotopic_with_symD:
     assumes "homotopic_with P X Y f g"
       shows "homotopic_with P X Y g f"
 proof -
   let ?I01 = "subtopology euclideanreal {0..1}"
   let ?j = "\<lambda>y. (1 - fst y, snd y)"
   have 1: "continuous_map (prod_topology ?I01 X) (prod_topology euclideanreal X) ?j"
     by (intro continuous_intros; simp add: continuous_map_subtopology_fst prod_topology_subtopology)
   have *: "continuous_map (prod_topology ?I01 X) (prod_topology ?I01 X) ?j"
   proof -
     have "continuous_map (prod_topology ?I01 X) (subtopology (prod_topology euclideanreal X) ({0..1} \<times> topspace X)) ?j"
       by (simp add: continuous_map_into_subtopology [OF 1] image_subset_iff)
     then show ?thesis
       by (simp add: prod_topology_subtopology(1))
   qed
   show ?thesis
     using assms
     apply (clarsimp simp: homotopic_with_def)
     subgoal for h
       by (rule_tac x="h \<circ> (\<lambda>y. (1 - fst y, snd y))" in exI) (simp add: continuous_map_compose [OF *])
     done
 qed
 
 lemma homotopic_with_sym:
    "homotopic_with P X Y f g \<longleftrightarrow> homotopic_with P X Y g f"
   by (metis homotopic_with_symD)
 
 proposition homotopic_with_trans:
     assumes "homotopic_with P X Y f g"  "homotopic_with P X Y g h"
     shows "homotopic_with P X Y f h"
 proof -
   let ?X01 = "prod_topology (subtopology euclideanreal {0..1}) X"
   obtain k1 k2
     where contk1: "continuous_map ?X01 Y k1" and contk2: "continuous_map ?X01 Y k2"
       and k12: "\<forall>x. k1 (1, x) = g x" "\<forall>x. k2 (0, x) = g x"
       "\<forall>x. k1 (0, x) = f x" "\<forall>x. k2 (1, x) = h x"
       and P:   "\<forall>t\<in>{0..1}. P (\<lambda>x. k1 (t, x))" "\<forall>t\<in>{0..1}. P (\<lambda>x. k2 (t, x))"
     using assms by (auto simp: homotopic_with_def)
   define k where "k \<equiv> \<lambda>y. if fst y \<le> 1/2
                              then (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y
                              else (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y"
   have keq: "k1 (2 * u, v) = k2 (2 * u -1, v)" if "u = 1/2"  for u v
     by (simp add: k12 that)
   show ?thesis
     unfolding homotopic_with_def
   proof (intro exI conjI)
     show "continuous_map ?X01 Y k"
       unfolding k_def
     proof (rule continuous_map_cases_le)
       show fst: "continuous_map ?X01 euclideanreal fst"
         using continuous_map_fst continuous_map_in_subtopology by blast
       show "continuous_map ?X01 euclideanreal (\<lambda>x. 1/2)"
         by simp
       show "continuous_map (subtopology ?X01 {y \<in> topspace ?X01. fst y \<le> 1/2}) Y
                (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x)))"
         apply (intro fst continuous_map_compose [OF _ contk1] continuous_intros continuous_map_into_subtopology continuous_map_from_subtopology | simp)+
         by (force simp: prod_topology_subtopology)
       show "continuous_map (subtopology ?X01 {y \<in> topspace ?X01. 1/2 \<le> fst y}) Y
                (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x)))"
         apply (intro fst continuous_map_compose [OF _ contk2] continuous_intros continuous_map_into_subtopology continuous_map_from_subtopology | simp)+
         by (force simp: prod_topology_subtopology)
       show "(k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y = (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y"
         if "y \<in> topspace ?X01" and "fst y = 1/2" for y
         using that by (simp add: keq)
     qed
     show "\<forall>x. k (0, x) = f x"
       by (simp add: k12 k_def)
     show "\<forall>x. k (1, x) = h x"
       by (simp add: k12 k_def)
     show "\<forall>t\<in>{0..1}. P (\<lambda>x. k (t, x))"
     proof 
       fix t show "t\<in>{0..1} \<Longrightarrow> P (\<lambda>x. k (t, x))"
         by (cases "t \<le> 1/2") (auto simp: k_def P)
     qed
   qed
 qed
 
 lemma homotopic_with_id2: 
   "(\<And>x. x \<in> topspace X \<Longrightarrow> g (f x) = x) \<Longrightarrow> homotopic_with (\<lambda>x. True) X X (g \<circ> f) id"
   by (metis comp_apply continuous_map_id eq_id_iff homotopic_with_equal homotopic_with_symD)
 
 subsection\<open>Continuity lemmas\<close>
 
 lemma homotopic_with_compose_continuous_map_left:
   "\<lbrakk>homotopic_with p X1 X2 f g; continuous_map X2 X3 h; \<And>j. p j \<Longrightarrow> q(h \<circ> j)\<rbrakk>
    \<Longrightarrow> homotopic_with q X1 X3 (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_with_def
   apply clarify
   subgoal for k
     by (rule_tac x="h \<circ> k" in exI) (rule conjI continuous_map_compose | simp add: o_def)+
   done
 
 lemma homotopic_with_compose_continuous_map_right:
   assumes hom: "homotopic_with p X2 X3 f g" and conth: "continuous_map X1 X2 h"
     and q: "\<And>j. p j \<Longrightarrow> q(j \<circ> h)"
   shows "homotopic_with q X1 X3 (f \<circ> h) (g \<circ> h)"
 proof -
   obtain k
     where contk: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X2) X3 k"
       and k: "\<forall>x. k (0, x) = f x" "\<forall>x. k (1, x) = g x" and p: "\<And>t. t\<in>{0..1} \<Longrightarrow> p (\<lambda>x. k (t, x))"
     using hom unfolding homotopic_with_def by blast
   have hsnd: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) X2 (h \<circ> snd)"
     by (rule continuous_map_compose [OF continuous_map_snd conth])
   let ?h = "k \<circ> (\<lambda>(t,x). (t,h x))"
   show ?thesis
     unfolding homotopic_with_def
   proof (intro exI conjI allI ballI)
     have "continuous_map (prod_topology (top_of_set {0..1}) X1)
      (prod_topology (top_of_set {0..1::real}) X2) (\<lambda>(t, x). (t, h x))"
       by (metis (mono_tags, lifting) case_prod_beta' comp_def continuous_map_eq continuous_map_fst continuous_map_pairedI hsnd)
     then show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) X3 ?h"
       by (intro conjI continuous_map_compose [OF _ contk])
     show "q (\<lambda>x. ?h (t, x))" if "t \<in> {0..1}" for t
       using q [OF p [OF that]] by (simp add: o_def)
   qed (auto simp: k)
 qed
 
 corollary homotopic_compose:
   assumes "homotopic_with (\<lambda>x. True) X Y f f'" "homotopic_with (\<lambda>x. True) Y Z g g'"
   shows "homotopic_with (\<lambda>x. True) X Z (g \<circ> f) (g' \<circ> f')"
   by (metis assms homotopic_with_compose_continuous_map_left homotopic_with_compose_continuous_map_right homotopic_with_imp_continuous_maps homotopic_with_trans)
 
 proposition homotopic_with_compose_continuous_right:
     "\<lbrakk>homotopic_with_canon (\<lambda>f. p (f \<circ> h)) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
      \<Longrightarrow> homotopic_with_canon p W Y (f \<circ> h) (g \<circ> h)"
   by (simp add: homotopic_with_compose_continuous_map_right)
 
 proposition homotopic_with_compose_continuous_left:
      "\<lbrakk>homotopic_with_canon (\<lambda>f. p (h \<circ> f)) X Y f g; continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
       \<Longrightarrow> homotopic_with_canon p X Z (h \<circ> f) (h \<circ> g)"
   by (simp add: homotopic_with_compose_continuous_map_left)
 
 lemma homotopic_from_subtopology:
    "homotopic_with P X X' f g \<Longrightarrow> homotopic_with P (subtopology X S) X' f g"
   by (metis continuous_map_id_subt homotopic_with_compose_continuous_map_right o_id)
 
 lemma homotopic_on_emptyI:
     assumes "topspace X = {}" "P f" "P g"
     shows "homotopic_with P X X' f g"
   by (metis assms continuous_map_on_empty empty_iff homotopic_with_equal)
 
 lemma homotopic_on_empty:
    "topspace X = {} \<Longrightarrow> (homotopic_with P X X' f g \<longleftrightarrow> P f \<and> P g)"
   using homotopic_on_emptyI homotopic_with_imp_property by metis
 
 lemma homotopic_with_canon_on_empty [simp]: "homotopic_with_canon (\<lambda>x. True) {} t f g"
   by (auto intro: homotopic_with_equal)
 
 lemma homotopic_constant_maps:
    "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. a) (\<lambda>x. b) \<longleftrightarrow>
     topspace X = {} \<or> path_component_of X' a b" (is "?lhs = ?rhs")
 proof (cases "topspace X = {}")
   case False
   then obtain c where c: "c \<in> topspace X"
     by blast
   have "\<exists>g. continuous_map (top_of_set {0..1::real}) X' g \<and> g 0 = a \<and> g 1 = b"
     if "x \<in> topspace X" and hom: "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. a) (\<lambda>x. b)" for x
   proof -
     obtain h :: "real \<times> 'a \<Rightarrow> 'b"
       where conth: "continuous_map (prod_topology (top_of_set {0..1}) X) X' h"
         and h: "\<And>x. h (0, x) = a" "\<And>x. h (1, x) = b"
       using hom by (auto simp: homotopic_with_def)
     have cont: "continuous_map (top_of_set {0..1}) X' (h \<circ> (\<lambda>t. (t, c)))"
       by (rule continuous_map_compose [OF _ conth] continuous_intros c | simp)+
     then show ?thesis
       by (force simp: h)
   qed
   moreover have "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. g 0) (\<lambda>x. g 1)"
     if "x \<in> topspace X" "a = g 0" "b = g 1" "continuous_map (top_of_set {0..1}) X' g"
     for x and g :: "real \<Rightarrow> 'b"
     unfolding homotopic_with_def
     by (force intro!: continuous_map_compose continuous_intros c that)
   ultimately show ?thesis
     using False by (auto simp: path_component_of_def pathin_def)
 qed (simp add: homotopic_on_empty)
 
 proposition homotopic_with_eq:
    assumes h: "homotopic_with P X Y f g"
        and f': "\<And>x. x \<in> topspace X \<Longrightarrow> f' x = f x"
        and g': "\<And>x. x \<in> topspace X \<Longrightarrow> g' x = g x"
        and P:  "(\<And>h k. (\<And>x. x \<in> topspace X \<Longrightarrow> h x = k x) \<Longrightarrow> P h \<longleftrightarrow> P k)"
    shows "homotopic_with P X Y f' g'"
   by (smt (verit, ccfv_SIG) assms homotopic_with)
 
 lemma homotopic_with_prod_topology:
   assumes "homotopic_with p X1 Y1 f f'" and "homotopic_with q X2 Y2 g g'"
     and r: "\<And>i j. \<lbrakk>p i; q j\<rbrakk> \<Longrightarrow> r(\<lambda>(x,y). (i x, j y))"
   shows "homotopic_with r (prod_topology X1 X2) (prod_topology Y1 Y2)
                           (\<lambda>z. (f(fst z),g(snd z))) (\<lambda>z. (f'(fst z), g'(snd z)))"
 proof -
   obtain h
     where h: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) Y1 h"
       and h0: "\<And>x. h (0, x) = f x"
       and h1: "\<And>x. h (1, x) = f' x"
       and p: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> p (\<lambda>x. h (t,x))"
     using assms unfolding homotopic_with_def by auto
   obtain k
     where k: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X2) Y2 k"
       and k0: "\<And>x. k (0, x) = g x"
       and k1: "\<And>x. k (1, x) = g' x"
       and q: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> q (\<lambda>x. k (t,x))"
     using assms unfolding homotopic_with_def by auto
   let ?hk = "\<lambda>(t,x,y). (h(t,x), k(t,y))"
   show ?thesis
     unfolding homotopic_with_def
   proof (intro conjI allI exI)
     show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (prod_topology X1 X2))
                          (prod_topology Y1 Y2) ?hk"
       unfolding continuous_map_pairwise case_prod_unfold
       by (rule conjI continuous_map_pairedI continuous_intros continuous_map_id [unfolded id_def]
           continuous_map_fst_of [unfolded o_def] continuous_map_snd_of [unfolded o_def]
           continuous_map_compose [OF _ h, unfolded o_def]
           continuous_map_compose [OF _ k, unfolded o_def])+
   next
     fix x
     show "?hk (0, x) = (f (fst x), g (snd x))" "?hk (1, x) = (f' (fst x), g' (snd x))"
       by (auto simp: case_prod_beta h0 k0 h1 k1)
   qed (auto simp: p q r)
 qed
 
 
 lemma homotopic_with_product_topology:
   assumes ht: "\<And>i. i \<in> I \<Longrightarrow> homotopic_with (p i) (X i) (Y i) (f i) (g i)"
     and pq: "\<And>h. (\<And>i. i \<in> I \<Longrightarrow> p i (h i)) \<Longrightarrow> q(\<lambda>x. (\<lambda>i\<in>I. h i (x i)))"
   shows "homotopic_with q (product_topology X I) (product_topology Y I)
                           (\<lambda>z. (\<lambda>i\<in>I. (f i) (z i))) (\<lambda>z. (\<lambda>i\<in>I. (g i) (z i)))"
 proof -
   obtain h
     where h: "\<And>i. i \<in> I \<Longrightarrow> continuous_map (prod_topology (subtopology euclideanreal {0..1}) (X i)) (Y i) (h i)"
       and h0: "\<And>i x. i \<in> I \<Longrightarrow> h i (0, x) = f i x"
       and h1: "\<And>i x. i \<in> I \<Longrightarrow> h i (1, x) = g i x"
       and p: "\<And>i t. \<lbrakk>i \<in> I; t \<in> {0..1}\<rbrakk> \<Longrightarrow> p i (\<lambda>x. h i (t,x))"
     using ht unfolding homotopic_with_def by metis
   show ?thesis
     unfolding homotopic_with_def
   proof (intro conjI allI exI)
     let ?h = "\<lambda>(t,z). \<lambda>i\<in>I. h i (t,z i)"
     have "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (product_topology X I))
                          (Y i) (\<lambda>x. h i (fst x, snd x i))" if "i \<in> I" for i
     proof -
       have \<section>: "continuous_map (prod_topology (top_of_set {0..1}) (product_topology X I)) (X i) (\<lambda>x. snd x i)"
         using continuous_map_componentwise continuous_map_snd that by fastforce
       show ?thesis
         unfolding continuous_map_pairwise case_prod_unfold
         by (intro conjI that \<section> continuous_intros continuous_map_compose [OF _ h, unfolded o_def])
     qed
     then show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (product_topology X I))
          (product_topology Y I) ?h"
       by (auto simp: continuous_map_componentwise case_prod_beta)
     show "?h (0, x) = (\<lambda>i\<in>I. f i (x i))" "?h (1, x) = (\<lambda>i\<in>I. g i (x i))" for x
       by (auto simp: case_prod_beta h0 h1)
     show "\<forall>t\<in>{0..1}. q (\<lambda>x. ?h (t, x))"
       by (force intro: p pq)
   qed
 qed
 
 text\<open>Homotopic triviality implicitly incorporates path-connectedness.\<close>
 lemma homotopic_triviality:
   shows  "(\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> T \<and>
                  continuous_on S g \<and> g ` S \<subseteq> T
                  \<longrightarrow> homotopic_with_canon (\<lambda>x. True) S T f g) \<longleftrightarrow>
           (S = {} \<or> path_connected T) \<and>
           (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> T \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)))"
           (is "?lhs = ?rhs")
 proof (cases "S = {} \<or> T = {}")
   case True then show ?thesis
     by (auto simp: homotopic_on_emptyI)
 next
   case False show ?thesis
   proof
     assume LHS [rule_format]: ?lhs
     have pab: "path_component T a b" if "a \<in> T" "b \<in> T" for a b
     proof -
       have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. b)"
         by (simp add: LHS image_subset_iff that)
       then show ?thesis
         using False homotopic_constant_maps [of "top_of_set S" "top_of_set T" a b] by auto
     qed
     moreover
     have "\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)" if "continuous_on S f" "f ` S \<subseteq> T" for f
       using False LHS continuous_on_const that by blast
     ultimately show ?rhs
       by (simp add: path_connected_component)
   next
     assume RHS: ?rhs
     with False have T: "path_connected T"
       by blast
     show ?lhs
     proof clarify
       fix f g
       assume "continuous_on S f" "f ` S \<subseteq> T" "continuous_on S g" "g ` S \<subseteq> T"
       obtain c d where c: "homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)" and d: "homotopic_with_canon (\<lambda>x. True) S T g (\<lambda>x. d)"
         using False \<open>continuous_on S f\<close> \<open>f ` S \<subseteq> T\<close>  RHS \<open>continuous_on S g\<close> \<open>g ` S \<subseteq> T\<close> by blast
       with T have "path_component T c d"
         by (metis False ex_in_conv homotopic_with_imp_subset2 image_subset_iff path_connected_component)
       then have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. c) (\<lambda>x. d)"
         by (simp add: homotopic_constant_maps)
       with c d show "homotopic_with_canon (\<lambda>x. True) S T f g"
         by (meson homotopic_with_symD homotopic_with_trans)
     qed
   qed
 qed
 
 
 subsection\<open>Homotopy of paths, maintaining the same endpoints\<close>
 
 
 definition\<^marker>\<open>tag important\<close> homotopic_paths :: "['a set, real \<Rightarrow> 'a, real \<Rightarrow> 'a::topological_space] \<Rightarrow> bool"
   where
      "homotopic_paths S p q \<equiv>
        homotopic_with_canon (\<lambda>r. pathstart r = pathstart p \<and> pathfinish r = pathfinish p) {0..1} S p q"
 
 lemma homotopic_paths:
    "homotopic_paths S p q \<longleftrightarrow>
       (\<exists>h. continuous_on ({0..1} \<times> {0..1}) h \<and>
           h ` ({0..1} \<times> {0..1}) \<subseteq> S \<and>
           (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
           (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
           (\<forall>t \<in> {0..1::real}. pathstart(h \<circ> Pair t) = pathstart p \<and>
                         pathfinish(h \<circ> Pair t) = pathfinish p))"
   by (auto simp: homotopic_paths_def homotopic_with pathstart_def pathfinish_def)
 
 proposition homotopic_paths_imp_pathstart:
      "homotopic_paths S p q \<Longrightarrow> pathstart p = pathstart q"
   by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
 
 proposition homotopic_paths_imp_pathfinish:
      "homotopic_paths S p q \<Longrightarrow> pathfinish p = pathfinish q"
   by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
 
 lemma homotopic_paths_imp_path:
      "homotopic_paths S p q \<Longrightarrow> path p \<and> path q"
   using homotopic_paths_def homotopic_with_imp_continuous_maps path_def continuous_map_subtopology_eu by blast
 
 lemma homotopic_paths_imp_subset:
      "homotopic_paths S p q \<Longrightarrow> path_image p \<subseteq> S \<and> path_image q \<subseteq> S"
   by (metis (mono_tags) continuous_map_subtopology_eu homotopic_paths_def homotopic_with_imp_continuous_maps path_image_def)
 
 proposition homotopic_paths_refl [simp]: "homotopic_paths S p p \<longleftrightarrow> path p \<and> path_image p \<subseteq> S"
   by (simp add: homotopic_paths_def path_def path_image_def)
 
 proposition homotopic_paths_sym: "homotopic_paths S p q \<Longrightarrow> homotopic_paths S q p"
   by (metis (mono_tags) homotopic_paths_def homotopic_paths_imp_pathfinish homotopic_paths_imp_pathstart homotopic_with_symD)
 
 proposition homotopic_paths_sym_eq: "homotopic_paths S p q \<longleftrightarrow> homotopic_paths S q p"
   by (metis homotopic_paths_sym)
 
 proposition homotopic_paths_trans [trans]:
   assumes "homotopic_paths S p q" "homotopic_paths S q r"
   shows "homotopic_paths S p r"
   using assms homotopic_paths_imp_pathfinish homotopic_paths_imp_pathstart unfolding homotopic_paths_def
   by (smt (verit, ccfv_SIG) homotopic_with_mono homotopic_with_trans)
 
 proposition homotopic_paths_eq:
      "\<lbrakk>path p; path_image p \<subseteq> S; \<And>t. t \<in> {0..1} \<Longrightarrow> p t = q t\<rbrakk> \<Longrightarrow> homotopic_paths S p q"
   by (smt (verit, best) homotopic_paths homotopic_paths_refl)
 
 proposition homotopic_paths_reparametrize:
   assumes "path p"
       and pips: "path_image p \<subseteq> S"
       and contf: "continuous_on {0..1} f"
       and f01:"f ` {0..1} \<subseteq> {0..1}"
       and [simp]: "f(0) = 0" "f(1) = 1"
       and q: "\<And>t. t \<in> {0..1} \<Longrightarrow> q(t) = p(f t)"
     shows "homotopic_paths S p q"
 proof -
   have contp: "continuous_on {0..1} p"
     by (metis \<open>path p\<close> path_def)
   then have "continuous_on {0..1} (p \<circ> f)"
     using contf continuous_on_compose continuous_on_subset f01 by blast
   then have "path q"
     by (simp add: path_def) (metis q continuous_on_cong)
   have piqs: "path_image q \<subseteq> S"
     by (metis (no_types, opaque_lifting) pips f01 image_subset_iff path_image_def q)
   have fb0: "\<And>a b. \<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> (1 - a) * f b + a * b"
     using f01 by force
   have fb1: "\<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> (1 - a) * f b + a * b \<le> 1" for a b
     using f01 [THEN subsetD, of "f b"] by (simp add: convex_bound_le)
   have "homotopic_paths S q p"
   proof (rule homotopic_paths_trans)
     show "homotopic_paths S q (p \<circ> f)"
       using q by (force intro: homotopic_paths_eq [OF  \<open>path q\<close> piqs])
   next
     show "homotopic_paths S (p \<circ> f) p"
       using pips [unfolded path_image_def]
       apply (simp add: homotopic_paths_def homotopic_with_def)
       apply (rule_tac x="p \<circ> (\<lambda>y. (1 - (fst y)) *\<^sub>R ((f \<circ> snd) y) + (fst y) *\<^sub>R snd y)"  in exI)
       apply (rule conjI contf continuous_intros continuous_on_subset [OF contp] | simp)+
       by (auto simp: fb0 fb1 pathstart_def pathfinish_def)
   qed
   then show ?thesis
     by (simp add: homotopic_paths_sym)
 qed
 
 lemma homotopic_paths_subset: "\<lbrakk>homotopic_paths S p q; S \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t p q"
   unfolding homotopic_paths by fast
 
 
 text\<open> A slightly ad-hoc but useful lemma in constructing homotopies.\<close>
 lemma continuous_on_homotopic_join_lemma:
   fixes q :: "[real,real] \<Rightarrow> 'a::topological_space"
   assumes p: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. p (fst y) (snd y))" (is "continuous_on ?A ?p")
       and q: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. q (fst y) (snd y))" (is "continuous_on ?A ?q")
       and pf: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish(p t) = pathstart(q t)"
     shows "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. (p(fst y) +++ q(fst y)) (snd y))"
 proof -
   have \<section>: "(\<lambda>t. p (fst t) (2 * snd t)) = ?p \<circ> (\<lambda>y. (fst y, 2 * snd y))"
           "(\<lambda>t. q (fst t) (2 * snd t - 1)) = ?q \<circ> (\<lambda>y. (fst y, 2 * snd y - 1))"
     by force+
   show ?thesis
     unfolding joinpaths_def
   proof (rule continuous_on_cases_le)
     show "continuous_on {y \<in> ?A. snd y \<le> 1/2} (\<lambda>t. p (fst t) (2 * snd t))" 
          "continuous_on {y \<in> ?A. 1/2 \<le> snd y} (\<lambda>t. q (fst t) (2 * snd t - 1))"
          "continuous_on ?A snd"
       unfolding \<section>
       by (rule continuous_intros continuous_on_subset [OF p] continuous_on_subset [OF q] | force)+
   qed (use pf in \<open>auto simp: mult.commute pathstart_def pathfinish_def\<close>)
 qed
 
 text\<open> Congruence properties of homotopy w.r.t. path-combining operations.\<close>
 
 lemma homotopic_paths_reversepath_D:
       assumes "homotopic_paths S p q"
       shows   "homotopic_paths S (reversepath p) (reversepath q)"
   using assms
   apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
   apply (rule_tac x="h \<circ> (\<lambda>x. (fst x, 1 - snd x))" in exI)
   apply (rule conjI continuous_intros)+
   apply (auto simp: reversepath_def pathstart_def pathfinish_def elim!: continuous_on_subset)
   done
 
 proposition homotopic_paths_reversepath:
      "homotopic_paths S (reversepath p) (reversepath q) \<longleftrightarrow> homotopic_paths S p q"
   using homotopic_paths_reversepath_D by force
 
 
 proposition homotopic_paths_join:
     "\<lbrakk>homotopic_paths S p p'; homotopic_paths S q q'; pathfinish p = pathstart q\<rbrakk> \<Longrightarrow> homotopic_paths S (p +++ q) (p' +++ q')"
   apply (clarsimp simp: homotopic_paths_def homotopic_with_def)
   apply (rename_tac k1 k2)
   apply (rule_tac x="(\<lambda>y. ((k1 \<circ> Pair (fst y)) +++ (k2 \<circ> Pair (fst y))) (snd y))" in exI)
   apply (intro conjI continuous_intros continuous_on_homotopic_join_lemma; force simp: joinpaths_def pathstart_def pathfinish_def path_image_def)
   done
 
 proposition homotopic_paths_continuous_image:
     "\<lbrakk>homotopic_paths S f g; continuous_on S h; h ` S \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_paths_def
   by (simp add: homotopic_with_compose_continuous_map_left pathfinish_compose pathstart_compose)
 
 
 subsection\<open>Group properties for homotopy of paths\<close>
 
 text\<^marker>\<open>tag important\<close>\<open>So taking equivalence classes under homotopy would give the fundamental group\<close>
 
 proposition homotopic_paths_rid:
   assumes "path p" "path_image p \<subseteq> S"
   shows "homotopic_paths S (p +++ linepath (pathfinish p) (pathfinish p)) p"
 proof -
   have \<section>: "continuous_on {0..1} (\<lambda>t::real. if t \<le> 1/2 then 2 *\<^sub>R t else 1)"
     unfolding split_01
     by (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
   show ?thesis
     apply (rule homotopic_paths_sym)
     using assms unfolding pathfinish_def joinpaths_def
     by (intro \<section> continuous_on_cases continuous_intros homotopic_paths_reparametrize [where f = "\<lambda>t. if t \<le> 1/2 then 2 *\<^sub>R t else 1"]; force)
 qed
 
 proposition homotopic_paths_lid:
    "\<lbrakk>path p; path_image p \<subseteq> S\<rbrakk> \<Longrightarrow> homotopic_paths S (linepath (pathstart p) (pathstart p) +++ p) p"
   using homotopic_paths_rid [of "reversepath p" S]
   by (metis homotopic_paths_reversepath path_image_reversepath path_reversepath pathfinish_linepath
         pathfinish_reversepath reversepath_joinpaths reversepath_linepath)
 
 proposition homotopic_paths_assoc:
    "\<lbrakk>path p; path_image p \<subseteq> S; path q; path_image q \<subseteq> S; path r; path_image r \<subseteq> S; pathfinish p = pathstart q;
      pathfinish q = pathstart r\<rbrakk>
     \<Longrightarrow> homotopic_paths S (p +++ (q +++ r)) ((p +++ q) +++ r)"
   apply (subst homotopic_paths_sym)
   apply (rule homotopic_paths_reparametrize
            [where f = "\<lambda>t. if  t \<le> 1/2 then inverse 2 *\<^sub>R t
                            else if  t \<le> 3 / 4 then t - (1 / 4)
                            else 2 *\<^sub>R t - 1"])
   apply (simp_all del: le_divide_eq_numeral1 add: subset_path_image_join)
   apply (rule continuous_on_cases_1 continuous_intros | auto simp: joinpaths_def)+
   done
 
 proposition homotopic_paths_rinv:
   assumes "path p" "path_image p \<subseteq> S"
     shows "homotopic_paths S (p +++ reversepath p) (linepath (pathstart p) (pathstart p))"
 proof -
   have p: "continuous_on {0..1} p" 
     using assms by (auto simp: path_def)
   let ?A = "{0..1} \<times> {0..1}"
   have "continuous_on ?A (\<lambda>x. (subpath 0 (fst x) p +++ reversepath (subpath 0 (fst x) p)) (snd x))"
     unfolding joinpaths_def subpath_def reversepath_def path_def add_0_right diff_0_right
   proof (rule continuous_on_cases_le)
     show "continuous_on {x \<in> ?A. snd x \<le> 1/2} (\<lambda>t. p (fst t * (2 * snd t)))"
          "continuous_on {x \<in> ?A. 1/2 \<le> snd x} (\<lambda>t. p (fst t * (1 - (2 * snd t - 1))))"
          "continuous_on ?A snd"
       by (intro continuous_on_compose2 [OF p] continuous_intros; auto simp: mult_le_one)+
   qed (auto simp: algebra_simps)
   then show ?thesis
     using assms
     apply (subst homotopic_paths_sym_eq)
     unfolding homotopic_paths_def homotopic_with_def
     apply (rule_tac x="(\<lambda>y. (subpath 0 (fst y) p +++ reversepath(subpath 0 (fst y) p)) (snd y))" in exI)
     apply (force simp: mult_le_one path_defs joinpaths_def subpath_def reversepath_def)
     done
 qed
 
 proposition homotopic_paths_linv:
   assumes "path p" "path_image p \<subseteq> S"
     shows "homotopic_paths S (reversepath p +++ p) (linepath (pathfinish p) (pathfinish p))"
   using homotopic_paths_rinv [of "reversepath p" S] assms by simp
 
 
 subsection\<open>Homotopy of loops without requiring preservation of endpoints\<close>
 
 definition\<^marker>\<open>tag important\<close> homotopic_loops :: "'a::topological_space set \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool"  where
  "homotopic_loops S p q \<equiv>
      homotopic_with_canon (\<lambda>r. pathfinish r = pathstart r) {0..1} S p q"
 
 lemma homotopic_loops:
    "homotopic_loops S p q \<longleftrightarrow>
       (\<exists>h. continuous_on ({0..1::real} \<times> {0..1}) h \<and>
           image h ({0..1} \<times> {0..1}) \<subseteq> S \<and>
           (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
           (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
           (\<forall>t \<in> {0..1}. pathfinish(h \<circ> Pair t) = pathstart(h \<circ> Pair t)))"
   by (simp add: homotopic_loops_def pathstart_def pathfinish_def homotopic_with)
 
 proposition homotopic_loops_imp_loop:
      "homotopic_loops S p q \<Longrightarrow> pathfinish p = pathstart p \<and> pathfinish q = pathstart q"
 using homotopic_with_imp_property homotopic_loops_def by blast
 
 proposition homotopic_loops_imp_path:
      "homotopic_loops S p q \<Longrightarrow> path p \<and> path q"
   unfolding homotopic_loops_def path_def
   using homotopic_with_imp_continuous_maps continuous_map_subtopology_eu by blast
 
 proposition homotopic_loops_imp_subset:
      "homotopic_loops S p q \<Longrightarrow> path_image p \<subseteq> S \<and> path_image q \<subseteq> S"
   unfolding homotopic_loops_def path_image_def
   by (meson continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 proposition homotopic_loops_refl:
      "homotopic_loops S p p \<longleftrightarrow>
       path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p"
   by (simp add: homotopic_loops_def path_image_def path_def)
 
 proposition homotopic_loops_sym: "homotopic_loops S p q \<Longrightarrow> homotopic_loops S q p"
   by (simp add: homotopic_loops_def homotopic_with_sym)
 
 proposition homotopic_loops_sym_eq: "homotopic_loops S p q \<longleftrightarrow> homotopic_loops S q p"
   by (metis homotopic_loops_sym)
 
 proposition homotopic_loops_trans:
    "\<lbrakk>homotopic_loops S p q; homotopic_loops S q r\<rbrakk> \<Longrightarrow> homotopic_loops S p r"
   unfolding homotopic_loops_def by (blast intro: homotopic_with_trans)
 
 proposition homotopic_loops_subset:
    "\<lbrakk>homotopic_loops S p q; S \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t p q"
   by (fastforce simp add: homotopic_loops)
 
 proposition homotopic_loops_eq:
    "\<lbrakk>path p; path_image p \<subseteq> S; pathfinish p = pathstart p; \<And>t. t \<in> {0..1} \<Longrightarrow> p(t) = q(t)\<rbrakk>
           \<Longrightarrow> homotopic_loops S p q"
   unfolding homotopic_loops_def path_image_def path_def pathstart_def pathfinish_def
   by (auto intro: homotopic_with_eq [OF homotopic_with_refl [where f = p, THEN iffD2]])
 
 proposition homotopic_loops_continuous_image:
    "\<lbrakk>homotopic_loops S f g; continuous_on S h; h ` S \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_loops_def
   by (simp add: homotopic_with_compose_continuous_map_left pathfinish_def pathstart_def)
 
 
 subsection\<open>Relations between the two variants of homotopy\<close>
 
 proposition homotopic_paths_imp_homotopic_loops:
     "\<lbrakk>homotopic_paths S p q; pathfinish p = pathstart p; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> homotopic_loops S p q"
   by (auto simp: homotopic_with_def homotopic_paths_def homotopic_loops_def)
 
 proposition homotopic_loops_imp_homotopic_paths_null:
   assumes "homotopic_loops S p (linepath a a)"
     shows "homotopic_paths S p (linepath (pathstart p) (pathstart p))"
 proof -
   have "path p" by (metis assms homotopic_loops_imp_path)
   have ploop: "pathfinish p = pathstart p" by (metis assms homotopic_loops_imp_loop)
   have pip: "path_image p \<subseteq> S" by (metis assms homotopic_loops_imp_subset)
   let ?A = "{0..1::real} \<times> {0..1::real}"
   obtain h where conth: "continuous_on ?A h"
              and hs: "h ` ?A \<subseteq> S"
              and h0[simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(0,x) = p x"
              and h1[simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(1,x) = a"
              and ends: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish (h \<circ> Pair t) = pathstart (h \<circ> Pair t)"
     using assms by (auto simp: homotopic_loops homotopic_with)
   have conth0: "path (\<lambda>u. h (u, 0))"
     unfolding path_def
   proof (rule continuous_on_compose [of _ _ h, unfolded o_def])
     show "continuous_on ((\<lambda>x. (x, 0)) ` {0..1}) h"
       by (force intro: continuous_on_subset [OF conth])
   qed (force intro: continuous_intros)
   have pih0: "path_image (\<lambda>u. h (u, 0)) \<subseteq> S"
     using hs by (force simp: path_image_def)
   have c1: "continuous_on ?A (\<lambda>x. h (fst x * snd x, 0))"
   proof (rule continuous_on_compose [of _ _ h, unfolded o_def])
     show "continuous_on ((\<lambda>x. (fst x * snd x, 0)) ` ?A) h"
       by (force simp: mult_le_one intro: continuous_on_subset [OF conth])
   qed (force intro: continuous_intros)+
   have c2: "continuous_on ?A (\<lambda>x. h (fst x - fst x * snd x, 0))"
   proof (rule continuous_on_compose [of _ _ h, unfolded o_def])
     show "continuous_on ((\<lambda>x. (fst x - fst x * snd x, 0)) ` ?A) h"
       by (auto simp: algebra_simps add_increasing2 mult_left_le intro: continuous_on_subset [OF conth])
   qed (force intro: continuous_intros)
   have [simp]: "\<And>t. \<lbrakk>0 \<le> t \<and> t \<le> 1\<rbrakk> \<Longrightarrow> h (t, 1) = h (t, 0)"
     using ends by (simp add: pathfinish_def pathstart_def)
   have adhoc_le: "c * 4 \<le> 1 + c * (d * 4)" if "\<not> d * 4 \<le> 3" "0 \<le> c" "c \<le> 1" for c d::real
   proof -
     have "c * 3 \<le> c * (d * 4)" using that less_eq_real_def by auto
     with \<open>c \<le> 1\<close> show ?thesis by fastforce
   qed
   have *: "\<And>p x. \<lbrakk>path p \<and> path(reversepath p);
                   path_image p \<subseteq> S \<and> path_image(reversepath p) \<subseteq> S;
                   pathfinish p = pathstart(linepath a a +++ reversepath p) \<and>
                    pathstart(reversepath p) = a \<and> pathstart p = x\<rbrakk>
                   \<Longrightarrow> homotopic_paths S (p +++ linepath a a +++ reversepath p) (linepath x x)"
     by (metis homotopic_paths_lid homotopic_paths_join
               homotopic_paths_trans homotopic_paths_sym homotopic_paths_rinv)
   have 1: "homotopic_paths S p (p +++ linepath (pathfinish p) (pathfinish p))"
     using \<open>path p\<close> homotopic_paths_rid homotopic_paths_sym pip by blast
   moreover have "homotopic_paths S (p +++ linepath (pathfinish p) (pathfinish p))
                                    (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))"
     using homotopic_paths_lid [of "p +++ linepath (pathfinish p) (pathfinish p)" S]
     by (metis 1 homotopic_paths_imp_path homotopic_paths_imp_subset homotopic_paths_sym pathstart_join)
   moreover 
   have "homotopic_paths S (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))
                                    ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))"
     unfolding homotopic_paths_def homotopic_with_def
   proof (intro exI strip conjI)
     let ?h = "\<lambda>y. (subpath 0 (fst y) (\<lambda>u. h (u, 0)) +++ (\<lambda>u. h (Pair (fst y) u)) 
                +++ subpath (fst y) 0 (\<lambda>u. h (u, 0))) (snd y)" 
     have "continuous_on ?A ?h"
       by (intro continuous_on_homotopic_join_lemma; simp add: path_defs joinpaths_def subpath_def conth c1 c2)
     moreover have "?h ` ?A \<subseteq> S"
       unfolding joinpaths_def subpath_def
       by (force simp: algebra_simps mult_le_one mult_left_le intro: hs [THEN subsetD] adhoc_le)
   ultimately show "continuous_map (prod_topology (top_of_set {0..1}) (top_of_set {0..1}))
                          (top_of_set S) ?h"
     by (simp add: subpath_reversepath)
   qed (use ploop in \<open>simp_all add: reversepath_def path_defs joinpaths_def o_def subpath_def conth c1 c2\<close>)
   moreover have "homotopic_paths S ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))
                                    (linepath (pathstart p) (pathstart p))"
     by (rule *; simp add: pih0 pathstart_def pathfinish_def conth0; simp add: reversepath_def joinpaths_def)
   ultimately show ?thesis
     by (blast intro: homotopic_paths_trans)
 qed
 
 proposition homotopic_loops_conjugate:
   fixes S :: "'a::real_normed_vector set"
   assumes "path p" "path q" and pip: "path_image p \<subseteq> S" and piq: "path_image q \<subseteq> S"
       and pq: "pathfinish p = pathstart q" and qloop: "pathfinish q = pathstart q"
     shows "homotopic_loops S (p +++ q +++ reversepath p) q"
 proof -
   have contp: "continuous_on {0..1} p"  using \<open>path p\<close> [unfolded path_def] by blast
   have contq: "continuous_on {0..1} q"  using \<open>path q\<close> [unfolded path_def] by blast
   let ?A = "{0..1::real} \<times> {0..1::real}"
   have c1: "continuous_on ?A (\<lambda>x. p ((1 - fst x) * snd x + fst x))"
   proof (rule continuous_on_compose [of _ _ p, unfolded o_def])
     show "continuous_on ((\<lambda>x. (1 - fst x) * snd x + fst x) ` ?A) p"
       by (auto intro: continuous_on_subset [OF contp] simp: algebra_simps add_increasing2 mult_right_le_one_le sum_le_prod1)
   qed (force intro: continuous_intros)
   have c2: "continuous_on ?A (\<lambda>x. p ((fst x - 1) * snd x + 1))"
   proof (rule continuous_on_compose [of _ _ p, unfolded o_def])
     show "continuous_on ((\<lambda>x. (fst x - 1) * snd x + 1) ` ?A) p"
       by (auto intro: continuous_on_subset [OF contp] simp: algebra_simps add_increasing2 mult_left_le_one_le)
   qed (force intro: continuous_intros)
 
   have ps1: "\<And>a b. \<lbrakk>b * 2 \<le> 1; 0 \<le> b; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((1 - a) * (2 * b) + a) \<in> S"
     using sum_le_prod1
     by (force simp: algebra_simps add_increasing2 mult_left_le intro: pip [unfolded path_image_def, THEN subsetD])
   have ps2: "\<And>a b. \<lbrakk>\<not> 4 * b \<le> 3; b \<le> 1; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((a - 1) * (4 * b - 3) + 1) \<in> S"
     apply (rule pip [unfolded path_image_def, THEN subsetD])
     apply (rule image_eqI, blast)
     apply (simp add: algebra_simps)
     by (metis add_mono affine_ineq linear mult.commute mult.left_neutral mult_right_mono
               add.commute zero_le_numeral)
   have qs: "\<And>a b. \<lbrakk>4 * b \<le> 3; \<not> b * 2 \<le> 1\<rbrakk> \<Longrightarrow> q (4 * b - 2) \<in> S"
     using path_image_def piq by fastforce
   have "homotopic_loops S (p +++ q +++ reversepath p)
                           (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q))"
     unfolding homotopic_loops_def homotopic_with_def
   proof (intro exI strip conjI)
     let ?h = "(\<lambda>y. (subpath (fst y) 1 p +++ q +++ subpath 1 (fst y) p) (snd y))" 
     have "continuous_on ?A (\<lambda>y. q (snd y))"
       by (force simp: contq intro: continuous_on_compose [of _ _ q, unfolded o_def] continuous_on_id continuous_on_snd)
     then have "continuous_on ?A ?h"
       using pq qloop
       by (intro continuous_on_homotopic_join_lemma) (auto simp: path_defs joinpaths_def subpath_def c1 c2)
     then show "continuous_map (prod_topology (top_of_set {0..1}) (top_of_set {0..1})) (top_of_set S) ?h"
       by (auto simp: joinpaths_def subpath_def  ps1 ps2 qs)
     show "?h (1,x) = (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q)) x"  for x
       using pq by (simp add: pathfinish_def subpath_refl)
   qed (auto simp: subpath_reversepath)
   moreover have "homotopic_loops S (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q)) q"
   proof -
     have "homotopic_paths S (linepath (pathfinish q) (pathfinish q) +++ q) q"
       using \<open>path q\<close> homotopic_paths_lid qloop piq by auto
     hence 1: "\<And>f. homotopic_paths S f q \<or> \<not> homotopic_paths S f (linepath (pathfinish q) (pathfinish q) +++ q)"
       using homotopic_paths_trans by blast
     hence "homotopic_paths S (linepath (pathfinish q) (pathfinish q) +++ q +++ linepath (pathfinish q) (pathfinish q)) q"
       by (smt (verit, best) \<open>path q\<close> homotopic_paths_imp_path homotopic_paths_imp_subset homotopic_paths_lid 
           homotopic_paths_rid homotopic_paths_trans pathstart_join piq qloop)
     thus ?thesis
       by (metis (no_types) qloop homotopic_loops_sym homotopic_paths_imp_homotopic_loops homotopic_paths_imp_pathfinish homotopic_paths_sym)
   qed
   ultimately show ?thesis
     by (blast intro: homotopic_loops_trans)
 qed
 
 lemma homotopic_paths_loop_parts:
   assumes loops: "homotopic_loops S (p +++ reversepath q) (linepath a a)" and "path q"
   shows "homotopic_paths S p q"
 proof -
   have paths: "homotopic_paths S (p +++ reversepath q) (linepath (pathstart p) (pathstart p))"
     using homotopic_loops_imp_homotopic_paths_null [OF loops] by simp
   then have "path p"
     using \<open>path q\<close> homotopic_loops_imp_path loops path_join path_join_path_ends path_reversepath by blast
   show ?thesis
   proof (cases "pathfinish p = pathfinish q")
     case True
     obtain pipq: "path_image p \<subseteq> S" "path_image q \<subseteq> S"
       by (metis Un_subset_iff paths \<open>path p\<close> \<open>path q\<close> homotopic_loops_imp_subset homotopic_paths_imp_path loops
            path_image_join path_image_reversepath path_imp_reversepath path_join_eq)
     have "homotopic_paths S p (p +++ (linepath (pathfinish p) (pathfinish p)))"
       using \<open>path p\<close> \<open>path_image p \<subseteq> S\<close> homotopic_paths_rid homotopic_paths_sym by blast
     moreover have "homotopic_paths S (p +++ (linepath (pathfinish p) (pathfinish p))) (p +++ (reversepath q +++ q))"
       by (simp add: True \<open>path p\<close> \<open>path q\<close> pipq homotopic_paths_join homotopic_paths_linv homotopic_paths_sym)
     moreover have "homotopic_paths S (p +++ (reversepath q +++ q)) ((p +++ reversepath q) +++ q)"
       by (simp add: True \<open>path p\<close> \<open>path q\<close> homotopic_paths_assoc pipq)
     moreover have "homotopic_paths S ((p +++ reversepath q) +++ q) (linepath (pathstart p) (pathstart p) +++ q)"
       by (simp add: \<open>path q\<close> homotopic_paths_join paths pipq)
     ultimately show ?thesis
       by (metis \<open>path q\<close> homotopic_paths_imp_path homotopic_paths_lid homotopic_paths_trans path_join_path_ends pathfinish_linepath pipq(2))
   next
     case False
     then show ?thesis
       using \<open>path q\<close> homotopic_loops_imp_path loops path_join_path_ends by fastforce
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Homotopy of "nearby" function, paths and loops\<close>
 
 lemma homotopic_with_linear:
   fixes f g :: "_ \<Rightarrow> 'b::real_normed_vector"
   assumes contf: "continuous_on S f"
       and contg:"continuous_on S g"
       and sub: "\<And>x. x \<in> S \<Longrightarrow> closed_segment (f x) (g x) \<subseteq> t"
     shows "homotopic_with_canon (\<lambda>z. True) S t f g"
   unfolding homotopic_with_def
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R f(snd y) + (fst y) *\<^sub>R g(snd y))" in exI)
   using sub closed_segment_def
      by (fastforce intro: continuous_intros continuous_on_subset [OF contf] continuous_on_compose2 [where g=f]
             continuous_on_subset [OF contg] continuous_on_compose2 [where g=g])
 
 lemma homotopic_paths_linear:
   fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
           "\<And>t. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> S"
     shows "homotopic_paths S g h"
   using assms
   unfolding path_def
   apply (simp add: closed_segment_def pathstart_def pathfinish_def homotopic_paths_def homotopic_with_def)
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R (g \<circ> snd) y + (fst y) *\<^sub>R (h \<circ> snd) y)" in exI)
   apply (intro conjI subsetI continuous_intros; force)
   done
 
 lemma homotopic_loops_linear:
   fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
           "\<And>t x. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> S"
     shows "homotopic_loops S g h"
   using assms
   unfolding path_defs homotopic_loops_def homotopic_with_def
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R g(snd y) + (fst y) *\<^sub>R h(snd y))" in exI)
   by (force simp: closed_segment_def intro!: continuous_intros intro: continuous_on_compose2 [where g=g] continuous_on_compose2 [where g=h])
 
 lemma homotopic_paths_nearby_explicit:
   assumes \<section>: "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
       and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> S\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
     shows "homotopic_paths S g h"
   using homotopic_paths_linear [OF \<section>] by (metis linorder_not_le no norm_minus_commute segment_bound1 subsetI)
 
 lemma homotopic_loops_nearby_explicit:
   assumes \<section>: "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
       and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> S\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
     shows "homotopic_loops S g h"
   using homotopic_loops_linear [OF \<section>] by (metis linorder_not_le no norm_minus_commute segment_bound1 subsetI)
 
 lemma homotopic_nearby_paths:
   fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "path g" "open S" "path_image g \<subseteq> S"
     shows "\<exists>e. 0 < e \<and>
                (\<forall>h. path h \<and>
                     pathstart h = pathstart g \<and> pathfinish h = pathfinish g \<and>
                     (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_paths S g h)"
 proof -
   obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - S \<Longrightarrow> e \<le> dist x y"
     using separate_compact_closed [of "path_image g" "-S"] assms by force
   show ?thesis
     using e [unfolded dist_norm] \<open>e > 0\<close>
     by (fastforce simp: path_image_def intro!: homotopic_paths_nearby_explicit assms exI)
 qed
 
 lemma homotopic_nearby_loops:
   fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "path g" "open S" "path_image g \<subseteq> S" "pathfinish g = pathstart g"
     shows "\<exists>e. 0 < e \<and>
                (\<forall>h. path h \<and> pathfinish h = pathstart h \<and>
                     (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_loops S g h)"
 proof -
   obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - S \<Longrightarrow> e \<le> dist x y"
     using separate_compact_closed [of "path_image g" "-S"] assms by force
   show ?thesis
     using e [unfolded dist_norm] \<open>e > 0\<close>
     by (fastforce simp: path_image_def intro!: homotopic_loops_nearby_explicit assms exI)
 qed
 
 
 subsection\<open> Homotopy and subpaths\<close>
 
 lemma homotopic_join_subpaths1:
   assumes "path g" and pag: "path_image g \<subseteq> S"
       and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}" "u \<le> v" "v \<le> w"
     shows "homotopic_paths S (subpath u v g +++ subpath v w g) (subpath u w g)"
 proof -
   have 1: "t * 2 \<le> 1 \<Longrightarrow> u + t * (v * 2) \<le> v + t * (u * 2)" for t
     using affine_ineq \<open>u \<le> v\<close> by fastforce
   have 2: "t * 2 > 1 \<Longrightarrow> u + (2*t - 1) * v \<le> v + (2*t - 1) * w" for t
     by (metis add_mono_thms_linordered_semiring(1) diff_gt_0_iff_gt less_eq_real_def mult.commute mult_right_mono \<open>u \<le> v\<close> \<open>v \<le> w\<close>)
   have t2: "\<And>t::real. t*2 = 1 \<Longrightarrow> t = 1/2" by auto
   have "homotopic_paths (path_image g) (subpath u v g +++ subpath v w g) (subpath u w g)"
   proof (cases "w = u")
     case True
     then show ?thesis
       by (metis \<open>path g\<close> homotopic_paths_rinv path_image_subpath_subset path_subpath pathstart_subpath reversepath_subpath subpath_refl u v)
   next
     case False
     let ?f = "\<lambda>t. if  t \<le> 1/2 then inverse((w - u)) *\<^sub>R (2 * (v - u)) *\<^sub>R t
                                else inverse((w - u)) *\<^sub>R ((v - u) + (w - v) *\<^sub>R (2 *\<^sub>R t - 1))"
     show ?thesis
     proof (rule homotopic_paths_sym [OF homotopic_paths_reparametrize [where f = ?f]])
       show "path (subpath u w g)"
         using assms(1) path_subpath u w(1) by blast
       show "path_image (subpath u w g) \<subseteq> path_image g"
         by (meson path_image_subpath_subset u w(1))
       show "continuous_on {0..1} ?f"
         unfolding split_01
         by (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def dest!: t2)+
       show "?f ` {0..1} \<subseteq> {0..1}"
         using False assms
         by (force simp: field_simps not_le mult_left_mono affine_ineq dest!: 1 2)
       show "(subpath u v g +++ subpath v w g) t = subpath u w g (?f t)" if "t \<in> {0..1}" for t 
         using assms
         unfolding joinpaths_def subpath_def by (auto simp: divide_simps add.commute mult.commute mult.left_commute)
     qed (use False in auto)
   qed
   then show ?thesis
     by (rule homotopic_paths_subset [OF _ pag])
 qed
 
 lemma homotopic_join_subpaths2:
   assumes "homotopic_paths S (subpath u v g +++ subpath v w g) (subpath u w g)"
   shows "homotopic_paths S (subpath w v g +++ subpath v u g) (subpath w u g)"
   by (metis assms homotopic_paths_reversepath_D pathfinish_subpath pathstart_subpath reversepath_joinpaths reversepath_subpath)
 
 lemma homotopic_join_subpaths3:
   assumes hom: "homotopic_paths S (subpath u v g +++ subpath v w g) (subpath u w g)"
       and "path g" and pag: "path_image g \<subseteq> S"
       and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}"
     shows "homotopic_paths S (subpath v w g +++ subpath w u g) (subpath v u g)"
 proof -
   obtain wvg: "path (subpath w v g)" "path_image (subpath w v g) \<subseteq> S" 
      and wug: "path (subpath w u g)" "path_image (subpath w u g) \<subseteq> S"
      and vug: "path (subpath v u g)" "path_image (subpath v u g) \<subseteq> S"
     by (meson \<open>path g\<close> pag path_image_subpath_subset path_subpath subset_trans u v w)
   have "homotopic_paths S (subpath u w g +++ subpath w v g) 
                           ((subpath u v g +++ subpath v w g) +++ subpath w v g)"
     by (simp add: hom homotopic_paths_join homotopic_paths_sym wvg)
   also have "homotopic_paths S ((subpath u v g +++ subpath v w g) +++ subpath w v g) 
                                (subpath u v g +++ subpath v w g +++ subpath w v g)"
     using wvg vug \<open>path g\<close>
     by (metis homotopic_paths_assoc homotopic_paths_sym path_image_subpath_commute path_subpath
         pathfinish_subpath pathstart_subpath u v w)
   also have "homotopic_paths S (subpath u v g +++ subpath v w g +++ subpath w v g)
                                (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g)))"
     using wvg vug \<open>path g\<close>
     by (metis homotopic_paths_join homotopic_paths_linv homotopic_paths_refl path_image_subpath_commute
         path_subpath pathfinish_subpath pathstart_join pathstart_subpath reversepath_subpath u v)
   also have "homotopic_paths S (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g))) (subpath u v g)"
     using vug \<open>path g\<close> by (metis homotopic_paths_rid path_image_subpath_commute path_subpath u v)
   finally have "homotopic_paths S (subpath u w g +++ subpath w v g) (subpath u v g)" .
   then show ?thesis
     using homotopic_join_subpaths2 by blast
 qed
 
 proposition homotopic_join_subpaths:
    "\<lbrakk>path g; path_image g \<subseteq> S; u \<in> {0..1}; v \<in> {0..1}; w \<in> {0..1}\<rbrakk>
     \<Longrightarrow> homotopic_paths S (subpath u v g +++ subpath v w g) (subpath u w g)"
   by (smt (verit, del_insts) homotopic_join_subpaths1 homotopic_join_subpaths2 homotopic_join_subpaths3)
 
 text\<open>Relating homotopy of trivial loops to path-connectedness.\<close>
 
 lemma path_component_imp_homotopic_points:
   assumes "path_component S a b"
   shows "homotopic_loops S (linepath a a) (linepath b b)"
 proof -
   obtain g :: "real \<Rightarrow> 'a" where g: "continuous_on {0..1} g" "g ` {0..1} \<subseteq> S" "g 0 = a" "g 1 = b"
     using assms by (auto simp: path_defs)
   then have "continuous_on ({0..1} \<times> {0..1}) (g \<circ> fst)"
     by (fastforce intro!: continuous_intros)+
   with g show ?thesis
     by (auto simp: homotopic_loops_def homotopic_with_def path_defs image_subset_iff)
 qed
 
 lemma homotopic_loops_imp_path_component_value:
    "\<lbrakk>homotopic_loops S p q; 0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> path_component S (p t) (q t)"
 apply (clarsimp simp: homotopic_loops_def homotopic_with_def path_defs)
 apply (rule_tac x="h \<circ> (\<lambda>u. (u, t))" in exI)
 apply (fastforce elim!: continuous_on_subset intro!: continuous_intros)
 done
 
 lemma homotopic_points_eq_path_component:
    "homotopic_loops S (linepath a a) (linepath b b) \<longleftrightarrow> path_component S a b"
   using homotopic_loops_imp_path_component_value path_component_imp_homotopic_points by fastforce
 
 lemma path_connected_eq_homotopic_points:
   "path_connected S \<longleftrightarrow>
       (\<forall>a b. a \<in> S \<and> b \<in> S \<longrightarrow> homotopic_loops S (linepath a a) (linepath b b))"
   by (auto simp: path_connected_def path_component_def homotopic_points_eq_path_component)
 
 
 subsection\<open>Simply connected sets\<close>
 
 text\<^marker>\<open>tag important\<close>\<open>defined as "all loops are homotopic (as loops)\<close>
 
 definition\<^marker>\<open>tag important\<close> simply_connected where
   "simply_connected S \<equiv>
         \<forall>p q. path p \<and> pathfinish p = pathstart p \<and> path_image p \<subseteq> S \<and>
               path q \<and> pathfinish q = pathstart q \<and> path_image q \<subseteq> S
               \<longrightarrow> homotopic_loops S p q"
 
 lemma simply_connected_empty [iff]: "simply_connected {}"
   by (simp add: simply_connected_def)
 
 lemma simply_connected_imp_path_connected:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<Longrightarrow> path_connected S"
 by (simp add: simply_connected_def path_connected_eq_homotopic_points)
 
 lemma simply_connected_imp_connected:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<Longrightarrow> connected S"
 by (simp add: path_connected_imp_connected simply_connected_imp_path_connected)
 
 lemma simply_connected_eq_contractible_loop_any:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
             (\<forall>p a. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p \<and> a \<in> S
                   \<longrightarrow> homotopic_loops S p (linepath a a))"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     unfolding simply_connected_def by force
 next
   assume ?rhs then show ?lhs
     unfolding simply_connected_def
     by (metis pathfinish_in_path_image subsetD  homotopic_loops_trans homotopic_loops_sym)
 qed
 
 lemma simply_connected_eq_contractible_loop_some:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
                 path_connected S \<and>
                 (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
                     \<longrightarrow> (\<exists>a. a \<in> S \<and> homotopic_loops S p (linepath a a)))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
   using simply_connected_eq_contractible_loop_any by (blast intro: simply_connected_imp_path_connected)
 next
   assume ?rhs
   then show ?lhs
     by (meson homotopic_loops_trans path_connected_eq_homotopic_points simply_connected_eq_contractible_loop_any)
 qed
 
 lemma simply_connected_eq_contractible_loop_all:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
          S = {} \<or>
          (\<exists>a \<in> S. \<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
                 \<longrightarrow> homotopic_loops S p (linepath a a))"
         (is "?lhs = ?rhs")
 proof (cases "S = {}")
   case True then show ?thesis by force
 next
   case False
   then obtain a where "a \<in> S" by blast
   then show ?thesis
     by (meson False homotopic_loops_sym homotopic_loops_trans simply_connected_def simply_connected_eq_contractible_loop_any)
 qed
 
 lemma simply_connected_eq_contractible_path:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
            path_connected S \<and>
            (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
             \<longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p)))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding simply_connected_imp_path_connected
     by (metis simply_connected_eq_contractible_loop_some homotopic_loops_imp_homotopic_paths_null)
 next
   assume  ?rhs
   then show ?lhs
     using homotopic_paths_imp_homotopic_loops simply_connected_eq_contractible_loop_some by fastforce
 qed
 
 lemma simply_connected_eq_homotopic_paths:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
           path_connected S \<and>
           (\<forall>p q. path p \<and> path_image p \<subseteq> S \<and>
                 path q \<and> path_image q \<subseteq> S \<and>
                 pathstart q = pathstart p \<and> pathfinish q = pathfinish p
                 \<longrightarrow> homotopic_paths S p q)"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have pc: "path_connected S"
         and *:  "\<And>p. \<lbrakk>path p; path_image p \<subseteq> S;
                        pathfinish p = pathstart p\<rbrakk>
                       \<Longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p))"
     by (auto simp: simply_connected_eq_contractible_path)
   have "homotopic_paths S p q"
         if "path p" "path_image p \<subseteq> S" "path q"
            "path_image q \<subseteq> S" "pathstart q = pathstart p"
            "pathfinish q = pathfinish p" for p q
   proof -
     have "homotopic_paths S p (p +++ reversepath q +++ q)"
       using that
       by (smt (verit, best) homotopic_paths_join homotopic_paths_linv homotopic_paths_rid homotopic_paths_sym 
           homotopic_paths_trans pathstart_linepath)
     also have "homotopic_paths S (p +++ reversepath q +++ q)
                                  ((p +++ reversepath q) +++ q)"
       by (simp add: that homotopic_paths_assoc)
     also have "homotopic_paths S ((p +++ reversepath q) +++ q)
                                  (linepath (pathstart q) (pathstart q) +++ q)"
       using * [of "p +++ reversepath q"] that
       by (simp add: homotopic_paths_assoc homotopic_paths_join path_image_join)
     also have "homotopic_paths S (linepath (pathstart q) (pathstart q) +++ q) q"
       using that homotopic_paths_lid by blast
     finally show ?thesis .
   qed
   then show ?rhs
     by (blast intro: pc *)
 next
   assume ?rhs
   then show ?lhs
     by (force simp: simply_connected_eq_contractible_path)
 qed
 
 proposition simply_connected_Times:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   assumes S: "simply_connected S" and T: "simply_connected T"
     shows "simply_connected(S \<times> T)"
 proof -
   have "homotopic_loops (S \<times> T) p (linepath (a, b) (a, b))"
        if "path p" "path_image p \<subseteq> S \<times> T" "p 1 = p 0" "a \<in> S" "b \<in> T"
        for p a b
   proof -
     have "path (fst \<circ> p)"
       by (simp add: continuous_on_fst Path_Connected.path_continuous_image [OF \<open>path p\<close>])
     moreover have "path_image (fst \<circ> p) \<subseteq> S"
       using that by (force simp add: path_image_def)
     ultimately have p1: "homotopic_loops S (fst \<circ> p) (linepath a a)"
       using S that
       by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
     have "path (snd \<circ> p)"
       by (simp add: continuous_on_snd Path_Connected.path_continuous_image [OF \<open>path p\<close>])
     moreover have "path_image (snd \<circ> p) \<subseteq> T"
       using that by (force simp: path_image_def)
     ultimately have p2: "homotopic_loops T (snd \<circ> p) (linepath b b)"
       using T that
       by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
     show ?thesis
       using p1 p2 unfolding homotopic_loops
       apply clarify
       subgoal for h k
         by (rule_tac x="\<lambda>z. (h z, k z)" in exI) (force intro: continuous_intros simp: path_defs)
       done
   qed
   with assms show ?thesis
     by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
 qed
 
 
 subsection\<open>Contractible sets\<close>
 
 definition\<^marker>\<open>tag important\<close> contractible where
  "contractible S \<equiv> \<exists>a. homotopic_with_canon (\<lambda>x. True) S S id (\<lambda>x. a)"
 
 proposition contractible_imp_simply_connected:
   fixes S :: "_::real_normed_vector set"
   assumes "contractible S" shows "simply_connected S"
 proof (cases "S = {}")
   case True then show ?thesis by force
 next
   case False
   obtain a where a: "homotopic_with_canon (\<lambda>x. True) S S id (\<lambda>x. a)"
     using assms by (force simp: contractible_def)
   then have "a \<in> S"
     by (metis False homotopic_constant_maps homotopic_with_symD homotopic_with_trans path_component_in_topspace topspace_euclidean_subtopology)
   have "\<forall>p. path p \<and>
             path_image p \<subseteq> S \<and> pathfinish p = pathstart p \<longrightarrow>
             homotopic_loops S p (linepath a a)"
     using a apply (clarsimp simp: homotopic_loops_def homotopic_with_def path_defs)
     apply (rule_tac x="(h \<circ> (\<lambda>y. (fst y, (p \<circ> snd) y)))" in exI)
     apply (intro conjI continuous_on_compose continuous_intros; force elim: continuous_on_subset)
     done
   with \<open>a \<in> S\<close> show ?thesis
     by (auto simp: simply_connected_eq_contractible_loop_all False)
 qed
 
 corollary contractible_imp_connected:
   fixes S :: "_::real_normed_vector set"
   shows "contractible S \<Longrightarrow> connected S"
 by (simp add: contractible_imp_simply_connected simply_connected_imp_connected)
 
 lemma contractible_imp_path_connected:
   fixes S :: "_::real_normed_vector set"
   shows "contractible S \<Longrightarrow> path_connected S"
 by (simp add: contractible_imp_simply_connected simply_connected_imp_path_connected)
 
 lemma nullhomotopic_through_contractible:
   fixes S :: "_::topological_space set"
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
       and g: "continuous_on T g" "g ` T \<subseteq> U"
       and T: "contractible T"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S U (g \<circ> f) (\<lambda>x. c)"
 proof -
   obtain b where b: "homotopic_with_canon (\<lambda>x. True) T T id (\<lambda>x. b)"
     using assms by (force simp: contractible_def)
   have "homotopic_with_canon (\<lambda>f. True) T U (g \<circ> id) (g \<circ> (\<lambda>x. b))"
     by (metis Abstract_Topology.continuous_map_subtopology_eu b g homotopic_with_compose_continuous_map_left)
   then have "homotopic_with_canon (\<lambda>f. True) S U (g \<circ> id \<circ> f) (g \<circ> (\<lambda>x. b) \<circ> f)"
     by (simp add: f homotopic_with_compose_continuous_map_right)
   then show ?thesis
     by (simp add: comp_def that)
 qed
 
 lemma nullhomotopic_into_contractible:
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
       and T: "contractible T"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S T f (\<lambda>x. c)"
   by (rule nullhomotopic_through_contractible [OF f, of id T]) (use assms in auto)
 
 lemma nullhomotopic_from_contractible:
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
       and S: "contractible S"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S T f (\<lambda>x. c)"
   by (auto simp: comp_def intro: nullhomotopic_through_contractible [OF continuous_on_id _ f S])
 
 lemma homotopic_through_contractible:
   fixes S :: "_::real_normed_vector set"
   assumes "continuous_on S f1" "f1 ` S \<subseteq> T"
           "continuous_on T g1" "g1 ` T \<subseteq> U"
           "continuous_on S f2" "f2 ` S \<subseteq> T"
           "continuous_on T g2" "g2 ` T \<subseteq> U"
           "contractible T" "path_connected U"
    shows "homotopic_with_canon (\<lambda>h. True) S U (g1 \<circ> f1) (g2 \<circ> f2)"
 proof -
   obtain c1 where c1: "homotopic_with_canon (\<lambda>h. True) S U (g1 \<circ> f1) (\<lambda>x. c1)"
     by (rule nullhomotopic_through_contractible [of S f1 T g1 U]) (use assms in auto)
   obtain c2 where c2: "homotopic_with_canon (\<lambda>h. True) S U (g2 \<circ> f2) (\<lambda>x. c2)"
     by (rule nullhomotopic_through_contractible [of S f2 T g2 U]) (use assms in auto)
   have "S = {} \<or> (\<exists>t. path_connected t \<and> t \<subseteq> U \<and> c2 \<in> t \<and> c1 \<in> t)"
   proof (cases "S = {}")
     case True then show ?thesis by force
   next
     case False
     with c1 c2 have "c1 \<in> U" "c2 \<in> U"
       using homotopic_with_imp_continuous_maps by fastforce+
     with \<open>path_connected U\<close> show ?thesis by blast
   qed
   then have "homotopic_with_canon (\<lambda>h. True) S U (\<lambda>x. c2) (\<lambda>x. c1)"
     by (simp add: path_component homotopic_constant_maps)
   then show ?thesis
     using c1 c2 homotopic_with_symD homotopic_with_trans by blast
 qed
 
 lemma homotopic_into_contractible:
   fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
     and g: "continuous_on S g" "g ` S \<subseteq> T"
     and T: "contractible T"
   shows "homotopic_with_canon (\<lambda>h. True) S T f g"
   using homotopic_through_contractible [of S f T id T g id]
   by (simp add: assms contractible_imp_path_connected)
 
 lemma homotopic_from_contractible:
   fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
     and g: "continuous_on S g" "g ` S \<subseteq> T"
     and "contractible S" "path_connected T"
   shows "homotopic_with_canon (\<lambda>h. True) S T f g"
   using homotopic_through_contractible [of S id S f T id g]
   by (simp add: assms contractible_imp_path_connected)
 
 subsection\<open>Starlike sets\<close>
 
 definition\<^marker>\<open>tag important\<close> "starlike S \<longleftrightarrow> (\<exists>a\<in>S. \<forall>x\<in>S. closed_segment a x \<subseteq> S)"
 
 lemma starlike_UNIV [simp]: "starlike UNIV"
   by (simp add: starlike_def)
 
 lemma convex_imp_starlike:
   "convex S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> starlike S"
   unfolding convex_contains_segment starlike_def by auto
 
 lemma starlike_convex_tweak_boundary_points:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "S \<noteq> {}" and ST: "rel_interior S \<subseteq> T" and TS: "T \<subseteq> closure S"
   shows "starlike T"
 proof -
   have "rel_interior S \<noteq> {}"
     by (simp add: assms rel_interior_eq_empty)
   with ST obtain a where a: "a \<in> rel_interior S" and "a \<in> T" by blast
   have "\<And>x. x \<in> T \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
     by (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> a]) (use assms in auto)
   then have "\<forall>x\<in>T. a \<in> T \<and> open_segment a x \<subseteq> T"
     using ST by (blast intro: a \<open>a \<in> T\<close> rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
   then show ?thesis
     unfolding starlike_def using bexI [OF _ \<open>a \<in> T\<close>]
     by (simp add: closed_segment_eq_open)
 qed
 
 lemma starlike_imp_contractible_gen:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "starlike S"
       and P: "\<And>a T. \<lbrakk>a \<in> S; 0 \<le> T; T \<le> 1\<rbrakk> \<Longrightarrow> P(\<lambda>x. (1 - T) *\<^sub>R x + T *\<^sub>R a)"
     obtains a where "homotopic_with_canon P S S (\<lambda>x. x) (\<lambda>x. a)"
 proof -
   obtain a where "a \<in> S" and a: "\<And>x. x \<in> S \<Longrightarrow> closed_segment a x \<subseteq> S"
     using S by (auto simp: starlike_def)
   have "\<And>t b. 0 \<le> t \<and> t \<le> 1 \<Longrightarrow>
               \<exists>u. (1 - t) *\<^sub>R b + t *\<^sub>R a = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1"
     by (metis add_diff_cancel_right' diff_ge_0_iff_ge le_add_diff_inverse pth_c(1))
   then have "(\<lambda>y. (1 - fst y) *\<^sub>R snd y + fst y *\<^sub>R a) ` ({0..1} \<times> S) \<subseteq> S"
     using a [unfolded closed_segment_def] by force
   then have "homotopic_with_canon P S S (\<lambda>x. x) (\<lambda>x. a)"
     using \<open>a \<in> S\<close>
     unfolding homotopic_with_def
     apply (rule_tac x="\<lambda>y. (1 - (fst y)) *\<^sub>R snd y + (fst y) *\<^sub>R a" in exI)
     apply (force simp add: P intro: continuous_intros)
     done
   then show ?thesis
     using that by blast
 qed
 
 lemma starlike_imp_contractible:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> contractible S"
   using starlike_imp_contractible_gen contractible_def by (fastforce simp: id_def)
 
 lemma contractible_UNIV [simp]: "contractible (UNIV :: 'a::real_normed_vector set)"
   by (simp add: starlike_imp_contractible)
 
 lemma starlike_imp_simply_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> simply_connected S"
   by (simp add: contractible_imp_simply_connected starlike_imp_contractible)
 
 lemma convex_imp_simply_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "convex S \<Longrightarrow> simply_connected S"
   using convex_imp_starlike starlike_imp_simply_connected by blast
 
 lemma starlike_imp_path_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> path_connected S"
   by (simp add: simply_connected_imp_path_connected starlike_imp_simply_connected)
 
 lemma starlike_imp_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> connected S"
   by (simp add: path_connected_imp_connected starlike_imp_path_connected)
 
 lemma is_interval_simply_connected_1:
   fixes S :: "real set"
   shows "is_interval S \<longleftrightarrow> simply_connected S"
   by (meson convex_imp_simply_connected is_interval_connected_1 is_interval_convex_1 simply_connected_imp_connected)
 
 lemma contractible_empty [simp]: "contractible {}"
   by (simp add: contractible_def homotopic_on_emptyI)
 
 lemma contractible_convex_tweak_boundary_points:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" and TS: "rel_interior S \<subseteq> T" "T \<subseteq> closure S"
   shows "contractible T"
   by (metis assms closure_eq_empty contractible_empty empty_subsetI 
       starlike_convex_tweak_boundary_points starlike_imp_contractible subset_antisym)
 
 lemma convex_imp_contractible:
   fixes S :: "'a::real_normed_vector set"
   shows "convex S \<Longrightarrow> contractible S"
   using contractible_empty convex_imp_starlike starlike_imp_contractible by blast
 
 lemma contractible_sing [simp]:
   fixes a :: "'a::real_normed_vector"
   shows "contractible {a}"
   by (rule convex_imp_contractible [OF convex_singleton])
 
 lemma is_interval_contractible_1:
   fixes S :: "real set"
   shows  "is_interval S \<longleftrightarrow> contractible S"
   using contractible_imp_simply_connected convex_imp_contractible is_interval_convex_1
     is_interval_simply_connected_1 by auto
 
 lemma contractible_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes S: "contractible S" and T: "contractible T"
   shows "contractible (S \<times> T)"
 proof -
   obtain a h where conth: "continuous_on ({0..1} \<times> S) h"
              and hsub: "h ` ({0..1} \<times> S) \<subseteq> S"
              and [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (0, x) = x"
              and [simp]: "\<And>x. x \<in> S \<Longrightarrow>  h (1::real, x) = a"
     using S by (auto simp: contractible_def homotopic_with)
   obtain b k where contk: "continuous_on ({0..1} \<times> T) k"
              and ksub: "k ` ({0..1} \<times> T) \<subseteq> T"
              and [simp]: "\<And>x. x \<in> T \<Longrightarrow> k (0, x) = x"
              and [simp]: "\<And>x. x \<in> T \<Longrightarrow>  k (1::real, x) = b"
     using T by (auto simp: contractible_def homotopic_with)
   show ?thesis
     apply (simp add: contractible_def homotopic_with)
     apply (rule exI [where x=a])
     apply (rule exI [where x=b])
     apply (rule exI [where x = "\<lambda>z. (h (fst z, fst(snd z)), k (fst z, snd(snd z)))"])
     using hsub ksub
     apply (fastforce intro!: continuous_intros continuous_on_compose2 [OF conth] continuous_on_compose2 [OF contk])
     done
 qed
 
 
 subsection\<open>Local versions of topological properties in general\<close>
 
 definition\<^marker>\<open>tag important\<close> locally :: "('a::topological_space set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
 where
  "locally P S \<equiv>
         \<forall>w x. openin (top_of_set S) w \<and> x \<in> w
               \<longrightarrow> (\<exists>u v. openin (top_of_set S) u \<and> P v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w)"
 
 lemma locallyI:
   assumes "\<And>w x. \<lbrakk>openin (top_of_set S) w; x \<in> w\<rbrakk>
                   \<Longrightarrow> \<exists>u v. openin (top_of_set S) u \<and> P v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w"
     shows "locally P S"
 using assms by (force simp: locally_def)
 
 lemma locallyE:
   assumes "locally P S" "openin (top_of_set S) w" "x \<in> w"
   obtains u v where "openin (top_of_set S) u"
                     "P v" "x \<in> u" "u \<subseteq> v" "v \<subseteq> w"
   using assms unfolding locally_def by meson
 
 lemma locally_mono:
   assumes "locally P S" "\<And>T. P T \<Longrightarrow> Q T"
     shows "locally Q S"
 by (metis assms locally_def)
 
 lemma locally_open_subset:
   assumes "locally P S" "openin (top_of_set S) t"
     shows "locally P t"
   by (smt (verit, ccfv_SIG) assms order.trans locally_def openin_imp_subset openin_subset_trans openin_trans)
 
 lemma locally_diff_closed:
     "\<lbrakk>locally P S; closedin (top_of_set S) t\<rbrakk> \<Longrightarrow> locally P (S - t)"
   using locally_open_subset closedin_def by fastforce
 
 lemma locally_empty [iff]: "locally P {}"
   by (simp add: locally_def openin_subtopology)
 
 lemma locally_singleton [iff]:
   fixes a :: "'a::metric_space"
   shows "locally P {a} \<longleftrightarrow> P {a}"
 proof -
   have "\<forall>x::real. \<not> 0 < x \<Longrightarrow> P {a}"
     using zero_less_one by blast
   then show ?thesis
     unfolding locally_def
     by (auto simp: openin_euclidean_subtopology_iff subset_singleton_iff conj_disj_distribR)
 qed
 
 lemma locally_iff:
     "locally P S \<longleftrightarrow>
      (\<forall>T x. open T \<and> x \<in> S \<inter> T \<longrightarrow> (\<exists>U. open U \<and> (\<exists>V. P V \<and> x \<in> S \<inter> U \<and> S \<inter> U \<subseteq> V \<and> V \<subseteq> S \<inter> T)))"
   by (smt (verit) locally_def openin_open)
 
 lemma locally_Int:
   assumes S: "locally P S" and T: "locally P T"
       and P: "\<And>S T. P S \<and> P T \<Longrightarrow> P(S \<inter> T)"
   shows "locally P (S \<inter> T)"
   unfolding locally_iff
 proof clarify
   fix A x
   assume "open A" "x \<in> A" "x \<in> S" "x \<in> T"
   then obtain U1 V1 U2 V2 
     where "open U1" "P V1" "x \<in> S \<inter> U1" "S \<inter> U1 \<subseteq> V1 \<and> V1 \<subseteq> S \<inter> A" 
           "open U2" "P V2" "x \<in> T \<inter> U2" "T \<inter> U2 \<subseteq> V2 \<and> V2 \<subseteq> T \<inter> A"
     using S T unfolding locally_iff by (meson IntI)
   then have "S \<inter> T \<inter> (U1 \<inter> U2) \<subseteq> V1 \<inter> V2" "V1 \<inter> V2 \<subseteq> S \<inter> T \<inter> A" "x \<in> S \<inter> T \<inter> (U1 \<inter> U2)"
     by blast+
   moreover have "P (V1 \<inter> V2)"
     by (simp add: P \<open>P V1\<close> \<open>P V2\<close>)
   ultimately show "\<exists>U. open U \<and> (\<exists>V. P V \<and> x \<in> S \<inter> T \<inter> U \<and> S \<inter> T \<inter> U \<subseteq> V \<and> V \<subseteq> S \<inter> T \<inter> A)"
     using \<open>open U1\<close> \<open>open U2\<close> by blast
 qed
 
 
 lemma locally_Times:
   fixes S :: "('a::metric_space) set" and T :: "('b::metric_space) set"
   assumes PS: "locally P S" and QT: "locally Q T" and R: "\<And>S T. P S \<and> Q T \<Longrightarrow> R(S \<times> T)"
   shows "locally R (S \<times> T)"
     unfolding locally_def
 proof (clarify)
   fix W x y
   assume W: "openin (top_of_set (S \<times> T)) W" and xy: "(x, y) \<in> W"
   then obtain U V where "openin (top_of_set S) U" "x \<in> U"
                         "openin (top_of_set T) V" "y \<in> V" "U \<times> V \<subseteq> W"
     using Times_in_interior_subtopology by metis
   then obtain U1 U2 V1 V2
          where opeS: "openin (top_of_set S) U1 \<and> P U2 \<and> x \<in> U1 \<and> U1 \<subseteq> U2 \<and> U2 \<subseteq> U"
            and opeT: "openin (top_of_set T) V1 \<and> Q V2 \<and> y \<in> V1 \<and> V1 \<subseteq> V2 \<and> V2 \<subseteq> V"
     by (meson PS QT locallyE)
   then have "openin (top_of_set (S \<times> T)) (U1 \<times> V1)"
     by (simp add: openin_Times)
   moreover have "R (U2 \<times> V2)"
     by (simp add: R opeS opeT)
   moreover have "U1 \<times> V1 \<subseteq> U2 \<times> V2 \<and> U2 \<times> V2 \<subseteq> W"
     using opeS opeT \<open>U \<times> V \<subseteq> W\<close> by auto 
   ultimately show "\<exists>U V. openin (top_of_set (S \<times> T)) U \<and> R V \<and> (x,y) \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W"
     using opeS opeT by auto 
 qed
 
 
 proposition homeomorphism_locally_imp:
   fixes S :: "'a::metric_space set" and T :: "'b::t2_space set"
   assumes S: "locally P S" and hom: "homeomorphism S T f g"
       and Q: "\<And>S S'. \<lbrakk>P S; homeomorphism S S' f g\<rbrakk> \<Longrightarrow> Q S'"
     shows "locally Q T"
 proof (clarsimp simp: locally_def)
   fix W y
   assume "y \<in> W" and "openin (top_of_set T) W"
   then obtain A where T: "open A" "W = T \<inter> A"
     by (force simp: openin_open)
   then have "W \<subseteq> T" by auto
   have f: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "f ` S = T" "continuous_on S f"
    and g: "\<And>y. y \<in> T \<Longrightarrow> f(g y) = y" "g ` T = S" "continuous_on T g"
     using hom by (auto simp: homeomorphism_def)
   have gw: "g ` W = S \<inter> f -` W"
     using \<open>W \<subseteq> T\<close> g by force
   have "openin (top_of_set S) (g ` W)"
     using \<open>openin (top_of_set T) W\<close> continuous_on_open f gw by auto
   then obtain U V
     where osu: "openin (top_of_set S) U" and uv: "P V" "g y \<in> U" "U \<subseteq> V" "V \<subseteq> g ` W"
     by (metis S \<open>y \<in> W\<close> image_eqI locallyE)
   have "V \<subseteq> S" using uv by (simp add: gw)
   have fv: "f ` V = T \<inter> {x. g x \<in> V}"
     using \<open>f ` S = T\<close> f \<open>V \<subseteq> S\<close> by auto
   have contvf: "continuous_on V f"
     using \<open>V \<subseteq> S\<close> continuous_on_subset f(3) by blast
   have "f ` V \<subseteq> W"
     using uv using Int_lower2 gw image_subsetI mem_Collect_eq subset_iff by auto
   then have contvg: "continuous_on (f ` V) g"
     using \<open>W \<subseteq> T\<close> continuous_on_subset [OF g(3)] by blast
   have "V \<subseteq> g ` f ` V"
     by (metis \<open>V \<subseteq> S\<close> hom homeomorphism_def homeomorphism_of_subsets order_refl)
   then have homv: "homeomorphism V (f ` V) f g"
     using \<open>V \<subseteq> S\<close> f by (auto simp: homeomorphism_def contvf contvg)
   have "openin (top_of_set (g ` T)) U"
     using \<open>g ` T = S\<close> by (simp add: osu)
   then have "openin (top_of_set T) (T \<inter> g -` U)"
     using \<open>continuous_on T g\<close> continuous_on_open [THEN iffD1] by blast
   moreover have "\<exists>V. Q V \<and> y \<in> (T \<inter> g -` U) \<and> (T \<inter> g -` U) \<subseteq> V \<and> V \<subseteq> W"
   proof (intro exI conjI)
     show "Q (f ` V)"
       using Q homv \<open>P V\<close> by blast
     show "y \<in> T \<inter> g -` U"
       using T(2) \<open>y \<in> W\<close> \<open>g y \<in> U\<close> by blast
     show "T \<inter> g -` U \<subseteq> f ` V"
       using g(1) image_iff uv(3) by fastforce
     show "f ` V \<subseteq> W"
       using \<open>f ` V \<subseteq> W\<close> by blast
   qed
   ultimately show "\<exists>U. openin (top_of_set T) U \<and> (\<exists>v. Q v \<and> y \<in> U \<and> U \<subseteq> v \<and> v \<subseteq> W)"
     by meson
 qed
 
 lemma homeomorphism_locally:
   fixes f:: "'a::metric_space \<Rightarrow> 'b::metric_space"
   assumes "homeomorphism S T f g"
       and "\<And>S T. homeomorphism S T f g \<Longrightarrow> (P S \<longleftrightarrow> Q T)"
     shows "locally P S \<longleftrightarrow> locally Q T"
   by (smt (verit) assms homeomorphism_locally_imp homeomorphism_symD)
 
 lemma homeomorphic_locally:
   fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
   assumes hom: "S homeomorphic T"
           and iff: "\<And>X Y. X homeomorphic Y \<Longrightarrow> (P X \<longleftrightarrow> Q Y)"
     shows "locally P S \<longleftrightarrow> locally Q T"
   by (smt (verit, ccfv_SIG) hom homeomorphic_def homeomorphism_locally homeomorphism_locally_imp iff)
 
 lemma homeomorphic_local_compactness:
   fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
   shows "S homeomorphic T \<Longrightarrow> locally compact S \<longleftrightarrow> locally compact T"
   by (simp add: homeomorphic_compactness homeomorphic_locally)
 
 lemma locally_translation:
   fixes P :: "'a :: real_normed_vector set \<Rightarrow> bool"
   shows "(\<And>S. P ((+) a ` S) = P S) \<Longrightarrow> locally P ((+) a ` S) = locally P S"
   using homeomorphism_locally [OF homeomorphism_translation]
   by (metis (full_types) homeomorphism_image2)
 
 lemma locally_injective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes f: "linear f" "inj f" and iff: "\<And>S. P (f ` S) \<longleftrightarrow> Q S"
   shows "locally P (f ` S) \<longleftrightarrow> locally Q S"
   using homeomorphism_locally [of "f`S" _ _ f] linear_homeomorphism_image [OF f]
   by (metis (no_types, lifting) homeomorphism_image2 iff)
 
 lemma locally_open_map_image:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes P: "locally P S"
       and f: "continuous_on S f"
       and oo: "\<And>T. openin (top_of_set S) T \<Longrightarrow> openin (top_of_set (f ` S)) (f ` T)"
       and Q: "\<And>T. \<lbrakk>T \<subseteq> S; P T\<rbrakk> \<Longrightarrow> Q(f ` T)"
     shows "locally Q (f ` S)"
 proof (clarsimp simp: locally_def)
   fix W y
   assume oiw: "openin (top_of_set (f ` S)) W" and "y \<in> W"
   then have "W \<subseteq> f ` S" by (simp add: openin_euclidean_subtopology_iff)
   have oivf: "openin (top_of_set S) (S \<inter> f -` W)"
     by (rule continuous_on_open [THEN iffD1, rule_format, OF f oiw])
   then obtain x where "x \<in> S" "f x = y"
     using \<open>W \<subseteq> f ` S\<close> \<open>y \<in> W\<close> by blast
   then obtain U V
     where "openin (top_of_set S) U" "P V" "x \<in> U" "U \<subseteq> V" "V \<subseteq> S \<inter> f -` W"
     by (metis IntI P \<open>y \<in> W\<close> locallyE oivf vimageI)
   then have "openin (top_of_set (f ` S)) (f ` U)"
     by (simp add: oo)
   then show "\<exists>X. openin (top_of_set (f ` S)) X \<and> (\<exists>Y. Q Y \<and> y \<in> X \<and> X \<subseteq> Y \<and> Y \<subseteq> W)"
     using Q \<open>P V\<close> \<open>U \<subseteq> V\<close> \<open>V \<subseteq> S \<inter> f -` W\<close> \<open>f x = y\<close> \<open>x \<in> U\<close> by blast
 qed
 
 
 subsection\<open>An induction principle for connected sets\<close>
 
 proposition connected_induction:
   assumes "connected S"
       and opD: "\<And>T a. \<lbrakk>openin (top_of_set S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<and> Q x \<longrightarrow> Q y)"
       and etc: "a \<in> S" "b \<in> S" "P a" "P b" "Q a"
     shows "Q b"
 proof -
   let ?A = "{b. \<exists>T. openin (top_of_set S) T \<and> b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> Q x)}"
   let ?B = "{b. \<exists>T. openin (top_of_set S) T \<and> b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> \<not> Q x)}"
   have "?A \<inter> ?B = {}"
     by (clarsimp simp: set_eq_iff) (metis (no_types, opaque_lifting) Int_iff opD openin_Int)
   moreover have "S \<subseteq> ?A \<union> ?B"
     by clarsimp (meson opI)
   moreover have "openin (top_of_set S) ?A"
     by (subst openin_subopen, blast)
   moreover have "openin (top_of_set S) ?B"
     by (subst openin_subopen, blast)
   ultimately have "?A = {} \<or> ?B = {}"
     by (metis (no_types, lifting) \<open>connected S\<close> connected_openin)
   then show ?thesis
     by clarsimp (meson opI etc)
 qed
 
 lemma connected_equivalence_relation_gen:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S" "P a" "P b"
       and trans: "\<And>x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z"
       and opD: "\<And>T a. \<lbrakk>openin (top_of_set S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<longrightarrow> R x y)"
     shows "R a b"
 proof -
   have "\<And>a b c. \<lbrakk>a \<in> S; P a; b \<in> S; c \<in> S; P b; P c; R a b\<rbrakk> \<Longrightarrow> R a c"
     apply (rule connected_induction [OF \<open>connected S\<close> opD], simp_all)
     by (meson trans opI)
   then show ?thesis by (metis etc opI)
 qed
 
 lemma connected_induction_simple:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S" "P a"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<longrightarrow> P y)"
     shows "P b"
   by (rule connected_induction [OF \<open>connected S\<close> _, where P = "\<lambda>x. True"])
      (use opI etc in auto)
 
 lemma connected_equivalence_relation:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S"
       and sym: "\<And>x y. \<lbrakk>R x y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> R y x"
       and trans: "\<And>x y z. \<lbrakk>R x y; R y z; x \<in> S; y \<in> S; z \<in> S\<rbrakk> \<Longrightarrow> R x z"
       and opI: "\<And>a. a \<in> S \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. R a x)"
     shows "R a b"
 proof -
   have "\<And>a b c. \<lbrakk>a \<in> S; b \<in> S; c \<in> S; R a b\<rbrakk> \<Longrightarrow> R a c"
     apply (rule connected_induction_simple [OF \<open>connected S\<close>], simp_all)
     by (meson local.sym local.trans opI openin_imp_subset subsetCE)
   then show ?thesis by (metis etc opI)
 qed
 
 lemma locally_constant_imp_constant:
   assumes "connected S"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. f x = f a)"
     shows "f constant_on S"
 proof -
   have "\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f x = f y"
     apply (rule connected_equivalence_relation [OF \<open>connected S\<close>], simp_all)
     by (metis opI)
   then show ?thesis
     by (metis constant_on_def)
 qed
 
 lemma locally_constant:
   assumes "connected S"
   shows "locally (\<lambda>U. f constant_on U) S \<longleftrightarrow> f constant_on S" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (smt (verit, del_insts) assms constant_on_def locally_constant_imp_constant locally_def openin_subtopology_self subset_iff)
 next
   assume ?rhs then show ?lhs
     by (metis constant_on_subset locallyI openin_imp_subset order_refl)
 qed
 
 
 subsection\<open>Basic properties of local compactness\<close>
 
 proposition locally_compact:
   fixes S :: "'a :: metric_space set"
   shows
     "locally compact S \<longleftrightarrow>
      (\<forall>x \<in> S. \<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> S \<and>
                     openin (top_of_set S) u \<and> compact v)"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (meson locallyE openin_subtopology_self)
 next
   assume r [rule_format]: ?rhs
   have *: "\<exists>u v.
               openin (top_of_set S) u \<and>
               compact v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> S \<inter> T"
           if "open T" "x \<in> S" "x \<in> T" for x T
   proof -
     obtain u v where uv: "x \<in> u" "u \<subseteq> v" "v \<subseteq> S" "compact v" "openin (top_of_set S) u"
       using r [OF \<open>x \<in> S\<close>] by auto
     obtain e where "e>0" and e: "cball x e \<subseteq> T"
       using open_contains_cball \<open>open T\<close> \<open>x \<in> T\<close> by blast
     show ?thesis
       apply (rule_tac x="(S \<inter> ball x e) \<inter> u" in exI)
       apply (rule_tac x="cball x e \<inter> v" in exI)
       using that \<open>e > 0\<close> e uv
       apply auto
       done
   qed
   show ?lhs
     by (rule locallyI) (metis "*" Int_iff openin_open)
 qed
 
 lemma locally_compactE:
   fixes S :: "'a :: metric_space set"
   assumes "locally compact S"
   obtains u v where "\<And>x. x \<in> S \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> S \<and>
                              openin (top_of_set S) (u x) \<and> compact (v x)"
   using assms unfolding locally_compact by metis
 
 lemma locally_compact_alt:
   fixes S :: "'a :: heine_borel set"
   shows "locally compact S \<longleftrightarrow>
          (\<forall>x \<in> S. \<exists>U. x \<in> U \<and>
                     openin (top_of_set S) U \<and> compact(closure U) \<and> closure U \<subseteq> S)"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (meson bounded_subset closure_minimal compact_closure compact_imp_bounded 
               compact_imp_closed dual_order.trans locally_compactE)
 next
   assume ?rhs then show ?lhs
     by (meson closure_subset locally_compact)
 qed
 
 lemma locally_compact_Int_cball:
   fixes S :: "'a :: heine_borel set"
   shows "locally compact S \<longleftrightarrow> (\<forall>x \<in> S. \<exists>e. 0 < e \<and> closed(cball x e \<inter> S))"
         (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then have "\<And>x U V e. \<lbrakk>U \<subseteq> V; V \<subseteq> S; compact V; 0 < e; cball x e \<inter> S \<subseteq> U\<rbrakk>
        \<Longrightarrow> closed (cball x e \<inter> S)"
     by (metis compact_Int compact_cball compact_imp_closed inf.absorb_iff2 inf.assoc inf.orderE)
   with L show ?rhs
     by (meson locally_compactE openin_contains_cball)
 next
   assume R: ?rhs
   show ?lhs unfolding locally_compact 
   proof
     fix x
     assume "x \<in> S"
     then obtain e where "e>0" and "compact (cball x e \<inter> S)"
       by (metis Int_commute compact_Int_closed compact_cball inf.right_idem R)
     moreover have "\<forall>y\<in>ball x e \<inter> S. \<exists>\<epsilon>>0. cball y \<epsilon> \<inter> S \<subseteq> ball x e"
       by (meson Elementary_Metric_Spaces.open_ball IntD1 le_infI1 open_contains_cball_eq)
     moreover have "openin (top_of_set S) (ball x e \<inter> S)"
       by (simp add: inf_commute openin_open_Int)
     ultimately show "\<exists>U V. x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and> openin (top_of_set S) U \<and> compact V"
       by (metis Int_iff \<open>0 < e\<close> \<open>x \<in> S\<close> ball_subset_cball centre_in_ball inf_commute inf_le1 inf_mono order_refl)
   qed
 qed
 
 lemma locally_compact_compact:
   fixes S :: "'a :: heine_borel set"
   shows "locally compact S \<longleftrightarrow>
          (\<forall>K. K \<subseteq> S \<and> compact K
               \<longrightarrow> (\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and>
                          openin (top_of_set S) U \<and> compact V))"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain u v where
     uv: "\<And>x. x \<in> S \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> S \<and>
                              openin (top_of_set S) (u x) \<and> compact (v x)"
     by (metis locally_compactE)
   have *: "\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and> openin (top_of_set S) U \<and> compact V"
           if "K \<subseteq> S" "compact K" for K
   proof -
     have "\<And>C. (\<forall>c\<in>C. openin (top_of_set K) c) \<and> K \<subseteq> \<Union>C \<Longrightarrow>
                     \<exists>D\<subseteq>C. finite D \<and> K \<subseteq> \<Union>D"
       using that by (simp add: compact_eq_openin_cover)
     moreover have "\<forall>c \<in> (\<lambda>x. K \<inter> u x) ` K. openin (top_of_set K) c"
       using that by clarify (metis subsetD inf.absorb_iff2 openin_subset openin_subtopology_Int_subset topspace_euclidean_subtopology uv)
     moreover have "K \<subseteq> \<Union>((\<lambda>x. K \<inter> u x) ` K)"
       using that by clarsimp (meson subsetCE uv)
     ultimately obtain D where "D \<subseteq> (\<lambda>x. K \<inter> u x) ` K" "finite D" "K \<subseteq> \<Union>D"
       by metis
     then obtain T where T: "T \<subseteq> K" "finite T" "K \<subseteq> \<Union>((\<lambda>x. K \<inter> u x) ` T)"
       by (metis finite_subset_image)
     have Tuv: "\<Union>(u ` T) \<subseteq> \<Union>(v ` T)"
       using T that by (force dest!: uv)
     moreover
     have "openin (top_of_set S) (\<Union> (u ` T))"
       using T that uv by fastforce
     moreover
     obtain "compact (\<Union> (v ` T))" "\<Union> (v ` T) \<subseteq> S"
       by (metis T UN_subset_iff \<open>K \<subseteq> S\<close> compact_UN subset_iff uv)
     ultimately show ?thesis
       using T by auto 
   qed
   show ?rhs
     by (blast intro: *)
 next
   assume ?rhs
   then show ?lhs
     apply (clarsimp simp: locally_compact)
     apply (drule_tac x="{x}" in spec, simp)
     done
 qed
 
 lemma open_imp_locally_compact:
   fixes S :: "'a :: heine_borel set"
   assumes "open S"
     shows "locally compact S"
 proof -
   have *: "\<exists>U V. x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and> openin (top_of_set S) U \<and> compact V"
           if "x \<in> S" for x
   proof -
     obtain e where "e>0" and e: "cball x e \<subseteq> S"
       using open_contains_cball assms \<open>x \<in> S\<close> by blast
     have ope: "openin (top_of_set S) (ball x e)"
       by (meson e open_ball ball_subset_cball dual_order.trans open_subset)
     show ?thesis
       by (meson \<open>0 < e\<close> ball_subset_cball centre_in_ball compact_cball e ope)
   qed
   show ?thesis
     unfolding locally_compact by (blast intro: *)
 qed
 
 lemma closed_imp_locally_compact:
   fixes S :: "'a :: heine_borel set"
   assumes "closed S"
     shows "locally compact S"
 proof -
   have *: "\<exists>U V. x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> S \<and> openin (top_of_set S) U \<and> compact V"
           if "x \<in> S" for x
     apply (rule_tac x = "S \<inter> ball x 1" in exI, rule_tac x = "S \<inter> cball x 1" in exI)
     using \<open>x \<in> S\<close> assms by auto
   show ?thesis
     unfolding locally_compact by (blast intro: *)
 qed
 
 lemma locally_compact_UNIV: "locally compact (UNIV :: 'a :: heine_borel set)"
   by (simp add: closed_imp_locally_compact)
 
 lemma locally_compact_Int:
   fixes S :: "'a :: t2_space set"
   shows "\<lbrakk>locally compact S; locally compact T\<rbrakk> \<Longrightarrow> locally compact (S \<inter> T)"
   by (simp add: compact_Int locally_Int)
 
 lemma locally_compact_closedin:
   fixes S :: "'a :: heine_borel set"
   shows "\<lbrakk>closedin (top_of_set S) T; locally compact S\<rbrakk>
         \<Longrightarrow> locally compact T"
   unfolding closedin_closed
   using closed_imp_locally_compact locally_compact_Int by blast
 
 lemma locally_compact_delete:
      fixes S :: "'a :: t1_space set"
      shows "locally compact S \<Longrightarrow> locally compact (S - {a})"
   by (auto simp: openin_delete locally_open_subset)
 
 lemma locally_closed:
   fixes S :: "'a :: heine_borel set"
   shows "locally closed S \<longleftrightarrow> locally compact S"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding locally_def
     apply (elim all_forward imp_forward asm_rl exE)
     apply (rule_tac x = "u \<inter> ball x 1" in exI)
     apply (rule_tac x = "v \<inter> cball x 1" in exI)
     apply (force intro: openin_trans)
     done
 next
   assume ?rhs then show ?lhs
     using compact_eq_bounded_closed locally_mono by blast
 qed
 
 lemma locally_compact_openin_Un:
   fixes S :: "'a::euclidean_space set"
   assumes LCS: "locally compact S" and LCT:"locally compact T"
       and opS: "openin (top_of_set (S \<union> T)) S"
       and opT: "openin (top_of_set (S \<union> T)) T"
     shows "locally compact (S \<union> T)"
 proof -
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> S"
       by (meson \<open>x \<in> S\<close> opS openin_contains_cball)
     then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> S"
       by force
     ultimately have "closed (cball x (min e1 e2) \<inter> (S \<union> T))"
       by (metis (no_types, lifting) cball_min_Int closed_Int closed_cball inf_assoc inf_commute)
     then show ?thesis
       by (metis \<open>0 < e1\<close> \<open>0 < e2\<close> min_def)
   qed
   moreover have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> T"
       by (meson \<open>x \<in> T\<close> opT openin_contains_cball)
     then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> T"
       by force
     moreover have "closed (cball x e1 \<inter> (cball x e2 \<inter> T))"
       by (metis closed_Int closed_cball e1 inf_left_commute)
     ultimately show ?thesis
       by (rule_tac x="min e1 e2" in exI) (simp add: \<open>0 < e2\<close> cball_min_Int inf_assoc)
   qed
   ultimately show ?thesis
     by (force simp: locally_compact_Int_cball)
 qed
 
 lemma locally_compact_closedin_Un:
   fixes S :: "'a::euclidean_space set"
   assumes LCS: "locally compact S" and LCT:"locally compact T"
       and clS: "closedin (top_of_set (S \<union> T)) S"
       and clT: "closedin (top_of_set (S \<union> T)) T"
     shows "locally compact (S \<union> T)"
 proof -
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2 > 0" and e2: "closed (cball x e2 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     moreover have "closed (cball x (min e1 e2) \<inter> (S \<union> T))"
       by (smt (verit) Int_Un_distrib2 Int_commute cball_min_Int closed_Int closed_Un closed_cball e1 e2 inf_left_commute)
     ultimately show ?thesis
       by (rule_tac x="min e1 e2" in exI) linarith
   qed
   moreover
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<in> S" "x \<notin> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S - T"
       using clT x by (fastforce simp: openin_contains_cball closedin_def)
     then have "closed (cball x e2 \<inter> T)"
     proof -
       have "{} = T - (T - cball x e2)"
         using Diff_subset Int_Diff \<open>cball x e2 \<inter> (S \<union> T) \<subseteq> S - T\<close> by auto
       then show ?thesis
         by (simp add: Diff_Diff_Int inf_commute)
     qed
     with e1 have "closed ((cball x e1 \<inter> cball x e2) \<inter> (S \<union> T))"
       apply (simp add: inf_commute inf_sup_distrib2)
       by (metis closed_Int closed_Un closed_cball inf_assoc inf_left_commute)
     then have "closed (cball x (min e1 e2) \<inter> (S \<union> T))"
       by (simp add: cball_min_Int inf_commute)
     ultimately show ?thesis
       using \<open>0 < e2\<close> by (rule_tac x="min e1 e2" in exI) linarith 
   qed
   moreover
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<notin> S" "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S \<union> T - S"
       using clS x by (fastforce simp: openin_contains_cball closedin_def)
     then have "closed (cball x e2 \<inter> S)"
       by (metis Diff_disjoint Int_empty_right closed_empty inf.left_commute inf.orderE inf_sup_absorb)
     with e1 have "closed ((cball x e1 \<inter> cball x e2) \<inter> (S \<union> T))"
       apply (simp add: inf_commute inf_sup_distrib2)
       by (metis closed_Int closed_Un closed_cball inf_assoc inf_left_commute)
     then have "closed (cball x (min e1 e2) \<inter> (S \<union> T))"
       by (auto simp: cball_min_Int)
     ultimately show ?thesis
       using \<open>0 < e2\<close> by (rule_tac x="min e1 e2" in exI) linarith
   qed
   ultimately show ?thesis
     by (auto simp: locally_compact_Int_cball)
 qed
 
 lemma locally_compact_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   shows "\<lbrakk>locally compact S; locally compact T\<rbrakk> \<Longrightarrow> locally compact (S \<times> T)"
   by (auto simp: compact_Times locally_Times)
 
 lemma locally_compact_compact_subopen:
   fixes S :: "'a :: heine_borel set"
   shows
    "locally compact S \<longleftrightarrow>
     (\<forall>K T. K \<subseteq> S \<and> compact K \<and> open T \<and> K \<subseteq> T
           \<longrightarrow> (\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
                      openin (top_of_set S) U \<and> compact V))"
    (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof clarify
     fix K :: "'a set" and T :: "'a set"
     assume "K \<subseteq> S" and "compact K" and "open T" and "K \<subseteq> T"
     obtain U V where "K \<subseteq> U" "U \<subseteq> V" "V \<subseteq> S" "compact V"
                  and ope: "openin (top_of_set S) U"
       using L unfolding locally_compact_compact by (meson \<open>K \<subseteq> S\<close> \<open>compact K\<close>)
     show "\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
                 openin (top_of_set S) U \<and> compact V"
     proof (intro exI conjI)
       show "K \<subseteq> U \<inter> T"
         by (simp add: \<open>K \<subseteq> T\<close> \<open>K \<subseteq> U\<close>)
       show "U \<inter> T \<subseteq> closure(U \<inter> T)"
         by (rule closure_subset)
       show "closure (U \<inter> T) \<subseteq> S"
         by (metis \<open>U \<subseteq> V\<close> \<open>V \<subseteq> S\<close> \<open>compact V\<close> closure_closed closure_mono compact_imp_closed inf.cobounded1 subset_trans)
       show "openin (top_of_set S) (U \<inter> T)"
         by (simp add: \<open>open T\<close> ope openin_Int_open)
       show "compact (closure (U \<inter> T))"
         by (meson Int_lower1 \<open>U \<subseteq> V\<close> \<open>compact V\<close> bounded_subset compact_closure compact_eq_bounded_closed)
     qed auto
   qed
 next
   assume ?rhs then show ?lhs
     unfolding locally_compact_compact
     by (metis open_openin openin_topspace subtopology_superset top.extremum topspace_euclidean_subtopology)
 qed
 
 
 subsection\<open>Sura-Bura's results about compact components of sets\<close>
 
 proposition Sura_Bura_compact:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and C: "C \<in> components S"
   shows "C = \<Inter>{T. C \<subseteq> T \<and> openin (top_of_set S) T \<and>
                            closedin (top_of_set S) T}"
          (is "C = \<Inter>?\<T>")
 proof
   obtain x where x: "C = connected_component_set S x" and "x \<in> S"
     using C by (auto simp: components_def)
   have "C \<subseteq> S"
     by (simp add: C in_components_subset)
   have "\<Inter>?\<T> \<subseteq> connected_component_set S x"
   proof (rule connected_component_maximal)
     have "x \<in> C"
       by (simp add: \<open>x \<in> S\<close> x)
     then show "x \<in> \<Inter>?\<T>"
       by blast
     have clo: "closed (\<Inter>?\<T>)"
       by (simp add: \<open>compact S\<close> closed_Inter closedin_compact_eq compact_imp_closed)
     have False
       if K1: "closedin (top_of_set (\<Inter>?\<T>)) K1" and
          K2: "closedin (top_of_set (\<Inter>?\<T>)) K2" and
          K12_Int: "K1 \<inter> K2 = {}" and K12_Un: "K1 \<union> K2 = \<Inter>?\<T>" and "K1 \<noteq> {}" "K2 \<noteq> {}"
        for K1 K2
     proof -
       have "closed K1" "closed K2"
         using closedin_closed_trans clo K1 K2 by blast+
       then obtain V1 V2 where "open V1" "open V2" "K1 \<subseteq> V1" "K2 \<subseteq> V2" and V12: "V1 \<inter> V2 = {}"
         using separation_normal \<open>K1 \<inter> K2 = {}\<close> by metis
       have SV12_ne: "(S - (V1 \<union> V2)) \<inter> (\<Inter>?\<T>) \<noteq> {}"
       proof (rule compact_imp_fip)
         show "compact (S - (V1 \<union> V2))"
           by (simp add: \<open>open V1\<close> \<open>open V2\<close> \<open>compact S\<close> compact_diff open_Un)
         show clo\<T>: "closed T" if "T \<in> ?\<T>" for T
           using that \<open>compact S\<close>
           by (force intro: closedin_closed_trans simp add: compact_imp_closed)
         show "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> \<noteq> {}" if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
         proof
           assume djo: "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> = {}"
           obtain D where opeD: "openin (top_of_set S) D"
                    and cloD: "closedin (top_of_set S) D"
                    and "C \<subseteq> D" and DV12: "D \<subseteq> V1 \<union> V2"
           proof (cases "\<F> = {}")
             case True
             with \<open>C \<subseteq> S\<close> djo that show ?thesis
               by force
           next
             case False show ?thesis
             proof
               show ope: "openin (top_of_set S) (\<Inter>\<F>)"
                 using openin_Inter \<open>finite \<F>\<close> False \<F> by blast
               then show "closedin (top_of_set S) (\<Inter>\<F>)"
                 by (meson clo\<T> \<F> closed_Inter closed_subset openin_imp_subset subset_eq)
               show "C \<subseteq> \<Inter>\<F>"
                 using \<F> by auto
               show "\<Inter>\<F> \<subseteq> V1 \<union> V2"
                 using ope djo openin_imp_subset by fastforce
             qed
           qed
           have "connected C"
             by (simp add: x)
           have "closed D"
             using \<open>compact S\<close> cloD closedin_closed_trans compact_imp_closed by blast
           have cloV1: "closedin (top_of_set D) (D \<inter> closure V1)"
             and cloV2: "closedin (top_of_set D) (D \<inter> closure V2)"
             by (simp_all add: closedin_closed_Int)
           moreover have "D \<inter> closure V1 = D \<inter> V1" "D \<inter> closure V2 = D \<inter> V2"
             using \<open>D \<subseteq> V1 \<union> V2\<close> \<open>open V1\<close> \<open>open V2\<close> V12
             by (auto simp: closure_subset [THEN subsetD] closure_iff_nhds_not_empty, blast+)
           ultimately have cloDV1: "closedin (top_of_set D) (D \<inter> V1)"
                       and cloDV2:  "closedin (top_of_set D) (D \<inter> V2)"
             by metis+
           then obtain U1 U2 where "closed U1" "closed U2"
                and D1: "D \<inter> V1 = D \<inter> U1" and D2: "D \<inter> V2 = D \<inter> U2"
             by (auto simp: closedin_closed)
           have "D \<inter> U1 \<inter> C \<noteq> {}"
           proof
             assume "D \<inter> U1 \<inter> C = {}"
             then have *: "C \<subseteq> D \<inter> V2"
               using D1 DV12 \<open>C \<subseteq> D\<close> by auto
             have 1: "openin (top_of_set S) (D \<inter> V2)"
               by (simp add: \<open>open V2\<close> opeD openin_Int_open)
             have 2: "closedin (top_of_set S) (D \<inter> V2)"
               using cloD cloDV2 closedin_trans by blast
             have "\<Inter> ?\<T> \<subseteq> D \<inter> V2"
               by (rule Inter_lower) (use * 1 2 in simp)
             then show False
               using K1 V12 \<open>K1 \<noteq> {}\<close> \<open>K1 \<subseteq> V1\<close> closedin_imp_subset by blast
           qed
           moreover have "D \<inter> U2 \<inter> C \<noteq> {}"
           proof
             assume "D \<inter> U2 \<inter> C = {}"
             then have *: "C \<subseteq> D \<inter> V1"
               using D2 DV12 \<open>C \<subseteq> D\<close> by auto
             have 1: "openin (top_of_set S) (D \<inter> V1)"
               by (simp add: \<open>open V1\<close> opeD openin_Int_open)
             have 2: "closedin (top_of_set S) (D \<inter> V1)"
               using cloD cloDV1 closedin_trans by blast
             have "\<Inter>?\<T> \<subseteq> D \<inter> V1"
               by (rule Inter_lower) (use * 1 2 in simp)
             then show False
               using K2 V12 \<open>K2 \<noteq> {}\<close> \<open>K2 \<subseteq> V2\<close> closedin_imp_subset by blast
           qed
           ultimately show False
             using \<open>connected C\<close> [unfolded connected_closed, simplified, rule_format, of concl: "D \<inter> U1" "D \<inter> U2"]
             using \<open>C \<subseteq> D\<close> D1 D2 V12 DV12 \<open>closed U1\<close> \<open>closed U2\<close> \<open>closed D\<close>
             by blast
         qed
       qed
       show False
         by (metis (full_types) DiffE UnE Un_upper2 SV12_ne \<open>K1 \<subseteq> V1\<close> \<open>K2 \<subseteq> V2\<close> disjoint_iff_not_equal subsetCE sup_ge1 K12_Un)
     qed
     then show "connected (\<Inter>?\<T>)"
       by (auto simp: connected_closedin_eq)
     show "\<Inter>?\<T> \<subseteq> S"
       by (fastforce simp: C in_components_subset)
   qed
   with x show "\<Inter>?\<T> \<subseteq> C" by simp
 qed auto
 
 
 corollary Sura_Bura_clopen_subset:
   fixes S :: "'a::euclidean_space set"
   assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
       and U: "open U" "C \<subseteq> U"
   obtains K where "openin (top_of_set S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
 proof (rule ccontr)
   assume "\<not> thesis"
   with that have neg: "\<nexists>K. openin (top_of_set S) K \<and> compact K \<and> C \<subseteq> K \<and> K \<subseteq> U"
     by metis
   obtain V K where "C \<subseteq> V" "V \<subseteq> U" "V \<subseteq> K" "K \<subseteq> S" "compact K"
                and opeSV: "openin (top_of_set S) V"
     using S U \<open>compact C\<close> by (meson C in_components_subset locally_compact_compact_subopen)
   let ?\<T> = "{T. C \<subseteq> T \<and> openin (top_of_set K) T \<and> compact T \<and> T \<subseteq> K}"
   have CK: "C \<in> components K"
     by (meson C \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> components_intermediate_subset subset_trans)
   with \<open>compact K\<close>
   have "C = \<Inter>{T. C \<subseteq> T \<and> openin (top_of_set K) T \<and> closedin (top_of_set K) T}"
     by (simp add: Sura_Bura_compact)
   then have Ceq: "C = \<Inter>?\<T>"
     by (simp add: closedin_compact_eq \<open>compact K\<close>)
   obtain W where "open W" and W: "V = S \<inter> W"
     using opeSV by (auto simp: openin_open)
   have "-(U \<inter> W) \<inter> \<Inter>?\<T> \<noteq> {}"
   proof (rule closed_imp_fip_compact)
     show "- (U \<inter> W) \<inter> \<Inter>\<F> \<noteq> {}"
       if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
     proof (cases "\<F> = {}")
       case True
       have False if "U = UNIV" "W = UNIV"
       proof -
         have "V = S"
           by (simp add: W \<open>W = UNIV\<close>)
         with neg show False
           using \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> \<open>V \<subseteq> U\<close> \<open>compact K\<close> by auto
       qed
       with True show ?thesis
         by auto
     next
       case False
       show ?thesis
       proof
         assume "- (U \<inter> W) \<inter> \<Inter>\<F> = {}"
         then have FUW: "\<Inter>\<F> \<subseteq> U \<inter> W"
           by blast
         have "C \<subseteq> \<Inter>\<F>"
           using \<F> by auto
         moreover have "compact (\<Inter>\<F>)"
           by (metis (no_types, lifting) compact_Inter False mem_Collect_eq subsetCE \<F>)
         moreover have "\<Inter>\<F> \<subseteq> K"
           using False that(2) by fastforce
         moreover have opeKF: "openin (top_of_set K) (\<Inter>\<F>)"
           using False \<F> \<open>finite \<F>\<close> by blast
         then have opeVF: "openin (top_of_set V) (\<Inter>\<F>)"
           using W \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> opeKF \<open>\<Inter>\<F> \<subseteq> K\<close> FUW openin_subset_trans by fastforce
         then have "openin (top_of_set S) (\<Inter>\<F>)"
           by (metis opeSV openin_trans)
         moreover have "\<Inter>\<F> \<subseteq> U"
           by (meson \<open>V \<subseteq> U\<close> opeVF dual_order.trans openin_imp_subset)
         ultimately show False
           using neg by blast
       qed
     qed
   qed (use \<open>open W\<close> \<open>open U\<close> in auto)
   with W Ceq \<open>C \<subseteq> V\<close> \<open>C \<subseteq> U\<close> show False
     by auto
 qed
 
 
 corollary Sura_Bura_clopen_subset_alt:
   fixes S :: "'a::euclidean_space set"
   assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
       and opeSU: "openin (top_of_set S) U" and "C \<subseteq> U"
   obtains K where "openin (top_of_set S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
 proof -
   obtain V where "open V" "U = S \<inter> V"
     using opeSU by (auto simp: openin_open)
   with \<open>C \<subseteq> U\<close> have "C \<subseteq> V"
     by auto
   then show ?thesis
     using Sura_Bura_clopen_subset [OF S C \<open>compact C\<close> \<open>open V\<close>]
     by (metis \<open>U = S \<inter> V\<close> inf.bounded_iff openin_imp_subset that)
 qed
 
 corollary Sura_Bura:
   fixes S :: "'a::euclidean_space set"
   assumes "locally compact S" "C \<in> components S" "compact C"
   shows "C = \<Inter> {K. C \<subseteq> K \<and> compact K \<and> openin (top_of_set S) K}"
          (is "C = ?rhs")
 proof
   show "?rhs \<subseteq> C"
   proof (clarsimp, rule ccontr)
     fix x
     assume *: "\<forall>X. C \<subseteq> X \<and> compact X \<and> openin (top_of_set S) X \<longrightarrow> x \<in> X"
       and "x \<notin> C"
     obtain U V where "open U" "open V" "{x} \<subseteq> U" "C \<subseteq> V" "U \<inter> V = {}"
       using separation_normal [of "{x}" C]
       by (metis Int_empty_left \<open>x \<notin> C\<close> \<open>compact C\<close> closed_empty closed_insert compact_imp_closed insert_disjoint(1))
     have "x \<notin> V"
       using \<open>U \<inter> V = {}\<close> \<open>{x} \<subseteq> U\<close> by blast
     then show False
       by (meson "*" Sura_Bura_clopen_subset \<open>C \<subseteq> V\<close> \<open>open V\<close> assms(1) assms(2) assms(3) subsetCE)
   qed
 qed blast
 
 
 subsection\<open>Special cases of local connectedness and path connectedness\<close>
 
 lemma locally_connected_1:
   assumes
     "\<And>V x. \<lbrakk>openin (top_of_set S) V; x \<in> V\<rbrakk> \<Longrightarrow> \<exists>U. openin (top_of_set S) U \<and> connected U \<and> x \<in> U \<and> U \<subseteq> V"
    shows "locally connected S"
   by (metis assms locally_def)
 
 lemma locally_connected_2:
   assumes "locally connected S"
           "openin (top_of_set S) t"
           "x \<in> t"
    shows "openin (top_of_set S) (connected_component_set t x)"
 proof -
   { fix y :: 'a
     let ?SS = "top_of_set S"
     assume 1: "openin ?SS t"
               "\<forall>w x. openin ?SS w \<and> x \<in> w \<longrightarrow> (\<exists>u. openin ?SS u \<and> (\<exists>v. connected v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w))"
     and "connected_component t x y"
     then have "y \<in> t" and y: "y \<in> connected_component_set t x"
       using connected_component_subset by blast+
     obtain F where
       "\<forall>x y. (\<exists>w. openin ?SS w \<and> (\<exists>u. connected u \<and> x \<in> w \<and> w \<subseteq> u \<and> u \<subseteq> y)) = (openin ?SS (F x y) \<and> (\<exists>u. connected u \<and> x \<in> F x y \<and> F x y \<subseteq> u \<and> u \<subseteq> y))"
       by moura
     then obtain G where
        "\<forall>a A. (\<exists>U. openin ?SS U \<and> (\<exists>V. connected V \<and> a \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> A)) = (openin ?SS (F a A) \<and> connected (G a A) \<and> a \<in> F a A \<and> F a A \<subseteq> G a A \<and> G a A \<subseteq> A)"
       by moura
     then have *: "openin ?SS (F y t) \<and> connected (G y t) \<and> y \<in> F y t \<and> F y t \<subseteq> G y t \<and> G y t \<subseteq> t"
       using 1 \<open>y \<in> t\<close> by presburger
     have "G y t \<subseteq> connected_component_set t y"
       by (metis (no_types) * connected_component_eq_self connected_component_mono contra_subsetD)
     then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> connected_component_set t x"
       by (metis (no_types) * connected_component_eq dual_order.trans y)
   }
   then show ?thesis
     using assms openin_subopen by (force simp: locally_def)
 qed
 
 lemma locally_connected_3:
   assumes "\<And>t x. \<lbrakk>openin (top_of_set S) t; x \<in> t\<rbrakk>
               \<Longrightarrow> openin (top_of_set S)
                           (connected_component_set t x)"
           "openin (top_of_set S) v" "x \<in> v"
    shows  "\<exists>u. openin (top_of_set S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v"
 using assms connected_component_subset by fastforce
 
 lemma locally_connected:
   "locally connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
           \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v))"
 by (metis locally_connected_1 locally_connected_2 locally_connected_3)
 
 lemma locally_connected_open_connected_component:
   "locally connected S \<longleftrightarrow>
    (\<forall>t x. openin (top_of_set S) t \<and> x \<in> t
           \<longrightarrow> openin (top_of_set S) (connected_component_set t x))"
 by (metis locally_connected_1 locally_connected_2 locally_connected_3)
 
 lemma locally_path_connected_1:
   assumes
     "\<And>v x. \<lbrakk>openin (top_of_set S) v; x \<in> v\<rbrakk>
               \<Longrightarrow> \<exists>u. openin (top_of_set S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
    shows "locally path_connected S"
   by (force simp add: locally_def dest: assms)
 
 lemma locally_path_connected_2:
   assumes "locally path_connected S"
           "openin (top_of_set S) t"
           "x \<in> t"
    shows "openin (top_of_set S) (path_component_set t x)"
 proof -
   { fix y :: 'a
     let ?SS = "top_of_set S"
     assume 1: "openin ?SS t"
               "\<forall>w x. openin ?SS w \<and> x \<in> w \<longrightarrow> (\<exists>u. openin ?SS u \<and> (\<exists>v. path_connected v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w))"
     and "path_component t x y"
     then have "y \<in> t" and y: "y \<in> path_component_set t x"
       using path_component_mem(2) by blast+
     obtain F where
       "\<forall>x y. (\<exists>w. openin ?SS w \<and> (\<exists>u. path_connected u \<and> x \<in> w \<and> w \<subseteq> u \<and> u \<subseteq> y)) = (openin ?SS (F x y) \<and> (\<exists>u. path_connected u \<and> x \<in> F x y \<and> F x y \<subseteq> u \<and> u \<subseteq> y))"
       by moura
     then obtain G where
        "\<forall>a A. (\<exists>U. openin ?SS U \<and> (\<exists>V. path_connected V \<and> a \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> A)) = (openin ?SS (F a A) \<and> path_connected (G a A) \<and> a \<in> F a A \<and> F a A \<subseteq> G a A \<and> G a A \<subseteq> A)"
       by moura
     then have *: "openin ?SS (F y t) \<and> path_connected (G y t) \<and> y \<in> F y t \<and> F y t \<subseteq> G y t \<and> G y t \<subseteq> t"
       using 1 \<open>y \<in> t\<close> by presburger
     have "G y t \<subseteq> path_component_set t y"
       using * path_component_maximal rev_subsetD by blast
     then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> path_component_set t x"
       by (metis "*" \<open>G y t \<subseteq> path_component_set t y\<close> dual_order.trans path_component_eq y)
   }
   then show ?thesis
     using assms openin_subopen by (force simp: locally_def)
 qed
 
 lemma locally_path_connected_3:
   assumes "\<And>t x. \<lbrakk>openin (top_of_set S) t; x \<in> t\<rbrakk>
               \<Longrightarrow> openin (top_of_set S) (path_component_set t x)"
           "openin (top_of_set S) v" "x \<in> v"
    shows  "\<exists>u. openin (top_of_set S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
 proof -
   have "path_component v x x"
     by (meson assms(3) path_component_refl)
   then show ?thesis
     by (metis assms mem_Collect_eq path_component_subset path_connected_path_component)
 qed
 
 proposition locally_path_connected:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>V x. openin (top_of_set S) V \<and> x \<in> V
           \<longrightarrow> (\<exists>U. openin (top_of_set S) U \<and> path_connected U \<and> x \<in> U \<and> U \<subseteq> V))"
   by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
 
 proposition locally_path_connected_open_path_component:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>t x. openin (top_of_set S) t \<and> x \<in> t
           \<longrightarrow> openin (top_of_set S) (path_component_set t x))"
   by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
 
 lemma locally_connected_open_component:
   "locally connected S \<longleftrightarrow>
    (\<forall>t c. openin (top_of_set S) t \<and> c \<in> components t
           \<longrightarrow> openin (top_of_set S) c)"
 by (metis components_iff locally_connected_open_connected_component)
 
 proposition locally_connected_im_kleinen:
   "locally connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
        \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and>
                 x \<in> u \<and> u \<subseteq> v \<and>
                 (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> v \<and> x \<in> c \<and> y \<in> c))))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (fastforce simp add: locally_connected)
 next
   assume ?rhs
   have *: "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> c"
        if "openin (top_of_set S) t" and c: "c \<in> components t" and "x \<in> c" for t c x
   proof -
     from that \<open>?rhs\<close> [rule_format, of t x]
     obtain u where u:
       "openin (top_of_set S) u \<and> x \<in> u \<and> u \<subseteq> t \<and>
        (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> t \<and> x \<in> c \<and> y \<in> c))"
       using in_components_subset by auto
     obtain F :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
       "\<forall>x y. (\<exists>z. z \<in> x \<and> y = connected_component_set x z) = (F x y \<in> x \<and> y = connected_component_set x (F x y))"
       by moura
     then have F: "F t c \<in> t \<and> c = connected_component_set t (F t c)"
       by (meson components_iff c)
     obtain G :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
         G: "\<forall>x y. (\<exists>z. z \<in> y \<and> z \<notin> x) = (G x y \<in> y \<and> G x y \<notin> x)"
       by moura
      have "G c u \<notin> u \<or> G c u \<in> c"
       using F by (metis (full_types) u connected_componentI connected_component_eq mem_Collect_eq that(3))
     then show ?thesis
       using G u by auto
   qed
   show ?lhs
     unfolding locally_connected_open_component by (meson "*" openin_subopen)
 qed
 
 proposition locally_path_connected_im_kleinen:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
        \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and>
                 x \<in> u \<and> u \<subseteq> v \<and>
                 (\<forall>y. y \<in> u \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> v \<and>
                                 pathstart p = x \<and> pathfinish p = y))))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply (simp add: locally_path_connected path_connected_def)
     apply (erule all_forward ex_forward imp_forward conjE | simp)+
     by (meson dual_order.trans)
 next
   assume ?rhs
   have *: "\<exists>T. openin (top_of_set S) T \<and>
                x \<in> T \<and> T \<subseteq> path_component_set u z"
        if "openin (top_of_set S) u" and "z \<in> u" and c: "path_component u z x" for u z x
   proof -
     have "x \<in> u"
       by (meson c path_component_mem(2))
     with that \<open>?rhs\<close> [rule_format, of u x]
     obtain U where U:
       "openin (top_of_set S) U \<and> x \<in> U \<and> U \<subseteq> u \<and>
        (\<forall>y. y \<in> U \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> u \<and> pathstart p = x \<and> pathfinish p = y))"
        by blast
     show ?thesis
       by (metis U c mem_Collect_eq path_component_def path_component_eq subsetI)
   qed
   show ?lhs
     unfolding locally_path_connected_open_path_component
     using "*" openin_subopen by fastforce
 qed
 
 lemma locally_path_connected_imp_locally_connected:
   "locally path_connected S \<Longrightarrow> locally connected S"
 using locally_mono path_connected_imp_connected by blast
 
 lemma locally_connected_components:
   "\<lbrakk>locally connected S; c \<in> components S\<rbrakk> \<Longrightarrow> locally connected c"
 by (meson locally_connected_open_component locally_open_subset openin_subtopology_self)
 
 lemma locally_path_connected_components:
   "\<lbrakk>locally path_connected S; c \<in> components S\<rbrakk> \<Longrightarrow> locally path_connected c"
 by (meson locally_connected_open_component locally_open_subset locally_path_connected_imp_locally_connected openin_subtopology_self)
 
 lemma locally_path_connected_connected_component:
   "locally path_connected S \<Longrightarrow> locally path_connected (connected_component_set S x)"
 by (metis components_iff connected_component_eq_empty locally_empty locally_path_connected_components)
 
 lemma open_imp_locally_path_connected:
   fixes S :: "'a :: real_normed_vector set"
   assumes "open S"
   shows "locally path_connected S"
 proof (rule locally_mono)
   show "locally convex S"
     using assms unfolding locally_def
     by (meson open_ball centre_in_ball convex_ball openE open_subset openin_imp_subset openin_open_trans subset_trans)
   show "\<And>T::'a set. convex T \<Longrightarrow> path_connected T"
     using convex_imp_path_connected by blast
 qed
 
 lemma open_imp_locally_connected:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> locally connected S"
 by (simp add: locally_path_connected_imp_locally_connected open_imp_locally_path_connected)
 
 lemma locally_path_connected_UNIV: "locally path_connected (UNIV::'a :: real_normed_vector set)"
   by (simp add: open_imp_locally_path_connected)
 
 lemma locally_connected_UNIV: "locally connected (UNIV::'a :: real_normed_vector set)"
   by (simp add: open_imp_locally_connected)
 
 lemma openin_connected_component_locally_connected:
     "locally connected S
      \<Longrightarrow> openin (top_of_set S) (connected_component_set S x)"
   by (metis connected_component_eq_empty locally_connected_2 openin_empty openin_subtopology_self)
 
 lemma openin_components_locally_connected:
     "\<lbrakk>locally connected S; c \<in> components S\<rbrakk> \<Longrightarrow> openin (top_of_set S) c"
   using locally_connected_open_component openin_subtopology_self by blast
 
 lemma openin_path_component_locally_path_connected:
   "locally path_connected S
         \<Longrightarrow> openin (top_of_set S) (path_component_set S x)"
 by (metis (no_types) empty_iff locally_path_connected_2 openin_subopen openin_subtopology_self path_component_eq_empty)
 
 lemma closedin_path_component_locally_path_connected:
   assumes "locally path_connected S"
   shows "closedin (top_of_set S) (path_component_set S x)"
 proof -
   have "openin (top_of_set S) (\<Union> ({path_component_set S y |y. y \<in> S} - {path_component_set S x}))"
     using locally_path_connected_2 assms by fastforce
   then show ?thesis
     by  (simp add: closedin_def path_component_subset complement_path_component_Union)
 qed
 
 lemma convex_imp_locally_path_connected:
   fixes S :: "'a:: real_normed_vector set"
   assumes "convex S"
   shows "locally path_connected S"
 proof (clarsimp simp: locally_path_connected)
   fix V x
   assume "openin (top_of_set S) V" and "x \<in> V"
   then obtain T e where  "V = S \<inter> T" "x \<in> S" "0 < e" "ball x e \<subseteq> T"
     by (metis Int_iff openE openin_open)
   then have "openin (top_of_set S) (S \<inter> ball x e)" "path_connected (S \<inter> ball x e)"
     by (simp_all add: assms convex_Int convex_imp_path_connected openin_open_Int)
   then show "\<exists>U. openin (top_of_set S) U \<and> path_connected U \<and> x \<in> U \<and> U \<subseteq> V"
     using \<open>0 < e\<close> \<open>V = S \<inter> T\<close> \<open>ball x e \<subseteq> T\<close> \<open>x \<in> S\<close> by auto
 qed
 
 lemma convex_imp_locally_connected:
   fixes S :: "'a:: real_normed_vector set"
   shows "convex S \<Longrightarrow> locally connected S"
   by (simp add: locally_path_connected_imp_locally_connected convex_imp_locally_path_connected)
 
 
 subsection\<open>Relations between components and path components\<close>
 
 lemma path_component_eq_connected_component:
   assumes "locally path_connected S"
     shows "(path_component S x = connected_component S x)"
 proof (cases "x \<in> S")
   case True
   have "openin (top_of_set (connected_component_set S x)) (path_component_set S x)"
   proof (rule openin_subset_trans)
     show "openin (top_of_set S) (path_component_set S x)"
       by (simp add: True assms locally_path_connected_2)
     show "connected_component_set S x \<subseteq> S"
       by (simp add: connected_component_subset)
   qed (simp add: path_component_subset_connected_component)
   moreover have "closedin (top_of_set (connected_component_set S x)) (path_component_set S x)"
     proof (rule closedin_subset_trans [of S])
   show "closedin (top_of_set S) (path_component_set S x)"
     by (simp add: assms closedin_path_component_locally_path_connected)
   show "connected_component_set S x \<subseteq> S"
     by (simp add: connected_component_subset)
   qed (simp add: path_component_subset_connected_component)
   ultimately have *: "path_component_set S x = connected_component_set S x"
     by (metis connected_connected_component connected_clopen True path_component_eq_empty)
   then show ?thesis
     by blast
 next
   case False then show ?thesis
     by (metis Collect_empty_eq_bot connected_component_eq_empty path_component_eq_empty)
 qed
 
 lemma path_component_eq_connected_component_set:
      "locally path_connected S \<Longrightarrow> (path_component_set S x = connected_component_set S x)"
 by (simp add: path_component_eq_connected_component)
 
 lemma locally_path_connected_path_component:
      "locally path_connected S \<Longrightarrow> locally path_connected (path_component_set S x)"
 using locally_path_connected_connected_component path_component_eq_connected_component by fastforce
 
 lemma open_path_connected_component:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> path_component S x = connected_component S x"
 by (simp add: path_component_eq_connected_component open_imp_locally_path_connected)
 
 lemma open_path_connected_component_set:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> path_component_set S x = connected_component_set S x"
 by (simp add: open_path_connected_component)
 
 proposition locally_connected_quotient_image:
   assumes lcS: "locally connected S"
       and oo: "\<And>T. T \<subseteq> f ` S
                 \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow>
                     openin (top_of_set (f ` S)) T"
     shows "locally connected (f ` S)"
 proof (clarsimp simp: locally_connected_open_component)
   fix U C
   assume opefSU: "openin (top_of_set (f ` S)) U" and "C \<in> components U"
   then have "C \<subseteq> U" "U \<subseteq> f ` S"
     by (meson in_components_subset openin_imp_subset)+
   then have "openin (top_of_set (f ` S)) C \<longleftrightarrow>
              openin (top_of_set S) (S \<inter> f -` C)"
     by (auto simp: oo)
   moreover have "openin (top_of_set S) (S \<inter> f -` C)"
   proof (subst openin_subopen, clarify)
     fix x
     assume "x \<in> S" "f x \<in> C"
     show "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> (S \<inter> f -` C)"
     proof (intro conjI exI)
       show "openin (top_of_set S) (connected_component_set (S \<inter> f -` U) x)"
       proof (rule ccontr)
         assume **: "\<not> openin (top_of_set S) (connected_component_set (S \<inter> f -` U) x)"
         then have "x \<notin> (S \<inter> f -` U)"
           using \<open>U \<subseteq> f ` S\<close> opefSU lcS locally_connected_2 oo by blast
         with ** show False
           by (metis (no_types) connected_component_eq_empty empty_iff openin_subopen)
       qed
     next
       show "x \<in> connected_component_set (S \<inter> f -` U) x"
         using \<open>C \<subseteq> U\<close> \<open>f x \<in> C\<close> \<open>x \<in> S\<close> by auto
     next
       have contf: "continuous_on S f"
         by (simp add: continuous_on_open oo openin_imp_subset)
       then have "continuous_on (connected_component_set (S \<inter> f -` U) x) f"
         by (meson connected_component_subset continuous_on_subset inf.boundedE)
       then have "connected (f ` connected_component_set (S \<inter> f -` U) x)"
         by (rule connected_continuous_image [OF _ connected_connected_component])
       moreover have "f ` connected_component_set (S \<inter> f -` U) x \<subseteq> U"
         using connected_component_in by blast
       moreover have "C \<inter> f ` connected_component_set (S \<inter> f -` U) x \<noteq> {}"
         using \<open>C \<subseteq> U\<close> \<open>f x \<in> C\<close> \<open>x \<in> S\<close> by fastforce
       ultimately have fC: "f ` (connected_component_set (S \<inter> f -` U) x) \<subseteq> C"
         by (rule components_maximal [OF \<open>C \<in> components U\<close>])
       have cUC: "connected_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` C)"
         using connected_component_subset fC by blast
       have "connected_component_set (S \<inter> f -` U) x \<subseteq> connected_component_set (S \<inter> f -` C) x"
       proof -
         { assume "x \<in> connected_component_set (S \<inter> f -` U) x"
           then have ?thesis
             using cUC connected_component_idemp connected_component_mono by blast }
         then show ?thesis
           using connected_component_eq_empty by auto
       qed
       also have "\<dots> \<subseteq> (S \<inter> f -` C)"
         by (rule connected_component_subset)
       finally show "connected_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` C)" .
     qed
   qed
   ultimately show "openin (top_of_set (f ` S)) C"
     by metis
 qed
 
 text\<open>The proof resembles that above but is not identical!\<close>
 proposition locally_path_connected_quotient_image:
   assumes lcS: "locally path_connected S"
       and oo: "\<And>T. T \<subseteq> f ` S
                 \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow> openin (top_of_set (f ` S)) T"
     shows "locally path_connected (f ` S)"
 proof (clarsimp simp: locally_path_connected_open_path_component)
   fix U y
   assume opefSU: "openin (top_of_set (f ` S)) U" and "y \<in> U"
   then have "path_component_set U y \<subseteq> U" "U \<subseteq> f ` S"
     by (meson path_component_subset openin_imp_subset)+
   then have "openin (top_of_set (f ` S)) (path_component_set U y) \<longleftrightarrow>
              openin (top_of_set S) (S \<inter> f -` path_component_set U y)"
   proof -
     have "path_component_set U y \<subseteq> f ` S"
       using \<open>U \<subseteq> f ` S\<close> \<open>path_component_set U y \<subseteq> U\<close> by blast
     then show ?thesis
       using oo by blast
   qed
   moreover have "openin (top_of_set S) (S \<inter> f -` path_component_set U y)"
   proof (subst openin_subopen, clarify)
     fix x
     assume "x \<in> S" and Uyfx: "path_component U y (f x)"
     then have "f x \<in> U"
       using path_component_mem by blast
     show "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> (S \<inter> f -` path_component_set U y)"
     proof (intro conjI exI)
       show "openin (top_of_set S) (path_component_set (S \<inter> f -` U) x)"
       proof (rule ccontr)
         assume **: "\<not> openin (top_of_set S) (path_component_set (S \<inter> f -` U) x)"
         then have "x \<notin> (S \<inter> f -` U)"
           by (metis (no_types, lifting) \<open>U \<subseteq> f ` S\<close> opefSU lcS oo locally_path_connected_open_path_component)
         then show False
           using ** \<open>path_component_set U y \<subseteq> U\<close>  \<open>x \<in> S\<close> \<open>path_component U y (f x)\<close> by blast
       qed
     next
       show "x \<in> path_component_set (S \<inter> f -` U) x"
         by (simp add: \<open>f x \<in> U\<close> \<open>x \<in> S\<close> path_component_refl)
     next
       have contf: "continuous_on S f"
         by (simp add: continuous_on_open oo openin_imp_subset)
       then have "continuous_on (path_component_set (S \<inter> f -` U) x) f"
         by (meson Int_lower1 continuous_on_subset path_component_subset)
       then have "path_connected (f ` path_component_set (S \<inter> f -` U) x)"
         by (simp add: path_connected_continuous_image)
       moreover have "f ` path_component_set (S \<inter> f -` U) x \<subseteq> U"
         using path_component_mem by fastforce
       moreover have "f x \<in> f ` path_component_set (S \<inter> f -` U) x"
         by (force simp: \<open>x \<in> S\<close> \<open>f x \<in> U\<close> path_component_refl_eq)
       ultimately have "f ` (path_component_set (S \<inter> f -` U) x) \<subseteq> path_component_set U (f x)"
         by (meson path_component_maximal)
        also have  "\<dots> \<subseteq> path_component_set U y"
         by (simp add: Uyfx path_component_maximal path_component_subset path_component_sym)
       finally have fC: "f ` (path_component_set (S \<inter> f -` U) x) \<subseteq> path_component_set U y" .
       have cUC: "path_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` path_component_set U y)"
         using path_component_subset fC by blast
       have "path_component_set (S \<inter> f -` U) x \<subseteq> path_component_set (S \<inter> f -` path_component_set U y) x"
       proof -
         have "\<And>a. path_component_set (path_component_set (S \<inter> f -` U) x) a \<subseteq> path_component_set (S \<inter> f -` path_component_set U y) a"
           using cUC path_component_mono by blast
         then show ?thesis
           using path_component_path_component by blast
       qed
       also have "\<dots> \<subseteq> (S \<inter> f -` path_component_set U y)"
         by (rule path_component_subset)
       finally show "path_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` path_component_set U y)" .
     qed
   qed
   ultimately show "openin (top_of_set (f ` S)) (path_component_set U y)"
     by metis
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Components, continuity, openin, closedin\<close>
 
 lemma continuous_on_components_gen:
  fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   assumes "\<And>C. C \<in> components S \<Longrightarrow>
               openin (top_of_set S) C \<and> continuous_on C f"
     shows "continuous_on S f"
 proof (clarsimp simp: continuous_openin_preimage_eq)
   fix t :: "'b set"
   assume "open t"
   have *: "S \<inter> f -` t = (\<Union>c \<in> components S. c \<inter> f -` t)"
     by auto
   show "openin (top_of_set S) (S \<inter> f -` t)"
     unfolding * using \<open>open t\<close> assms continuous_openin_preimage_gen openin_trans openin_Union by blast
 qed
 
 lemma continuous_on_components:
  fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   assumes "locally connected S " "\<And>C. C \<in> components S \<Longrightarrow> continuous_on C f"
   shows "continuous_on S f"
 proof (rule continuous_on_components_gen)
   fix C
   assume "C \<in> components S"
   then show "openin (top_of_set S) C \<and> continuous_on C f"
     by (simp add: assms openin_components_locally_connected)
 qed
 
 lemma continuous_on_components_eq:
     "locally connected S
      \<Longrightarrow> (continuous_on S f \<longleftrightarrow> (\<forall>c \<in> components S. continuous_on c f))"
 by (meson continuous_on_components continuous_on_subset in_components_subset)
 
 lemma continuous_on_components_open:
  fixes S :: "'a::real_normed_vector set"
   assumes "open S "
           "\<And>c. c \<in> components S \<Longrightarrow> continuous_on c f"
     shows "continuous_on S f"
 using continuous_on_components open_imp_locally_connected assms by blast
 
 lemma continuous_on_components_open_eq:
   fixes S :: "'a::real_normed_vector set"
   shows "open S \<Longrightarrow> (continuous_on S f \<longleftrightarrow> (\<forall>c \<in> components S. continuous_on c f))"
 using continuous_on_subset in_components_subset
 by (blast intro: continuous_on_components_open)
 
 lemma closedin_union_complement_components:
   assumes U: "locally connected U"
       and S: "closedin (top_of_set U) S"
       and cuS: "c \<subseteq> components(U - S)"
     shows "closedin (top_of_set U) (S \<union> \<Union>c)"
 proof -
   have di: "(\<And>S T. S \<in> c \<and> T \<in> c' \<Longrightarrow> disjnt S T) \<Longrightarrow> disjnt (\<Union> c) (\<Union> c')" for c'
     by (simp add: disjnt_def) blast
   have "S \<subseteq> U"
     using S closedin_imp_subset by blast
   moreover have "U - S = \<Union>c \<union> \<Union>(components (U - S) - c)"
     by (metis Diff_partition Union_components Union_Un_distrib assms(3))
   moreover have "disjnt (\<Union>c) (\<Union>(components (U - S) - c))"
     apply (rule di)
     by (metis di DiffD1 DiffD2 assms(3) components_nonoverlap disjnt_def subsetCE)
   ultimately have eq: "S \<union> \<Union>c = U - (\<Union>(components(U - S) - c))"
     by (auto simp: disjnt_def)
   have *: "openin (top_of_set U) (\<Union>(components (U - S) - c))"
   proof (rule openin_Union [OF openin_trans [of "U - S"]])
     show "openin (top_of_set (U - S)) T" if "T \<in> components (U - S) - c" for T
       using that by (simp add: U S locally_diff_closed openin_components_locally_connected)
     show "openin (top_of_set U) (U - S)" if "T \<in> components (U - S) - c" for T
       using that by (simp add: openin_diff S)
   qed
   have "closedin (top_of_set U) (U - \<Union> (components (U - S) - c))"
     by (metis closedin_diff closedin_topspace topspace_euclidean_subtopology *)
   then have "openin (top_of_set U) (U - (U - \<Union>(components (U - S) - c)))"
     by (simp add: openin_diff)
   then show ?thesis
     by (force simp: eq closedin_def)
 qed
 
 lemma closed_union_complement_components:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "closed S" and c: "c \<subseteq> components(- S)"
     shows "closed(S \<union> \<Union> c)"
 proof -
   have "closedin (top_of_set UNIV) (S \<union> \<Union>c)"
     by (metis Compl_eq_Diff_UNIV S c closed_closedin closedin_union_complement_components locally_connected_UNIV subtopology_UNIV)
   then show ?thesis by simp
 qed
 
 lemma closedin_Un_complement_component:
   fixes S :: "'a::real_normed_vector set"
   assumes u: "locally connected u"
       and S: "closedin (top_of_set u) S"
       and c: " c \<in> components(u - S)"
     shows "closedin (top_of_set u) (S \<union> c)"
 proof -
   have "closedin (top_of_set u) (S \<union> \<Union>{c})"
     using c by (blast intro: closedin_union_complement_components [OF u S])
   then show ?thesis
     by simp
 qed
 
 lemma closed_Un_complement_component:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "closed S" and c: " c \<in> components(-S)"
     shows "closed (S \<union> c)"
   by (metis Compl_eq_Diff_UNIV S c closed_closedin closedin_Un_complement_component
       locally_connected_UNIV subtopology_UNIV)
 
 
 subsection\<open>Existence of isometry between subspaces of same dimension\<close>
 
 lemma isometry_subset_subspace:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S \<le> dim T"
   obtains f where "linear f" "f ` S \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
 proof -
   obtain B where "B \<subseteq> S" and Borth: "pairwise orthogonal B"
              and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "finite B" "card B = dim S" "span B = S"
     by (metis orthonormal_basis_subspace [OF S] independent_finite)
   obtain C where "C \<subseteq> T" and Corth: "pairwise orthogonal C"
              and C1:"\<And>x. x \<in> C \<Longrightarrow> norm x = 1"
              and "independent C" "finite C" "card C = dim T" "span C = T"
     by (metis orthonormal_basis_subspace [OF T] independent_finite)
   obtain fb where "fb ` B \<subseteq> C" "inj_on fb B"
     by (metis \<open>card B = dim S\<close> \<open>card C = dim T\<close> \<open>finite B\<close> \<open>finite C\<close> card_le_inj d)
   then have pairwise_orth_fb: "pairwise (\<lambda>v j. orthogonal (fb v) (fb j)) B"
     using Corth unfolding pairwise_def inj_on_def
     by (blast intro: orthogonal_clauses)
   obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
     using linear_independent_extend \<open>independent B\<close> by fastforce
   have "span (f ` B) \<subseteq> span C"
     by (metis \<open>fb ` B \<subseteq> C\<close> ffb image_cong span_mono)
   then have "f ` S \<subseteq> T"
     unfolding \<open>span B = S\<close> \<open>span C = T\<close> span_linear_image[OF \<open>linear f\<close>] .
   have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
     using B1 C1 \<open>fb ` B \<subseteq> C\<close> by auto
   have "norm (f x) = norm x" if "x \<in> S" for x
   proof -
     interpret linear f by fact
     obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
       using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
     have "norm (f x)^2 = norm (\<Sum>v\<in>B. a v *\<^sub>R fb v)^2" by (simp add: sum scale ffb x)
     also have "\<dots> = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
     proof (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
       show "pairwise (\<lambda>v j. orthogonal (a v *\<^sub>R fb v) (a j *\<^sub>R fb j)) B"
         by (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
     qed
     also have "\<dots> = norm x ^2"
       by (simp add: x pairwise_ortho_scaleR Borth norm_sum_Pythagorean [OF \<open>finite B\<close>])
     finally show ?thesis
       by (simp add: norm_eq_sqrt_inner)
   qed
   then show ?thesis
     by (rule that [OF \<open>linear f\<close> \<open>f ` S \<subseteq> T\<close>])
 qed
 
 proposition isometries_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
   obtains f g where "linear f" "linear g" "f ` S = T" "g ` T = S"
                     "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
                     "\<And>x. x \<in> T \<Longrightarrow> norm(g x) = norm x"
                     "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
                     "\<And>x. x \<in> T \<Longrightarrow> f(g x) = x"
 proof -
   obtain B where "B \<subseteq> S" and Borth: "pairwise orthogonal B"
              and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "finite B" "card B = dim S" "span B = S"
     by (metis orthonormal_basis_subspace [OF S] independent_finite)
   obtain C where "C \<subseteq> T" and Corth: "pairwise orthogonal C"
              and C1:"\<And>x. x \<in> C \<Longrightarrow> norm x = 1"
              and "independent C" "finite C" "card C = dim T" "span C = T"
     by (metis orthonormal_basis_subspace [OF T] independent_finite)
   obtain fb where "bij_betw fb B C"
     by (metis \<open>finite B\<close> \<open>finite C\<close> bij_betw_iff_card \<open>card B = dim S\<close> \<open>card C = dim T\<close> d)
   then have pairwise_orth_fb: "pairwise (\<lambda>v j. orthogonal (fb v) (fb j)) B"
     using Corth unfolding pairwise_def inj_on_def bij_betw_def
     by (blast intro: orthogonal_clauses)
   obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
     using linear_independent_extend \<open>independent B\<close> by fastforce
   interpret f: linear f by fact
   define gb where "gb \<equiv> inv_into B fb"
   then have pairwise_orth_gb: "pairwise (\<lambda>v j. orthogonal (gb v) (gb j)) C"
     using Borth \<open>bij_betw fb B C\<close> unfolding pairwise_def bij_betw_def by force
   obtain g where "linear g" and ggb: "\<And>x. x \<in> C \<Longrightarrow> g x = gb x"
     using linear_independent_extend \<open>independent C\<close> by fastforce
   interpret g: linear g by fact
   have "span (f ` B) \<subseteq> span C"
     by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on eq_iff ffb image_cong)
   then have "f ` S \<subseteq> T"
     unfolding \<open>span B = S\<close> \<open>span C = T\<close> span_linear_image[OF \<open>linear f\<close>] .
   have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
     using B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on by fastforce
   have f [simp]: "norm (f x) = norm x" "g (f x) = x" if "x \<in> S" for x
   proof -
     obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
       using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
     have "f x = (\<Sum>v \<in> B. f (a v *\<^sub>R v))"
       using linear_sum [OF \<open>linear f\<close>] x by auto
     also have "\<dots> = (\<Sum>v \<in> B. a v *\<^sub>R f v)"
       by (simp add: f.sum f.scale)
     also have "\<dots> = (\<Sum>v \<in> B. a v *\<^sub>R fb v)"
       by (simp add: ffb cong: sum.cong)
     finally have *: "f x = (\<Sum>v\<in>B. a v *\<^sub>R fb v)" .
     then have "(norm (f x))\<^sup>2 = (norm (\<Sum>v\<in>B. a v *\<^sub>R fb v))\<^sup>2" by simp
     also have "\<dots> = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
     proof (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
       show "pairwise (\<lambda>v j. orthogonal (a v *\<^sub>R fb v) (a j *\<^sub>R fb j)) B"
         by (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
     qed
     also have "\<dots> = (norm x)\<^sup>2"
       by (simp add: x pairwise_ortho_scaleR Borth norm_sum_Pythagorean [OF \<open>finite B\<close>])
     finally show "norm (f x) = norm x"
       by (simp add: norm_eq_sqrt_inner)
     have "g (f x) = g (\<Sum>v\<in>B. a v *\<^sub>R fb v)" by (simp add: *)
     also have "\<dots> = (\<Sum>v\<in>B. g (a v *\<^sub>R fb v))"
       by (simp add: g.sum g.scale)
     also have "\<dots> = (\<Sum>v\<in>B. a v *\<^sub>R g (fb v))"
       by (simp add: g.scale)
     also have "\<dots> = (\<Sum>v\<in>B. a v *\<^sub>R v)"
     proof (rule sum.cong [OF refl])
       show "a x *\<^sub>R g (fb x) = a x *\<^sub>R x" if "x \<in> B" for x
         using that \<open>bij_betw fb B C\<close> bij_betwE bij_betw_inv_into_left gb_def ggb by fastforce
     qed
     also have "\<dots> = x"
       using x by blast
     finally show "g (f x) = x" .
   qed
   have [simp]: "\<And>x. x \<in> C \<Longrightarrow> norm (gb x) = norm x"
     by (metis B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on gb_def inv_into_into)
   have g [simp]: "f (g x) = x" if "x \<in> T" for x
   proof -
     obtain a where x: "x = (\<Sum>v \<in> C. a v *\<^sub>R v)"
       using \<open>finite C\<close> \<open>span C = T\<close> \<open>x \<in> T\<close> span_finite by fastforce
     have "g x = (\<Sum>v \<in> C. g (a v *\<^sub>R v))"
       by (simp add: x g.sum)
     also have "\<dots> = (\<Sum>v \<in> C. a v *\<^sub>R g v)"
       by (simp add: g.scale)
     also have "\<dots> = (\<Sum>v \<in> C. a v *\<^sub>R gb v)"
       by (simp add: ggb cong: sum.cong)
     finally have "f (g x) = f (\<Sum>v\<in>C. a v *\<^sub>R gb v)" by simp
     also have "\<dots> = (\<Sum>v\<in>C. f (a v *\<^sub>R gb v))"
       by (simp add: f.scale f.sum)
     also have "\<dots> = (\<Sum>v\<in>C. a v *\<^sub>R f (gb v))"
       by (simp add: f.scale f.sum)
     also have "\<dots> = (\<Sum>v\<in>C. a v *\<^sub>R v)"
       using \<open>bij_betw fb B C\<close>
       by (simp add: bij_betw_def gb_def bij_betw_inv_into_right ffb inv_into_into)
     also have "\<dots> = x"
       using x by blast
     finally show "f (g x) = x" .
   qed
   have gim: "g ` T = S"
     by (metis (full_types) S T \<open>f ` S \<subseteq> T\<close> d dim_eq_span dim_image_le f(2) g.linear_axioms
         image_iff linear_subspace_image span_eq_iff subset_iff)
   have fim: "f ` S = T"
     using \<open>g ` T = S\<close> image_iff by fastforce
   have [simp]: "norm (g x) = norm x" if "x \<in> T" for x
     using fim that by auto
   show ?thesis
     by (rule that [OF \<open>linear f\<close> \<open>linear g\<close>]) (simp_all add: fim gim)
 qed
 
 corollary isometry_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
   obtains f where "linear f" "f ` S = T" "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
 using isometries_subspaces [OF assms]
 by metis
 
 corollary isomorphisms_UNIV_UNIV:
   assumes "DIM('M) = DIM('N)"
   obtains f::"'M::euclidean_space \<Rightarrow>'N::euclidean_space" and g
   where "linear f" "linear g"
                     "\<And>x. norm(f x) = norm x" "\<And>y. norm(g y) = norm y"
                     "\<And>x. g (f x) = x" "\<And>y. f(g y) = y"
   using assms by (auto intro: isometries_subspaces [of "UNIV::'M set" "UNIV::'N set"])
 
 lemma homeomorphic_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
     shows "S homeomorphic T"
 proof -
   obtain f g where "linear f" "linear g" "f ` S = T" "g ` T = S"
                    "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "\<And>x. x \<in> T \<Longrightarrow> f(g x) = x"
     by (blast intro: isometries_subspaces [OF assms])
   then show ?thesis
     unfolding homeomorphic_def homeomorphism_def
     apply (rule_tac x=f in exI, rule_tac x=g in exI)
     apply (auto simp: linear_continuous_on linear_conv_bounded_linear)
     done
 qed
 
 lemma homeomorphic_affine_sets:
   assumes "affine S" "affine T" "aff_dim S = aff_dim T"
     shows "S homeomorphic T"
 proof (cases "S = {} \<or> T = {}")
   case True  with assms aff_dim_empty homeomorphic_empty show ?thesis
     by metis
 next
   case False
   then obtain a b where ab: "a \<in> S" "b \<in> T" by auto
   then have ss: "subspace ((+) (- a) ` S)" "subspace ((+) (- b) ` T)"
     using affine_diffs_subspace assms by blast+
   have dd: "dim ((+) (- a) ` S) = dim ((+) (- b) ` T)"
     using assms ab  by (simp add: aff_dim_eq_dim  [OF hull_inc] image_def)
   have "S homeomorphic ((+) (- a) ` S)"
     by (fact homeomorphic_translation)
   also have "\<dots> homeomorphic ((+) (- b) ` T)"
     by (rule homeomorphic_subspaces [OF ss dd])
   also have "\<dots> homeomorphic T"
     using homeomorphic_translation [of T "- b"] by (simp add: homeomorphic_sym [of T])
   finally show ?thesis .
 qed
 
 
 subsection\<open>Retracts, in a general sense, preserve (co)homotopic triviality)\<close>
 
 locale\<^marker>\<open>tag important\<close> Retracts =
   fixes S h t k
   assumes conth: "continuous_on S h"
       and imh: "h ` S = t"
       and contk: "continuous_on t k"
       and imk: "k ` t \<subseteq> S"
       and idhk: "\<And>y. y \<in> t \<Longrightarrow> h(k y) = y"
 
 begin
 
 lemma homotopically_trivial_retraction_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> t; Q f\<rbrakk> \<Longrightarrow> P(k \<circ> f)"
       and Q: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S; P f\<rbrakk> \<Longrightarrow> Q(h \<circ> f)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> U \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on U f; f ` U \<subseteq> S; P f;
                        continuous_on U g; g ` U \<subseteq> S; P g\<rbrakk>
                        \<Longrightarrow> homotopic_with_canon P U S f g"
       and contf: "continuous_on U f" and imf: "f ` U \<subseteq> t" and Qf: "Q f"
       and contg: "continuous_on U g" and img: "g ` U \<subseteq> t" and Qg: "Q g"
     shows "homotopic_with_canon Q U t f g"
 proof -
   have "continuous_on U (k \<circ> f)"
     using contf continuous_on_compose continuous_on_subset contk imf by blast
   moreover have "(k \<circ> f) ` U \<subseteq> S"
     using imf imk by fastforce
   moreover have "P (k \<circ> f)"
     by (simp add: P Qf contf imf)
   moreover have "continuous_on U (k \<circ> g)"
     using contg continuous_on_compose continuous_on_subset contk img by blast
   moreover have "(k \<circ> g) ` U \<subseteq> S"
     using img imk by fastforce
   moreover have "P (k \<circ> g)"
     by (simp add: P Qg contg img)
   ultimately have "homotopic_with_canon P U S (k \<circ> f) (k \<circ> g)"
     by (rule hom)
   then have "homotopic_with_canon Q U t (h \<circ> (k \<circ> f)) (h \<circ> (k \<circ> g))"
     apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono])
     using Q by (auto simp: conth imh)
   then show ?thesis
   proof (rule homotopic_with_eq; simp)
     show "\<And>h k. (\<And>x. x \<in> U \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       using Qeq topspace_euclidean_subtopology by blast
     show "\<And>x. x \<in> U \<Longrightarrow> f x = h (k (f x))" "\<And>x. x \<in> U \<Longrightarrow> g x = h (k (g x))"
       using idhk imf img by auto
   qed 
 qed
 
 lemma homotopically_trivial_retraction_null_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> t; Q f\<rbrakk> \<Longrightarrow> P(k \<circ> f)"
       and Q: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S; P f\<rbrakk> \<Longrightarrow> Q(h \<circ> f)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> U \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S; P f\<rbrakk>
                      \<Longrightarrow> \<exists>c. homotopic_with_canon P U S f (\<lambda>x. c)"
       and contf: "continuous_on U f" and imf:"f ` U \<subseteq> t" and Qf: "Q f"
   obtains c where "homotopic_with_canon Q U t f (\<lambda>x. c)"
 proof -
   have feq: "\<And>x. x \<in> U \<Longrightarrow> (h \<circ> (k \<circ> f)) x = f x" using idhk imf by auto
   have "continuous_on U (k \<circ> f)"
     using contf continuous_on_compose continuous_on_subset contk imf by blast
   moreover have "(k \<circ> f) ` U \<subseteq> S"
     using imf imk by fastforce
   moreover have "P (k \<circ> f)"
     by (simp add: P Qf contf imf)
   ultimately obtain c where "homotopic_with_canon P U S (k \<circ> f) (\<lambda>x. c)"
     by (metis hom)
   then have "homotopic_with_canon Q U t (h \<circ> (k \<circ> f)) (h \<circ> (\<lambda>x. c))"
     apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono])
     using Q by (auto simp: conth imh)
   then have "homotopic_with_canon Q U t f (\<lambda>x. h c)"
   proof (rule homotopic_with_eq)
     show "\<And>x. x \<in> topspace (top_of_set U) \<Longrightarrow> f x = (h \<circ> (k \<circ> f)) x"
       using feq by auto
     show "\<And>h k. (\<And>x. x \<in> topspace (top_of_set U) \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       using Qeq topspace_euclidean_subtopology by blast
   qed auto
   then show ?thesis
     using that by blast
 qed
 
 lemma cohomotopically_trivial_retraction_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on t f; f ` t \<subseteq> U; Q f\<rbrakk> \<Longrightarrow> P(f \<circ> h)"
       and Q: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> U; P f\<rbrakk> \<Longrightarrow> Q(f \<circ> k)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> t \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on S f; f ` S \<subseteq> U; P f;
                        continuous_on S g; g ` S \<subseteq> U; P g\<rbrakk>
                        \<Longrightarrow> homotopic_with_canon P S U f g"
       and contf: "continuous_on t f" and imf: "f ` t \<subseteq> U" and Qf: "Q f"
       and contg: "continuous_on t g" and img: "g ` t \<subseteq> U" and Qg: "Q g"
     shows "homotopic_with_canon Q t U f g"
 proof -
   have feq: "\<And>x. x \<in> t \<Longrightarrow> (f \<circ> h \<circ> k) x = f x" using idhk imf by auto
   have geq: "\<And>x. x \<in> t \<Longrightarrow> (g \<circ> h \<circ> k) x = g x" using idhk img by auto
   have "continuous_on S (f \<circ> h)"
     using contf conth continuous_on_compose imh by blast
   moreover have "(f \<circ> h) ` S \<subseteq> U"
     using imf imh by fastforce
   moreover have "P (f \<circ> h)"
     by (simp add: P Qf contf imf)
   moreover have "continuous_on S (g \<circ> h)"
     using contg continuous_on_compose continuous_on_subset conth imh by blast
   moreover have "(g \<circ> h) ` S \<subseteq> U"
     using img imh by fastforce
   moreover have "P (g \<circ> h)"
     by (simp add: P Qg contg img)
   ultimately have "homotopic_with_canon P S U (f \<circ> h) (g \<circ> h)"
     by (rule hom)
   then have "homotopic_with_canon Q t U (f \<circ> h \<circ> k) (g \<circ> h \<circ> k)"
     apply (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono])
     using Q by (auto simp: contk imk)
   then show ?thesis
   proof (rule homotopic_with_eq)
     show "f x = (f \<circ> h \<circ> k) x" "g x = (g \<circ> h \<circ> k) x" 
       if "x \<in> topspace (top_of_set t)" for x
       using feq geq that by force+
   qed (use Qeq topspace_euclidean_subtopology in blast)
 qed
 
 lemma cohomotopically_trivial_retraction_null_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on t f; f ` t \<subseteq> U; Q f\<rbrakk> \<Longrightarrow> P(f \<circ> h)"
       and Q: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> U; P f\<rbrakk> \<Longrightarrow> Q(f \<circ> k)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> t \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on S f; f ` S \<subseteq> U; P f\<rbrakk>
                        \<Longrightarrow> \<exists>c. homotopic_with_canon P S U f (\<lambda>x. c)"
       and contf: "continuous_on t f" and imf: "f ` t \<subseteq> U" and Qf: "Q f"
   obtains c where "homotopic_with_canon Q t U f (\<lambda>x. c)"
 proof -
   have feq: "\<And>x. x \<in> t \<Longrightarrow> (f \<circ> h \<circ> k) x = f x" using idhk imf by auto
   have "continuous_on S (f \<circ> h)"
     using contf conth continuous_on_compose imh by blast
   moreover have "(f \<circ> h) ` S \<subseteq> U"
     using imf imh by fastforce
   moreover have "P (f \<circ> h)"
     by (simp add: P Qf contf imf)
   ultimately obtain c where "homotopic_with_canon P S U (f \<circ> h) (\<lambda>x. c)"
     by (metis hom)
   then have \<section>: "homotopic_with_canon Q t U (f \<circ> h \<circ> k) ((\<lambda>x. c) \<circ> k)"
   proof (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono])
     show "\<And>h. \<lbrakk>continuous_map (top_of_set S) (top_of_set U) h; P h\<rbrakk> \<Longrightarrow> Q (h \<circ> k)"
       using Q by auto
   qed (auto simp: contk imk)
   moreover have "homotopic_with_canon Q t U f (\<lambda>x. c)"
     using homotopic_with_eq [OF \<section>] feq Qeq by fastforce
   ultimately show ?thesis 
     using that by blast
 qed
 
 end
 
 lemma simply_connected_retraction_gen:
   shows "\<lbrakk>simply_connected S; continuous_on S h; h ` S = T;
           continuous_on T k; k ` T \<subseteq> S; \<And>y. y \<in> T \<Longrightarrow> h(k y) = y\<rbrakk>
         \<Longrightarrow> simply_connected T"
 apply (simp add: simply_connected_def path_def path_image_def homotopic_loops_def, clarify)
 apply (rule Retracts.homotopically_trivial_retraction_gen
         [of S h _ k _ "\<lambda>p. pathfinish p = pathstart p"  "\<lambda>p. pathfinish p = pathstart p"])
 apply (simp_all add: Retracts_def pathfinish_def pathstart_def)
 done
 
 lemma homeomorphic_simply_connected:
     "\<lbrakk>S homeomorphic T; simply_connected S\<rbrakk> \<Longrightarrow> simply_connected T"
   by (auto simp: homeomorphic_def homeomorphism_def intro: simply_connected_retraction_gen)
 
 lemma homeomorphic_simply_connected_eq:
     "S homeomorphic T \<Longrightarrow> (simply_connected S \<longleftrightarrow> simply_connected T)"
   by (metis homeomorphic_simply_connected homeomorphic_sym)
 
 
 subsection\<open>Homotopy equivalence\<close>
 
 subsection\<open>Homotopy equivalence of topological spaces.\<close>
 
 definition\<^marker>\<open>tag important\<close> homotopy_equivalent_space
              (infix "homotopy'_equivalent'_space" 50)
   where "X homotopy_equivalent_space Y \<equiv>
         (\<exists>f g. continuous_map X Y f \<and>
               continuous_map Y X g \<and>
               homotopic_with (\<lambda>x. True) X X (g \<circ> f) id \<and>
               homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) id)"
 
 lemma homeomorphic_imp_homotopy_equivalent_space:
   "X homeomorphic_space Y \<Longrightarrow> X homotopy_equivalent_space Y"
   unfolding homeomorphic_space_def homotopy_equivalent_space_def
   apply (erule ex_forward)+
   by (simp add: homotopic_with_equal homotopic_with_sym homeomorphic_maps_def)
 
 lemma homotopy_equivalent_space_refl:
    "X homotopy_equivalent_space X"
   by (simp add: homeomorphic_imp_homotopy_equivalent_space homeomorphic_space_refl)
 
 lemma homotopy_equivalent_space_sym:
    "X homotopy_equivalent_space Y \<longleftrightarrow> Y homotopy_equivalent_space X"
   by (meson homotopy_equivalent_space_def)
 
 lemma homotopy_eqv_trans [trans]:
   assumes 1: "X homotopy_equivalent_space Y" and 2: "Y homotopy_equivalent_space U"
     shows "X homotopy_equivalent_space U"
 proof -
   obtain f1 g1 where f1: "continuous_map X Y f1"
                  and g1: "continuous_map Y X g1"
                  and hom1: "homotopic_with (\<lambda>x. True) X X (g1 \<circ> f1) id"
                            "homotopic_with (\<lambda>x. True) Y Y (f1 \<circ> g1) id"
     using 1 by (auto simp: homotopy_equivalent_space_def)
   obtain f2 g2 where f2: "continuous_map Y U f2"
                  and g2: "continuous_map U Y g2"
                  and hom2: "homotopic_with (\<lambda>x. True) Y Y (g2 \<circ> f2) id"
                            "homotopic_with (\<lambda>x. True) U U (f2 \<circ> g2) id"
     using 2 by (auto simp: homotopy_equivalent_space_def)
   have "homotopic_with (\<lambda>f. True) X Y (g2 \<circ> f2 \<circ> f1) (id \<circ> f1)"
     using f1 hom2(1) homotopic_with_compose_continuous_map_right by metis
   then have "homotopic_with (\<lambda>f. True) X Y (g2 \<circ> (f2 \<circ> f1)) (id \<circ> f1)"
     by (simp add: o_assoc)
   then have "homotopic_with (\<lambda>x. True) X X
          (g1 \<circ> (g2 \<circ> (f2 \<circ> f1))) (g1 \<circ> (id \<circ> f1))"
     by (simp add: g1 homotopic_with_compose_continuous_map_left)
   moreover have "homotopic_with (\<lambda>x. True) X X (g1 \<circ> id \<circ> f1) id"
     using hom1 by simp
   ultimately have SS: "homotopic_with (\<lambda>x. True) X X (g1 \<circ> g2 \<circ> (f2 \<circ> f1)) id"
     by (metis comp_assoc homotopic_with_trans id_comp)
   have "homotopic_with (\<lambda>f. True) U Y (f1 \<circ> g1 \<circ> g2) (id \<circ> g2)"
     using g2 hom1(2) homotopic_with_compose_continuous_map_right by fastforce
   then have "homotopic_with (\<lambda>f. True) U Y (f1 \<circ> (g1 \<circ> g2)) (id \<circ> g2)"
     by (simp add: o_assoc)
   then have "homotopic_with (\<lambda>x. True) U U
          (f2 \<circ> (f1 \<circ> (g1 \<circ> g2))) (f2 \<circ> (id \<circ> g2))"
     by (simp add: f2 homotopic_with_compose_continuous_map_left)
   moreover have "homotopic_with (\<lambda>x. True) U U (f2 \<circ> id \<circ> g2) id"
     using hom2 by simp
   ultimately have UU: "homotopic_with (\<lambda>x. True) U U (f2 \<circ> f1 \<circ> (g1 \<circ> g2)) id"
     by (simp add: fun.map_comp hom2(2) homotopic_with_trans)
   show ?thesis
     unfolding homotopy_equivalent_space_def
     by (blast intro: f1 f2 g1 g2 continuous_map_compose SS UU)
 qed
 
 lemma deformation_retraction_imp_homotopy_equivalent_space:
   "\<lbrakk>homotopic_with (\<lambda>x. True) X X (S \<circ> r) id; retraction_maps X Y r S\<rbrakk>
     \<Longrightarrow> X homotopy_equivalent_space Y"
   unfolding homotopy_equivalent_space_def retraction_maps_def
   using homotopic_with_id2 by fastforce
 
 lemma deformation_retract_imp_homotopy_equivalent_space:
    "\<lbrakk>homotopic_with (\<lambda>x. True) X X r id; retraction_maps X Y r id\<rbrakk>
     \<Longrightarrow> X homotopy_equivalent_space Y"
   using deformation_retraction_imp_homotopy_equivalent_space by force
 
 lemma deformation_retract_of_space:
   "S \<subseteq> topspace X \<and>
    (\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id) \<longleftrightarrow>
    S retract_of_space X \<and> (\<exists>f. homotopic_with (\<lambda>x. True) X X id f \<and> f ` (topspace X) \<subseteq> S)"
 proof (cases "S \<subseteq> topspace X")
   case True
   moreover have "(\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id)
              \<longleftrightarrow> (S retract_of_space X \<and> (\<exists>f. homotopic_with (\<lambda>x. True) X X id f \<and> f ` topspace X \<subseteq> S))"
     unfolding retract_of_space_def
   proof safe
     fix f r
     assume f: "homotopic_with (\<lambda>x. True) X X id f"
       and fS: "f ` topspace X \<subseteq> S"
       and r: "continuous_map X (subtopology X S) r"
       and req: "\<forall>x\<in>S. r x = x"
     show "\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id"
     proof (intro exI conjI)
       have "homotopic_with (\<lambda>x. True) X X f r"
         proof (rule homotopic_with_eq)
           show "homotopic_with (\<lambda>x. True) X X (r \<circ> f) (r \<circ> id)"
             by (metis continuous_map_into_fulltopology f homotopic_with_compose_continuous_map_left homotopic_with_symD r)
           show "f x = (r \<circ> f) x" if "x \<in> topspace X" for x
             using that fS req by auto
         qed auto
       then show "homotopic_with (\<lambda>x. True) X X id r"
         by (rule homotopic_with_trans [OF f])
     next
       show "retraction_maps X (subtopology X S) r id"
         by (simp add: r req retraction_maps_def)
     qed
   qed (use True in \<open>auto simp: retraction_maps_def topspace_subtopology_subset continuous_map_in_subtopology\<close>)
   ultimately show ?thesis by simp
 qed (auto simp: retract_of_space_def retraction_maps_def)
 
 
 
 subsection\<open>Contractible spaces\<close>
 
 text\<open>The definition (which agrees with "contractible" on subsets of Euclidean space)
 is a little cryptic because we don't in fact assume that the constant "a" is in the space.
 This forces the convention that the empty space / set is contractible, avoiding some special cases. \<close>
 
 definition contractible_space where
   "contractible_space X \<equiv> \<exists>a. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
 
 lemma contractible_space_top_of_set [simp]:"contractible_space (top_of_set S) \<longleftrightarrow> contractible S"
   by (auto simp: contractible_space_def contractible_def)
 
 lemma contractible_space_empty:
    "topspace X = {} \<Longrightarrow> contractible_space X"
   unfolding contractible_space_def homotopic_with_def
   apply (rule_tac x=undefined in exI)
   apply (rule_tac x="\<lambda>(t,x). if t = 0 then x else undefined" in exI)
   apply (auto simp: continuous_map_on_empty)
   done
 
 lemma contractible_space_singleton:
   "topspace X = {a} \<Longrightarrow> contractible_space X"
   unfolding contractible_space_def homotopic_with_def
   apply (rule_tac x=a in exI)
   apply (rule_tac x="\<lambda>(t,x). if t = 0 then x else a" in exI)
   apply (auto intro: continuous_map_eq [where f = "\<lambda>z. a"])
   done
 
 lemma contractible_space_subset_singleton:
    "topspace X \<subseteq> {a} \<Longrightarrow> contractible_space X"
   by (meson contractible_space_empty contractible_space_singleton subset_singletonD)
 
 lemma contractible_space_subtopology_singleton:
    "contractible_space(subtopology X {a})"
   by (meson contractible_space_subset_singleton insert_subset path_connectedin_singleton path_connectedin_subtopology subsetI)
 
 lemma contractible_space:
    "contractible_space X \<longleftrightarrow>
         topspace X = {} \<or>
         (\<exists>a \<in> topspace X. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a))"
 proof (cases "topspace X = {}")
   case False
   then show ?thesis
     using homotopic_with_imp_continuous_maps  by (fastforce simp: contractible_space_def)
 qed (simp add: contractible_space_empty)
 
 lemma contractible_imp_path_connected_space:
   assumes "contractible_space X" shows "path_connected_space X"
 proof (cases "topspace X = {}")
   case False
   have *: "path_connected_space X"
     if "a \<in> topspace X" and conth: "continuous_map (prod_topology (top_of_set {0..1}) X) X h"
       and h: "\<forall>x. h (0, x) = x" "\<forall>x. h (1, x) = a"
     for a and h :: "real \<times> 'a \<Rightarrow> 'a"
   proof -
     have "path_component_of X b a" if "b \<in> topspace X" for b
       unfolding path_component_of_def
     proof (intro exI conjI)
       let ?g = "h \<circ> (\<lambda>x. (x,b))"
       show "pathin X ?g"
         unfolding pathin_def
       proof (rule continuous_map_compose [OF _ conth])
         show "continuous_map (top_of_set {0..1}) (prod_topology (top_of_set {0..1}) X) (\<lambda>x. (x, b))"
           using that by (auto intro!: continuous_intros)
       qed
     qed (use h in auto)
   then show ?thesis
     by (metis path_component_of_equiv path_connected_space_iff_path_component)
   qed
   show ?thesis
     using assms False by (auto simp: contractible_space homotopic_with_def *)
 qed (simp add: path_connected_space_topspace_empty)
 
 lemma contractible_imp_connected_space:
    "contractible_space X \<Longrightarrow> connected_space X"
   by (simp add: contractible_imp_path_connected_space path_connected_imp_connected_space)
 
 lemma contractible_space_alt:
    "contractible_space X \<longleftrightarrow> (\<forall>a \<in> topspace X. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a))" (is "?lhs = ?rhs")
 proof
   assume X: ?lhs
   then obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
     by (auto simp: contractible_space_def)
   show ?rhs
   proof
     show "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. b)" if "b \<in> topspace X" for b
     proof (rule homotopic_with_trans [OF a])
       show "homotopic_with (\<lambda>x. True) X X (\<lambda>x. a) (\<lambda>x. b)"
         using homotopic_constant_maps path_connected_space_imp_path_component_of
         by (metis (full_types) X a continuous_map_const contractible_imp_path_connected_space homotopic_with_imp_continuous_maps that)
     qed
   qed
 next
   assume R: ?rhs
   then show ?lhs
     unfolding contractible_space_def by (metis equals0I homotopic_on_emptyI)
 qed
 
 
 lemma compose_const [simp]: "f \<circ> (\<lambda>x. a) = (\<lambda>x. f a)" "(\<lambda>x. a) \<circ> g = (\<lambda>x. a)"
   by (simp_all add: o_def)
 
 lemma nullhomotopic_through_contractible_space:
   assumes f: "continuous_map X Y f" and g: "continuous_map Y Z g" and Y: "contractible_space Y"
   obtains c where "homotopic_with (\<lambda>h. True) X Z (g \<circ> f) (\<lambda>x. c)"
 proof -
   obtain b where b: "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. b)"
     using Y by (auto simp: contractible_space_def)
   show thesis
     using homotopic_with_compose_continuous_map_right
            [OF homotopic_with_compose_continuous_map_left [OF b g] f]
     by (force simp add: that)
 qed
 
 lemma nullhomotopic_into_contractible_space:
   assumes f: "continuous_map X Y f" and Y: "contractible_space Y"
   obtains c where "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
   using nullhomotopic_through_contractible_space [OF f _ Y]
   by (metis continuous_map_id id_comp)
 
 lemma nullhomotopic_from_contractible_space:
   assumes f: "continuous_map X Y f" and X: "contractible_space X"
   obtains c where "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
   using nullhomotopic_through_contractible_space [OF _ f X]
   by (metis comp_id continuous_map_id)
 
 lemma homotopy_dominated_contractibility:
   assumes f: "continuous_map X Y f" and g: "continuous_map Y X g"
     and hom: "homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) id" and X: "contractible_space X"
   shows "contractible_space Y"
 proof -
   obtain c where c: "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
     using nullhomotopic_from_contractible_space [OF f X] .
   have "homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) (\<lambda>x. c)"
     using homotopic_with_compose_continuous_map_right [OF c g] by fastforce
   then have "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. c)"
     using homotopic_with_trans [OF _ hom] homotopic_with_symD by blast
   then show ?thesis
     unfolding contractible_space_def ..
 qed
 
 lemma homotopy_equivalent_space_contractibility:
    "X homotopy_equivalent_space Y \<Longrightarrow> (contractible_space X \<longleftrightarrow> contractible_space Y)"
   unfolding homotopy_equivalent_space_def
   by (blast intro: homotopy_dominated_contractibility)
 
 lemma homeomorphic_space_contractibility:
    "X homeomorphic_space Y
         \<Longrightarrow> (contractible_space X \<longleftrightarrow> contractible_space Y)"
   by (simp add: homeomorphic_imp_homotopy_equivalent_space homotopy_equivalent_space_contractibility)
 
+lemma homotopic_through_contractible_space:
+   "continuous_map X Y f \<and>
+        continuous_map X Y f' \<and>
+        continuous_map Y Z g \<and>
+        continuous_map Y Z g' \<and>
+        contractible_space Y \<and> path_connected_space Z
+        \<Longrightarrow> homotopic_with (\<lambda>h. True) X Z (g \<circ> f) (g' \<circ> f')"
+  using nullhomotopic_through_contractible_space [of X Y f Z g]
+  using nullhomotopic_through_contractible_space [of X Y f' Z g']
+  by (metis continuous_map_const homotopic_constant_maps homotopic_with_imp_continuous_maps 
+      homotopic_with_trans path_connected_space_iff_path_component homotopic_with_sym)
+
+lemma homotopic_from_contractible_space:
+   "continuous_map X Y f \<and> continuous_map X Y g \<and>
+        contractible_space X \<and> path_connected_space Y
+        \<Longrightarrow> homotopic_with (\<lambda>x. True) X Y f g"
+  by (metis comp_id continuous_map_id homotopic_through_contractible_space)
+
+lemma homotopic_into_contractible_space:
+   "continuous_map X Y f \<and> continuous_map X Y g \<and>
+        contractible_space Y
+        \<Longrightarrow> homotopic_with (\<lambda>x. True) X Y f g"
+  by (metis continuous_map_id contractible_imp_path_connected_space homotopic_through_contractible_space id_comp)
+
 lemma contractible_eq_homotopy_equivalent_singleton_subtopology:
    "contractible_space X \<longleftrightarrow>
         topspace X = {} \<or> (\<exists>a \<in> topspace X. X homotopy_equivalent_space (subtopology X {a}))"(is "?lhs = ?rhs")
 proof (cases "topspace X = {}")
   case False
   show ?thesis
   proof
     assume ?lhs
     then obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
       by (auto simp: contractible_space_def)
     then have "a \<in> topspace X"
       by (metis False continuous_map_const homotopic_with_imp_continuous_maps)
     then have "homotopic_with (\<lambda>x. True) (subtopology X {a}) (subtopology X {a}) id (\<lambda>x. a)"
       using connectedin_absolute connectedin_sing contractible_space_alt contractible_space_subtopology_singleton by fastforce
     then have "X homotopy_equivalent_space subtopology X {a}"
       unfolding homotopy_equivalent_space_def using \<open>a \<in> topspace X\<close>
       by (metis (full_types) a comp_id continuous_map_const continuous_map_id_subt empty_subsetI homotopic_with_symD
            id_comp insertI1 insert_subset topspace_subtopology_subset)
     with \<open>a \<in> topspace X\<close> show ?rhs
       by blast
   next
     assume ?rhs
     then show ?lhs
       by (meson False contractible_space_subtopology_singleton homotopy_equivalent_space_contractibility)
   qed
 qed (simp add: contractible_space_empty)
 
 lemma contractible_space_retraction_map_image:
   assumes "retraction_map X Y f" and X: "contractible_space X"
   shows "contractible_space Y"
 proof -
   obtain g where f: "continuous_map X Y f" and g: "continuous_map Y X g" and fg: "\<forall>y \<in> topspace Y. f(g y) = y"
     using assms by (auto simp: retraction_map_def retraction_maps_def)
   obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
     using X by (auto simp: contractible_space_def)
   have "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. f a)"
   proof (rule homotopic_with_eq)
     show "homotopic_with (\<lambda>x. True) Y Y (f \<circ> id \<circ> g) (f \<circ> (\<lambda>x. a) \<circ> g)"
       using f g a homotopic_with_compose_continuous_map_left homotopic_with_compose_continuous_map_right by metis
   qed (use fg in auto)
   then show ?thesis
     unfolding contractible_space_def by blast
 qed
 
 lemma contractible_space_prod_topology:
    "contractible_space(prod_topology X Y) \<longleftrightarrow>
     topspace X = {} \<or> topspace Y = {} \<or> contractible_space X \<and> contractible_space Y"
 proof (cases "topspace X = {} \<or> topspace Y = {}")
   case True
   then have "topspace (prod_topology X Y) = {}"
     by simp
   then show ?thesis
     by (auto simp: contractible_space_empty)
 next
   case False
   have "contractible_space(prod_topology X Y) \<longleftrightarrow> contractible_space X \<and> contractible_space Y"
   proof safe
     assume XY: "contractible_space (prod_topology X Y)"
     with False have "retraction_map (prod_topology X Y) X fst"
       by (auto simp: contractible_space False retraction_map_fst)
     then show "contractible_space X"
       by (rule contractible_space_retraction_map_image [OF _ XY])
     have "retraction_map (prod_topology X Y) Y snd"
       using False XY  by (auto simp: contractible_space False retraction_map_snd)
     then show "contractible_space Y"
       by (rule contractible_space_retraction_map_image [OF _ XY])
   next
     assume "contractible_space X" and "contractible_space Y"
     with False obtain a b
       where "a \<in> topspace X" and a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
         and "b \<in> topspace Y" and b: "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. b)"
       by (auto simp: contractible_space)
     with False show "contractible_space (prod_topology X Y)"
       apply (simp add: contractible_space)
       apply (rule_tac x=a in bexI)
        apply (rule_tac x=b in bexI)
       using homotopic_with_prod_topology [OF a b]
         apply (metis (no_types, lifting) case_prod_Pair case_prod_beta' eq_id_iff)
        apply auto
       done
   qed
   with False show ?thesis
     by auto
 qed
 
 
 lemma contractible_space_product_topology:
   "contractible_space(product_topology X I) \<longleftrightarrow>
     topspace (product_topology X I) = {} \<or> (\<forall>i \<in> I. contractible_space(X i))"
 proof (cases "topspace (product_topology X I) = {}")
   case False
   have 1: "contractible_space (X i)"
     if XI: "contractible_space (product_topology X I)" and "i \<in> I"
     for i
   proof (rule contractible_space_retraction_map_image [OF _ XI])
     show "retraction_map (product_topology X I) (X i) (\<lambda>x. x i)"
       using False by (simp add: retraction_map_product_projection \<open>i \<in> I\<close>)
   qed
   have 2: "contractible_space (product_topology X I)"
     if "x \<in> topspace (product_topology X I)" and cs: "\<forall>i\<in>I. contractible_space (X i)"
     for x :: "'a \<Rightarrow> 'b"
   proof -
     obtain f where f: "\<And>i. i\<in>I \<Longrightarrow> homotopic_with (\<lambda>x. True) (X i) (X i) id (\<lambda>x. f i)"
       using cs unfolding contractible_space_def by metis
     have "homotopic_with (\<lambda>x. True)
                          (product_topology X I) (product_topology X I) id (\<lambda>x. restrict f I)"
       by (rule homotopic_with_eq [OF homotopic_with_product_topology [OF f]]) (auto)
     then show ?thesis
       by (auto simp: contractible_space_def)
   qed
   show ?thesis
     using False 1 2 by blast
 qed (simp add: contractible_space_empty)
 
 
 lemma contractible_space_subtopology_euclideanreal [simp]:
   "contractible_space(subtopology euclideanreal S) \<longleftrightarrow> is_interval S"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "path_connectedin (subtopology euclideanreal S) S"
     using contractible_imp_path_connected_space path_connectedin_topspace path_connectedin_absolute
     by (simp add: contractible_imp_path_connected) 
   then show ?rhs
     by (simp add: is_interval_path_connected_1)
 next
   assume ?rhs
   then have "convex S"
     by (simp add: is_interval_convex_1)
   show ?lhs
   proof (cases "S = {}")
     case False
     then obtain z where "z \<in> S"
       by blast
     show ?thesis
       unfolding contractible_space_def homotopic_with_def
     proof (intro exI conjI allI)
       note \<section> = convexD [OF \<open>convex S\<close>, simplified]
       show "continuous_map (prod_topology (top_of_set {0..1}) (top_of_set S)) (top_of_set S)
                            (\<lambda>(t,x). (1 - t) * x + t * z)"
         using  \<open>z \<in> S\<close> 
         by (auto simp: case_prod_unfold intro!: continuous_intros \<section>)
     qed auto
   qed (simp add: contractible_space_empty)
 qed
 
 
 corollary contractible_space_euclideanreal: "contractible_space euclideanreal"
 proof -
   have "contractible_space (subtopology euclideanreal UNIV)"
     using contractible_space_subtopology_euclideanreal by blast
   then show ?thesis
     by simp
 qed
 
 
 abbreviation\<^marker>\<open>tag important\<close> homotopy_eqv :: "'a::topological_space set \<Rightarrow> 'b::topological_space set \<Rightarrow> bool"
              (infix "homotopy'_eqv" 50)
   where "S homotopy_eqv T \<equiv> top_of_set S homotopy_equivalent_space top_of_set T"
 
 
 
 
 
 lemma homeomorphic_imp_homotopy_eqv: "S homeomorphic T \<Longrightarrow> S homotopy_eqv T"
   unfolding homeomorphic_def homeomorphism_def homotopy_equivalent_space_def
   by (metis continuous_map_subtopology_eu homotopic_with_id2 openin_imp_subset openin_subtopology_self topspace_euclidean_subtopology)
 
 
 lemma homotopy_eqv_inj_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "(f ` S) homotopy_eqv S"
   by (metis assms homeomorphic_sym homeomorphic_imp_homotopy_eqv linear_homeomorphic_image)
 
 lemma homotopy_eqv_translation:
     fixes S :: "'a::real_normed_vector set"
     shows "(+) a ` S homotopy_eqv S"
   using homeomorphic_imp_homotopy_eqv homeomorphic_translation homeomorphic_sym by blast
 
 lemma homotopy_eqv_homotopic_triviality_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on U f" "f ` U \<subseteq> T"
       and g: "continuous_on U g" "g ` U \<subseteq> T"
       and homUS: "\<And>f g. \<lbrakk>continuous_on U f; f ` U \<subseteq> S;
                          continuous_on U g; g ` U \<subseteq> S\<rbrakk>
                          \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) U S f g"
     shows "homotopic_with_canon (\<lambda>x. True) U T f g"
 proof -
   obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
                and k: "continuous_on T k" "k ` T \<subseteq> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (auto simp: homotopy_equivalent_space_def)
   have "homotopic_with_canon (\<lambda>f. True) U S (k \<circ> f) (k \<circ> g)"
   proof (rule homUS)
     show "continuous_on U (k \<circ> f)" "continuous_on U (k \<circ> g)"
       using continuous_on_compose continuous_on_subset f g k by blast+
   qed (use f g k in \<open>(force simp: o_def)+\<close> )
   then have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> (k \<circ> f)) (h \<circ> (k \<circ> g))"
     by (rule homotopic_with_compose_continuous_left; simp add: h)
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> k \<circ> f) (id \<circ> f)"
     by (rule homotopic_with_compose_continuous_right [where X=T and Y=T]; simp add: hom f)
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> k \<circ> g) (id \<circ> g)"
     by (rule homotopic_with_compose_continuous_right [where X=T and Y=T]; simp add: hom g)
   ultimately show "homotopic_with_canon (\<lambda>x. True) U T f g"
     unfolding o_assoc
     by (metis homotopic_with_trans homotopic_with_sym id_comp) 
 qed
 
 lemma homotopy_eqv_homotopic_triviality:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f g. continuous_on U f \<and> f ` U \<subseteq> S \<and>
                    continuous_on U g \<and> g ` U \<subseteq> S
                    \<longrightarrow> homotopic_with_canon (\<lambda>x. True) U S f g) \<longleftrightarrow>
            (\<forall>f g. continuous_on U f \<and> f ` U \<subseteq> T \<and>
                   continuous_on U g \<and> g ` U \<subseteq> T
                   \<longrightarrow> homotopic_with_canon (\<lambda>x. True) U T f g)"
       (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (metis assms homotopy_eqv_homotopic_triviality_imp)
 next
   assume ?rhs
   moreover
   have "T homotopy_eqv S"
     using assms homotopy_equivalent_space_sym by blast
   ultimately show ?lhs
     by (blast intro: homotopy_eqv_homotopic_triviality_imp)
 qed
 
 
 lemma homotopy_eqv_cohomotopic_triviality_null_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on T f" "f ` T \<subseteq> U"
       and homSU: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> U\<rbrakk>
                       \<Longrightarrow> \<exists>c. homotopic_with_canon (\<lambda>x. True) S U f (\<lambda>x. c)"
   obtains c where "homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. c)"
 proof -
   obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
                and k: "continuous_on T k" "k ` T \<subseteq> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (auto simp: homotopy_equivalent_space_def)
   obtain c where "homotopic_with_canon (\<lambda>x. True) S U (f \<circ> h) (\<lambda>x. c)"
   proof (rule exE [OF homSU])
     show "continuous_on S (f \<circ> h)"
       using continuous_on_compose continuous_on_subset f h by blast
   qed (use f h in force)
   then have "homotopic_with_canon (\<lambda>x. True) T U ((f \<circ> h) \<circ> k) ((\<lambda>x. c) \<circ> k)"
     by (rule homotopic_with_compose_continuous_right [where X=S]) (use k in auto)
   moreover have "homotopic_with_canon (\<lambda>x. True) T U (f \<circ> id) (f \<circ> (h \<circ> k))"
     by (rule homotopic_with_compose_continuous_left [where Y=T])
        (use f in \<open>auto simp: hom homotopic_with_symD\<close>)
   ultimately show ?thesis
     using that homotopic_with_trans by (fastforce simp add: o_def)
 qed
 
 lemma homotopy_eqv_cohomotopic_triviality_null:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f. continuous_on S f \<and> f ` S \<subseteq> U
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S U f (\<lambda>x. c))) \<longleftrightarrow>
            (\<forall>f. continuous_on T f \<and> f ` T \<subseteq> U
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. c)))"
 by (rule iffI; metis assms homotopy_eqv_cohomotopic_triviality_null_imp homotopy_equivalent_space_sym)
 
 text \<open>Similar to the proof above\<close>
 lemma homotopy_eqv_homotopic_triviality_null_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on U f" "f ` U \<subseteq> T"
       and homSU: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S\<rbrakk>
                       \<Longrightarrow> \<exists>c. homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. c)"
     shows "\<exists>c. homotopic_with_canon (\<lambda>x. True) U T f (\<lambda>x. c)"
 proof -
   obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
                and k: "continuous_on T k" "k ` T \<subseteq> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (auto simp: homotopy_equivalent_space_def)
   obtain c::'a where "homotopic_with_canon (\<lambda>x. True) U S (k \<circ> f) (\<lambda>x. c)"
   proof (rule exE [OF homSU [of "k \<circ> f"]])
     show "continuous_on U (k \<circ> f)"
       using continuous_on_compose continuous_on_subset f k by blast
   qed (use f k in force)
   then have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> (k \<circ> f)) (h \<circ> (\<lambda>x. c))"
     by (rule homotopic_with_compose_continuous_left [where Y=S]) (use h in auto)
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (id \<circ> f) ((h \<circ> k) \<circ> f)"
     by (rule homotopic_with_compose_continuous_right [where X=T])
        (use f in \<open>auto simp: hom homotopic_with_symD\<close>)
   ultimately show ?thesis
     using homotopic_with_trans by (fastforce simp add: o_def)
 qed
 
 lemma homotopy_eqv_homotopic_triviality_null:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f. continuous_on U f \<and> f ` U \<subseteq> S
                   \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. c))) \<longleftrightarrow>
            (\<forall>f. continuous_on U f \<and> f ` U \<subseteq> T
                   \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) U T f (\<lambda>x. c)))"
 by (rule iffI; metis assms homotopy_eqv_homotopic_triviality_null_imp homotopy_equivalent_space_sym)
 
 lemma homotopy_eqv_contractible_sets:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
   assumes "contractible S" "contractible T" "S = {} \<longleftrightarrow> T = {}"
     shows "S homotopy_eqv T"
 proof (cases "S = {}")
   case True with assms show ?thesis
     by (simp add: homeomorphic_imp_homotopy_eqv)
 next
   case False
   with assms obtain a b where "a \<in> S" "b \<in> T"
     by auto
   then show ?thesis
     unfolding homotopy_equivalent_space_def
     apply (rule_tac x="\<lambda>x. b" in exI, rule_tac x="\<lambda>x. a" in exI)
     apply (intro assms conjI continuous_on_id' homotopic_into_contractible; force)
     done
 qed
 
 lemma homotopy_eqv_empty1 [simp]:
   fixes S :: "'a::real_normed_vector set"
   shows "S homotopy_eqv ({}::'b::real_normed_vector set) \<longleftrightarrow> S = {}" (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis continuous_map_subtopology_eu empty_iff equalityI homotopy_equivalent_space_def image_subset_iff subsetI)
 qed (simp add: homotopy_eqv_contractible_sets)
 
 lemma homotopy_eqv_empty2 [simp]:
   fixes S :: "'a::real_normed_vector set"
   shows "({}::'b::real_normed_vector set) homotopy_eqv S \<longleftrightarrow> S = {}"
   using homotopy_equivalent_space_sym homotopy_eqv_empty1 by blast
 
 lemma homotopy_eqv_contractibility:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "S homotopy_eqv T \<Longrightarrow> (contractible S \<longleftrightarrow> contractible T)"
   by (meson contractible_space_top_of_set homotopy_equivalent_space_contractibility)
 
 lemma homotopy_eqv_sing:
   fixes S :: "'a::real_normed_vector set" and a :: "'b::real_normed_vector"
   shows "S homotopy_eqv {a} \<longleftrightarrow> S \<noteq> {} \<and> contractible S"
 proof (cases "S = {}")
   case False then show ?thesis
     by (metis contractible_sing empty_not_insert homotopy_eqv_contractibility homotopy_eqv_contractible_sets)
 qed simp
 
 lemma homeomorphic_contractible_eq:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "S homeomorphic T \<Longrightarrow> (contractible S \<longleftrightarrow> contractible T)"
 by (simp add: homeomorphic_imp_homotopy_eqv homotopy_eqv_contractibility)
 
 lemma homeomorphic_contractible:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "\<lbrakk>contractible S; S homeomorphic T\<rbrakk> \<Longrightarrow> contractible T"
   by (metis homeomorphic_contractible_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Misc other results\<close>
 
 lemma bounded_connected_Compl_real:
   fixes S :: "real set"
   assumes "bounded S" and conn: "connected(- S)"
     shows "S = {}"
 proof -
   obtain a b where "S \<subseteq> box a b"
     by (meson assms bounded_subset_box_symmetric)
   then have "a \<notin> S" "b \<notin> S"
     by auto
   then have "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> x \<in> - S"
     by (meson Compl_iff conn connected_iff_interval)
   then show ?thesis
     using \<open>S \<subseteq> box a b\<close> by auto
 qed
 
 corollary bounded_path_connected_Compl_real:
   fixes S :: "real set"
   assumes "bounded S" "path_connected(- S)" shows "S = {}"
   by (simp add: assms bounded_connected_Compl_real path_connected_imp_connected)
 
 lemma bounded_connected_Compl_1:
   fixes S :: "'a::{euclidean_space} set"
   assumes "bounded S" and conn: "connected(- S)" and 1: "DIM('a) = 1"
     shows "S = {}"
 proof -
   have "DIM('a) = DIM(real)"
     by (simp add: "1")
   then obtain f::"'a \<Rightarrow> real" and g
   where "linear f" "\<And>x. norm(f x) = norm x" and fg: "\<And>x. g(f x) = x" "\<And>y. f(g y) = y"
     by (rule isomorphisms_UNIV_UNIV) blast
   with \<open>bounded S\<close> have "bounded (f ` S)"
     using bounded_linear_image linear_linear by blast
   have "bij f" by (metis fg bijI')
   have "connected (f ` (-S))"
     using connected_linear_image assms \<open>linear f\<close> by blast
   moreover have "f ` (-S) = - (f ` S)"
     by (simp add: \<open>bij f\<close> bij_image_Compl_eq)
   finally have "connected (- (f ` S))"
     by simp
   then have "f ` S = {}"
     using \<open>bounded (f ` S)\<close> bounded_connected_Compl_real by blast
   then show ?thesis
     by blast
 qed
 
 lemma connected_card_eq_iff_nontrivial:
   fixes S :: "'a::metric_space set"
   shows "connected S \<Longrightarrow> uncountable S \<longleftrightarrow> \<not>(\<exists>a. S \<subseteq> {a})"
   by (metis connected_uncountable finite.emptyI finite.insertI rev_finite_subset singleton_iff subsetI uncountable_infinite)
 
 lemma connected_finite_iff_sing:
   fixes S :: "'a::metric_space set"
   assumes "connected S"
   shows "finite S \<longleftrightarrow> S = {} \<or> (\<exists>a. S = {a})" 
   using assms connected_uncountable countable_finite by blast
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open> Some simple positive connection theorems\<close>
 
 proposition path_connected_convex_diff_countable:
   fixes U :: "'a::euclidean_space set"
   assumes "convex U" "\<not> collinear U" "countable S"
     shows "path_connected(U - S)"
 proof (clarsimp simp: path_connected_def)
   fix a b
   assume "a \<in> U" "a \<notin> S" "b \<in> U" "b \<notin> S"
   let ?m = "midpoint a b"
   show "\<exists>g. path g \<and> path_image g \<subseteq> U - S \<and> pathstart g = a \<and> pathfinish g = b"
   proof (cases "a = b")
     case True
     then show ?thesis
       by (metis DiffI \<open>a \<in> U\<close> \<open>a \<notin> S\<close> path_component_def path_component_refl)
   next
     case False
     then have "a \<noteq> ?m" "b \<noteq> ?m"
       using midpoint_eq_endpoint by fastforce+
     have "?m \<in> U"
       using \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>convex U\<close> convex_contains_segment by force
     obtain c where "c \<in> U" and nc_abc: "\<not> collinear {a,b,c}"
       by (metis False \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>\<not> collinear U\<close> collinear_triples insert_absorb)
     have ncoll_mca: "\<not> collinear {?m,c,a}"
       by (metis (full_types) \<open>a \<noteq> ?m\<close> collinear_3_trans collinear_midpoint insert_commute nc_abc)
     have ncoll_mcb: "\<not> collinear {?m,c,b}"
       by (metis (full_types) \<open>b \<noteq> ?m\<close> collinear_3_trans collinear_midpoint insert_commute nc_abc)
     have "c \<noteq> ?m"
       by (metis collinear_midpoint insert_commute nc_abc)
     then have "closed_segment ?m c \<subseteq> U"
       by (simp add: \<open>c \<in> U\<close> \<open>?m \<in> U\<close> \<open>convex U\<close> closed_segment_subset)
     then obtain z where z: "z \<in> closed_segment ?m c"
                     and disjS: "(closed_segment a z \<union> closed_segment z b) \<inter> S = {}"
     proof -
       have False if "closed_segment ?m c \<subseteq> {z. (closed_segment a z \<union> closed_segment z b) \<inter> S \<noteq> {}}"
       proof -
         have closb: "closed_segment ?m c \<subseteq>
                  {z \<in> closed_segment ?m c. closed_segment a z \<inter> S \<noteq> {}} \<union> {z \<in> closed_segment ?m c. closed_segment z b \<inter> S \<noteq> {}}"
           using that by blast
         have *: "countable {z \<in> closed_segment ?m c. closed_segment z u \<inter> S \<noteq> {}}"
           if "u \<in> U" "u \<notin> S" and ncoll: "\<not> collinear {?m, c, u}" for u
         proof -
           have **: False if x1: "x1 \<in> closed_segment ?m c" and x2: "x2 \<in> closed_segment ?m c"
                             and "x1 \<noteq> x2" "x1 \<noteq> u"
                             and w: "w \<in> closed_segment x1 u" "w \<in> closed_segment x2 u"
                             and "w \<in> S" for x1 x2 w
           proof -
             have "x1 \<in> affine hull {?m,c}" "x2 \<in> affine hull {?m,c}"
               using segment_as_ball x1 x2 by auto
             then have coll_x1: "collinear {x1, ?m, c}" and coll_x2: "collinear {?m, c, x2}"
               by (simp_all add: affine_hull_3_imp_collinear) (metis affine_hull_3_imp_collinear insert_commute)
             have "\<not> collinear {x1, u, x2}"
             proof
               assume "collinear {x1, u, x2}"
               then have "collinear {?m, c, u}"
                 by (metis (full_types) \<open>c \<noteq> ?m\<close> coll_x1 coll_x2 collinear_3_trans insert_commute ncoll \<open>x1 \<noteq> x2\<close>)
               with ncoll show False ..
             qed
             then have "closed_segment x1 u \<inter> closed_segment u x2 = {u}"
               by (blast intro!: Int_closed_segment)
             then have "w = u"
               using closed_segment_commute w by auto
             show ?thesis
               using \<open>u \<notin> S\<close> \<open>w = u\<close> that(7) by auto
           qed
           then have disj: "disjoint ((\<Union>z\<in>closed_segment ?m c. {closed_segment z u \<inter> S}))"
             by (fastforce simp: pairwise_def disjnt_def)
           have cou: "countable ((\<Union>z \<in> closed_segment ?m c. {closed_segment z u \<inter> S}) - {{}})"
             apply (rule pairwise_disjnt_countable_Union [OF _ pairwise_subset [OF disj]])
              apply (rule countable_subset [OF _ \<open>countable S\<close>], auto)
             done
           define f where "f \<equiv> \<lambda>X. (THE z. z \<in> closed_segment ?m c \<and> X = closed_segment z u \<inter> S)"
           show ?thesis
           proof (rule countable_subset [OF _ countable_image [OF cou, where f=f]], clarify)
             fix x
             assume x: "x \<in> closed_segment ?m c" "closed_segment x u \<inter> S \<noteq> {}"
             show "x \<in> f ` ((\<Union>z\<in>closed_segment ?m c. {closed_segment z u \<inter> S}) - {{}})"
             proof (rule_tac x="closed_segment x u \<inter> S" in image_eqI)
               show "x = f (closed_segment x u \<inter> S)"
                 unfolding f_def 
                 by (rule the_equality [symmetric]) (use x in \<open>auto dest: **\<close>)
             qed (use x in auto)
           qed
         qed
         have "uncountable (closed_segment ?m c)"
           by (metis \<open>c \<noteq> ?m\<close> uncountable_closed_segment)
         then show False
           using closb * [OF \<open>a \<in> U\<close> \<open>a \<notin> S\<close> ncoll_mca] * [OF \<open>b \<in> U\<close> \<open>b \<notin> S\<close> ncoll_mcb]
           by (simp add: closed_segment_commute countable_subset)
       qed
       then show ?thesis
         by (force intro: that)
     qed
     show ?thesis
     proof (intro exI conjI)
       have "path_image (linepath a z +++ linepath z b) \<subseteq> U"
         by (metis \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>closed_segment ?m c \<subseteq> U\<close> z \<open>convex U\<close> closed_segment_subset contra_subsetD path_image_linepath subset_path_image_join)
       with disjS show "path_image (linepath a z +++ linepath z b) \<subseteq> U - S"
         by (force simp: path_image_join)
     qed auto
   qed
 qed
 
 
 corollary connected_convex_diff_countable:
   fixes U :: "'a::euclidean_space set"
   assumes "convex U" "\<not> collinear U" "countable S"
   shows "connected(U - S)"
   by (simp add: assms path_connected_convex_diff_countable path_connected_imp_connected)
 
 lemma path_connected_punctured_convex:
   assumes "convex S" and aff: "aff_dim S \<noteq> 1"
     shows "path_connected(S - {a})"
 proof -
   consider "aff_dim S = -1" | "aff_dim S = 0" | "aff_dim S \<ge> 2"
     using assms aff_dim_geq [of S] by linarith
   then show ?thesis
   proof cases
     assume "aff_dim S = -1"
     then show ?thesis
       by (metis aff_dim_empty empty_Diff path_connected_empty)
   next
     assume "aff_dim S = 0"
     then show ?thesis
       by (metis aff_dim_eq_0 Diff_cancel Diff_empty Diff_insert0 convex_empty convex_imp_path_connected path_connected_singleton singletonD)
   next
     assume ge2: "aff_dim S \<ge> 2"
     then have "\<not> collinear S"
     proof (clarsimp simp: collinear_affine_hull)
       fix u v
       assume "S \<subseteq> affine hull {u, v}"
       then have "aff_dim S \<le> aff_dim {u, v}"
         by (metis (no_types) aff_dim_affine_hull aff_dim_subset)
       with ge2 show False
         by (metis (no_types) aff_dim_2 antisym aff not_numeral_le_zero one_le_numeral order_trans)
     qed
     moreover have "countable {a}"
       by simp
     ultimately show ?thesis
       by (metis path_connected_convex_diff_countable [OF \<open>convex S\<close>])
   qed
 qed
 
 lemma connected_punctured_convex:
   shows "\<lbrakk>convex S; aff_dim S \<noteq> 1\<rbrakk> \<Longrightarrow> connected(S - {a})"
   using path_connected_imp_connected path_connected_punctured_convex by blast
 
 lemma path_connected_complement_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "countable S"
   shows "path_connected(- S)"
 proof -
   have "\<not> collinear (UNIV::'a set)"
     using assms by (auto simp: collinear_aff_dim [of "UNIV :: 'a set"])
   then have "path_connected(UNIV - S)"
     by (simp add: \<open>countable S\<close> path_connected_convex_diff_countable)
   then show ?thesis
     by (simp add: Compl_eq_Diff_UNIV)
 qed
 
 proposition path_connected_openin_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "connected S" and ope: "openin (top_of_set (affine hull S)) S"
       and "\<not> collinear S" "countable T"
     shows "path_connected(S - T)"
 proof (clarsimp simp: path_connected_component)
   fix x y
   assume xy: "x \<in> S" "x \<notin> T" "y \<in> S" "y \<notin> T"
   show "path_component (S - T) x y"
   proof (rule connected_equivalence_relation_gen [OF \<open>connected S\<close>, where P = "\<lambda>x. x \<notin> T"])
     show "\<exists>z. z \<in> U \<and> z \<notin> T" if opeU: "openin (top_of_set S) U" and "x \<in> U" for U x
     proof -
       have "openin (top_of_set (affine hull S)) U"
         using opeU ope openin_trans by blast
       with \<open>x \<in> U\<close> obtain r where Usub: "U \<subseteq> affine hull S" and "r > 0"
                               and subU: "ball x r \<inter> affine hull S \<subseteq> U"
         by (auto simp: openin_contains_ball)
       with \<open>x \<in> U\<close> have x: "x \<in> ball x r \<inter> affine hull S"
         by auto
       have "\<not> S \<subseteq> {x}"
         using \<open>\<not> collinear S\<close>  collinear_subset by blast
       then obtain x' where "x' \<noteq> x" "x' \<in> S"
         by blast
       obtain y where y: "y \<noteq> x" "y \<in> ball x r \<inter> affine hull S"
       proof
         show "x + (r / 2 / norm(x' - x)) *\<^sub>R (x' - x) \<noteq> x"
           using \<open>x' \<noteq> x\<close> \<open>r > 0\<close> by auto
         show "x + (r / 2 / norm (x' - x)) *\<^sub>R (x' - x) \<in> ball x r \<inter> affine hull S"
           using \<open>x' \<noteq> x\<close> \<open>r > 0\<close> \<open>x' \<in> S\<close> x
           by (simp add: dist_norm mem_affine_3_minus hull_inc)
       qed
       have "convex (ball x r \<inter> affine hull S)"
         by (simp add: affine_imp_convex convex_Int)
       with x y subU have "uncountable U"
         by (meson countable_subset uncountable_convex)
       then have "\<not> U \<subseteq> T"
         using \<open>countable T\<close> countable_subset by blast
       then show ?thesis by blast
     qed
     show "\<exists>U. openin (top_of_set S) U \<and> x \<in> U \<and>
               (\<forall>x\<in>U. \<forall>y\<in>U. x \<notin> T \<and> y \<notin> T \<longrightarrow> path_component (S - T) x y)"
           if "x \<in> S" for x
     proof -
       obtain r where Ssub: "S \<subseteq> affine hull S" and "r > 0"
                  and subS: "ball x r \<inter> affine hull S \<subseteq> S"
         using ope \<open>x \<in> S\<close> by (auto simp: openin_contains_ball)
       then have conv: "convex (ball x r \<inter> affine hull S)"
         by (simp add: affine_imp_convex convex_Int)
       have "\<not> aff_dim (affine hull S) \<le> 1"
         using \<open>\<not> collinear S\<close> collinear_aff_dim by auto
       then have "\<not> aff_dim (ball x r \<inter> affine hull S) \<le> 1"
         by (metis (no_types, opaque_lifting) aff_dim_convex_Int_open IntI open_ball \<open>0 < r\<close> aff_dim_affine_hull affine_affine_hull affine_imp_convex centre_in_ball empty_iff hull_subset inf_commute subsetCE that)
       then have "\<not> collinear (ball x r \<inter> affine hull S)"
         by (simp add: collinear_aff_dim)
       then have *: "path_connected ((ball x r \<inter> affine hull S) - T)"
         by (rule path_connected_convex_diff_countable [OF conv _ \<open>countable T\<close>])
       have ST: "ball x r \<inter> affine hull S - T \<subseteq> S - T"
         using subS by auto
       show ?thesis
       proof (intro exI conjI)
         show "x \<in> ball x r \<inter> affine hull S"
           using \<open>x \<in> S\<close> \<open>r > 0\<close> by (simp add: hull_inc)
         have "openin (top_of_set (affine hull S)) (ball x r \<inter> affine hull S)"
           by (subst inf.commute) (simp add: openin_Int_open)
         then show "openin (top_of_set S) (ball x r \<inter> affine hull S)"
           by (rule openin_subset_trans [OF _ subS Ssub])
       qed (use * path_component_trans in \<open>auto simp: path_connected_component path_component_of_subset [OF ST]\<close>)
     qed
   qed (use xy path_component_trans in auto)
 qed
 
 corollary connected_openin_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "connected S" and ope: "openin (top_of_set (affine hull S)) S"
       and "\<not> collinear S" "countable T"
     shows "connected(S - T)"
   by (metis path_connected_imp_connected path_connected_openin_diff_countable [OF assms])
 
 corollary path_connected_open_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "open S" "connected S" "countable T"
   shows "path_connected(S - T)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp)
 next
   case False
   show ?thesis
   proof (rule path_connected_openin_diff_countable)
     show "openin (top_of_set (affine hull S)) S"
       by (simp add: assms hull_subset open_subset)
     show "\<not> collinear S"
       using assms False by (simp add: collinear_aff_dim aff_dim_open)
   qed (simp_all add: assms)
 qed
 
 corollary connected_open_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "open S" "connected S" "countable T"
   shows "connected(S - T)"
 by (simp add: assms path_connected_imp_connected path_connected_open_diff_countable)
 
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Self-homeomorphisms shuffling points about\<close>
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>The theorem \<open>homeomorphism_moving_points_exists\<close>\<close>
 
 lemma homeomorphism_moving_point_1:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and u: "u \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                     "f a = u" "\<And>x. x \<in> sphere a r \<Longrightarrow> f x = x"
 proof -
   have nou: "norm (u - a) < r" and "u \<in> T"
     using u by (auto simp: dist_norm norm_minus_commute)
   then have "0 < r"
     by (metis DiffD1 Diff_Diff_Int ball_eq_empty centre_in_ball not_le u)
   define f where "f \<equiv> \<lambda>x. (1 - norm(x - a) / r) *\<^sub>R (u - a) + x"
   have *: "False" if eq: "x + (norm y / r) *\<^sub>R u = y + (norm x / r) *\<^sub>R u"
                   and nou: "norm u < r" and yx: "norm y < norm x" for x y and u::'a
   proof -
     have "x = y + (norm x / r - (norm y / r)) *\<^sub>R u"
       using eq by (simp add: algebra_simps)
     then have "norm x = norm (y + ((norm x - norm y) / r) *\<^sub>R u)"
       by (metis diff_divide_distrib)
     also have "\<dots> \<le> norm y + norm(((norm x - norm y) / r) *\<^sub>R u)"
       using norm_triangle_ineq by blast
     also have "\<dots> = norm y + (norm x - norm y) * (norm u / r)"
       using yx \<open>r > 0\<close>
       by (simp add: field_split_simps)
     also have "\<dots> < norm y + (norm x - norm y) * 1"
     proof (subst add_less_cancel_left)
       show "(norm x - norm y) * (norm u / r) < (norm x - norm y) * 1"
       proof (rule mult_strict_left_mono)
         show "norm u / r < 1"
           using \<open>0 < r\<close> divide_less_eq_1_pos nou by blast
       qed (simp add: yx)
     qed
     also have "\<dots> = norm x"
       by simp
     finally show False by simp
   qed
   have "inj f"
     unfolding f_def
   proof (clarsimp simp: inj_on_def)
     fix x y
     assume "(1 - norm (x - a) / r) *\<^sub>R (u - a) + x =
             (1 - norm (y - a) / r) *\<^sub>R (u - a) + y"
     then have eq: "(x - a) + (norm (y - a) / r) *\<^sub>R (u - a) = (y - a) + (norm (x - a) / r) *\<^sub>R (u - a)"
       by (auto simp: algebra_simps)
     show "x=y"
     proof (cases "norm (x - a) = norm (y - a)")
       case True
       then show ?thesis
         using eq by auto
     next
       case False
       then consider "norm (x - a) < norm (y - a)" | "norm (x - a) > norm (y - a)"
         by linarith
       then have "False"
       proof cases
         case 1 show False
           using * [OF _ nou 1] eq by simp
       next
         case 2 with * [OF eq nou] show False
           by auto
       qed
       then show "x=y" ..
     qed
   qed
   then have inj_onf: "inj_on f (cball a r \<inter> T)"
     using inj_on_Int by fastforce
   have contf: "continuous_on (cball a r \<inter> T) f"
     unfolding f_def using \<open>0 < r\<close>  by (intro continuous_intros) blast
   have fim: "f ` (cball a r \<inter> T) = cball a r \<inter> T"
   proof
     have *: "norm (y + (1 - norm y / r) *\<^sub>R u) \<le> r" if "norm y \<le> r" "norm u < r" for y u::'a
     proof -
       have "norm (y + (1 - norm y / r) *\<^sub>R u) \<le> norm y + norm((1 - norm y / r) *\<^sub>R u)"
         using norm_triangle_ineq by blast
       also have "\<dots> = norm y + abs(1 - norm y / r) * norm u"
         by simp
       also have "\<dots> \<le> r"
       proof -
         have "(r - norm u) * (r - norm y) \<ge> 0"
           using that by auto
         then have "r * norm u + r * norm y \<le> r * r + norm u * norm y"
           by (simp add: algebra_simps)
         then show ?thesis
         using that \<open>0 < r\<close> by (simp add: abs_if field_simps)
       qed
       finally show ?thesis .
     qed
     have "f ` (cball a r) \<subseteq> cball a r"
       using * nou
       apply (clarsimp simp: dist_norm norm_minus_commute f_def)
       by (metis diff_add_eq diff_diff_add diff_diff_eq2 norm_minus_commute)
     moreover have "f ` T \<subseteq> T"
       unfolding f_def using \<open>affine T\<close> \<open>a \<in> T\<close> \<open>u \<in> T\<close>
       by (force simp: add.commute mem_affine_3_minus)
     ultimately show "f ` (cball a r \<inter> T) \<subseteq> cball a r \<inter> T"
       by blast
   next
     show "cball a r \<inter> T \<subseteq> f ` (cball a r \<inter> T)"
     proof (clarsimp simp: dist_norm norm_minus_commute)
       fix x
       assume x: "norm (x - a) \<le> r" and "x \<in> T"
       have "\<exists>v \<in> {0..1}. ((1 - v) * r - norm ((x - a) - v *\<^sub>R (u - a))) \<bullet> 1 = 0"
         by (rule ivt_decreasing_component_on_1) (auto simp: x continuous_intros)
       then obtain v where "0 \<le> v" "v \<le> 1"
         and v: "(1 - v) * r = norm ((x - a) - v *\<^sub>R (u - a))"
         by auto
       then have n: "norm (a - (x - v *\<^sub>R (u - a))) = r - r * v"
         by (simp add: field_simps norm_minus_commute)
       show "x \<in> f ` (cball a r \<inter> T)"
       proof (rule image_eqI)
         show "x = f (x - v *\<^sub>R (u - a))"
           using \<open>r > 0\<close> v by (simp add: f_def) (simp add: field_simps)
         have "x - v *\<^sub>R (u - a) \<in> cball a r"
           using \<open>r > 0\<close>\<open>0 \<le> v\<close>
           by (simp add: dist_norm n)
         moreover have "x - v *\<^sub>R (u - a) \<in> T"
           by (simp add: f_def \<open>u \<in> T\<close> \<open>x \<in> T\<close> assms mem_affine_3_minus2)
         ultimately show "x - v *\<^sub>R (u - a) \<in> cball a r \<inter> T"
           by blast
       qed
     qed
   qed
   have "compact (cball a r \<inter> T)"
     by (simp add: affine_closed compact_Int_closed \<open>affine T\<close>)
   then obtain g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
     by (metis homeomorphism_compact [OF _ contf fim inj_onf])
   then show thesis
     apply (rule_tac f=f in that)
     using \<open>r > 0\<close> by (simp_all add: f_def dist_norm norm_minus_commute)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point_2:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and u: "u \<in> ball a r \<inter> T" and v: "v \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                     "f u = v" "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> f x = x"
 proof -
   have "0 < r"
     by (metis DiffD1 Diff_Diff_Int ball_eq_empty centre_in_ball not_le u)
   obtain f1 g1 where hom1: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f1 g1"
                  and "f1 a = u" and f1: "\<And>x. x \<in> sphere a r \<Longrightarrow> f1 x = x"
     using homeomorphism_moving_point_1 [OF \<open>affine T\<close> \<open>a \<in> T\<close> u] by blast
   obtain f2 g2 where hom2: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f2 g2"
                  and "f2 a = v" and f2: "\<And>x. x \<in> sphere a r \<Longrightarrow> f2 x = x"
     using homeomorphism_moving_point_1 [OF \<open>affine T\<close> \<open>a \<in> T\<close> v] by blast
   show ?thesis
   proof
     show "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) (f2 \<circ> g1) (f1 \<circ> g2)"
       by (metis homeomorphism_compose homeomorphism_symD hom1 hom2)
     have "g1 u = a"
       using \<open>0 < r\<close> \<open>f1 a = u\<close> assms hom1 homeomorphism_apply1 by fastforce
     then show "(f2 \<circ> g1) u = v"
       by (simp add: \<open>f2 a = v\<close>)
     show "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> (f2 \<circ> g1) x = x"
       using f1 f2 hom1 homeomorphism_apply1 by fastforce
   qed
 qed
 
 
 corollary\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point_3:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and ST: "ball a r \<inter> T \<subseteq> S" "S \<subseteq> T"
       and u: "u \<in> ball a r \<inter> T" and v: "v \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism S S f g"
                     "f u = v" "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> ball a r \<inter> T"
 proof -
   obtain f g where hom: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                and "f u = v" and fid: "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> f x = x"
     using homeomorphism_moving_point_2 [OF \<open>affine T\<close> \<open>a \<in> T\<close> u v] by blast
   have gid: "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> g x = x"
     using fid hom homeomorphism_apply1 by fastforce
   define ff where "ff \<equiv> \<lambda>x. if x \<in> ball a r \<inter> T then f x else x"
   define gg where "gg \<equiv> \<lambda>x. if x \<in> ball a r \<inter> T then g x else x"
   show ?thesis
   proof
     show "homeomorphism S S ff gg"
     proof (rule homeomorphismI)
       have "continuous_on ((cball a r \<inter> T) \<union> (T - ball a r)) ff"
         unfolding ff_def
         using homeomorphism_cont1 [OF hom] 
         by (intro continuous_on_cases) (auto simp: affine_closed \<open>affine T\<close> fid)
       then show "continuous_on S ff"
         by (rule continuous_on_subset) (use ST in auto)
       have "continuous_on ((cball a r \<inter> T) \<union> (T - ball a r)) gg"
         unfolding gg_def
         using homeomorphism_cont2 [OF hom] 
         by (intro continuous_on_cases) (auto simp: affine_closed \<open>affine T\<close> gid)
       then show "continuous_on S gg"
         by (rule continuous_on_subset) (use ST in auto)
       show "ff ` S \<subseteq> S"
       proof (clarsimp simp: ff_def)
         fix x
         assume "x \<in> S" and x: "dist a x < r" and "x \<in> T"
         then have "f x \<in> cball a r \<inter> T"
           using homeomorphism_image1 [OF hom] by force
         then show "f x \<in> S"
           using ST(1) \<open>x \<in> T\<close> gid hom homeomorphism_def x by fastforce
       qed
       show "gg ` S \<subseteq> S"
       proof (clarsimp simp: gg_def)
         fix x
         assume "x \<in> S" and x: "dist a x < r" and "x \<in> T"
         then have "g x \<in> cball a r \<inter> T"
           using homeomorphism_image2 [OF hom] by force
         then have "g x \<in> ball a r"
           using homeomorphism_apply2 [OF hom]
             by (metis Diff_Diff_Int Diff_iff  \<open>x \<in> T\<close> cball_def fid le_less mem_Collect_eq mem_ball mem_sphere x)
         then show "g x \<in> S"
           using ST(1) \<open>g x \<in> cball a r \<inter> T\<close> by force
         qed
       show "\<And>x. x \<in> S \<Longrightarrow> gg (ff x) = x"
         unfolding ff_def gg_def
         using homeomorphism_apply1 [OF hom] homeomorphism_image1 [OF hom]
         by simp (metis Int_iff homeomorphism_apply1 [OF hom] fid image_eqI less_eq_real_def mem_cball mem_sphere)
       show "\<And>x. x \<in> S \<Longrightarrow> ff (gg x) = x"
         unfolding ff_def gg_def
         using homeomorphism_apply2 [OF hom] homeomorphism_image2 [OF hom]
         by simp (metis Int_iff fid image_eqI less_eq_real_def mem_cball mem_sphere)
     qed
     show "ff u = v"
       using u by (auto simp: ff_def \<open>f u = v\<close>)
     show "{x. \<not> (ff x = x \<and> gg x = x)} \<subseteq> ball a r \<inter> T"
       by (auto simp: ff_def gg_def)
   qed
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point:
   fixes a :: "'a::euclidean_space"
   assumes ope: "openin (top_of_set (affine hull S)) S"
       and "S \<subseteq> T"
       and TS: "T \<subseteq> affine hull S"
       and S: "connected S" "a \<in> S" "b \<in> S"
   obtains f g where "homeomorphism T T f g" "f a = b"
                     "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
                     "bounded {x. \<not> (f x = x \<and> g x = x)}"
 proof -
   have 1: "\<exists>h k. homeomorphism T T h k \<and> h (f d) = d \<and>
               {x. \<not> (h x = x \<and> k x = x)} \<subseteq> S \<and> bounded {x. \<not> (h x = x \<and> k x = x)}"
         if "d \<in> S" "f d \<in> S" and homfg: "homeomorphism T T f g"
         and S: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
         and bo: "bounded {x. \<not> (f x = x \<and> g x = x)}" for d f g
   proof (intro exI conjI)
     show homgf: "homeomorphism T T g f"
       by (metis homeomorphism_symD homfg)
     then show "g (f d) = d"
       by (meson \<open>S \<subseteq> T\<close> homeomorphism_def subsetD \<open>d \<in> S\<close>)
     show "{x. \<not> (g x = x \<and> f x = x)} \<subseteq> S"
       using S by blast
     show "bounded {x. \<not> (g x = x \<and> f x = x)}"
       using bo by (simp add: conj_commute)
   qed
   have 2: "\<exists>f g. homeomorphism T T f g \<and> f x = f2 (f1 x) \<and>
                  {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
              if "x \<in> S" "f1 x \<in> S" "f2 (f1 x) \<in> S"
                 and hom: "homeomorphism T T f1 g1" "homeomorphism T T f2 g2"
                 and sub: "{x. \<not> (f1 x = x \<and> g1 x = x)} \<subseteq> S"   "{x. \<not> (f2 x = x \<and> g2 x = x)} \<subseteq> S"
                 and bo: "bounded {x. \<not> (f1 x = x \<and> g1 x = x)}"  "bounded {x. \<not> (f2 x = x \<and> g2 x = x)}"
              for x f1 f2 g1 g2
   proof (intro exI conjI)
     show homgf: "homeomorphism T T (f2 \<circ> f1) (g1 \<circ> g2)"
       by (metis homeomorphism_compose hom)
     then show "(f2 \<circ> f1) x = f2 (f1 x)"
       by force
     show "{x. \<not> ((f2 \<circ> f1) x = x \<and> (g1 \<circ> g2) x = x)} \<subseteq> S"
       using sub by force
     have "bounded ({x. \<not>(f1 x = x \<and> g1 x = x)} \<union> {x. \<not>(f2 x = x \<and> g2 x = x)})"
       using bo by simp
     then show "bounded {x. \<not> ((f2 \<circ> f1) x = x \<and> (g1 \<circ> g2) x = x)}"
       by (rule bounded_subset) auto
   qed
   have 3: "\<exists>U. openin (top_of_set S) U \<and>
               d \<in> U \<and>
               (\<forall>x\<in>U.
                   \<exists>f g. homeomorphism T T f g \<and> f d = x \<and>
                         {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and>
                         bounded {x. \<not> (f x = x \<and> g x = x)})"
            if "d \<in> S" for d
   proof -
     obtain r where "r > 0" and r: "ball d r \<inter> affine hull S \<subseteq> S"
       by (metis \<open>d \<in> S\<close> ope openin_contains_ball)
     have *: "\<exists>f g. homeomorphism T T f g \<and> f d = e \<and>
                    {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and>
                    bounded {x. \<not> (f x = x \<and> g x = x)}" if "e \<in> S" "e \<in> ball d r" for e
       apply (rule homeomorphism_moving_point_3 [of "affine hull S" d r T d e])
       using r \<open>S \<subseteq> T\<close> TS that 
             apply (auto simp: \<open>d \<in> S\<close> \<open>0 < r\<close> hull_inc)
       using bounded_subset by blast
     show ?thesis
       by (rule_tac x="S \<inter> ball d r" in exI) (fastforce simp: openin_open_Int \<open>0 < r\<close> that intro: *)
   qed
   have "\<exists>f g. homeomorphism T T f g \<and> f a = b \<and>
               {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
     by (rule connected_equivalence_relation [OF S]; blast intro: 1 2 3)
   then show ?thesis
     using that by auto
 qed
 
 
 lemma homeomorphism_moving_points_exists_gen:
   assumes K: "finite K" "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
              "pairwise (\<lambda>i j. (x i \<noteq> x j) \<and> (y i \<noteq> y j)) K"
       and "2 \<le> aff_dim S"
       and ope: "openin (top_of_set (affine hull S)) S"
       and "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   shows "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(x i) = y i) \<and>
                {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
   using assms
 proof (induction K)
   case empty
   then show ?case
     by (force simp: homeomorphism_ident)
 next
   case (insert i K)
   then have xney: "\<And>j. \<lbrakk>j \<in> K; j \<noteq> i\<rbrakk> \<Longrightarrow> x i \<noteq> x j \<and> y i \<noteq> y j"
        and pw: "pairwise (\<lambda>i j. x i \<noteq> x j \<and> y i \<noteq> y j) K"
        and "x i \<in> S" "y i \<in> S"
        and xyS: "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
     by (simp_all add: pairwise_insert)
   obtain f g where homfg: "homeomorphism T T f g" and feq: "\<And>i. i \<in> K \<Longrightarrow> f(x i) = y i"
                and fg_sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
                and bo_fg: "bounded {x. \<not> (f x = x \<and> g x = x)}"
     using insert.IH [OF xyS pw] insert.prems by (blast intro: that)
   then have "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(x i) = y i) \<and>
                    {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
     using insert by blast
   have aff_eq: "affine hull (S - y ` K) = affine hull S"
   proof (rule affine_hull_Diff [OF ope])
     show "finite (y ` K)"
       by (simp add: insert.hyps(1))
     show "y ` K \<subset> S"
       using \<open>y i \<in> S\<close> insert.hyps(2) xney xyS by fastforce
   qed
   have f_in_S: "f x \<in> S" if "x \<in> S" for x
     using homfg fg_sub homeomorphism_apply1 \<open>S \<subseteq> T\<close>
   proof -
     have "(f (f x) \<noteq> f x \<or> g (f x) \<noteq> f x) \<or> f x \<in> S"
       by (metis \<open>S \<subseteq> T\<close> homfg subsetD homeomorphism_apply1 that)
     then show ?thesis
       using fg_sub by force
   qed
   obtain h k where homhk: "homeomorphism T T h k" and heq: "h (f (x i)) = y i"
                and hk_sub: "{x. \<not> (h x = x \<and> k x = x)} \<subseteq> S - y ` K"
                and bo_hk:  "bounded {x. \<not> (h x = x \<and> k x = x)}"
   proof (rule homeomorphism_moving_point [of "S - y`K" T "f(x i)" "y i"])
     show "openin (top_of_set (affine hull (S - y ` K))) (S - y ` K)"
       by (simp add: aff_eq openin_diff finite_imp_closedin image_subset_iff hull_inc insert xyS)
     show "S - y ` K \<subseteq> T"
       using \<open>S \<subseteq> T\<close> by auto
     show "T \<subseteq> affine hull (S - y ` K)"
       using insert by (simp add: aff_eq)
     show "connected (S - y ` K)"
     proof (rule connected_openin_diff_countable [OF \<open>connected S\<close> ope])
       show "\<not> collinear S"
         using collinear_aff_dim \<open>2 \<le> aff_dim S\<close> by force
       show "countable (y ` K)"
         using countable_finite insert.hyps(1) by blast
     qed
     have "\<And>k. \<lbrakk>f (x i) = y k; k \<in> K\<rbrakk> \<Longrightarrow> False"
         by (metis feq homfg \<open>x i \<in> S\<close> homeomorphism_def \<open>S \<subseteq> T\<close> \<open>i \<notin> K\<close> subsetCE xney xyS)
     then show "f (x i) \<in> S - y ` K"
       by (auto simp: f_in_S \<open>x i \<in> S\<close>)
     show "y i \<in> S - y ` K"
       using insert.hyps xney by (auto simp: \<open>y i \<in> S\<close>)
   qed blast
   show ?case
   proof (intro exI conjI)
     show "homeomorphism T T (h \<circ> f) (g \<circ> k)"
       using homfg homhk homeomorphism_compose by blast
     show "\<forall>i \<in> insert i K. (h \<circ> f) (x i) = y i"
       using feq hk_sub by (auto simp: heq)
     show "{x. \<not> ((h \<circ> f) x = x \<and> (g \<circ> k) x = x)} \<subseteq> S"
       using fg_sub hk_sub by force
     have "bounded ({x. \<not>(f x = x \<and> g x = x)} \<union> {x. \<not>(h x = x \<and> k x = x)})"
       using bo_fg bo_hk bounded_Un by blast
     then show "bounded {x. \<not> ((h \<circ> f) x = x \<and> (g \<circ> k) x = x)}"
       by (rule bounded_subset) auto
   qed
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_points_exists:
   fixes S :: "'a::euclidean_space set"
   assumes 2: "2 \<le> DIM('a)" "open S" "connected S" "S \<subseteq> T" "finite K"
       and KS: "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
       and pw: "pairwise (\<lambda>i j. (x i \<noteq> x j) \<and> (y i \<noteq> y j)) K"
       and S: "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   obtains f g where "homeomorphism T T f g" "\<And>i. i \<in> K \<Longrightarrow> f(x i) = y i"
                     "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S" "bounded {x. (\<not> (f x = x \<and> g x = x))}"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using KS homeomorphism_ident that by fastforce
 next
   case False
   then have affS: "affine hull S = UNIV"
     by (simp add: affine_hull_open \<open>open S\<close>)
   then have ope: "openin (top_of_set (affine hull S)) S"
     using \<open>open S\<close> open_openin by auto
   have "2 \<le> DIM('a)" by (rule 2)
   also have "\<dots> = aff_dim (UNIV :: 'a set)"
     by simp
   also have "\<dots> \<le> aff_dim S"
     by (metis aff_dim_UNIV aff_dim_affine_hull aff_dim_le_DIM affS)
   finally have "2 \<le> aff_dim S"
     by linarith
   then show ?thesis
     using homeomorphism_moving_points_exists_gen [OF \<open>finite K\<close> KS pw _ ope S] that by fastforce
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>The theorem \<open>homeomorphism_grouping_points_exists\<close>\<close>
 
 lemma homeomorphism_grouping_point_1:
   fixes a::real and c::real
   assumes "a < b" "c < d"
   obtains f g where "homeomorphism (cbox a b) (cbox c d) f g" "f a = c" "f b = d"
 proof -
   define f where "f \<equiv> \<lambda>x. ((d - c) / (b - a)) * x + (c - a * ((d - c) / (b - a)))"
   have "\<exists>g. homeomorphism (cbox a b) (cbox c d) f g"
   proof (rule homeomorphism_compact)
     show "continuous_on (cbox a b) f"
       unfolding f_def by (intro continuous_intros)
     have "f ` {a..b} = {c..d}"
       unfolding f_def image_affinity_atLeastAtMost
       using assms sum_sqs_eq by (auto simp: field_split_simps)
     then show "f ` cbox a b = cbox c d"
       by auto
     show "inj_on f (cbox a b)"
       unfolding f_def inj_on_def using assms by auto
   qed auto
   then obtain g where "homeomorphism (cbox a b) (cbox c d) f g" ..
   then show ?thesis
   proof
     show "f a = c"
       by (simp add: f_def)
     show "f b = d"
       using assms sum_sqs_eq [of a b] by (auto simp: f_def field_split_simps)
   qed
 qed
 
 lemma homeomorphism_grouping_point_2:
   fixes a::real and w::real
   assumes hom_ab: "homeomorphism (cbox a b) (cbox u v) f1 g1"
       and hom_bc: "homeomorphism (cbox b c) (cbox v w) f2 g2"
       and "b \<in> cbox a c" "v \<in> cbox u w"
       and eq: "f1 a = u" "f1 b = v" "f2 b = v" "f2 c = w"
  obtains f g where "homeomorphism (cbox a c) (cbox u w) f g" "f a = u" "f c = w"
                    "\<And>x. x \<in> cbox a b \<Longrightarrow> f x = f1 x" "\<And>x. x \<in> cbox b c \<Longrightarrow> f x = f2 x"
 proof -
   have le: "a \<le> b" "b \<le> c" "u \<le> v" "v \<le> w"
     using assms by simp_all
   then have ac: "cbox a c = cbox a b \<union> cbox b c" and uw: "cbox u w = cbox u v \<union> cbox v w"
     by auto
   define f where "f \<equiv> \<lambda>x. if x \<le> b then f1 x else f2 x"
   have "\<exists>g. homeomorphism (cbox a c) (cbox u w) f g"
   proof (rule homeomorphism_compact)
     have cf1: "continuous_on (cbox a b) f1"
       using hom_ab homeomorphism_cont1 by blast
     have cf2: "continuous_on (cbox b c) f2"
       using hom_bc homeomorphism_cont1 by blast
     show "continuous_on (cbox a c) f"
       unfolding f_def using le eq
       by (force intro: continuous_on_cases_le [OF continuous_on_subset [OF cf1] continuous_on_subset [OF cf2]])
     have "f ` cbox a b = f1 ` cbox a b" "f ` cbox b c = f2 ` cbox b c"
       unfolding f_def using eq by force+
     then show "f ` cbox a c = cbox u w"
       unfolding ac uw image_Un by (metis hom_ab hom_bc homeomorphism_def)
     have neq12: "f1 x \<noteq> f2 y" if x: "a \<le> x" "x \<le> b" and y: "b < y" "y \<le> c" for x y
     proof -
       have "f1 x \<in> cbox u v"
         by (metis hom_ab homeomorphism_def image_eqI mem_box_real(2) x)
       moreover have "f2 y \<in> cbox v w"
         by (metis (full_types) hom_bc homeomorphism_def image_subset_iff mem_box_real(2) not_le not_less_iff_gr_or_eq order_refl y)
       moreover have "f2 y \<noteq> f2 b"
         by (metis cancel_comm_monoid_add_class.diff_cancel diff_gt_0_iff_gt hom_bc homeomorphism_def le(2) less_imp_le less_numeral_extra(3) mem_box_real(2) order_refl y)
       ultimately show ?thesis
         using le eq by simp
     qed
     have "inj_on f1 (cbox a b)"
       by (metis (full_types) hom_ab homeomorphism_def inj_onI)
     moreover have "inj_on f2 (cbox b c)"
       by (metis (full_types) hom_bc homeomorphism_def inj_onI)
     ultimately show "inj_on f (cbox a c)"
       apply (simp (no_asm) add: inj_on_def)
       apply (simp add: f_def inj_on_eq_iff)
       using neq12 by force
   qed auto
   then obtain g where "homeomorphism (cbox a c) (cbox u w) f g" ..
   then show ?thesis
     using eq f_def le that by force
 qed
 
 lemma homeomorphism_grouping_point_3:
   fixes a::real
   assumes cbox_sub: "cbox c d \<subseteq> box a b" "cbox u v \<subseteq> box a b"
       and box_ne: "box c d \<noteq> {}" "box u v \<noteq> {}"
   obtains f g where "homeomorphism (cbox a b) (cbox a b) f g" "f a = a" "f b = b"
                     "\<And>x. x \<in> cbox c d \<Longrightarrow> f x \<in> cbox u v"
 proof -
   have less: "a < c" "a < u" "d < b" "v < b" "c < d" "u < v" "cbox c d \<noteq> {}"
     using assms
     by (simp_all add: cbox_sub subset_eq)
   obtain f1 g1 where 1: "homeomorphism (cbox a c) (cbox a u) f1 g1"
                    and f1_eq: "f1 a = a" "f1 c = u"
     using homeomorphism_grouping_point_1 [OF \<open>a < c\<close> \<open>a < u\<close>] .
   obtain f2 g2 where 2: "homeomorphism (cbox c d) (cbox u v) f2 g2"
                    and f2_eq: "f2 c = u" "f2 d = v"
     using homeomorphism_grouping_point_1 [OF \<open>c < d\<close> \<open>u < v\<close>] .
   obtain f3 g3 where 3: "homeomorphism (cbox d b) (cbox v b) f3 g3"
                    and f3_eq: "f3 d = v" "f3 b = b"
     using homeomorphism_grouping_point_1 [OF \<open>d < b\<close> \<open>v < b\<close>] .
   obtain f4 g4 where 4: "homeomorphism (cbox a d) (cbox a v) f4 g4" and "f4 a = a" "f4 d = v"
                  and f4_eq: "\<And>x. x \<in> cbox a c \<Longrightarrow> f4 x = f1 x" "\<And>x. x \<in> cbox c d \<Longrightarrow> f4 x = f2 x"
     using homeomorphism_grouping_point_2 [OF 1 2] less  by (auto simp: f1_eq f2_eq)
   obtain f g where fg: "homeomorphism (cbox a b) (cbox a b) f g" "f a = a" "f b = b"
                and f_eq: "\<And>x. x \<in> cbox a d \<Longrightarrow> f x = f4 x" "\<And>x. x \<in> cbox d b \<Longrightarrow> f x = f3 x"
     using homeomorphism_grouping_point_2 [OF 4 3] less by (auto simp: f4_eq f3_eq f2_eq f1_eq)
   show ?thesis
   proof (rule that [OF fg])
     show "f x \<in> cbox u v" if "x \<in> cbox c d" for x 
       using that f4_eq f_eq homeomorphism_image1 [OF 2]
       by (metis atLeastAtMost_iff box_real(2) image_eqI less(1) less_eq_real_def order_trans)
   qed
 qed
 
 
 lemma homeomorphism_grouping_point_4:
   fixes T :: "real set"
   assumes "open U" "open S" "connected S" "U \<noteq> {}" "finite K" "K \<subseteq> S" "U \<subseteq> S" "S \<subseteq> T"
   obtains f g where "homeomorphism T T f g"
                     "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}"
 proof -
   obtain c d where "box c d \<noteq> {}" "cbox c d \<subseteq> U"
   proof -
     obtain u where "u \<in> U"
       using \<open>U \<noteq> {}\<close> by blast
     then obtain e where "e > 0" "cball u e \<subseteq> U"
       using \<open>open U\<close> open_contains_cball by blast
     then show ?thesis
       by (rule_tac c=u and d="u+e" in that) (auto simp: dist_norm subset_iff)
   qed
   have "compact K"
     by (simp add: \<open>finite K\<close> finite_imp_compact)
   obtain a b where "box a b \<noteq> {}" "K \<subseteq> cbox a b" "cbox a b \<subseteq> S"
   proof (cases "K = {}")
     case True then show ?thesis
       using \<open>box c d \<noteq> {}\<close> \<open>cbox c d \<subseteq> U\<close> \<open>U \<subseteq> S\<close> that by blast
   next
     case False
     then obtain a b where "a \<in> K" "b \<in> K"
             and a: "\<And>x. x \<in> K \<Longrightarrow> a \<le> x" and b: "\<And>x. x \<in> K \<Longrightarrow> x \<le> b"
       using compact_attains_inf compact_attains_sup by (metis \<open>compact K\<close>)+
     obtain e where "e > 0" "cball b e \<subseteq> S"
       using \<open>open S\<close> open_contains_cball
       by (metis \<open>b \<in> K\<close> \<open>K \<subseteq> S\<close> subsetD)
     show ?thesis
     proof
       show "box a (b + e) \<noteq> {}"
         using \<open>0 < e\<close> \<open>b \<in> K\<close> a by force
       show "K \<subseteq> cbox a (b + e)"
         using \<open>0 < e\<close> a b by fastforce
       have "a \<in> S"
         using \<open>a \<in> K\<close> assms(6) by blast
       have "b + e \<in> S"
         using \<open>0 < e\<close> \<open>cball b e \<subseteq> S\<close>  by (force simp: dist_norm)
       show "cbox a (b + e) \<subseteq> S"
         using \<open>a \<in> S\<close> \<open>b + e \<in> S\<close> \<open>connected S\<close> connected_contains_Icc by auto
     qed
   qed
   obtain w z where "cbox w z \<subseteq> S" and sub_wz: "cbox a b \<union> cbox c d \<subseteq> box w z"
   proof -
     have "a \<in> S" "b \<in> S"
       using \<open>box a b \<noteq> {}\<close> \<open>cbox a b \<subseteq> S\<close> by auto
     moreover have "c \<in> S" "d \<in> S"
       using \<open>box c d \<noteq> {}\<close> \<open>cbox c d \<subseteq> U\<close> \<open>U \<subseteq> S\<close> by force+
     ultimately have "min a c \<in> S" "max b d \<in> S"
       by linarith+
     then obtain e1 e2 where "e1 > 0" "cball (min a c) e1 \<subseteq> S" "e2 > 0" "cball (max b d) e2 \<subseteq> S"
       using \<open>open S\<close> open_contains_cball by metis
     then have *: "min a c - e1 \<in> S" "max b d + e2 \<in> S"
       by (auto simp: dist_norm)
     show ?thesis
     proof
       show "cbox (min a c - e1) (max b d+ e2) \<subseteq> S"
         using * \<open>connected S\<close> connected_contains_Icc by auto
       show "cbox a b \<union> cbox c d \<subseteq> box (min a c - e1) (max b d + e2)"
         using \<open>0 < e1\<close> \<open>0 < e2\<close> by auto
     qed
   qed
   then
   obtain f g where hom: "homeomorphism (cbox w z) (cbox w z) f g"
                and "f w = w" "f z = z"
                and fin: "\<And>x. x \<in> cbox a b \<Longrightarrow> f x \<in> cbox c d"
     using homeomorphism_grouping_point_3 [of a b w z c d]
     using \<open>box a b \<noteq> {}\<close> \<open>box c d \<noteq> {}\<close> by blast
   have contfg: "continuous_on (cbox w z) f" "continuous_on (cbox w z) g"
     using hom homeomorphism_def by blast+
   define f' where "f' \<equiv> \<lambda>x. if x \<in> cbox w z then f x else x"
   define g' where "g' \<equiv> \<lambda>x. if x \<in> cbox w z then g x else x"
   show ?thesis
   proof
     have T: "cbox w z \<union> (T - box w z) = T"
       using \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> by auto
     show "homeomorphism T T f' g'"
     proof
       have clo: "closedin (top_of_set (cbox w z \<union> (T - box w z))) (T - box w z)"
         by (metis Diff_Diff_Int Diff_subset T closedin_def open_box openin_open_Int topspace_euclidean_subtopology)
       have "\<And>x. \<lbrakk>w \<le> x \<and> x \<le> z; w < x \<longrightarrow> \<not> x < z\<rbrakk> \<Longrightarrow> f x = x"
         using \<open>f w = w\<close> \<open>f z = z\<close> by auto
       moreover have "\<And>x. \<lbrakk>w \<le> x \<and> x \<le> z; w < x \<longrightarrow> \<not> x < z\<rbrakk> \<Longrightarrow> g x = x"
         using \<open>f w = w\<close> \<open>f z = z\<close> hom homeomorphism_apply1 by fastforce
       ultimately
       have "continuous_on (cbox w z \<union> (T - box w z)) f'" "continuous_on (cbox w z \<union> (T - box w z)) g'"
         unfolding f'_def g'_def
         by (intro continuous_on_cases_local contfg continuous_on_id clo; auto simp: closed_subset)+
       then show "continuous_on T f'" "continuous_on T g'"
         by (simp_all only: T)
       show "f' ` T \<subseteq> T"
         unfolding f'_def
         by clarsimp (metis \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> subsetD hom homeomorphism_def imageI mem_box_real(2))
       show "g' ` T \<subseteq> T"
         unfolding g'_def
         by clarsimp (metis \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> subsetD hom homeomorphism_def imageI mem_box_real(2))
       show "\<And>x. x \<in> T \<Longrightarrow> g' (f' x) = x"
         unfolding f'_def g'_def
         using homeomorphism_apply1 [OF hom]  homeomorphism_image1 [OF hom] by fastforce
       show "\<And>y. y \<in> T \<Longrightarrow> f' (g' y) = y"
         unfolding f'_def g'_def
         using homeomorphism_apply2 [OF hom]  homeomorphism_image2 [OF hom] by fastforce
     qed
     show "\<And>x. x \<in> K \<Longrightarrow> f' x \<in> U"
       using fin sub_wz \<open>K \<subseteq> cbox a b\<close> \<open>cbox c d \<subseteq> U\<close> by (force simp: f'_def)
     show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> S"
       using \<open>cbox w z \<subseteq> S\<close> by (auto simp: f'_def g'_def)
     show "bounded {x. \<not> (f' x = x \<and> g' x = x)}"
     proof (rule bounded_subset [of "cbox w z"])
       show "bounded (cbox w z)"
         using bounded_cbox by blast
       show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> cbox w z"
         by (auto simp: f'_def g'_def)
     qed
   qed
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_grouping_points_exists:
   fixes S :: "'a::euclidean_space set"
   assumes "open U" "open S" "connected S" "U \<noteq> {}" "finite K" "K \<subseteq> S" "U \<subseteq> S" "S \<subseteq> T"
   obtains f g where "homeomorphism T T f g" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}" "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U"
 proof (cases "2 \<le> DIM('a)")
   case True
   have TS: "T \<subseteq> affine hull S"
     using affine_hull_open assms by blast
   have "infinite U"
     using \<open>open U\<close> \<open>U \<noteq> {}\<close> finite_imp_not_open by blast
   then obtain P where "P \<subseteq> U" "finite P" "card K = card P"
     using infinite_arbitrarily_large by metis
   then obtain \<gamma> where \<gamma>: "bij_betw \<gamma> K P"
     using \<open>finite K\<close> finite_same_card_bij by blast
   obtain f g where "homeomorphism T T f g" "\<And>i. i \<in> K \<Longrightarrow> f (id i) = \<gamma> i" "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S" "bounded {x. \<not> (f x = x \<and> g x = x)}"
   proof (rule homeomorphism_moving_points_exists [OF True \<open>open S\<close> \<open>connected S\<close> \<open>S \<subseteq> T\<close> \<open>finite K\<close>])
     show "\<And>i. i \<in> K \<Longrightarrow> id i \<in> S \<and> \<gamma> i \<in> S"
       using \<open>P \<subseteq> U\<close> \<open>bij_betw \<gamma> K P\<close> \<open>K \<subseteq> S\<close> \<open>U \<subseteq> S\<close> bij_betwE by blast
     show "pairwise (\<lambda>i j. id i \<noteq> id j \<and> \<gamma> i \<noteq> \<gamma> j) K"
       using \<gamma> by (auto simp: pairwise_def bij_betw_def inj_on_def)
   qed (use affine_hull_open assms that in auto)
   then show ?thesis
     using \<gamma> \<open>P \<subseteq> U\<close> bij_betwE by (fastforce simp add: intro!: that)
 next
   case False
   with DIM_positive have "DIM('a) = 1"
     by (simp add: dual_order.antisym)
   then obtain h::"'a \<Rightarrow>real" and j
   where "linear h" "linear j"
     and noh: "\<And>x. norm(h x) = norm x" and noj: "\<And>y. norm(j y) = norm y"
     and hj:  "\<And>x. j(h x) = x" "\<And>y. h(j y) = y"
     and ranh: "surj h"
     using isomorphisms_UNIV_UNIV
     by (metis (mono_tags, opaque_lifting) DIM_real UNIV_eq_I range_eqI)
   obtain f g where hom: "homeomorphism (h ` T) (h ` T) f g"
                and f: "\<And>x. x \<in> h ` K \<Longrightarrow> f x \<in> h ` U"
                and sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> h ` S"
                and bou: "bounded {x. \<not> (f x = x \<and> g x = x)}"
     apply (rule homeomorphism_grouping_point_4 [of "h ` U" "h ` S" "h ` K" "h ` T"])
     by (simp_all add: assms image_mono  \<open>linear h\<close> open_surjective_linear_image connected_linear_image ranh)
   have jf: "j (f (h x)) = x \<longleftrightarrow> f (h x) = h x" for x
     by (metis hj)
   have jg: "j (g (h x)) = x \<longleftrightarrow> g (h x) = h x" for x
     by (metis hj)
   have cont_hj: "continuous_on X h"  "continuous_on Y j" for X Y
     by (simp_all add: \<open>linear h\<close> \<open>linear j\<close> linear_linear linear_continuous_on)
   show ?thesis
   proof
     show "homeomorphism T T (j \<circ> f \<circ> h) (j \<circ> g \<circ> h)"
     proof
       show "continuous_on T (j \<circ> f \<circ> h)" "continuous_on T (j \<circ> g \<circ> h)"
         using hom homeomorphism_def
         by (blast intro: continuous_on_compose cont_hj)+
       show "(j \<circ> f \<circ> h) ` T \<subseteq> T" "(j \<circ> g \<circ> h) ` T \<subseteq> T"
         by auto (metis (mono_tags, opaque_lifting) hj(1) hom homeomorphism_def imageE imageI)+
       show "\<And>x. x \<in> T \<Longrightarrow> (j \<circ> g \<circ> h) ((j \<circ> f \<circ> h) x) = x"
         using hj hom homeomorphism_apply1 by fastforce
       show "\<And>y. y \<in> T \<Longrightarrow> (j \<circ> f \<circ> h) ((j \<circ> g \<circ> h) y) = y"
         using hj hom homeomorphism_apply2 by fastforce
     qed
     show "{x. \<not> ((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)} \<subseteq> S"
     proof (clarsimp simp: jf jg hj)
       show "f (h x) = h x \<longrightarrow> g (h x) \<noteq> h x \<Longrightarrow> x \<in> S" for x
         using sub [THEN subsetD, of "h x"] hj by simp (metis imageE)
     qed
     have "bounded (j ` {x. (\<not> (f x = x \<and> g x = x))})"
       by (rule bounded_linear_image [OF bou]) (use \<open>linear j\<close> linear_conv_bounded_linear in auto)
     moreover
     have *: "{x. \<not>((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)} = j ` {x. (\<not> (f x = x \<and> g x = x))}"
       using hj by (auto simp: jf jg image_iff, metis+)
     ultimately show "bounded {x. \<not> ((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)}"
       by metis
     show "\<And>x. x \<in> K \<Longrightarrow> (j \<circ> f \<circ> h) x \<in> U"
       using f hj by fastforce
   qed
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_grouping_points_exists_gen:
   fixes S :: "'a::euclidean_space set"
   assumes opeU: "openin (top_of_set S) U"
       and opeS: "openin (top_of_set (affine hull S)) S"
       and "U \<noteq> {}" "finite K" "K \<subseteq> S" and S: "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   obtains f g where "homeomorphism T T f g" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}" "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U"
 proof (cases "2 \<le> aff_dim S")
   case True
   have opeU': "openin (top_of_set (affine hull S)) U"
     using opeS opeU openin_trans by blast
   obtain u where "u \<in> U" "u \<in> S"
     using \<open>U \<noteq> {}\<close> opeU openin_imp_subset by fastforce+
   have "infinite U"
   proof (rule infinite_openin [OF opeU \<open>u \<in> U\<close>])
     show "u islimpt S"
       using True \<open>u \<in> S\<close> assms(8) connected_imp_perfect_aff_dim by fastforce
   qed
   then obtain P where "P \<subseteq> U" "finite P" "card K = card P"
     using infinite_arbitrarily_large by metis
   then obtain \<gamma> where \<gamma>: "bij_betw \<gamma> K P"
     using \<open>finite K\<close> finite_same_card_bij by blast
   have "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(id i) = \<gamma> i) \<and>
                {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
   proof (rule homeomorphism_moving_points_exists_gen [OF \<open>finite K\<close> _ _ True opeS S])
     show "\<And>i. i \<in> K \<Longrightarrow> id i \<in> S \<and> \<gamma> i \<in> S"
       by (metis id_apply opeU openin_contains_cball subsetCE \<open>P \<subseteq> U\<close> \<open>bij_betw \<gamma> K P\<close> \<open>K \<subseteq> S\<close> bij_betwE)
     show "pairwise (\<lambda>i j. id i \<noteq> id j \<and> \<gamma> i \<noteq> \<gamma> j) K"
       using \<gamma> by (auto simp: pairwise_def bij_betw_def inj_on_def)
   qed
   then show ?thesis
     using \<gamma> \<open>P \<subseteq> U\<close> bij_betwE by (fastforce simp add: intro!: that)
 next
   case False
   with aff_dim_geq [of S] consider "aff_dim S = -1" | "aff_dim S = 0" | "aff_dim S = 1" by linarith
   then show ?thesis
   proof cases
     assume "aff_dim S = -1"
     then have "S = {}"
       using aff_dim_empty by blast
     then have "False"
       using \<open>U \<noteq> {}\<close> \<open>K \<subseteq> S\<close> openin_imp_subset [OF opeU] by blast
     then show ?thesis ..
   next
     assume "aff_dim S = 0"
     then obtain a where "S = {a}"
       using aff_dim_eq_0 by blast
     then have "K \<subseteq> U"
       using \<open>U \<noteq> {}\<close> \<open>K \<subseteq> S\<close> openin_imp_subset [OF opeU] by blast
     show ?thesis
       using \<open>K \<subseteq> U\<close> by (intro that [of id id]) (auto intro: homeomorphismI)
   next
     assume "aff_dim S = 1"
     then have "affine hull S homeomorphic (UNIV :: real set)"
       by (auto simp: homeomorphic_affine_sets)
     then obtain h::"'a\<Rightarrow>real" and j where homhj: "homeomorphism (affine hull S) UNIV h j"
       using homeomorphic_def by blast
     then have h: "\<And>x. x \<in> affine hull S \<Longrightarrow> j(h(x)) = x" and j: "\<And>y. j y \<in> affine hull S \<and> h(j y) = y"
       by (auto simp: homeomorphism_def)
     have connh: "connected (h ` S)"
       by (meson Topological_Spaces.connected_continuous_image \<open>connected S\<close> homeomorphism_cont1 homeomorphism_of_subsets homhj hull_subset top_greatest)
     have hUS: "h ` U \<subseteq> h ` S"
       by (meson homeomorphism_imp_open_map homeomorphism_of_subsets homhj hull_subset opeS opeU open_UNIV openin_open_eq)
     have opn: "openin (top_of_set (affine hull S)) U \<Longrightarrow> open (h ` U)" for U
       using homeomorphism_imp_open_map [OF homhj]  by simp
     have "open (h ` U)" "open (h ` S)"
       by (auto intro: opeS opeU openin_trans opn)
     then obtain f g where hom: "homeomorphism (h ` T) (h ` T) f g"
                  and f: "\<And>x. x \<in> h ` K \<Longrightarrow> f x \<in> h ` U"
                  and sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> h ` S"
                  and bou: "bounded {x. \<not> (f x = x \<and> g x = x)}"
       apply (rule homeomorphism_grouping_points_exists [of "h ` U" "h ` S" "h ` K" "h ` T"])
       using assms by (auto simp: connh hUS)
     have jf: "\<And>x. x \<in> affine hull S \<Longrightarrow> j (f (h x)) = x \<longleftrightarrow> f (h x) = h x"
       by (metis h j)
     have jg: "\<And>x. x \<in> affine hull S \<Longrightarrow> j (g (h x)) = x \<longleftrightarrow> g (h x) = h x"
       by (metis h j)
     have cont_hj: "continuous_on T h"  "continuous_on Y j" for Y
     proof (rule continuous_on_subset [OF _ \<open>T \<subseteq> affine hull S\<close>])
       show "continuous_on (affine hull S) h"
         using homeomorphism_def homhj by blast
     qed (meson continuous_on_subset homeomorphism_def homhj top_greatest)
     define f' where "f' \<equiv> \<lambda>x. if x \<in> affine hull S then (j \<circ> f \<circ> h) x else x"
     define g' where "g' \<equiv> \<lambda>x. if x \<in> affine hull S then (j \<circ> g \<circ> h) x else x"
     show ?thesis
     proof
       show "homeomorphism T T f' g'"
       proof
         have "continuous_on T (j \<circ> f \<circ> h)"
           using hom homeomorphism_def by (intro continuous_on_compose cont_hj) blast
         then show "continuous_on T f'"
           apply (rule continuous_on_eq)
           using \<open>T \<subseteq> affine hull S\<close> f'_def by auto
         have "continuous_on T (j \<circ> g \<circ> h)"
           using hom homeomorphism_def by (intro continuous_on_compose cont_hj) blast
         then show "continuous_on T g'"
           apply (rule continuous_on_eq)
           using \<open>T \<subseteq> affine hull S\<close> g'_def by auto
         show "f' ` T \<subseteq> T"
         proof (clarsimp simp: f'_def)
           fix x assume "x \<in> T"
           then have "f (h x) \<in> h ` T"
             by (metis (no_types) hom homeomorphism_def image_subset_iff subset_refl)
           then show "j (f (h x)) \<in> T"
             using \<open>T \<subseteq> affine hull S\<close> h by auto
         qed
         show "g' ` T \<subseteq> T"
         proof (clarsimp simp: g'_def)
           fix x assume "x \<in> T"
           then have "g (h x) \<in> h ` T"
             by (metis (no_types) hom homeomorphism_def image_subset_iff subset_refl)
           then show "j (g (h x)) \<in> T"
             using \<open>T \<subseteq> affine hull S\<close> h by auto
         qed
         show "\<And>x. x \<in> T \<Longrightarrow> g' (f' x) = x"
           using h j hom homeomorphism_apply1 by (fastforce simp add: f'_def g'_def)
         show "\<And>y. y \<in> T \<Longrightarrow> f' (g' y) = y"
           using h j hom homeomorphism_apply2 by (fastforce simp add: f'_def g'_def)
       qed
     next
       have \<section>: "\<And>x y. \<lbrakk>x \<in> affine hull S; h x = h y; y \<in> S\<rbrakk> \<Longrightarrow> x \<in> S"
         by (metis h hull_inc)
       show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> S"
         using sub by (simp add: f'_def g'_def jf jg) (force elim: \<section>)
     next
       have "compact (j ` closure {x. \<not> (f x = x \<and> g x = x)})"
         using bou by (auto simp: compact_continuous_image cont_hj)
       then have "bounded (j ` {x. \<not> (f x = x \<and> g x = x)})"
         by (rule bounded_closure_image [OF compact_imp_bounded])
       moreover
       have *: "{x \<in> affine hull S. j (f (h x)) \<noteq> x \<or> j (g (h x)) \<noteq> x} = j ` {x. (\<not> (f x = x \<and> g x = x))}"
         using h j by (auto simp: image_iff; metis)
       ultimately have "bounded {x \<in> affine hull S. j (f (h x)) \<noteq> x \<or> j (g (h x)) \<noteq> x}"
         by metis
       then show "bounded {x. \<not> (f' x = x \<and> g' x = x)}"
         by (simp add: f'_def g'_def Collect_mono bounded_subset)
     next
       show "f' x \<in> U" if "x \<in> K" for x
       proof -
         have "U \<subseteq> S"
           using opeU openin_imp_subset by blast
         then have "j (f (h x)) \<in> U"
           using f h hull_subset that by fastforce
         then show "f' x \<in> U"
           using \<open>K \<subseteq> S\<close> S f'_def that by auto
       qed
     qed
   qed
 qed
 
 
 subsection\<open>Nullhomotopic mappings\<close>
 
 text\<open> A mapping out of a sphere is nullhomotopic iff it extends to the ball.
 This even works out in the degenerate cases when the radius is \<open>\<le>\<close> 0, and
 we also don't need to explicitly assume continuity since it's already implicit
 in both sides of the equivalence.\<close>
 
 lemma nullhomotopic_from_lemma:
   assumes contg: "continuous_on (cball a r - {a}) g"
       and fa: "\<And>e. 0 < e
                \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>x. x \<noteq> a \<and> norm(x - a) < d \<longrightarrow> norm(g x - f a) < e)"
       and r: "\<And>x. x \<in> cball a r \<and> x \<noteq> a \<Longrightarrow> f x = g x"
     shows "continuous_on (cball a r) f"
 proof (clarsimp simp: continuous_on_eq_continuous_within Ball_def)
   fix x
   assume x: "dist a x \<le> r"
   show "continuous (at x within cball a r) f"
   proof (cases "x=a")
     case True
     then show ?thesis
       by (metis continuous_within_eps_delta fa dist_norm dist_self r)
   next
     case False
     show ?thesis
     proof (rule continuous_transform_within [where f=g and d = "norm(x-a)"])
       have "\<exists>d>0. \<forall>x'\<in>cball a r.
                       dist x' x < d \<longrightarrow> dist (g x') (g x) < e" if "e>0" for e
       proof -
         obtain d where "d > 0"
            and d: "\<And>x'. \<lbrakk>dist x' a \<le> r; x' \<noteq> a; dist x' x < d\<rbrakk> \<Longrightarrow>
                                  dist (g x') (g x) < e"
           using contg False x \<open>e>0\<close>
           unfolding continuous_on_iff by (fastforce simp add: dist_commute intro: that)
         show ?thesis
           using \<open>d > 0\<close> \<open>x \<noteq> a\<close>
           by (rule_tac x="min d (norm(x - a))" in exI)
              (auto simp: dist_commute dist_norm [symmetric]  intro!: d)
       qed
       then show "continuous (at x within cball a r) g"
         using contg False by (auto simp: continuous_within_eps_delta)
       show "0 < norm (x - a)"
         using False by force
       show "x \<in> cball a r"
         by (simp add: x)
       show "\<And>x'. \<lbrakk>x' \<in> cball a r; dist x' x < norm (x - a)\<rbrakk>
         \<Longrightarrow> g x' = f x'"
         by (metis dist_commute dist_norm less_le r)
     qed
   qed
 qed
 
 proposition nullhomotopic_from_sphere_extension:
   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   shows  "(\<exists>c. homotopic_with_canon (\<lambda>x. True) (sphere a r) S f (\<lambda>x. c)) \<longleftrightarrow>
           (\<exists>g. continuous_on (cball a r) g \<and> g ` (cball a r) \<subseteq> S \<and>
                (\<forall>x \<in> sphere a r. g x = f x))"
          (is "?lhs = ?rhs")
 proof (cases r "0::real" rule: linorder_cases)
   case less
   then show ?thesis
     by (simp add: homotopic_on_emptyI)
 next
   case equal
   show ?thesis
   proof
     assume L: ?lhs
     with equal have [simp]: "f a \<in> S"
       using homotopic_with_imp_subset1 by fastforce
     obtain h:: "real \<times> 'M \<Rightarrow> 'a" 
       where h: "continuous_on ({0..1} \<times> {a}) h" "h ` ({0..1} \<times> {a}) \<subseteq> S" "h (0, a) = f a"    
       using L equal by (auto simp: homotopic_with)
     then have "continuous_on (cball a r) (\<lambda>x. h (0, a))" "(\<lambda>x. h (0, a)) ` cball a r \<subseteq> S"
       by (auto simp: equal)
     then show ?rhs
       using h(3) local.equal by force
   next
     assume ?rhs
     then show ?lhs
       using equal continuous_on_const by (force simp add: homotopic_with)
   qed
 next
   case greater
   let ?P = "continuous_on {x. norm(x - a) = r} f \<and> f ` {x. norm(x - a) = r} \<subseteq> S"
   have ?P if ?lhs using that
   proof
     fix c
     assume c: "homotopic_with_canon (\<lambda>x. True) (sphere a r) S f (\<lambda>x. c)"
     then have contf: "continuous_on (sphere a r) f" 
       by (metis homotopic_with_imp_continuous)
     moreover have fim: "f ` sphere a r \<subseteq> S"
       by (meson continuous_map_subtopology_eu c homotopic_with_imp_continuous_maps)
     show ?P
       using contf fim by (auto simp: sphere_def dist_norm norm_minus_commute)
   qed
   moreover have ?P if ?rhs using that
   proof
     fix g
     assume g: "continuous_on (cball a r) g \<and> g ` cball a r \<subseteq> S \<and> (\<forall>xa\<in>sphere a r. g xa = f xa)"
     then have "f ` {x. norm (x - a) = r} \<subseteq> S"
       using sphere_cball [of a r] unfolding image_subset_iff sphere_def
       by (metis dist_commute dist_norm mem_Collect_eq subset_eq)
     with g show ?P
       by (auto simp: dist_norm norm_minus_commute elim!: continuous_on_eq [OF continuous_on_subset])
   qed
   moreover have ?thesis if ?P
   proof
     assume ?lhs
     then obtain c where "homotopic_with_canon (\<lambda>x. True) (sphere a r) S (\<lambda>x. c) f"
       using homotopic_with_sym by blast
     then obtain h where conth: "continuous_on ({0..1::real} \<times> sphere a r) h"
                     and him: "h ` ({0..1} \<times> sphere a r) \<subseteq> S"
                     and h: "\<And>x. h(0, x) = c" "\<And>x. h(1, x) = f x"
       by (auto simp: homotopic_with_def)
     obtain b1::'M where "b1 \<in> Basis"
       using SOME_Basis by auto
     have "c \<in> h ` ({0..1} \<times> sphere a r)"
     proof
       show "c = h (0, a + r *\<^sub>R b1)"
         by (simp add: h)
       show "(0, a + r *\<^sub>R b1) \<in> {0..1::real} \<times> sphere a r"
         using greater \<open>b1 \<in> Basis\<close> by (auto simp: dist_norm)
     qed
     then have "c \<in> S"
       using him by blast
     have uconth: "uniformly_continuous_on ({0..1::real} \<times> (sphere a r)) h"
       by (force intro: compact_Times conth compact_uniformly_continuous)
     let ?g = "\<lambda>x. h (norm (x - a)/r,
                      a + (if x = a then r *\<^sub>R b1 else (r / norm(x - a)) *\<^sub>R (x - a)))"
     let ?g' = "\<lambda>x. h (norm (x - a)/r, a + (r / norm(x - a)) *\<^sub>R (x - a))"
     show ?rhs
     proof (intro exI conjI)
       have "continuous_on (cball a r - {a}) ?g'"
         using greater
         by (force simp: dist_norm norm_minus_commute intro: continuous_on_compose2 [OF conth] continuous_intros)
       then show "continuous_on (cball a r) ?g"
       proof (rule nullhomotopic_from_lemma)
         show "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> norm (?g' x - ?g a) < e" if "0 < e" for e
         proof -
           obtain d where "0 < d"
              and d: "\<And>x x'. \<lbrakk>x \<in> {0..1} \<times> sphere a r; x' \<in> {0..1} \<times> sphere a r; norm ( x' - x) < d\<rbrakk>
                         \<Longrightarrow> norm (h x' - h x) < e"
             using uniformly_continuous_onE [OF uconth \<open>0 < e\<close>] by (auto simp: dist_norm)
           have *: "norm (h (norm (x - a) / r,
                          a + (r / norm (x - a)) *\<^sub>R (x - a)) - h (0, a + r *\<^sub>R b1)) < e" (is  "norm (?ha - ?hb) < e")
                    if "x \<noteq> a" "norm (x - a) < r" "norm (x - a) < d * r" for x
           proof -
             have "norm (?ha - ?hb) = norm (?ha - h (0, a + (r / norm (x - a)) *\<^sub>R (x - a)))"
               by (simp add: h)
             also have "\<dots> < e"
               using greater \<open>0 < d\<close> \<open>b1 \<in> Basis\<close> that
               by (intro d) (simp_all add: dist_norm, simp add: field_simps) 
             finally show ?thesis .
           qed
           show ?thesis
             using greater \<open>0 < d\<close> 
             by (rule_tac x = "min r (d * r)" in exI) (auto simp: *)
         qed
         show "\<And>x. x \<in> cball a r \<and> x \<noteq> a \<Longrightarrow> ?g x = ?g' x"
           by auto
       qed
     next
       show "?g ` cball a r \<subseteq> S"
         using greater him \<open>c \<in> S\<close>
         by (force simp: h dist_norm norm_minus_commute)
     next
       show "\<forall>x\<in>sphere a r. ?g x = f x"
         using greater by (auto simp: h dist_norm norm_minus_commute)
     qed
   next
     assume ?rhs
     then obtain g where contg: "continuous_on (cball a r) g"
                     and gim: "g ` cball a r \<subseteq> S"
                     and gf: "\<forall>x \<in> sphere a r. g x = f x"
       by auto
     let ?h = "\<lambda>y. g (a + (fst y) *\<^sub>R (snd y - a))"
     have "continuous_on ({0..1} \<times> sphere a r) ?h"
     proof (rule continuous_on_compose2 [OF contg])
       show "continuous_on ({0..1} \<times> sphere a r) (\<lambda>x. a + fst x *\<^sub>R (snd x - a))"
         by (intro continuous_intros)
       qed (auto simp: dist_norm norm_minus_commute mult_left_le_one_le)
     moreover
     have "?h ` ({0..1} \<times> sphere a r) \<subseteq> S"
       by (auto simp: dist_norm norm_minus_commute mult_left_le_one_le gim [THEN subsetD])
     moreover
     have "\<forall>x\<in>sphere a r. ?h (0, x) = g a" "\<forall>x\<in>sphere a r. ?h (1, x) = f x"
       by (auto simp: dist_norm norm_minus_commute mult_left_le_one_le gf)
     ultimately have "homotopic_with_canon (\<lambda>x. True) (sphere a r) S (\<lambda>x. g a) f"
       by (auto simp: homotopic_with)
     then show ?lhs
       using homotopic_with_symD by blast
   qed
   ultimately
   show ?thesis by meson
 qed 
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Linear_Algebra.thy b/src/HOL/Analysis/Linear_Algebra.thy
--- a/src/HOL/Analysis/Linear_Algebra.thy
+++ b/src/HOL/Analysis/Linear_Algebra.thy
@@ -1,1661 +1,1661 @@
 (*  Title:      HOL/Analysis/Linear_Algebra.thy
     Author:     Amine Chaieb, University of Cambridge
 *)
 
 section \<open>Elementary Linear Algebra on Euclidean Spaces\<close>
 
 theory Linear_Algebra
 imports
   Euclidean_Space
   "HOL-Library.Infinite_Set"
 begin
 
 lemma linear_simps:
   assumes "bounded_linear f"
   shows
     "f (a + b) = f a + f b"
     "f (a - b) = f a - f b"
     "f 0 = 0"
     "f (- a) = - f a"
     "f (s *\<^sub>R v) = s *\<^sub>R (f v)"
 proof -
   interpret f: bounded_linear f by fact
   show "f (a + b) = f a + f b" by (rule f.add)
   show "f (a - b) = f a - f b" by (rule f.diff)
   show "f 0 = 0" by (rule f.zero)
   show "f (- a) = - f a" by (rule f.neg)
   show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scale)
 qed
 
 lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x \<in> (UNIV::'a::finite set)}"
   using finite finite_image_set by blast
 
 lemma substdbasis_expansion_unique:
   includes inner_syntax
   assumes d: "d \<subseteq> Basis"
   shows "(\<Sum>i\<in>d. f i *\<^sub>R i) = (x::'a::euclidean_space) \<longleftrightarrow>
     (\<forall>i\<in>Basis. (i \<in> d \<longrightarrow> f i = x \<bullet> i) \<and> (i \<notin> d \<longrightarrow> x \<bullet> i = 0))"
 proof -
   have *: "\<And>x a b P. x * (if P then a else b) = (if P then x * a else x * b)"
     by auto
   have **: "finite d"
     by (auto intro: finite_subset[OF assms])
   have ***: "\<And>i. i \<in> Basis \<Longrightarrow> (\<Sum>i\<in>d. f i *\<^sub>R i) \<bullet> i = (\<Sum>x\<in>d. if x = i then f x else 0)"
     using d
     by (auto intro!: sum.cong simp: inner_Basis inner_sum_left)
   show ?thesis
     unfolding euclidean_eq_iff[where 'a='a] by (auto simp: sum.delta[OF **] ***)
 qed
 
 lemma independent_substdbasis: "d \<subseteq> Basis \<Longrightarrow> independent d"
   by (rule independent_mono[OF independent_Basis])
 
 lemma subset_translation_eq [simp]:
     fixes a :: "'a::real_vector" shows "(+) a ` s \<subseteq> (+) a ` t \<longleftrightarrow> s \<subseteq> t"
   by auto
 
 lemma translate_inj_on:
   fixes A :: "'a::ab_group_add set"
   shows "inj_on (\<lambda>x. a + x) A"
   unfolding inj_on_def by auto
 
 lemma translation_assoc:
   fixes a b :: "'a::ab_group_add"
   shows "(\<lambda>x. b + x) ` ((\<lambda>x. a + x) ` S) = (\<lambda>x. (a + b) + x) ` S"
   by auto
 
 lemma translation_invert:
   fixes a :: "'a::ab_group_add"
   assumes "(\<lambda>x. a + x) ` A = (\<lambda>x. a + x) ` B"
   shows "A = B"
   using assms translation_assoc by fastforce
 
 lemma translation_galois:
   fixes a :: "'a::ab_group_add"
   shows "T = ((\<lambda>x. a + x) ` S) \<longleftrightarrow> S = ((\<lambda>x. (- a) + x) ` T)"
   by (metis add.right_inverse group_cancel.rule0 translation_invert translation_assoc)
 
 lemma translation_inverse_subset:
   assumes "((\<lambda>x. - a + x) ` V) \<le> (S :: 'n::ab_group_add set)"
   shows "V \<le> ((\<lambda>x. a + x) ` S)"
   by (metis assms subset_image_iff translation_galois)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More interesting properties of the norm\<close>
 
 unbundle inner_syntax
 
 text\<open>Equality of vectors in terms of \<^term>\<open>(\<bullet>)\<close> products.\<close>
 
 lemma linear_componentwise:
   fixes f:: "'a::euclidean_space \<Rightarrow> 'b::real_inner"
   assumes lf: "linear f"
   shows "(f x) \<bullet> j = (\<Sum>i\<in>Basis. (x\<bullet>i) * (f i\<bullet>j))" (is "?lhs = ?rhs")
 proof -
   interpret linear f by fact
   have "?rhs = (\<Sum>i\<in>Basis. (x\<bullet>i) *\<^sub>R (f i))\<bullet>j"
     by (simp add: inner_sum_left)
   then show ?thesis
     by (simp add: euclidean_representation sum[symmetric] scale[symmetric])
 qed
 
 lemma vector_eq: "x = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y \<and> y \<bullet> y = x \<bullet> x"
   by (metis (no_types, opaque_lifting) inner_commute inner_diff_right inner_eq_zero_iff right_minus_eq)
 
 lemma norm_triangle_half_r:
   "norm (y - x1) < e/2 \<Longrightarrow> norm (y - x2) < e/2 \<Longrightarrow> norm (x1 - x2) < e"
   using dist_triangle_half_r unfolding dist_norm[symmetric] by auto
 
 lemma norm_triangle_half_l:
   assumes "norm (x - y) < e/2" and "norm (x' - y) < e/2"
   shows "norm (x - x') < e"
   by (metis assms dist_norm dist_triangle_half_l)
 
 lemma abs_triangle_half_r:
   fixes y :: "'a::linordered_field"
   shows "abs (y - x1) < e/2 \<Longrightarrow> abs (y - x2) < e/2 \<Longrightarrow> abs (x1 - x2) < e"
   by linarith
 
 lemma abs_triangle_half_l:
   fixes y :: "'a::linordered_field"
   assumes "abs (x - y) < e/2" and "abs (x' - y) < e/2"
   shows "abs (x - x') < e"
   using assms by linarith
 
 lemma sum_clauses:
   shows "sum f {} = 0"
     and "finite S \<Longrightarrow> sum f (insert x S) = (if x \<in> S then sum f S else f x + sum f S)"
   by (auto simp add: insert_absorb)
 
 lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = z" and vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = y"
   by (metis inner_commute vector_eq)+
 
 subsection \<open>Substandard Basis\<close>
 
 lemma ex_card:
   assumes "n \<le> card A"
   shows "\<exists>S\<subseteq>A. card S = n"
   by (meson assms obtain_subset_with_card_n)
 
 lemma subspace_substandard: "subspace {x::'a::euclidean_space. (\<forall>i\<in>Basis. P i \<longrightarrow> x\<bullet>i = 0)}"
   by (auto simp: subspace_def inner_add_left)
 
 lemma dim_substandard:
   assumes d: "d \<subseteq> Basis"
   shows "dim {x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0} = card d" (is "dim ?A = _")
 proof (rule dim_unique)
   from d show "d \<subseteq> ?A"
     by (auto simp: inner_Basis)
   from d show "independent d"
     by (rule independent_mono [OF independent_Basis])
   have "x \<in> span d" if "\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0" for x
   proof -
     have "finite d"
       by (rule finite_subset [OF d finite_Basis])
     then have "(\<Sum>i\<in>d. (x \<bullet> i) *\<^sub>R i) \<in> span d"
       by (simp add: span_sum span_clauses)
     also have "(\<Sum>i\<in>d. (x \<bullet> i) *\<^sub>R i) = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i)"
       by (rule sum.mono_neutral_cong_left [OF finite_Basis d]) (auto simp: that)
     finally show "x \<in> span d"
       by (simp only: euclidean_representation)
   qed
   then show "?A \<subseteq> span d" by auto
 qed simp
 
 
 subsection \<open>Orthogonality\<close>
 
 definition\<^marker>\<open>tag important\<close> (in real_inner) "orthogonal x y \<longleftrightarrow> x \<bullet> y = 0"
 
 context real_inner
 begin
 
 lemma orthogonal_self: "orthogonal x x \<longleftrightarrow> x = 0"
   by (simp add: orthogonal_def)
 
 lemma orthogonal_clauses:
   "orthogonal a 0"
   "orthogonal a x \<Longrightarrow> orthogonal a (c *\<^sub>R x)"
   "orthogonal a x \<Longrightarrow> orthogonal a (- x)"
   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x + y)"
   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x - y)"
   "orthogonal 0 a"
   "orthogonal x a \<Longrightarrow> orthogonal (c *\<^sub>R x) a"
   "orthogonal x a \<Longrightarrow> orthogonal (- x) a"
   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x + y) a"
   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x - y) a"
   unfolding orthogonal_def inner_add inner_diff by auto
 
 end
 
 lemma orthogonal_commute: "orthogonal x y \<longleftrightarrow> orthogonal y x"
   by (simp add: orthogonal_def inner_commute)
 
 lemma orthogonal_scaleR [simp]: "c \<noteq> 0 \<Longrightarrow> orthogonal (c *\<^sub>R x) = orthogonal x"
   by (rule ext) (simp add: orthogonal_def)
 
 lemma pairwise_ortho_scaleR:
     "pairwise (\<lambda>i j. orthogonal (f i) (g j)) B
     \<Longrightarrow> pairwise (\<lambda>i j. orthogonal (a i *\<^sub>R f i) (a j *\<^sub>R g j)) B"
   by (auto simp: pairwise_def orthogonal_clauses)
 
 lemma orthogonal_rvsum:
     "\<lbrakk>finite s; \<And>y. y \<in> s \<Longrightarrow> orthogonal x (f y)\<rbrakk> \<Longrightarrow> orthogonal x (sum f s)"
   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
 
 lemma orthogonal_lvsum:
     "\<lbrakk>finite s; \<And>x. x \<in> s \<Longrightarrow> orthogonal (f x) y\<rbrakk> \<Longrightarrow> orthogonal (sum f s) y"
   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
 
 lemma norm_add_Pythagorean:
   assumes "orthogonal a b"
     shows "(norm (a + b))\<^sup>2 = (norm a)\<^sup>2 + (norm b)\<^sup>2"
 proof -
   from assms have "(a - (0 - b)) \<bullet> (a - (0 - b)) = a \<bullet> a - (0 - b \<bullet> b)"
     by (simp add: algebra_simps orthogonal_def inner_commute)
   then show ?thesis
     by (simp add: power2_norm_eq_inner)
 qed
 
 lemma norm_sum_Pythagorean:
   assumes "finite I" "pairwise (\<lambda>i j. orthogonal (f i) (f j)) I"
     shows "(norm (sum f I))\<^sup>2 = (\<Sum>i\<in>I. (norm (f i))\<^sup>2)"
 using assms
 proof (induction I rule: finite_induct)
   case empty then show ?case by simp
 next
   case (insert x I)
   then have "orthogonal (f x) (sum f I)"
     by (metis pairwise_insert orthogonal_rvsum)
   with insert show ?case
     by (simp add: pairwise_insert norm_add_Pythagorean)
 qed
 
 
 subsection  \<open>Orthogonality of a transformation\<close>
 
 definition\<^marker>\<open>tag important\<close>  "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation:
   "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v. norm (f v) = norm v)"
   by (smt (verit, ccfv_threshold) dot_norm linear_add norm_eq_sqrt_inner orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_id [simp]: "orthogonal_transformation (\<lambda>x. x)"
   by (simp add: linear_iff orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_orthogonal_transformation:
     "orthogonal_transformation f \<Longrightarrow> orthogonal (f x) (f y) \<longleftrightarrow> orthogonal x y"
   by (simp add: orthogonal_def orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_compose:
    "\<lbrakk>orthogonal_transformation f; orthogonal_transformation g\<rbrakk> \<Longrightarrow> orthogonal_transformation(f \<circ> g)"
   by (auto simp: orthogonal_transformation_def linear_compose)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_neg:
   "orthogonal_transformation(\<lambda>x. -(f x)) \<longleftrightarrow> orthogonal_transformation f"
   by (auto simp: orthogonal_transformation_def dest: linear_compose_neg)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_scaleR: "orthogonal_transformation f \<Longrightarrow> f (c *\<^sub>R v) = c *\<^sub>R f v"
   by (simp add: linear_iff orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_linear:
    "orthogonal_transformation f \<Longrightarrow> linear f"
   by (simp add: orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_inj:
   "orthogonal_transformation f \<Longrightarrow> inj f"
   unfolding orthogonal_transformation_def inj_on_def
   by (metis vector_eq)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_surj:
   "orthogonal_transformation f \<Longrightarrow> surj f"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (simp add: linear_injective_imp_surjective orthogonal_transformation_inj orthogonal_transformation_linear)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_bij:
   "orthogonal_transformation f \<Longrightarrow> bij f"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (simp add: bij_def orthogonal_transformation_inj orthogonal_transformation_surj)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_inv:
   "orthogonal_transformation f \<Longrightarrow> orthogonal_transformation (inv f)"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (metis (no_types, opaque_lifting) bijection.inv_right bijection_def inj_linear_imp_inv_linear orthogonal_transformation orthogonal_transformation_bij orthogonal_transformation_inj)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_norm:
   "orthogonal_transformation f \<Longrightarrow> norm (f x) = norm x"
   by (metis orthogonal_transformation)
 
 
 subsection \<open>Bilinear functions\<close>
 
 definition\<^marker>\<open>tag important\<close>
 bilinear :: "('a::real_vector \<Rightarrow> 'b::real_vector \<Rightarrow> 'c::real_vector) \<Rightarrow> bool" where
 "bilinear f \<longleftrightarrow> (\<forall>x. linear (\<lambda>y. f x y)) \<and> (\<forall>y. linear (\<lambda>x. f x y))"
 
 lemma bilinear_ladd: "bilinear h \<Longrightarrow> h (x + y) z = h x z + h y z"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_radd: "bilinear h \<Longrightarrow> h x (y + z) = h x y + h x z"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_times:
   fixes c::"'a::real_algebra" shows "bilinear (\<lambda>x y::'a. x*y)"
   by (auto simp: bilinear_def distrib_left distrib_right intro!: linearI)
 
 lemma bilinear_lmul: "bilinear h \<Longrightarrow> h (c *\<^sub>R x) y = c *\<^sub>R h x y"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_rmul: "bilinear h \<Longrightarrow> h x (c *\<^sub>R y) = c *\<^sub>R h x y"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_lneg: "bilinear h \<Longrightarrow> h (- x) y = - h x y"
   by (drule bilinear_lmul [of _ "- 1"]) simp
 
 lemma bilinear_rneg: "bilinear h \<Longrightarrow> h x (- y) = - h x y"
   by (drule bilinear_rmul [of _ _ "- 1"]) simp
 
 lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
   using add_left_imp_eq[of x y 0] by auto
 
 lemma bilinear_lzero:
   assumes "bilinear h"
   shows "h 0 x = 0"
   using bilinear_ladd [OF assms, of 0 0 x] by (simp add: eq_add_iff field_simps)
 
 lemma bilinear_rzero:
   assumes "bilinear h"
   shows "h x 0 = 0"
   using bilinear_radd [OF assms, of x 0 0 ] by (simp add: eq_add_iff field_simps)
 
 lemma bilinear_lsub: "bilinear h \<Longrightarrow> h (x - y) z = h x z - h y z"
   using bilinear_ladd [of h x "- y"] by (simp add: bilinear_lneg)
 
 lemma bilinear_rsub: "bilinear h \<Longrightarrow> h z (x - y) = h z x - h z y"
   using bilinear_radd [of h _ x "- y"] by (simp add: bilinear_rneg)
 
 lemma bilinear_sum:
   assumes "bilinear h"
   shows "h (sum f S) (sum g T) = sum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
 proof -
   interpret l: linear "\<lambda>x. h x y" for y using assms by (simp add: bilinear_def)
   interpret r: linear "\<lambda>y. h x y" for x using assms by (simp add: bilinear_def)
   have "h (sum f S) (sum g T) = sum (\<lambda>x. h (f x) (sum g T)) S"
     by (simp add: l.sum)
   also have "\<dots> = sum (\<lambda>x. sum (\<lambda>y. h (f x) (g y)) T) S"
     by (rule sum.cong) (simp_all add: r.sum)
   finally show ?thesis
     unfolding sum.cartesian_product .
 qed
 
 
 subsection \<open>Adjoints\<close>
 
 definition\<^marker>\<open>tag important\<close> adjoint :: "(('a::real_inner) \<Rightarrow> ('b::real_inner)) \<Rightarrow> 'b \<Rightarrow> 'a" where
 "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
 
 lemma adjoint_unique:
   assumes "\<forall>x y. inner (f x) y = inner x (g y)"
   shows "adjoint f = g"
   unfolding adjoint_def
 proof (rule some_equality)
   show "\<forall>x y. inner (f x) y = inner x (g y)"
     by (rule assms)
 next
   fix h
   assume "\<forall>x y. inner (f x) y = inner x (h y)"
   then show "h = g"
     by (metis assms ext vector_eq_ldot) 
 qed
 
 text \<open>TODO: The following lemmas about adjoints should hold for any
   Hilbert space (i.e. complete inner product space).
   (see \<^url>\<open>https://en.wikipedia.org/wiki/Hermitian_adjoint\<close>)
 \<close>
 
 lemma adjoint_works:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "x \<bullet> adjoint f y = f x \<bullet> y"
 proof -
   interpret linear f by fact
   have "\<forall>y. \<exists>w. \<forall>x. f x \<bullet> y = x \<bullet> w"
   proof (intro allI exI)
     fix y :: "'m" and x
     let ?w = "(\<Sum>i\<in>Basis. (f i \<bullet> y) *\<^sub>R i) :: 'n"
     have "f x \<bullet> y = f (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i) \<bullet> y"
       by (simp add: euclidean_representation)
     also have "\<dots> = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) \<bullet> y"
       by (simp add: sum scale)
     finally show "f x \<bullet> y = x \<bullet> ?w"
       by (simp add: inner_sum_left inner_sum_right mult.commute)
   qed
   then show ?thesis
     unfolding adjoint_def choice_iff
     by (intro someI2_ex[where Q="\<lambda>f'. x \<bullet> f' y = f x \<bullet> y"]) auto
 qed
 
 lemma adjoint_clauses:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "x \<bullet> adjoint f y = f x \<bullet> y"
     and "adjoint f y \<bullet> x = y \<bullet> f x"
   by (simp_all add: adjoint_works[OF lf] inner_commute)
 
 lemma adjoint_linear:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "linear (adjoint f)"
   by (simp add: lf linear_iff euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m]
     adjoint_clauses[OF lf] inner_distrib)
 
 lemma adjoint_adjoint:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "adjoint (adjoint f) = f"
   by (rule adjoint_unique, simp add: adjoint_clauses [OF lf])
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Euclidean Spaces as Typeclass\<close>
 
 lemma independent_Basis: "independent Basis"
   by (rule independent_Basis)
 
 lemma span_Basis [simp]: "span Basis = UNIV"
   by (rule span_Basis)
 
 lemma in_span_Basis: "x \<in> span Basis"
   unfolding span_Basis ..
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Linearity and Bilinearity continued\<close>
 
 lemma linear_bounded:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes lf: "linear f"
   shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
 proof
   interpret linear f by fact
   let ?B = "\<Sum>b\<in>Basis. norm (f b)"
   show "\<forall>x. norm (f x) \<le> ?B * norm x"
   proof
     fix x :: 'a
     let ?g = "\<lambda>b. (x \<bullet> b) *\<^sub>R f b"
     have "norm (f x) = norm (f (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b))"
       unfolding euclidean_representation ..
     also have "\<dots> = norm (sum ?g Basis)"
       by (simp add: sum scale)
     finally have th0: "norm (f x) = norm (sum ?g Basis)" .
     have th: "norm (?g i) \<le> norm (f i) * norm x" if "i \<in> Basis" for i
     proof -
       from Basis_le_norm[OF that, of x]
       show "norm (?g i) \<le> norm (f i) * norm x"
         unfolding norm_scaleR by (metis mult.commute mult_left_mono norm_ge_zero)
     qed
     from sum_norm_le[of _ ?g, OF th]
     show "norm (f x) \<le> ?B * norm x"
       by (simp add: sum_distrib_right th0)
   qed
 qed
 
 lemma linear_conv_bounded_linear:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<longleftrightarrow> bounded_linear f"
   by (metis mult.commute bounded_linear_axioms.intro bounded_linear_def linear_bounded)
 
 lemmas linear_linear = linear_conv_bounded_linear[symmetric]
 
 lemma inj_linear_imp_inv_bounded_linear:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
   shows "\<lbrakk>bounded_linear f; inj f\<rbrakk> \<Longrightarrow> bounded_linear (inv f)"
   by (simp add: inj_linear_imp_inv_linear linear_linear)
 
 lemma linear_bounded_pos:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes lf: "linear f"
  obtains B where "B > 0" "\<And>x. norm (f x) \<le> B * norm x"
   by (metis bounded_linear.pos_bounded lf linear_linear mult.commute)
 
 lemma linear_invertible_bounded_below_pos:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "linear g" and gf: "g \<circ> f = id"
   obtains B where "B > 0" "\<And>x. B * norm x \<le> norm(f x)"
 proof -
   obtain B where "B > 0" and B: "\<And>x. norm (g x) \<le> B * norm x"
     using linear_bounded_pos [OF \<open>linear g\<close>] by blast
   show thesis
   proof
     show "0 < 1/B"
       by (simp add: \<open>B > 0\<close>)
     show "1/B * norm x \<le> norm (f x)" for x
       by (smt (verit, ccfv_SIG) B \<open>0 < B\<close> gf comp_apply divide_inverse id_apply inverse_eq_divide 
               less_divide_eq mult.commute)
   qed
 qed
 
 lemma linear_inj_bounded_below_pos:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
   obtains B where "B > 0" "\<And>x. B * norm x \<le> norm(f x)"
   using linear_injective_left_inverse [OF assms]
     linear_invertible_bounded_below_pos assms by blast
 
 lemma bounded_linearI':
   fixes f ::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>x y. f (x + y) = f x + f y"
     and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
   shows "bounded_linear f"
   using assms linearI linear_conv_bounded_linear by blast
 
 lemma bilinear_bounded:
   fixes h :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'k::real_normed_vector"
   assumes bh: "bilinear h"
   shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
 proof (clarify intro!: exI[of _ "\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)"])
   fix x :: 'm
   fix y :: 'n
   have "norm (h x y) = norm (h (sum (\<lambda>i. (x \<bullet> i) *\<^sub>R i) Basis) (sum (\<lambda>i. (y \<bullet> i) *\<^sub>R i) Basis))"
     by (simp add: euclidean_representation)
   also have "\<dots> = norm (sum (\<lambda> (i,j). h ((x \<bullet> i) *\<^sub>R i) ((y \<bullet> j) *\<^sub>R j)) (Basis \<times> Basis))"
     unfolding bilinear_sum[OF bh] ..
   finally have th: "norm (h x y) = \<dots>" .
   have "\<And>i j. \<lbrakk>i \<in> Basis; j \<in> Basis\<rbrakk>
            \<Longrightarrow> \<bar>x \<bullet> i\<bar> * (\<bar>y \<bullet> j\<bar> * norm (h i j)) \<le> norm x * (norm y * norm (h i j))"
     by (auto simp add: zero_le_mult_iff Basis_le_norm mult_mono)
   then show "norm (h x y) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)) * norm x * norm y"
     unfolding sum_distrib_right th sum.cartesian_product
     by (clarsimp simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh]
       field_simps simp del: scaleR_scaleR intro!: sum_norm_le)
 qed
 
 lemma bilinear_conv_bounded_bilinear:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
 proof
   assume "bilinear h"
   show "bounded_bilinear h"
   proof
     fix x y z
     show "h (x + y) z = h x z + h y z"
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
   next
     fix x y z
     show "h x (y + z) = h x y + h x z"
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
   next
     show "h (scaleR r x) y = scaleR r (h x y)" "h x (scaleR r y) = scaleR r (h x y)" for r x y
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
       by simp_all
   next
     have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
       using \<open>bilinear h\<close> by (rule bilinear_bounded)
     then show "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
       by (simp add: ac_simps)
   qed
 next
   assume "bounded_bilinear h"
   then interpret h: bounded_bilinear h .
   show "bilinear h"
     unfolding bilinear_def linear_conv_bounded_linear
     using h.bounded_linear_left h.bounded_linear_right by simp
 qed
 
 lemma bilinear_bounded_pos:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   assumes bh: "bilinear h"
   shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
   by (metis mult.assoc bh bilinear_conv_bounded_bilinear bounded_bilinear.pos_bounded mult.commute)
 
 lemma bounded_linear_imp_has_derivative: 
   "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
   by (auto simp add: has_derivative_def linear_diff linear_linear linear_def
       dest: bounded_linear.linear)
 
 lemma linear_imp_has_derivative:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> (f has_derivative f) net"
   by (simp add: bounded_linear_imp_has_derivative linear_conv_bounded_linear)
 
 lemma bounded_linear_imp_differentiable: "bounded_linear f \<Longrightarrow> f differentiable net"
   using bounded_linear_imp_has_derivative differentiable_def by blast
 
 lemma linear_imp_differentiable:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> f differentiable net"
   by (metis linear_imp_has_derivative differentiable_def)
 
 lemma of_real_differentiable [simp,derivative_intros]: "of_real differentiable F"
   by (simp add: bounded_linear_imp_differentiable bounded_linear_of_real)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>We continue\<close>
 
 lemma independent_bound:
   fixes S :: "'a::euclidean_space set"
   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> DIM('a)"
   by (metis dim_subset_UNIV finiteI_independent dim_span_eq_card_independent)
 
 lemmas independent_imp_finite = finiteI_independent
 
 corollary\<^marker>\<open>tag unimportant\<close> independent_card_le:
   fixes S :: "'a::euclidean_space set"
   assumes "independent S"
   shows "card S \<le> DIM('a)"
   using assms independent_bound by auto
 
 lemma dependent_biggerset:
   fixes S :: "'a::euclidean_space set"
   shows "(finite S \<Longrightarrow> card S > DIM('a)) \<Longrightarrow> dependent S"
   by (metis independent_bound not_less)
 
 text \<open>Picking an orthogonal replacement for a spanning set.\<close>
 
 lemma vector_sub_project_orthogonal:
   fixes b x :: "'a::euclidean_space"
   shows "b \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *\<^sub>R b) = 0"
   unfolding inner_simps by auto
 
 lemma pairwise_orthogonal_insert:
   assumes "pairwise orthogonal S"
     and "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
   shows "pairwise orthogonal (insert x S)"
   using assms by (auto simp: pairwise_def orthogonal_commute)
 
 lemma basis_orthogonal:
   fixes B :: "'a::real_inner set"
   assumes fB: "finite B"
   shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
   (is " \<exists>C. ?P B C")
   using fB
 proof (induct rule: finite_induct)
   case empty
   then show ?case
     using pairwise_empty by blast
 next
   case (insert a B)
   note fB = \<open>finite B\<close> and aB = \<open>a \<notin> B\<close>
   from \<open>\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C\<close>
   obtain C where C: "finite C" "card C \<le> card B"
     "span C = span B" "pairwise orthogonal C" by blast
   let ?a = "a - sum (\<lambda>x. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x) C"
   let ?C = "insert ?a C"
   from C(1) have fC: "finite ?C"
     by simp
   have cC: "card ?C \<le> card (insert a B)"
     using C aB card_insert_if local.insert(1) by fastforce
   {
     fix x k
     have th0: "\<And>(a::'a) b c. a - (b - c) = c + (a - b)"
       by (simp add: field_simps)
     have "x - k *\<^sub>R (a - (\<Sum>x\<in>C. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x)) \<in> span C \<longleftrightarrow> x - k *\<^sub>R a \<in> span C"
       unfolding scaleR_right_diff_distrib th0
       by (intro span_add_eq span_scale span_sum span_base)
   }
   then have SC: "span ?C = span (insert a B)"
     unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto
   {
     fix y
     assume yC: "y \<in> C"
     then have Cy: "C = insert y (C - {y})"
       by blast
     have fth: "finite (C - {y})"
       using C by simp
     have "y \<noteq> 0 \<Longrightarrow> \<forall>x\<in>C - {y}. x \<bullet> a * (x \<bullet> y) / (x \<bullet> x) = 0"
       using \<open>pairwise orthogonal C\<close>
       by (metis Cy DiffE div_0 insertCI mult_zero_right orthogonal_def pairwise_insert)
     then have "orthogonal ?a y"
       unfolding orthogonal_def
       unfolding inner_diff inner_sum_left right_minus_eq
       unfolding sum.remove [OF \<open>finite C\<close> \<open>y \<in> C\<close>]
       by (auto simp add: sum.neutral inner_commute[of y a])
   }
   with \<open>pairwise orthogonal C\<close> have CPO: "pairwise orthogonal ?C"
     by (rule pairwise_orthogonal_insert)
   from fC cC SC CPO have "?P (insert a B) ?C"
     by blast
   then show ?case by blast
 qed
 
 lemma orthogonal_basis_exists:
   fixes V :: "('a::euclidean_space) set"
   shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (card B = dim V) \<and> pairwise orthogonal B"
 proof -
   from basis_exists[of V] obtain B where
     B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "card B = dim V"
     by force
   from B have fB: "finite B" "card B = dim V"
     using independent_bound by auto
   from basis_orthogonal[OF fB(1)] obtain C where
     C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C"
     by blast
   from C B have CSV: "C \<subseteq> span V"
     by (metis span_superset span_mono subset_trans)
   from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C"
     by (simp add: span_span)
   from C fB have "card C \<le> dim V"
     by simp
   moreover have "dim V \<le> card C"
     using span_card_ge_dim[OF CSV SVC C(1)]
     by simp
   ultimately have "card C = dim V"
     using C(1) by simp
   with C B CSV show ?thesis
     by (metis SVC card_eq_dim dim_span)
 qed
 
 text \<open>Low-dimensional subset is in a hyperplane (weak orthogonal complement).\<close>
 
 lemma span_not_univ_orthogonal:
   fixes S :: "'a::euclidean_space set"
   assumes sU: "span S \<noteq> UNIV"
   shows "\<exists>a::'a. a \<noteq> 0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
 proof -
   from sU obtain a where a: "a \<notin> span S"
     by blast
   from orthogonal_basis_exists obtain B where
     B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "card B = dim S" "pairwise orthogonal B"
     by blast
   from B have fB: "finite B" "card B = dim S"
     using independent_bound by auto
   have sSB: "span S = span B"
     by (simp add: B span_eq)
   let ?a = "a - sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B"
   have "sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B \<in> span S"
     by (simp add: sSB span_base span_mul span_sum)
   with a have a0:"?a  \<noteq> 0"
     by auto
   have "?a \<bullet> x = 0" if "x\<in>span B" for x
   proof (rule span_induct [OF that])
     show "subspace {x. ?a \<bullet> x = 0}"
       by (auto simp add: subspace_def inner_add)
   next
     {
       fix x
       assume x: "x \<in> B"
       from x have B': "B = insert x (B - {x})"
         by blast
       have fth: "finite (B - {x})"
         using fB by simp
       have "(\<Sum>b\<in>B - {x}. a \<bullet> b * (b \<bullet> x) / (b \<bullet> b)) = 0" if "x \<noteq> 0"
         by (smt (verit) B' B(5) DiffD2 divide_eq_0_iff inner_real_def inner_zero_right insertCI orthogonal_def pairwise_insert sum.neutral)
       then have "?a \<bullet> x = 0"
         apply (subst B')
         using fB fth
         unfolding sum_clauses(2)[OF fth]
         by (auto simp add: inner_add_left inner_diff_left inner_sum_left)
     }
     then show "?a \<bullet> x = 0" if "x \<in> B" for x
       using that by blast
     qed
   with a0 sSB show ?thesis
     by blast
 qed
 
 lemma span_not_univ_subset_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes SU: "span S \<noteq> UNIV"
   shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
   using span_not_univ_orthogonal[OF SU] by auto
 
 lemma lowdim_subset_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes d: "dim S < DIM('a)"
   shows "\<exists>a::'a. a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
   using d dim_eq_full nless_le span_not_univ_subset_hyperplane by blast
 
 lemma linear_eq_stdbasis:
   fixes f :: "'a::euclidean_space \<Rightarrow> _"
   assumes lf: "linear f"
     and lg: "linear g"
     and fg: "\<And>b. b \<in> Basis \<Longrightarrow> f b = g b"
   shows "f = g"
   using linear_eq_on_span[OF lf lg, of Basis] fg by auto
 
 
 text \<open>Similar results for bilinear functions.\<close>
 
 lemma bilinear_eq:
   assumes bf: "bilinear f"
     and bg: "bilinear g"
     and SB: "S \<subseteq> span B"
     and TC: "T \<subseteq> span C"
     and "x\<in>S" "y\<in>T"
     and fg: "\<And>x y. \<lbrakk>x \<in> B; y\<in> C\<rbrakk> \<Longrightarrow> f x y = g x y"
   shows "f x y = g x y"
 proof -
   let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
   from bf bg have sp: "subspace ?P"
     unfolding bilinear_def linear_iff subspace_def bf bg
     by (auto simp add: span_zero bilinear_lzero[OF bf] bilinear_lzero[OF bg]
         span_add Ball_def
       intro: bilinear_ladd[OF bf])
   have sfg: "\<And>x. x \<in> B \<Longrightarrow> subspace {a. f x a = g x a}"
     by (auto simp: subspace_def bf bg bilinear_rzero bilinear_radd bilinear_rmul)
   have "\<forall>y\<in> span C. f x y = g x y" if "x \<in> span B" for x
     using span_induct [OF that sp] fg sfg span_induct by blast
   then show ?thesis
     using SB TC assms by auto
 qed
 
 lemma bilinear_eq_stdbasis:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> _"
   assumes bf: "bilinear f"
     and bg: "bilinear g"
     and fg: "\<And>i j. i \<in> Basis \<Longrightarrow> j \<in> Basis \<Longrightarrow> f i j = g i j"
   shows "f = g"
   using bilinear_eq[OF bf bg equalityD2[OF span_Basis] equalityD2[OF span_Basis]] fg by blast
 
 
 subsection \<open>Infinity norm\<close>
 
 definition\<^marker>\<open>tag important\<close> "infnorm (x::'a::euclidean_space) = Sup {\<bar>x \<bullet> b\<bar> |b. b \<in> Basis}"
 
 lemma infnorm_set_image:
   fixes x :: "'a::euclidean_space"
   shows "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} = (\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
   by blast
 
 lemma infnorm_Max:
   fixes x :: "'a::euclidean_space"
   shows "infnorm x = Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis)"
   by (simp add: infnorm_def infnorm_set_image cSup_eq_Max)
 
 lemma infnorm_set_lemma:
   fixes x :: "'a::euclidean_space"
   shows "finite {\<bar>x \<bullet> i\<bar> |i. i \<in> Basis}"
     and "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} \<noteq> {}"
   unfolding infnorm_set_image by auto
 
 lemma infnorm_pos_le:
   fixes x :: "'a::euclidean_space"
   shows "0 \<le> infnorm x"
   by (simp add: infnorm_Max Max_ge_iff ex_in_conv)
 
 lemma infnorm_triangle:
   fixes x :: "'a::euclidean_space"
   shows "infnorm (x + y) \<le> infnorm x + infnorm y"
 proof -
   have *: "\<And>a b c d :: real. \<bar>a\<bar> \<le> c \<Longrightarrow> \<bar>b\<bar> \<le> d \<Longrightarrow> \<bar>a + b\<bar> \<le> c + d"
     by simp
   show ?thesis
     by (auto simp: infnorm_Max inner_add_left intro!: *)
 qed
 
 lemma infnorm_eq_0:
   fixes x :: "'a::euclidean_space"
   shows "infnorm x = 0 \<longleftrightarrow> x = 0"
 proof -
   have "infnorm x \<le> 0 \<longleftrightarrow> x = 0"
     unfolding infnorm_Max by (simp add: euclidean_all_zero_iff)
   then show ?thesis
     using infnorm_pos_le[of x] by simp
 qed
 
 lemma infnorm_0: "infnorm 0 = 0"
   by (simp add: infnorm_eq_0)
 
 lemma infnorm_neg: "infnorm (- x) = infnorm x"
   unfolding infnorm_def by simp
 
 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
   by (metis infnorm_neg minus_diff_eq)
 
 lemma absdiff_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
   by (smt (verit, del_insts) diff_add_cancel infnorm_sub infnorm_triangle)
 
 lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
   using infnorm_pos_le[of x] by arith
 
 lemma Basis_le_infnorm:
   fixes x :: "'a::euclidean_space"
   shows "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> infnorm x"
   by (simp add: infnorm_Max)
 
 lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
   unfolding infnorm_Max
 proof (safe intro!: Max_eqI)
   let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
   { fix b :: 'a
     assume "b \<in> Basis"
     then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
       by (simp add: abs_mult mult_left_mono)
   next
     from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
       by (auto simp del: Max_in)
     then show "\<bar>a\<bar> * Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis) \<in> (\<lambda>i. \<bar>a *\<^sub>R x \<bullet> i\<bar>) ` Basis"
       by (intro image_eqI[where x=b]) (auto simp: abs_mult)
   }
 qed simp
 
 lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \<le> \<bar>a\<bar> * infnorm x"
   unfolding infnorm_mul ..
 
 lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
   using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
 
 text \<open>Prove that it differs only up to a bound from Euclidean norm.\<close>
 
 lemma infnorm_le_norm: "infnorm x \<le> norm x"
   by (simp add: Basis_le_norm infnorm_Max)
 
 lemma norm_le_infnorm:
   fixes x :: "'a::euclidean_space"
   shows "norm x \<le> sqrt DIM('a) * infnorm x"
   unfolding norm_eq_sqrt_inner id_def
-proof (rule real_le_lsqrt[OF inner_ge_zero])
+proof (rule real_le_lsqrt)
   show "sqrt DIM('a) * infnorm x \<ge> 0"
     by (simp add: zero_le_mult_iff infnorm_pos_le)
   have "x \<bullet> x \<le> (\<Sum>b\<in>Basis. x \<bullet> b * (x \<bullet> b))"
     by (metis euclidean_inner order_refl)
   also have "\<dots> \<le> DIM('a) * \<bar>infnorm x\<bar>\<^sup>2"
     by (rule sum_bounded_above) (metis Basis_le_infnorm abs_le_square_iff power2_eq_square real_abs_infnorm)
   also have "\<dots> \<le> (sqrt DIM('a) * infnorm x)\<^sup>2"
     by (simp add: power_mult_distrib)
   finally show "x \<bullet> x \<le> (sqrt DIM('a) * infnorm x)\<^sup>2" .
 qed
 
 lemma tendsto_infnorm [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F"
   shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
 proof (rule tendsto_compose [OF LIM_I assms])
   fix r :: real
   assume "r > 0"
   then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
     by (metis real_norm_def le_less_trans absdiff_infnorm infnorm_le_norm)
 qed
 
 text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
 
 lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "x=0")
   case True
   then show ?thesis
     by auto
 next
   case False 
   from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
   have "?rhs \<longleftrightarrow>
       (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
         norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) = 0)"
     using False unfolding inner_simps
     by (auto simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
   also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)"
     using False  by (simp add: field_simps inner_commute)
   also have "\<dots> \<longleftrightarrow> ?lhs"
     using False by auto
   finally show ?thesis by metis
 qed
 
 lemma norm_cauchy_schwarz_abs_eq:
   "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
     norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
   using norm_cauchy_schwarz_eq [symmetric, of x y]
   using norm_cauchy_schwarz_eq [symmetric, of "-x" y] Cauchy_Schwarz_ineq2 [of x y]
   by auto
 
 lemma norm_triangle_eq:
   fixes x y :: "'a::real_inner"
   shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
 proof (cases "x = 0 \<or> y = 0")
   case True
   then show ?thesis
     by force
 next
   case False
   then have n: "norm x > 0" "norm y > 0"
     by auto
   have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
     by simp
   also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
     by (smt (verit, best) dot_norm inner_real_def inner_simps norm_cauchy_schwarz_eq power2_eq_square)
   finally show ?thesis .
 qed
 
 lemma dist_triangle_eq:
   fixes x y z :: "'a::real_inner"
   shows "dist x z = dist x y + dist y z \<longleftrightarrow>
     norm (x - y) *\<^sub>R (y - z) = norm (y - z) *\<^sub>R (x - y)"
   by (metis (no_types, lifting) add_diff_eq diff_add_cancel dist_norm norm_triangle_eq)
 
 subsection \<open>Collinearity\<close>
 
 definition\<^marker>\<open>tag important\<close> collinear :: "'a::real_vector set \<Rightarrow> bool"
   where "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u)"
 
 lemma collinear_alt:
      "collinear S \<longleftrightarrow> (\<exists>u v. \<forall>x \<in> S. \<exists>c. x = u + c *\<^sub>R v)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding collinear_def by (metis add.commute diff_add_cancel)
 next
   assume ?rhs
   then obtain u v where *: "\<And>x. x \<in> S \<Longrightarrow> \<exists>c. x = u + c *\<^sub>R v"
     by auto
   have "\<exists>c. x - y = c *\<^sub>R v" if "x \<in> S" "y \<in> S" for x y
         by (metis *[OF \<open>x \<in> S\<close>] *[OF \<open>y \<in> S\<close>] scaleR_left.diff add_diff_cancel_left)
   then show ?lhs
     using collinear_def by blast
 qed
 
 lemma collinear:
   fixes S :: "'a::{perfect_space,real_vector} set"
   shows "collinear S \<longleftrightarrow> (\<exists>u. u \<noteq> 0 \<and> (\<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u))"
 proof -
   have "\<exists>v. v \<noteq> 0 \<and> (\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R v)"
     if "\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R u" "u=0" for u
   proof -
     have "\<forall>x\<in>S. \<forall>y\<in>S. x = y"
       using that by auto
     moreover
     obtain v::'a where "v \<noteq> 0"
       using UNIV_not_singleton [of 0] by auto
     ultimately have "\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R v"
       by auto
     then show ?thesis
       using \<open>v \<noteq> 0\<close> by blast
   qed
   then show ?thesis
     by (metis collinear_def)
 qed
 
 lemma collinear_subset: "\<lbrakk>collinear T; S \<subseteq> T\<rbrakk> \<Longrightarrow> collinear S"
   by (meson collinear_def subsetCE)
 
 lemma collinear_empty [iff]: "collinear {}"
   by (simp add: collinear_def)
 
 lemma collinear_sing [iff]: "collinear {x}"
   by (simp add: collinear_def)
 
 lemma collinear_2 [iff]: "collinear {x, y}"
   by (simp add: collinear_def) (metis minus_diff_eq scaleR_left.minus scaleR_one)
 
 lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "x = 0 \<or> y = 0")
   case True
   then show ?thesis
     by (auto simp: insert_commute)
 next
   case False
   show ?thesis
   proof
     assume h: "?lhs"
     then obtain u where u: "\<forall> x\<in> {0,x,y}. \<forall>y\<in> {0,x,y}. \<exists>c. x - y = c *\<^sub>R u"
       unfolding collinear_def by blast
     from u[rule_format, of x 0] u[rule_format, of y 0]
     obtain cx and cy where
       cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
       by auto
     from cx cy False have cx0: "cx \<noteq> 0" and cy0: "cy \<noteq> 0" by auto
     let ?d = "cy / cx"
     from cx cy cx0 have "y = ?d *\<^sub>R x"
       by simp
     then show ?rhs using False by blast
   next
     assume h: "?rhs"
     then obtain c where c: "y = c *\<^sub>R x"
       using False by blast
     show ?lhs
       apply (simp add: collinear_def c)
       by (metis (mono_tags, lifting) scaleR_left.minus scaleR_left_diff_distrib scaleR_one)
   qed
 qed
 
 lemma collinear_iff_Reals: "collinear {0::complex,w,z} \<longleftrightarrow> z/w \<in> \<real>"
 proof
   show "z/w \<in> \<real> \<Longrightarrow> collinear {0,w,z}"
     by (metis Reals_cases collinear_lemma nonzero_divide_eq_eq scaleR_conv_of_real)
 qed (auto simp: collinear_lemma scaleR_conv_of_real)
 
 lemma collinear_scaleR_iff: "collinear {0, \<alpha> *\<^sub>R w, \<beta> *\<^sub>R z} \<longleftrightarrow> collinear {0,w,z} \<or> \<alpha>=0 \<or> \<beta>=0"
   (is "?lhs = ?rhs")
 proof (cases "\<alpha>=0 \<or> \<beta>=0")
   case False
   then have "(\<exists>c. \<beta> *\<^sub>R z = (c * \<alpha>) *\<^sub>R w) = (\<exists>c. z = c *\<^sub>R w)"
     by (metis mult.commute scaleR_scaleR vector_fraction_eq_iff)
   then show ?thesis
     by (auto simp add: collinear_lemma)
 qed (auto simp: collinear_lemma)
 
 lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
 proof (cases "x=0")
   case True
   then show ?thesis
     by (auto simp: insert_commute)
 next
   case False
   then have nnz: "norm x \<noteq> 0"
     by auto
   show ?thesis
   proof
     assume "\<bar>x \<bullet> y\<bar> = norm x * norm y"
     then show "collinear {0, x, y}"
       unfolding norm_cauchy_schwarz_abs_eq collinear_lemma
       by (meson eq_vector_fraction_iff nnz)
   next
     assume "collinear {0, x, y}"
     with False show "\<bar>x \<bullet> y\<bar> = norm x * norm y"
       unfolding norm_cauchy_schwarz_abs_eq collinear_lemma  by (auto simp: abs_if)
   qed
 qed
 
 lemma norm_triangle_eq_imp_collinear:
   fixes x y :: "'a::real_inner"
   assumes "norm (x + y) = norm x + norm y"
   shows "collinear{0,x,y}"
   using assms norm_cauchy_schwarz_abs_eq norm_cauchy_schwarz_equal norm_triangle_eq 
   by blast
 
 
 subsection\<open>Properties of special hyperplanes\<close>
 
 lemma subspace_hyperplane: "subspace {x. a \<bullet> x = 0}"
   by (simp add: subspace_def inner_right_distrib)
 
 lemma subspace_hyperplane2: "subspace {x. x \<bullet> a = 0}"
   by (simp add: inner_commute inner_right_distrib subspace_def)
 
 lemma special_hyperplane_span:
   fixes S :: "'n::euclidean_space set"
   assumes "k \<in> Basis"
   shows "{x. k \<bullet> x = 0} = span (Basis - {k})"
 proof -
   have *: "x \<in> span (Basis - {k})" if "k \<bullet> x = 0" for x
   proof -
     have "x = (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b)"
       by (simp add: euclidean_representation)
     also have "\<dots> = (\<Sum>b \<in> Basis - {k}. (x \<bullet> b) *\<^sub>R b)"
       by (auto simp: sum.remove [of _ k] inner_commute assms that)
     finally have "x = (\<Sum>b\<in>Basis - {k}. (x \<bullet> b) *\<^sub>R b)" .
     then show ?thesis
       by (simp add: span_finite)
   qed
   show ?thesis
     apply (rule span_subspace [symmetric])
     using assms
     apply (auto simp: inner_not_same_Basis intro: * subspace_hyperplane)
     done
 qed
 
 lemma dim_special_hyperplane:
   fixes k :: "'n::euclidean_space"
   shows "k \<in> Basis \<Longrightarrow> dim {x. k \<bullet> x = 0} = DIM('n) - 1"
   by (metis Diff_subset card_Diff_singleton indep_card_eq_dim_span independent_substdbasis special_hyperplane_span)
 
 proposition dim_hyperplane:
   fixes a :: "'a::euclidean_space"
   assumes "a \<noteq> 0"
     shows "dim {x. a \<bullet> x = 0} = DIM('a) - 1"
 proof -
   have span0: "span {x. a \<bullet> x = 0} = {x. a \<bullet> x = 0}"
     by (rule span_unique) (auto simp: subspace_hyperplane)
   then obtain B where "independent B"
               and Bsub: "B \<subseteq> {x. a \<bullet> x = 0}"
               and subspB: "{x. a \<bullet> x = 0} \<subseteq> span B"
               and card0: "(card B = dim {x. a \<bullet> x = 0})"
               and ortho: "pairwise orthogonal B"
     using orthogonal_basis_exists by metis
   with assms have "a \<notin> span B"
     by (metis (mono_tags, lifting) span_eq inner_eq_zero_iff mem_Collect_eq span0)
   then have ind: "independent (insert a B)"
     by (simp add: \<open>independent B\<close> independent_insert)
   have "finite B"
     using \<open>independent B\<close> independent_bound by blast
   have "UNIV \<subseteq> span (insert a B)"
   proof fix y::'a
     obtain r z where "y = r *\<^sub>R a + z" "a \<bullet> z = 0"
       by (metis add.commute diff_add_cancel vector_sub_project_orthogonal)
     then show "y \<in> span (insert a B)"
       by (metis (mono_tags, lifting) Bsub add_diff_cancel_left'
           mem_Collect_eq span0 span_breakdown_eq span_eq subspB)
   qed
   then have "DIM('a) = dim(insert a B)"
     by (metis independent_Basis span_Basis dim_eq_card top.extremum_uniqueI)
   then show ?thesis
     by (metis One_nat_def \<open>a \<notin> span B\<close> \<open>finite B\<close> card0 card_insert_disjoint 
         diff_Suc_Suc diff_zero dim_eq_card_independent ind span_base)
 qed
 
 lemma lowdim_eq_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes "dim S = DIM('a) - 1"
   obtains a where "a \<noteq> 0" and "span S = {x. a \<bullet> x = 0}"
 proof -
   obtain b where b: "b \<noteq> 0" "span S \<subseteq> {a. b \<bullet> a = 0}"
     by (metis DIM_positive assms diff_less zero_less_one lowdim_subset_hyperplane)
   then show ?thesis
     by (metis assms dim_hyperplane dim_span dim_subset subspace_dim_equal subspace_hyperplane subspace_span that)
 qed
 
 lemma dim_eq_hyperplane:
   fixes S :: "'n::euclidean_space set"
   shows "dim S = DIM('n) - 1 \<longleftrightarrow> (\<exists>a. a \<noteq> 0 \<and> span S = {x. a \<bullet> x = 0})"
 by (metis One_nat_def dim_hyperplane dim_span lowdim_eq_hyperplane)
 
 
 subsection\<open> Orthogonal bases and Gram-Schmidt process\<close>
 
 lemma pairwise_orthogonal_independent:
   assumes "pairwise orthogonal S" and "0 \<notin> S"
     shows "independent S"
 proof -
   have 0: "\<And>x y. \<lbrakk>x \<noteq> y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using assms by (simp add: pairwise_def orthogonal_def)
   have "False" if "a \<in> S" and a: "a \<in> span (S - {a})" for a
   proof -
     obtain T U where "T \<subseteq> S - {a}" "a = (\<Sum>v\<in>T. U v *\<^sub>R v)"
       using a by (force simp: span_explicit)
     then have "a \<bullet> a = a \<bullet> (\<Sum>v\<in>T. U v *\<^sub>R v)"
       by simp
     also have "\<dots> = 0"
       apply (simp add: inner_sum_right)
       by (smt (verit) "0" DiffE \<open>T \<subseteq> S - {a}\<close> in_mono insertCI mult_not_zero sum.neutral that(1))
     finally show ?thesis
       using \<open>0 \<notin> S\<close> \<open>a \<in> S\<close> by auto
   qed
   then show ?thesis
     by (force simp: dependent_def)
 qed
 
 lemma pairwise_orthogonal_imp_finite:
   fixes S :: "'a::euclidean_space set"
   assumes "pairwise orthogonal S"
     shows "finite S"
   by (metis Set.set_insert assms finite_insert independent_bound pairwise_insert 
             pairwise_orthogonal_independent)
 
 lemma subspace_orthogonal_to_vector: "subspace {y. orthogonal x y}"
   by (simp add: subspace_def orthogonal_clauses)
 
 lemma subspace_orthogonal_to_vectors: "subspace {y. \<forall>x \<in> S. orthogonal x y}"
   by (simp add: subspace_def orthogonal_clauses)
 
 lemma orthogonal_to_span:
   assumes a: "a \<in> span S" and x: "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
     shows "orthogonal x a"
   by (metis a orthogonal_clauses(1,2,4)
       span_induct_alt x)
 
 proposition Gram_Schmidt_step:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S" and x: "x \<in> span S"
     shows "orthogonal x (a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b))"
 proof -
   have "finite S"
     by (simp add: S pairwise_orthogonal_imp_finite)
   have "orthogonal (a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)) x"
        if "x \<in> S" for x
   proof -
     have "a \<bullet> x = (\<Sum>y\<in>S. if y = x then y \<bullet> a else 0)"
       by (simp add: \<open>finite S\<close> inner_commute that)
     also have "\<dots> =  (\<Sum>b\<in>S. b \<bullet> a * (b \<bullet> x) / (b \<bullet> b))"
       apply (rule sum.cong [OF refl], simp)
       by (meson S orthogonal_def pairwise_def that)
    finally show ?thesis
      by (simp add: orthogonal_def algebra_simps inner_sum_left)
   qed
   then show ?thesis
     using orthogonal_to_span orthogonal_commute x by blast
 qed
 
 
 lemma orthogonal_extension_aux:
   fixes S :: "'a::euclidean_space set"
   assumes "finite T" "finite S" "pairwise orthogonal S"
     shows "\<exists>U. pairwise orthogonal (S \<union> U) \<and> span (S \<union> U) = span (S \<union> T)"
 using assms
 proof (induction arbitrary: S)
   case empty then show ?case
     by simp (metis sup_bot_right)
 next
   case (insert a T)
   have 0: "\<And>x y. \<lbrakk>x \<noteq> y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using insert by (simp add: pairwise_def orthogonal_def)
   define a' where "a' = a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)"
   obtain U where orthU: "pairwise orthogonal (S \<union> insert a' U)"
              and spanU: "span (insert a' S \<union> U) = span (insert a' S \<union> T)"
     by (rule exE [OF insert.IH [of "insert a' S"]])
       (auto simp: Gram_Schmidt_step a'_def insert.prems orthogonal_commute
         pairwise_orthogonal_insert span_clauses)
   have orthS: "\<And>x. x \<in> S \<Longrightarrow> a' \<bullet> x = 0"
     using Gram_Schmidt_step a'_def insert.prems orthogonal_commute orthogonal_def span_base by blast
   have "span (S \<union> insert a' U) = span (insert a' (S \<union> T))"
     using spanU by simp
   also have "\<dots> = span (insert a (S \<union> T))"
     by (simp add: a'_def span_neg span_sum span_base span_mul eq_span_insert_eq)
   also have "\<dots> = span (S \<union> insert a T)"
     by simp
   finally show ?case
     using orthU by blast
 qed
 
 
 proposition orthogonal_extension:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S"
   obtains U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)"
 proof -
   obtain B where "finite B" "span B = span T"
     using basis_subspace_exists [of "span T"] subspace_span by metis
   with orthogonal_extension_aux [of B S]
   obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> B)"
     using assms pairwise_orthogonal_imp_finite by auto
   with \<open>span B = span T\<close> show ?thesis
     by (rule_tac U=U in that) (auto simp: span_Un)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_extension_strong:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S"
   obtains U where "U \<inter> (insert 0 S) = {}" "pairwise orthogonal (S \<union> U)"
                   "span (S \<union> U) = span (S \<union> T)"
 proof -
   obtain U where U: "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)"
     using orthogonal_extension assms by blast
   moreover have "pairwise orthogonal (S \<union> (U - insert 0 S))"
     by (smt (verit, best) Un_Diff_Int Un_iff U pairwise_def)
   ultimately show ?thesis
     by (metis Diff_disjoint Un_Diff_cancel Un_insert_left inf_commute span_insert_0 that)
 qed
 
 subsection\<open>Decomposing a vector into parts in orthogonal subspaces\<close>
 
 text\<open>existence of orthonormal basis for a subspace.\<close>
 
 lemma orthogonal_spanningset_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "B \<subseteq> S" "pairwise orthogonal B" "span B = S"
   by (metis assms basis_orthogonal basis_subspace_exists span_eq)
 
 lemma orthogonal_basis_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "0 \<notin> B" "B \<subseteq> S" "pairwise orthogonal B" "independent B"
                   "card B = dim S" "span B = S"
   by (metis assms dependent_zero orthogonal_basis_exists span_eq span_eq_iff)
 
 proposition orthonormal_basis_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "B \<subseteq> S" "pairwise orthogonal B"
               and "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
               and "independent B" "card B = dim S" "span B = S"
 proof -
   obtain B where "0 \<notin> B" "B \<subseteq> S"
              and orth: "pairwise orthogonal B"
              and "independent B" "card B = dim S" "span B = S"
     by (blast intro: orthogonal_basis_subspace [OF assms])
   have 1: "(\<lambda>x. x /\<^sub>R norm x) ` B \<subseteq> S"
     using \<open>span B = S\<close> span_superset span_mul by fastforce
   have 2: "pairwise orthogonal ((\<lambda>x. x /\<^sub>R norm x) ` B)"
     using orth by (force simp: pairwise_def orthogonal_clauses)
   have 3: "\<And>x. x \<in> (\<lambda>x. x /\<^sub>R norm x) ` B \<Longrightarrow> norm x = 1"
     by (metis (no_types, lifting) \<open>0 \<notin> B\<close> image_iff norm_sgn sgn_div_norm)
   have 4: "independent ((\<lambda>x. x /\<^sub>R norm x) ` B)"
     by (metis "2" "3" norm_zero pairwise_orthogonal_independent zero_neq_one)
   have "inj_on (\<lambda>x. x /\<^sub>R norm x) B"
   proof
     fix x y
     assume "x \<in> B" "y \<in> B" "x /\<^sub>R norm x = y /\<^sub>R norm y"
     moreover have "\<And>i. i \<in> B \<Longrightarrow> norm (i /\<^sub>R norm i) = 1"
       using 3 by blast
     ultimately show "x = y"
       by (metis norm_eq_1 orth orthogonal_clauses(7) orthogonal_commute orthogonal_def pairwise_def zero_neq_one)
   qed
   then have 5: "card ((\<lambda>x. x /\<^sub>R norm x) ` B) = dim S"
     by (metis \<open>card B = dim S\<close> card_image)
   have 6: "span ((\<lambda>x. x /\<^sub>R norm x) ` B) = S"
     by (metis "1" "4" "5" assms card_eq_dim independent_imp_finite span_subspace)
   show ?thesis
     by (rule that [OF 1 2 3 4 5 6])
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> orthogonal_to_subspace_exists_gen:
   fixes S :: "'a :: euclidean_space set"
   assumes "span S \<subset> span T"
   obtains x where "x \<noteq> 0" "x \<in> span T" "\<And>y. y \<in> span S \<Longrightarrow> orthogonal x y"
 proof -
   obtain B where "B \<subseteq> span S" and orthB: "pairwise orthogonal B"
              and "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "card B = dim S" "span B = span S"
     by (metis dim_span orthonormal_basis_subspace subspace_span)
   with assms obtain u where spanBT: "span B \<subseteq> span T" and "u \<notin> span B" "u \<in> span T"
     by auto
   obtain C where orthBC: "pairwise orthogonal (B \<union> C)" and spanBC: "span (B \<union> C) = span (B \<union> {u})"
     by (blast intro: orthogonal_extension [OF orthB])
   show thesis
   proof (cases "C \<subseteq> insert 0 B")
     case True
     then have "C \<subseteq> span B"
       using span_eq
       by (metis span_insert_0 subset_trans)
     moreover have "u \<in> span (B \<union> C)"
       using \<open>span (B \<union> C) = span (B \<union> {u})\<close> span_superset by force
     ultimately show ?thesis
       using True \<open>u \<notin> span B\<close>
       by (metis Un_insert_left span_insert_0 sup.orderE)
   next
     case False
     then obtain x where "x \<in> C" "x \<noteq> 0" "x \<notin> B"
       by blast
     then have "x \<in> span T"
       by (smt (verit, ccfv_SIG) Set.set_insert  \<open>u \<in> span T\<close> empty_subsetI insert_subset 
           le_sup_iff spanBC spanBT span_mono span_span span_superset subset_trans)
     moreover have "orthogonal x y" if "y \<in> span B" for y
       using that
     proof (rule span_induct)
       show "subspace {a. orthogonal x a}"
         by (simp add: subspace_orthogonal_to_vector)
       show "\<And>b. b \<in> B \<Longrightarrow> orthogonal x b"
         by (metis Un_iff \<open>x \<in> C\<close> \<open>x \<notin> B\<close> orthBC pairwise_def)
     qed
     ultimately show ?thesis
       using \<open>x \<noteq> 0\<close> that \<open>span B = span S\<close> by auto
   qed
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_to_subspace_exists:
   fixes S :: "'a :: euclidean_space set"
   assumes "dim S < DIM('a)"
   obtains x where "x \<noteq> 0" "\<And>y. y \<in> span S \<Longrightarrow> orthogonal x y"
 proof -
   have "span S \<subset> UNIV"
     by (metis assms dim_eq_full order_less_imp_not_less top.not_eq_extremum)
   with orthogonal_to_subspace_exists_gen [of S UNIV] that show ?thesis
     by (auto)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_to_vector_exists:
   fixes x :: "'a :: euclidean_space"
   assumes "2 \<le> DIM('a)"
   obtains y where "y \<noteq> 0" "orthogonal x y"
 proof -
   have "dim {x} < DIM('a)"
     using assms by auto
   then show thesis
     by (rule orthogonal_to_subspace_exists) (simp add: orthogonal_commute span_base that)
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> orthogonal_subspace_decomp_exists:
   fixes S :: "'a :: euclidean_space set"
   obtains y z
   where "y \<in> span S"
     and "\<And>w. w \<in> span S \<Longrightarrow> orthogonal z w"
     and "x = y + z"
 proof -
   obtain T where "0 \<notin> T" "T \<subseteq> span S" "pairwise orthogonal T" "independent T"
     "card T = dim (span S)" "span T = span S"
     using orthogonal_basis_subspace subspace_span by blast
   let ?a = "\<Sum>b\<in>T. (b \<bullet> x / (b \<bullet> b)) *\<^sub>R b"
   have orth: "orthogonal (x - ?a) w" if "w \<in> span S" for w
     by (simp add: Gram_Schmidt_step \<open>pairwise orthogonal T\<close> \<open>span T = span S\<close>
         orthogonal_commute that)
   with that[of ?a "x-?a"] \<open>T \<subseteq> span S\<close> show ?thesis
     by (simp add: span_mul span_sum subsetD)
 qed
 
 lemma orthogonal_subspace_decomp_unique:
   fixes S :: "'a :: euclidean_space set"
   assumes "x + y = x' + y'"
       and ST: "x \<in> span S" "x' \<in> span S" "y \<in> span T" "y' \<in> span T"
       and orth: "\<And>a b. \<lbrakk>a \<in> S; b \<in> T\<rbrakk> \<Longrightarrow> orthogonal a b"
   shows "x = x' \<and> y = y'"
 proof -
   have "x + y - y' = x'"
     by (simp add: assms)
   moreover have "\<And>a b. \<lbrakk>a \<in> span S; b \<in> span T\<rbrakk> \<Longrightarrow> orthogonal a b"
     by (meson orth orthogonal_commute orthogonal_to_span)
   ultimately have "0 = x' - x"
     using assms
     by (metis add.commute add_diff_cancel_right' diff_right_commute orthogonal_self span_diff)
   with assms show ?thesis by auto
 qed
 
 lemma vector_in_orthogonal_spanningset:
   fixes a :: "'a::euclidean_space"
   obtains S where "a \<in> S" "pairwise orthogonal S" "span S = UNIV"
   by (metis UnI1 Un_UNIV_right insertI1 orthogonal_extension pairwise_singleton span_UNIV)
 
 lemma vector_in_orthogonal_basis:
   fixes a :: "'a::euclidean_space"
   assumes "a \<noteq> 0"
   obtains S where "a \<in> S" "0 \<notin> S" "pairwise orthogonal S" "independent S" "finite S"
                   "span S = UNIV" "card S = DIM('a)"
 proof -
   obtain S where S: "a \<in> S" "pairwise orthogonal S" "span S = UNIV"
     using vector_in_orthogonal_spanningset .
   show thesis
   proof
     show "pairwise orthogonal (S - {0})"
       using pairwise_mono S(2) by blast
     show "independent (S - {0})"
       by (simp add: \<open>pairwise orthogonal (S - {0})\<close> pairwise_orthogonal_independent)
     show "finite (S - {0})"
       using \<open>independent (S - {0})\<close> independent_imp_finite by blast
     show "card (S - {0}) = DIM('a)"
       using span_delete_0 [of S] S
       by (simp add: \<open>independent (S - {0})\<close> indep_card_eq_dim_span)
   qed (use S \<open>a \<noteq> 0\<close> in auto)
 qed
 
 lemma vector_in_orthonormal_basis:
   fixes a :: "'a::euclidean_space"
   assumes "norm a = 1"
   obtains S where "a \<in> S" "pairwise orthogonal S" "\<And>x. x \<in> S \<Longrightarrow> norm x = 1"
     "independent S" "card S = DIM('a)" "span S = UNIV"
 proof -
   have "a \<noteq> 0"
     using assms by auto
   then obtain S where "a \<in> S" "0 \<notin> S" "finite S"
           and S: "pairwise orthogonal S" "independent S" "span S = UNIV" "card S = DIM('a)"
     by (metis vector_in_orthogonal_basis)
   let ?S = "(\<lambda>x. x /\<^sub>R norm x) ` S"
   show thesis
   proof
     show "a \<in> ?S"
       using \<open>a \<in> S\<close> assms image_iff by fastforce
   next
     show "pairwise orthogonal ?S"
       using \<open>pairwise orthogonal S\<close> by (auto simp: pairwise_def orthogonal_def)
     show "\<And>x. x \<in> (\<lambda>x. x /\<^sub>R norm x) ` S \<Longrightarrow> norm x = 1"
       using \<open>0 \<notin> S\<close> by (auto simp: field_split_simps)
     then show ind: "independent ?S"
       by (metis \<open>pairwise orthogonal ((\<lambda>x. x /\<^sub>R norm x) ` S)\<close> norm_zero pairwise_orthogonal_independent zero_neq_one)
     have "inj_on (\<lambda>x. x /\<^sub>R norm x) S"
       unfolding inj_on_def
       by (metis (full_types) S(1) \<open>0 \<notin> S\<close> inverse_nonzero_iff_nonzero norm_eq_zero orthogonal_scaleR orthogonal_self pairwise_def)
     then show "card ?S = DIM('a)"
       by (simp add: card_image S)
     then show "span ?S = UNIV"
       by (metis ind dim_eq_card dim_eq_full)
   qed
 qed
 
 proposition dim_orthogonal_sum:
   fixes A :: "'a::euclidean_space set"
   assumes "\<And>x y. \<lbrakk>x \<in> A; y \<in> B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     shows "dim(A \<union> B) = dim A + dim B"
 proof -
   have 1: "\<And>x y. \<lbrakk>x \<in> span A; y \<in> B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     by (erule span_induct [OF _ subspace_hyperplane2]; simp add: assms)
   have "\<And>x y. \<lbrakk>x \<in> span A; y \<in> span B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using 1 by (simp add: span_induct [OF _ subspace_hyperplane])
   then have 0: "\<And>x y. \<lbrakk>x \<in> span A; y \<in> span B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     by simp
   have "dim(A \<union> B) = dim (span (A \<union> B))"
     by (simp)
   also have "span (A \<union> B) = ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
     by (auto simp add: span_Un image_def)
   also have "dim \<dots> = dim {x + y |x y. x \<in> span A \<and> y \<in> span B}"
     by (auto intro!: arg_cong [where f=dim])
   also have "\<dots> = dim {x + y |x y. x \<in> span A \<and> y \<in> span B} + dim(span A \<inter> span B)"
     by (auto dest: 0)
   also have "\<dots> = dim A + dim B"
     using dim_sums_Int by fastforce
   finally show ?thesis .
 qed
 
 lemma dim_subspace_orthogonal_to_vectors:
   fixes A :: "'a::euclidean_space set"
   assumes "subspace A" "subspace B" "A \<subseteq> B"
     shows "dim {y \<in> B. \<forall>x \<in> A. orthogonal x y} + dim A = dim B"
 proof -
   have "dim (span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)) = dim (span B)"
   proof (rule arg_cong [where f=dim, OF subset_antisym])
     show "span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A) \<subseteq> span B"
       by (simp add: \<open>A \<subseteq> B\<close> Collect_restrict span_mono)
   next
     have *: "x \<in> span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)"
          if "x \<in> B" for x
     proof -
       obtain y z where "x = y + z" "y \<in> span A" and orth: "\<And>w. w \<in> span A \<Longrightarrow> orthogonal z w"
         using orthogonal_subspace_decomp_exists [of A x] that by auto
       moreover
       have "y \<in> span B"
         using \<open>y \<in> span A\<close> assms(3) span_mono by blast
       ultimately have "z \<in> B \<and> (\<forall>x. x \<in> A \<longrightarrow> orthogonal x z)"
         using assms by (metis orthogonal_commute span_add_eq span_eq_iff that)
       then have z: "z \<in> span {y \<in> B. \<forall>x\<in>A. orthogonal x y}"
         by (simp add: span_base)
       then show ?thesis
         by (smt (verit, best) \<open>x = y + z\<close> \<open>y \<in> span A\<close> le_sup_iff span_add_eq span_subspace_induct 
             span_superset subset_iff subspace_span)
     qed
     show "span B \<subseteq> span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)"
       by (rule span_minimal) (auto intro: * span_minimal)
   qed
   then show ?thesis
     by (metis (no_types, lifting) dim_orthogonal_sum dim_span mem_Collect_eq
         orthogonal_commute orthogonal_def)
 qed
 
 subsection\<open>Linear functions are (uniformly) continuous on any set\<close>
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Topological properties of linear functions\<close>
 
 lemma linear_lim_0:
   assumes "bounded_linear f"
   shows "(f \<longlongrightarrow> 0) (at (0))"
 proof -
   interpret f: bounded_linear f by fact
   have "(f \<longlongrightarrow> f 0) (at 0)"
     using tendsto_ident_at by (rule f.tendsto)
   then show ?thesis unfolding f.zero .
 qed
 
 lemma linear_continuous_at:
   "bounded_linear f \<Longrightarrow>continuous (at a) f"
   by (simp add: bounded_linear.isUCont isUCont_isCont)
 
 lemma linear_continuous_within:
   "bounded_linear f \<Longrightarrow> continuous (at x within s) f"
   using continuous_at_imp_continuous_at_within linear_continuous_at by blast
 
 lemma linear_continuous_on:
   "bounded_linear f \<Longrightarrow> continuous_on s f"
   using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
 
 lemma Lim_linear:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and h :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "(f \<longlongrightarrow> l) F" "linear h"
   shows "((\<lambda>x. h(f x)) \<longlongrightarrow> h l) F"
 proof -
   obtain B where B: "B > 0" "\<And>x. norm (h x) \<le> B * norm x"
     using linear_bounded_pos [OF \<open>linear h\<close>] by blast
   show ?thesis
     unfolding tendsto_iff
       by (simp add: assms bounded_linear.tendsto linear_linear tendstoD)
 qed
 
 lemma linear_continuous_compose:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and g :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous F f" "linear g"
   shows "continuous F (\<lambda>x. g(f x))"
   using assms unfolding continuous_def by (rule Lim_linear)
 
 lemma linear_continuous_on_compose:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and g :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous_on S f" "linear g"
   shows "continuous_on S (\<lambda>x. g(f x))"
   using assms by (simp add: continuous_on_eq_continuous_within linear_continuous_compose)
 
 text\<open>Also bilinear functions, in composition form\<close>
 
 lemma bilinear_continuous_compose:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous F f" "continuous F g" "bilinear h"
   shows "continuous F (\<lambda>x. h (f x) (g x))"
   using assms bilinear_conv_bounded_bilinear bounded_bilinear.continuous by blast
 
 lemma bilinear_continuous_on_compose:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
     and f :: "'d::t2_space \<Rightarrow> 'a"
   assumes "continuous_on S f" "continuous_on S g" "bilinear h"
   shows "continuous_on S (\<lambda>x. h (f x) (g x))"
   using assms by (simp add: continuous_on_eq_continuous_within bilinear_continuous_compose)
 
 end
diff --git a/src/HOL/Analysis/Urysohn.thy b/src/HOL/Analysis/Urysohn.thy
new file mode 100644
--- /dev/null
+++ b/src/HOL/Analysis/Urysohn.thy
@@ -0,0 +1,2240 @@
+(*  Title:      HOL/Analysis/Arcwise_Connected.thy
+    Authors:    LC Paulson, based on material from HOL Light
+*)
+
+section \<open>Urysohn lemma and its Consequences\<close>
+
+theory Urysohn
+imports Abstract_Topological_Spaces Abstract_Metric_Spaces Infinite_Sum Arcwise_Connected
+begin
+
+subsection \<open>Urysohn lemma and Tietze's theorem\<close>
+
+lemma Urysohn_lemma:
+  fixes a b :: real
+  assumes "normal_space X" "closedin X S" "closedin X T" "disjnt S T" "a \<le> b" 
+  obtains f where "continuous_map X (top_of_set {a..b}) f" "f ` S \<subseteq> {a}" "f ` T \<subseteq> {b}"
+proof -
+  obtain U where "openin X U" "S \<subseteq> U" "X closure_of U \<subseteq> topspace X - T"
+    using assms unfolding normal_space_alt disjnt_def
+    by (metis Diff_mono Un_Diff_Int closedin_def subset_eq sup_bot_right)
+  have "\<exists>G :: real \<Rightarrow> 'a set. G 0 = U \<and> G 1 = topspace X - T \<and>
+               (\<forall>x \<in> dyadics \<inter> {0..1}. \<forall>y \<in> dyadics \<inter> {0..1}. x < y \<longrightarrow> openin X (G x) \<and> openin X (G y) \<and> X closure_of (G x) \<subseteq> G y)"
+  proof (rule recursion_on_dyadic_fractions)
+    show "openin X U \<and> openin X (topspace X - T) \<and> X closure_of U \<subseteq> topspace X - T"
+      using \<open>X closure_of U \<subseteq> topspace X - T\<close> \<open>openin X U\<close> \<open>closedin X T\<close> by blast
+    show "\<exists>z. (openin X x \<and> openin X z \<and> X closure_of x \<subseteq> z) \<and> openin X z \<and> openin X y \<and> X closure_of z \<subseteq> y"
+      if "openin X x \<and> openin X y \<and> X closure_of x \<subseteq> y" for x y
+      by (meson that closedin_closure_of normal_space_alt \<open>normal_space X\<close>)
+    show "openin X x \<and> openin X z \<and> X closure_of x \<subseteq> z"
+      if "openin X x \<and> openin X y \<and> X closure_of x \<subseteq> y" and "openin X y \<and> openin X z \<and> X closure_of y \<subseteq> z" for x y z
+      by (meson that closure_of_subset openin_subset subset_trans)
+  qed
+  then obtain G :: "real \<Rightarrow> 'a set"
+      where G0: "G 0 = U" and G1: "G 1 = topspace X - T"
+        and G: "\<And>x y. \<lbrakk>x \<in> dyadics; y \<in> dyadics; 0 \<le> x; x < y; y \<le> 1\<rbrakk>
+                      \<Longrightarrow> openin X (G x) \<and> openin X (G y) \<and> X closure_of (G x) \<subseteq> G y"
+    by (smt (verit, del_insts) Int_iff atLeastAtMost_iff)
+  define f where "f \<equiv> \<lambda>x. Inf(insert 1 {r. r \<in> dyadics \<inter> {0..1} \<and> x \<in> G r})"
+  have f_ge: "f x \<ge> 0" if "x \<in> topspace X" for x
+    unfolding f_def by (force intro: cInf_greatest)
+  moreover have f_le1: "f x \<le> 1" if "x \<in> topspace X" for x
+  proof -
+    have "bdd_below {r \<in> dyadics \<inter> {0..1}. x \<in> G r}"
+      by (auto simp: bdd_below_def)
+    then show ?thesis
+       by (auto simp: f_def cInf_lower)
+  qed
+  ultimately have fim: "f ` topspace X \<subseteq> {0..1}"
+    by (auto simp: f_def)
+  have 0: "0 \<in> dyadics \<inter> {0..1::real}" and 1: "1 \<in> dyadics \<inter> {0..1::real}"
+    by (force simp: dyadics_def)+
+  then have opeG: "openin X (G r)" if "r \<in> dyadics \<inter> {0..1}" for r
+    using G G0 \<open>openin X U\<close> less_eq_real_def that by auto
+  have "x \<in> G 0" if "x \<in> S" for x
+    using G0 \<open>S \<subseteq> U\<close> that by blast
+  with 0 have fimS: "f ` S \<subseteq> {0}"
+    unfolding f_def by (force intro!: cInf_eq_minimum)
+  have False if "r \<in> dyadics" "0 \<le> r" "r < 1" "x \<in> G r" "x \<in> T" for r x
+    using G [of r 1] 1
+    by (smt (verit, best) DiffD2 G1 Int_iff closure_of_subset inf.orderE openin_subset that)
+  then have "r\<ge>1" if "r \<in> dyadics" "0 \<le> r" "r \<le> 1" "x \<in> G r" "x \<in> T" for r x
+    using linorder_not_le that by blast
+  then have fimT: "f ` T \<subseteq> {1}"
+    unfolding f_def by (force intro!: cInf_eq_minimum)
+  have fle1: "f z \<le> 1" for z
+    by (force simp: f_def intro: cInf_lower)
+  have fle: "f z \<le> x" if "x \<in> dyadics \<inter> {0..1}" "z \<in> G x" for z x
+    using that by (force simp: f_def intro: cInf_lower)
+  have *: "b \<le> f z" if "b \<le> 1" "\<And>x. \<lbrakk>x \<in> dyadics \<inter> {0..1}; z \<in> G x\<rbrakk> \<Longrightarrow> b \<le> x" for z b
+    using that by (force simp: f_def intro: cInf_greatest)
+  have **: "r \<le> f x" if r: "r \<in> dyadics \<inter> {0..1}" "x \<notin> G r" for r x
+  proof (rule *)
+    show "r \<le> s" if "s \<in> dyadics \<inter> {0..1}" and "x \<in> G s" for s :: real
+      using that r G [of s r] by (force simp add: dest: closure_of_subset openin_subset)
+  qed (use that in force)
+
+  have "\<exists>U. openin X U \<and> x \<in> U \<and> (\<forall>y \<in> U. \<bar>f y - f x\<bar> < \<epsilon>)"
+    if "x \<in> topspace X" and "0 < \<epsilon>" for x \<epsilon>
+  proof -
+    have A: "\<exists>r. r \<in> dyadics \<inter> {0..1} \<and> r < y \<and> \<bar>r - y\<bar> < d" if "0 < y" "y \<le> 1" "0 < d" for y d::real
+    proof -
+      obtain n q r 
+        where "of_nat q / 2^n < y" "y < of_nat r / 2^n" "\<bar>q / 2^n - r / 2^n \<bar> < d"
+        by (smt (verit, del_insts) padic_rational_approximation_straddle_pos  \<open>0 < d\<close> \<open>0 < y\<close>) 
+      then show ?thesis
+        unfolding dyadics_def
+        using divide_eq_0_iff that(2) by fastforce
+    qed
+    have B: "\<exists>r. r \<in> dyadics \<inter> {0..1} \<and> y < r \<and> \<bar>r - y\<bar> < d" if "0 \<le> y" "y < 1" "0 < d" for y d::real
+    proof -
+      obtain n q r 
+        where "of_nat q / 2^n \<le> y" "y < of_nat r / 2^n" "\<bar>q / 2^n - r / 2^n \<bar> < d"
+        using padic_rational_approximation_straddle_pos_le
+        by (smt (verit, del_insts) \<open>0 < d\<close> \<open>0 \<le> y\<close>) 
+      then show ?thesis
+        apply (clarsimp simp: dyadics_def)
+        using divide_eq_0_iff \<open>y < 1\<close>
+        by (smt (verit) divide_nonneg_nonneg divide_self of_nat_0_le_iff of_nat_1 power_0 zero_le_power) 
+    qed
+    show ?thesis
+    proof (cases "f x = 0")
+      case True
+      with B[of 0] obtain r where r: "r \<in> dyadics \<inter> {0..1}" "0 < r" "\<bar>r\<bar> < \<epsilon>/2"
+        by (smt (verit) \<open>0 < \<epsilon>\<close> half_gt_zero)
+      show ?thesis
+      proof (intro exI conjI)
+        show "openin X (G r)"
+          using opeG r(1) by blast
+        show "x \<in> G r"
+          using True ** r by force
+        show "\<forall>y \<in> G r. \<bar>f y - f x\<bar> < \<epsilon>"
+          using f_ge \<open>openin X (G r)\<close> fle openin_subset r by (fastforce simp: True)
+      qed
+    next
+      case False
+      show ?thesis 
+      proof (cases "f x = 1")
+        case True
+        with A[of 1] obtain r where r: "r \<in> dyadics \<inter> {0..1}" "r < 1" "\<bar>r-1\<bar> < \<epsilon>/2"
+          by (smt (verit) \<open>0 < \<epsilon>\<close> half_gt_zero)
+        define G' where "G' \<equiv> topspace X - X closure_of G r"
+        show ?thesis
+        proof (intro exI conjI)
+          show "openin X G'"
+            unfolding G'_def by fastforce
+          obtain r' where "r' \<in> dyadics \<and> 0 \<le> r' \<and> r' \<le> 1 \<and> r < r' \<and> \<bar>r' - r\<bar> < 1 - r"
+            using B r by force 
+          moreover
+          have "1 - r \<in> dyadics" "0 \<le> r"
+            using 1 r dyadics_diff by force+
+          ultimately have "x \<notin> X closure_of G r"
+            using G True r fle by force
+          then show "x \<in> G'"
+            by (simp add: G'_def that)
+          show "\<forall>y \<in> G'. \<bar>f y - f x\<bar> < \<epsilon>"
+            using ** f_le1 in_closure_of r by (fastforce simp add: True G'_def)
+        qed
+      next
+        case False
+        have "0 < f x" "f x < 1"
+          using fle1 f_ge that(1) \<open>f x \<noteq> 0\<close> \<open>f x \<noteq> 1\<close> by (metis order_le_less) +
+        obtain r where r: "r \<in> dyadics \<inter> {0..1}" "r < f x" "\<bar>r - f x\<bar> < \<epsilon> / 2"
+          using A \<open>0 < \<epsilon>\<close> \<open>0 < f x\<close> \<open>f x < 1\<close> by (smt (verit, best) half_gt_zero)
+        obtain r' where r': "r' \<in> dyadics \<inter> {0..1}" "f x < r'" "\<bar>r' - f x\<bar> < \<epsilon> / 2"
+          using B \<open>0 < \<epsilon>\<close> \<open>0 < f x\<close> \<open>f x < 1\<close> by (smt (verit, best) half_gt_zero)
+        have "r < 1"
+          using \<open>f x < 1\<close> r(2) by force
+        show ?thesis
+        proof (intro conjI exI)
+          show "openin X (G r' - X closure_of G r)"
+            using closedin_closure_of opeG r' by blast
+          have "x \<in> X closure_of G r \<Longrightarrow> False"
+            using B [of r "f x - r"] r \<open>r < 1\<close> G [of r] fle by force
+          then show "x \<in> G r' - X closure_of G r"
+            using ** r' by fastforce
+          show "\<forall>y\<in>G r' - X closure_of G r. \<bar>f y - f x\<bar> < \<epsilon>"
+            using r r' ** G closure_of_subset field_sum_of_halves fle openin_subset subset_eq
+            by (smt (verit) DiffE opeG)
+        qed
+      qed
+    qed
+  qed
+  then have contf: "continuous_map X (top_of_set {0..1}) f"
+    by (force simp add: Met_TC.continuous_map_to_metric dist_real_def continuous_map_in_subtopology fim simp flip: Met_TC.mtopology_is_euclideanreal)
+  define g where "g \<equiv> \<lambda>x. a + (b - a) * f x"
+  show thesis
+  proof
+    have "continuous_map X euclideanreal g"
+      using contf \<open>a \<le> b\<close> unfolding g_def by (auto simp: continuous_intros continuous_map_in_subtopology)
+    moreover have "g ` (topspace X) \<subseteq> {a..b}"
+      using mult_left_le [of "f _" "b-a"] contf \<open>a \<le> b\<close>   
+      by (simp add: g_def add.commute continuous_map_in_subtopology image_subset_iff le_diff_eq)
+    ultimately show "continuous_map X (top_of_set {a..b}) g"
+      by (meson continuous_map_in_subtopology)
+    show "g ` S \<subseteq> {a}" "g ` T \<subseteq> {b}"
+      using fimS fimT by (auto simp: g_def)
+  qed
+qed
+
+lemma Urysohn_lemma_alt:
+  fixes a b :: real
+  assumes "normal_space X" "closedin X S" "closedin X T" "disjnt S T"
+  obtains f where "continuous_map X euclideanreal f" "f ` S \<subseteq> {a}" "f ` T \<subseteq> {b}"
+  by (metis Urysohn_lemma assms continuous_map_in_subtopology disjnt_sym linear)
+
+lemma normal_space_iff_Urysohn_gen_alt:
+  assumes "a \<noteq> b"
+  shows "normal_space X \<longleftrightarrow>
+         (\<forall>S T. closedin X S \<and> closedin X T \<and> disjnt S T
+                \<longrightarrow> (\<exists>f. continuous_map X euclideanreal f \<and> f ` S \<subseteq> {a} \<and> f ` T \<subseteq> {b}))"
+ (is "?lhs=?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs" 
+    by (metis Urysohn_lemma_alt)
+next
+  assume R: ?rhs 
+  show ?lhs
+    unfolding normal_space_def
+  proof clarify
+    fix S T
+    assume "closedin X S" and "closedin X T" and "disjnt S T"
+    with R obtain f where contf: "continuous_map X euclideanreal f" and "f ` S \<subseteq> {a}" "f ` T \<subseteq> {b}"
+      by meson
+    show "\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+    proof (intro conjI exI)
+      show "openin X {x \<in> topspace X. f x \<in> ball a (\<bar>a - b\<bar> / 2)}"
+        by (force intro!: openin_continuous_map_preimage [OF contf])
+      show "openin X {x \<in> topspace X. f x \<in> ball b (\<bar>a - b\<bar> / 2)}"
+        by (force intro!: openin_continuous_map_preimage [OF contf])
+      show "S \<subseteq> {x \<in> topspace X. f x \<in> ball a (\<bar>a - b\<bar> / 2)}"
+        using \<open>closedin X S\<close> closedin_subset \<open>f ` S \<subseteq> {a}\<close> assms by force
+      show "T \<subseteq> {x \<in> topspace X. f x \<in> ball b (\<bar>a - b\<bar> / 2)}"
+        using \<open>closedin X T\<close> closedin_subset \<open>f ` T \<subseteq> {b}\<close> assms by force
+      have "\<And>x. \<lbrakk>x \<in> topspace X; dist a (f x) < \<bar>a-b\<bar>/2; dist b (f x) < \<bar>a-b\<bar>/2\<rbrakk> \<Longrightarrow> False"
+        by (smt (verit, best) dist_real_def dist_triangle_half_l)
+      then show "disjnt {x \<in> topspace X. f x \<in> ball a (\<bar>a-b\<bar> / 2)} {x \<in> topspace X. f x \<in> ball b (\<bar>a-b\<bar> / 2)}"
+        using disjnt_iff by fastforce
+    qed
+  qed
+qed 
+
+lemma normal_space_iff_Urysohn_gen:
+  fixes a b::real
+  shows
+   "a < b \<Longrightarrow> 
+      normal_space X \<longleftrightarrow>
+        (\<forall>S T. closedin X S \<and> closedin X T \<and> disjnt S T
+               \<longrightarrow> (\<exists>f. continuous_map X (top_of_set {a..b}) f \<and>
+                        f ` S \<subseteq> {a} \<and> f ` T \<subseteq> {b}))"
+  by (metis linear not_le Urysohn_lemma normal_space_iff_Urysohn_gen_alt continuous_map_in_subtopology)
+
+lemma normal_space_iff_Urysohn_alt:
+   "normal_space X \<longleftrightarrow>
+     (\<forall>S T. closedin X S \<and> closedin X T \<and> disjnt S T
+           \<longrightarrow> (\<exists>f. continuous_map X euclideanreal f \<and>
+                   f ` S \<subseteq> {0} \<and> f ` T \<subseteq> {1}))"
+  by (rule normal_space_iff_Urysohn_gen_alt) auto
+
+lemma normal_space_iff_Urysohn:
+   "normal_space X \<longleftrightarrow>
+     (\<forall>S T. closedin X S \<and> closedin X T \<and> disjnt S T
+            \<longrightarrow> (\<exists>f::'a\<Rightarrow>real. continuous_map X (top_of_set {0..1}) f \<and> 
+                               f ` S \<subseteq> {0} \<and> f ` T \<subseteq> {1}))"
+  by (rule normal_space_iff_Urysohn_gen) auto
+
+lemma normal_space_perfect_map_image:
+   "\<lbrakk>normal_space X; perfect_map X Y f\<rbrakk> \<Longrightarrow> normal_space Y"
+  unfolding perfect_map_def proper_map_def
+  using normal_space_continuous_closed_map_image by fastforce
+
+lemma Hausdorff_normal_space_closed_continuous_map_image:
+   "\<lbrakk>normal_space X; closed_map X Y f; continuous_map X Y f;
+     f ` topspace X = topspace Y; t1_space Y\<rbrakk>
+    \<Longrightarrow> Hausdorff_space Y"
+  by (metis normal_space_continuous_closed_map_image normal_t1_imp_Hausdorff_space)
+
+lemma normal_Hausdorff_space_closed_continuous_map_image:
+   "\<lbrakk>normal_space X; Hausdorff_space X; closed_map X Y f;
+     continuous_map X Y f; f ` topspace X = topspace Y\<rbrakk>
+    \<Longrightarrow> normal_space Y \<and> Hausdorff_space Y"
+  by (meson normal_space_continuous_closed_map_image normal_t1_eq_Hausdorff_space t1_space_closed_map_image)
+
+lemma Lindelof_cover:
+  assumes "regular_space X" and "Lindelof_space X" and "S \<noteq> {}" 
+    and clo: "closedin X S" "closedin X T" "disjnt S T"
+  obtains h :: "nat \<Rightarrow> 'a set" where 
+    "\<And>n. openin X (h n)" "\<And>n. disjnt T (X closure_of (h n))" and  "S \<subseteq> \<Union>(range h)"
+proof -
+  have "\<exists>U. openin X U \<and> x \<in> U \<and> disjnt T (X closure_of U)"
+    if "x \<in> S" for x
+    using \<open>regular_space X\<close> unfolding regular_space 
+    by (metis (full_types) Diff_iff \<open>disjnt S T\<close> clo closure_of_eq disjnt_iff in_closure_of that)
+  then obtain h where oh: "\<And>x. x \<in> S \<Longrightarrow> openin X (h x)"
+    and xh: "\<And>x. x \<in> S \<Longrightarrow> x \<in> h x"
+    and dh: "\<And>x. x \<in> S \<Longrightarrow> disjnt T (X closure_of h x)"
+    by metis
+  have "Lindelof_space(subtopology X S)"
+    by (simp add: Lindelof_space_closedin_subtopology \<open>Lindelof_space X\<close> \<open>closedin X S\<close>)
+  then obtain \<U> where \<U>: "countable \<U> \<and> \<U> \<subseteq> h ` S \<and> S \<subseteq> \<Union>\<U>"
+    unfolding Lindelof_space_subtopology_subset [OF closedin_subset [OF \<open>closedin X S\<close>]]
+    by (smt (verit, del_insts) oh xh UN_I image_iff subsetI)
+  with \<open>S \<noteq> {}\<close> have "\<U> \<noteq> {}"
+    by blast
+  show ?thesis
+  proof
+    show "openin X (from_nat_into \<U> n)" for n
+      by (metis \<U> from_nat_into image_iff \<open>\<U> \<noteq> {}\<close> oh subsetD)
+    show "disjnt T (X closure_of (from_nat_into \<U>) n)" for n
+      using dh from_nat_into [OF \<open>\<U> \<noteq> {}\<close>]
+      by (metis \<U> f_inv_into_f inv_into_into subset_eq)
+    show "S \<subseteq> \<Union>(range (from_nat_into \<U>))"
+      by (simp add: \<U> \<open>\<U> \<noteq> {}\<close>)
+  qed
+qed
+
+lemma regular_Lindelof_imp_normal_space:
+  assumes "regular_space X" and "Lindelof_space X"
+  shows "normal_space X"
+  unfolding normal_space_def
+proof clarify
+  fix S T
+  assume clo: "closedin X S" "closedin X T" and "disjnt S T"
+  show "\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+  proof (cases "S={} \<or> T={}")
+    case True
+    with clo show ?thesis
+      by (meson closedin_def disjnt_empty1 disjnt_empty2 openin_empty openin_topspace subset_empty)
+  next
+    case False
+    obtain h :: "nat \<Rightarrow> 'a set" where 
+      opeh: "\<And>n. openin X (h n)" and dish: "\<And>n. disjnt T (X closure_of (h n))"
+      and Sh: "S \<subseteq> \<Union>(range h)"
+      by (metis Lindelof_cover False \<open>disjnt S T\<close> assms clo)
+    obtain k :: "nat \<Rightarrow> 'a set" where 
+      opek: "\<And>n. openin X (k n)" and disk: "\<And>n. disjnt S (X closure_of (k n))"
+      and Tk: "T \<subseteq> \<Union>(range k)"
+      by (metis Lindelof_cover False \<open>disjnt S T\<close> assms clo disjnt_sym)
+    define U where "U \<equiv> \<Union>i. h i - (\<Union>j<i. X closure_of k j)"
+    define V where "V \<equiv> \<Union>i. k i - (\<Union>j\<le>i. X closure_of h j)"
+    show ?thesis
+    proof (intro exI conjI)
+      show "openin X U" "openin X V"
+        unfolding U_def V_def
+        by (force intro!: opek opeh closedin_Union closedin_closure_of)+
+      show "S \<subseteq> U" "T \<subseteq> V"
+        using Sh Tk dish disk by (fastforce simp: U_def V_def disjnt_iff)+
+      have "\<And>x i j. \<lbrakk>x \<in> k i; x \<in> h j; \<forall>j\<le>i. x \<notin> X closure_of h j\<rbrakk>
+                 \<Longrightarrow> \<exists>i<j. x \<in> X closure_of k i"
+        by (metis in_closure_of linorder_not_less opek openin_subset subsetD)
+      then show "disjnt U V"
+        by (force simp add: U_def V_def disjnt_iff)
+    qed
+  qed
+qed
+
+lemma Tietze_extension_closed_real_interval:
+  assumes "normal_space X" and "closedin X S"
+    and contf: "continuous_map (subtopology X S) euclideanreal f"
+    and fim: "f ` S \<subseteq> {a..b}" and "a \<le> b"
+  obtains g 
+  where "continuous_map X euclideanreal g" 
+        "\<And>x. x \<in> S \<Longrightarrow> g x = f x" "g ` topspace X \<subseteq> {a..b}"
+proof -
+  define c where "c \<equiv> max \<bar>a\<bar> \<bar>b\<bar> + 1"
+  have "0 < c" and c: "\<And>x. x \<in> S \<Longrightarrow> \<bar>f x\<bar> \<le> c"
+    using fim by (auto simp: c_def image_subset_iff)
+  define good where 
+    "good \<equiv> \<lambda>g n. continuous_map X euclideanreal g \<and> (\<forall>x \<in> S. \<bar>f x - g x\<bar> \<le> c * (2/3)^n)"
+  have step: "\<exists>g. good g (Suc n) \<and>
+              (\<forall>x \<in> topspace X. \<bar>g x - h x\<bar> \<le> c * (2/3)^n / 3)"
+    if h: "good h n" for n h
+  proof -
+    have pos: "0 < c * (2/3) ^ n"
+      by (simp add: \<open>0 < c\<close>)
+    have S_eq: "S = topspace(subtopology X S)" and "S \<subseteq> topspace X"
+      using \<open>closedin X S\<close> closedin_subset by auto
+    define d where "d \<equiv> c/3 * (2/3) ^ n"
+    define SA where "SA \<equiv> {x \<in> S. f x - h x \<in> {..-d}}"
+    define SB where "SB \<equiv> {x \<in> S. f x - h x \<in> {d..}}"
+    have contfh: "continuous_map (subtopology X S) euclideanreal (\<lambda>x. f x - h x)"
+      using that
+      by (simp add: contf good_def continuous_map_diff continuous_map_from_subtopology)
+    then have "closedin (subtopology X S) SA"
+      unfolding SA_def
+      by (smt (verit, del_insts) closed_closedin continuous_map_closedin Collect_cong S_eq closed_real_atMost)
+    then have "closedin X SA"
+      using \<open>closedin X S\<close> closedin_trans_full by blast
+    moreover have  "closedin (subtopology X S) SB"      
+      unfolding SB_def
+      using closedin_continuous_map_preimage_gen [OF contfh]
+      by (metis (full_types) S_eq closed_atLeast closed_closedin closedin_topspace)
+    then have "closedin X SB"
+      using \<open>closedin X S\<close> closedin_trans_full by blast
+    moreover have "disjnt SA SB"
+      using pos by (auto simp: d_def disjnt_def SA_def SB_def)
+    moreover have "-d \<le> d"
+      using pos by (auto simp: d_def)
+    ultimately
+    obtain g where contg: "continuous_map X (top_of_set {- d..d}) g"
+      and ga: "g ` SA \<subseteq> {- d}" and gb: "g ` SB \<subseteq> {d}"
+      using Urysohn_lemma \<open>normal_space X\<close> by metis
+    then have g_le_d: "\<And>x. x \<in> topspace X \<Longrightarrow> \<bar>g x\<bar> \<le> d"
+      by (simp add: abs_le_iff continuous_map_def minus_le_iff)
+    have g_eq_d: "\<And>x. \<lbrakk>x \<in> S; f x - h x \<le> -d\<rbrakk> \<Longrightarrow> g x = -d"
+      using ga by (auto simp: SA_def)
+    have g_eq_negd: "\<And>x. \<lbrakk>x \<in> S; f x - h x \<ge> d\<rbrakk> \<Longrightarrow> g x = d"
+      using gb by (auto simp: SB_def)
+    show ?thesis
+      unfolding good_def
+    proof (intro conjI strip exI)
+      show "continuous_map X euclideanreal (\<lambda>x. h x + g x)"
+        using contg continuous_map_add continuous_map_in_subtopology that
+        unfolding good_def by blast
+      show "\<bar>f x - (h x + g x)\<bar> \<le> c * (2 / 3) ^ Suc n" if "x \<in> S" for x
+      proof -
+        have x: "x \<in> topspace X"
+          using \<open>S \<subseteq> topspace X\<close> that by auto
+        have "\<bar>f x - h x\<bar> \<le> c * (2/3) ^ n"
+          using good_def h that by blast
+        with g_eq_d [OF that] g_eq_negd [OF that] g_le_d [OF x] 
+        have "\<bar>f x - (h x + g x)\<bar> \<le> d + d"
+          unfolding d_def by linarith
+        then show ?thesis 
+          by (simp add: d_def)
+      qed
+      show "\<bar>h x + g x - h x\<bar> \<le> c * (2 / 3) ^ n / 3" if "x \<in> topspace X" for x
+        using that d_def g_le_d by auto
+    qed
+  qed
+  then obtain nxtg where nxtg: "\<And>h n. good h n \<Longrightarrow> 
+          good (nxtg h n) (Suc n) \<and> (\<forall>x \<in> topspace X. \<bar>nxtg h n x - h x\<bar> \<le> c * (2/3)^n / 3)"
+    by metis
+  define g where "g \<equiv> rec_nat (\<lambda>x. 0) (\<lambda>n r. nxtg r n)"
+  have [simp]: "g 0 x = 0" for x
+    by (auto simp: g_def)
+  have g_Suc: "g(Suc n) = nxtg (g n) n" for n
+    by (auto simp: g_def)
+  have good: "good (g n) n" for n
+  proof (induction n)
+    case 0
+    with c show ?case
+      by (auto simp: good_def)
+  qed (simp add: g_Suc nxtg)
+  have *: "\<And>n x. x \<in> topspace X \<Longrightarrow> \<bar>g(Suc n) x - g n x\<bar> \<le> c * (2/3) ^ n / 3"
+    using nxtg g_Suc good by force
+  obtain h where conth:  "continuous_map X euclideanreal h"
+    and h: "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>topspace X. dist (g n x) (h x) < \<epsilon>"
+  proof (rule Met_TC.continuous_map_uniformly_Cauchy_limit)
+    show "\<forall>\<^sub>F n in sequentially. continuous_map X (Met_TC.mtopology) (g n)"
+      using good good_def by fastforce
+    show "\<exists>N. \<forall>m n x. N \<le> m \<longrightarrow> N \<le> n \<longrightarrow> x \<in> topspace X \<longrightarrow> dist (g m x) (g n x) < \<epsilon>"
+      if "\<epsilon> > 0" for \<epsilon> 
+    proof -
+      have "\<forall>\<^sub>F n in sequentially. \<bar>(2/3) ^ n\<bar> < \<epsilon>/c"
+      proof (rule Archimedean_eventually_pow_inverse)
+        show "0 < \<epsilon> / c"
+          by (simp add: \<open>0 < c\<close> that)
+      qed auto
+      then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> \<bar>(2/3) ^ n\<bar> < \<epsilon>/c"
+        by (meson eventually_sequentially order_le_less_trans)
+      have "\<bar>g m x - g n x\<bar> < \<epsilon>"
+        if "N \<le> m" "N \<le> n" and x: "x \<in> topspace X" "m \<le> n" for m n x
+      proof (cases "m < n")
+        case True
+        have 23: "(\<Sum>k = m..<n. (2/3)^k) = 3 * ((2/3) ^ m - (2/3::real) ^ n)"
+          using \<open>m \<le> n\<close>
+          by (induction n) (auto simp: le_Suc_eq)
+        have "\<bar>g m x - g n x\<bar> \<le> \<bar>\<Sum>k = m..<n. g (Suc k) x - g k x\<bar>"
+          by (subst sum_Suc_diff' [OF \<open>m \<le> n\<close>]) linarith
+        also have "\<dots> \<le> (\<Sum>k = m..<n. \<bar>g (Suc k) x - g k x\<bar>)"
+          by (rule sum_abs)
+        also have "\<dots> \<le> (\<Sum>k = m..<n. c * (2/3)^k / 3)"
+          by (meson "*" sum_mono x(1))
+        also have "\<dots> = (c/3) * (\<Sum>k = m..<n. (2/3)^k)"
+          by (simp add: sum_distrib_left)
+        also have "\<dots> = (c/3) * 3 * ((2/3) ^ m - (2/3) ^ n)"
+          by (simp add: sum_distrib_left 23)
+        also have "... < (c/3) * 3 * ((2/3) ^ m)"
+          using \<open>0 < c\<close> by auto
+        also have "\<dots> < \<epsilon>"
+          using N [OF \<open>N \<le> m\<close>] \<open>0 < c\<close> by (simp add: field_simps)
+        finally show ?thesis .
+      qed (use \<open>0 < \<epsilon>\<close> \<open>m \<le> n\<close> in auto)
+      then show ?thesis
+        by (metis dist_commute_lessI dist_real_def nle_le)
+    qed
+  qed auto
+  define \<phi> where "\<phi> \<equiv> \<lambda>x. max a (min (h x) b)"
+  show thesis
+  proof
+    show "continuous_map X euclidean \<phi>"
+      unfolding \<phi>_def using conth by (intro continuous_intros) auto
+    show "\<phi> x = f x" if "x \<in> S" for x 
+    proof -
+      have x: "x \<in> topspace X"
+        using \<open>closedin X S\<close> closedin_subset that by blast
+      have "h x = f x"
+      proof (rule Met_TC.limitin_metric_unique)
+        show "limitin Met_TC.mtopology (\<lambda>n. g n x) (h x) sequentially"
+          using h x by (force simp: tendsto_iff eventually_sequentially)
+        show "limitin Met_TC.mtopology (\<lambda>n. g n x) (f x) sequentially"
+        proof (clarsimp simp: tendsto_iff)
+          fix \<epsilon>::real
+          assume "\<epsilon> > 0"
+          then have "\<forall>\<^sub>F n in sequentially. \<bar>(2/3) ^ n\<bar> < \<epsilon>/c"
+            by (intro Archimedean_eventually_pow_inverse) (auto simp: \<open>c > 0\<close>)
+          then show "\<forall>\<^sub>F n in sequentially. dist (g n x) (f x) < \<epsilon>"
+            apply eventually_elim
+            by (smt (verit) good x good_def \<open>c > 0\<close> dist_real_def mult.commute pos_less_divide_eq that)
+        qed
+      qed auto
+      then show ?thesis
+        using that fim by (auto simp: \<phi>_def)
+    qed
+    then show "\<phi> ` topspace X \<subseteq> {a..b}"
+      using fim \<open>a \<le> b\<close> by (auto simp: \<phi>_def)
+  qed
+qed
+
+
+lemma Tietze_extension_realinterval:
+  assumes XS: "normal_space X" "closedin X S" and T: "is_interval T" "T \<noteq> {}" 
+    and contf: "continuous_map (subtopology X S) euclideanreal f" 
+    and "f ` S \<subseteq> T"
+  obtains g where "continuous_map X euclideanreal g"  "g ` topspace X \<subseteq> T"  "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
+proof -
+  define \<Phi> where 
+        "\<Phi> \<equiv> \<lambda>T::real set. \<forall>f. continuous_map (subtopology X S) euclidean f \<longrightarrow> f`S \<subseteq> T
+               \<longrightarrow> (\<exists>g. continuous_map X euclidean g \<and> g ` topspace X \<subseteq> T \<and> (\<forall>x \<in> S. g x = f x))"
+  have "\<Phi> T"
+    if *: "\<And>T. \<lbrakk>bounded T; is_interval T; T \<noteq> {}\<rbrakk> \<Longrightarrow> \<Phi> T"
+      and "is_interval T" "T \<noteq> {}" for T
+    unfolding \<Phi>_def
+  proof (intro strip)
+    fix f
+    assume contf: "continuous_map (subtopology X S) euclideanreal f"
+      and "f ` S \<subseteq> T"
+    have \<Phi>T: "\<Phi> ((\<lambda>x. x / (1 + \<bar>x\<bar>)) ` T)"
+    proof (rule *)
+      show "bounded ((\<lambda>x. x / (1 + \<bar>x\<bar>)) ` T)"
+        using shrink_range [of T] by (force intro: boundedI [where B=1])
+      show "is_interval ((\<lambda>x. x / (1 + \<bar>x\<bar>)) ` T)"
+        using connected_shrink that(2) is_interval_connected_1 by blast
+      show "(\<lambda>x. x / (1 + \<bar>x\<bar>)) ` T \<noteq> {}"
+        using \<open>T \<noteq> {}\<close> by auto
+    qed
+    moreover have "continuous_map (subtopology X S) euclidean ((\<lambda>x. x / (1 + \<bar>x\<bar>)) \<circ> f)"
+      by (metis contf continuous_map_compose continuous_map_into_fulltopology continuous_map_real_shrink)
+    moreover have "((\<lambda>x. x / (1 + \<bar>x\<bar>)) \<circ> f) ` S \<subseteq> (\<lambda>x. x / (1 + \<bar>x\<bar>)) ` T"
+      using \<open>f ` S \<subseteq> T\<close> by auto
+    ultimately obtain g 
+       where contg: "continuous_map X euclidean g" 
+         and gim: "g ` topspace X \<subseteq> (\<lambda>x. x / (1 + \<bar>x\<bar>)) ` T"
+         and geq: "\<And>x. x \<in> S \<Longrightarrow> g x = ((\<lambda>x. x / (1 + \<bar>x\<bar>)) \<circ> f) x"
+      using \<Phi>T unfolding \<Phi>_def by force
+    show "\<exists>g. continuous_map X euclideanreal g \<and> g ` topspace X \<subseteq> T \<and> (\<forall>x\<in>S. g x = f x)"
+    proof (intro conjI exI)
+      have "continuous_map X (top_of_set {-1<..<1}) g"
+        using contg continuous_map_in_subtopology gim shrink_range by blast
+      then show "continuous_map X euclideanreal ((\<lambda>x. x / (1 - \<bar>x\<bar>)) \<circ> g)"
+        by (rule continuous_map_compose) (auto simp: continuous_on_real_grow)
+      show "((\<lambda>x. x / (1 - \<bar>x\<bar>)) \<circ> g) ` topspace X \<subseteq> T"
+        using gim real_grow_shrink by fastforce
+      show "\<forall>x\<in>S. ((\<lambda>x. x / (1 - \<bar>x\<bar>)) \<circ> g) x = f x"
+        using geq real_grow_shrink by force
+    qed
+  qed
+  moreover have "\<Phi> T"
+    if "bounded T" "is_interval T" "T \<noteq> {}" for T
+    unfolding \<Phi>_def
+  proof (intro strip)
+    fix f
+    assume contf: "continuous_map (subtopology X S) euclideanreal f"
+      and "f ` S \<subseteq> T"
+    obtain a b where ab: "closure T = {a..b}"
+      by (meson \<open>bounded T\<close> \<open>is_interval T\<close> compact_closure connected_compact_interval_1 
+            connected_imp_connected_closure is_interval_connected)
+    with \<open>T \<noteq> {}\<close> have "a \<le> b" by auto
+    have "f ` S \<subseteq> {a..b}"
+      using \<open>f ` S \<subseteq> T\<close> ab closure_subset by auto
+    then obtain g where contg: "continuous_map X euclideanreal g"
+      and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x" and gim: "g ` topspace X \<subseteq> {a..b}"
+      using Tietze_extension_closed_real_interval [OF XS contf _ \<open>a \<le> b\<close>] by metis
+    define W where "W \<equiv> {x \<in> topspace X. g x \<in> closure T - T}"
+    have "{a..b} - {a, b} \<subseteq> T"
+      using that
+      by (metis ab atLeastAtMost_diff_ends convex_interior_closure interior_atLeastAtMost_real 
+          interior_subset is_interval_convex)
+    with finite_imp_compact have "compact (closure T - T)"
+      by (metis Diff_eq_empty_iff Diff_insert2 ab finite.emptyI finite_Diff_insert)
+    then have "closedin X W"
+      unfolding W_def using closedin_continuous_map_preimage [OF contg] compact_imp_closed by force
+    moreover have "disjnt W S"
+      unfolding W_def disjnt_iff using \<open>f ` S \<subseteq> T\<close> gf by blast
+    ultimately obtain h :: "'a \<Rightarrow> real" 
+      where conth: "continuous_map X (top_of_set {0..1}) h" 
+            and him: "h ` W \<subseteq> {0}" "h ` S \<subseteq> {1}"
+      by (metis XS normal_space_iff_Urysohn) 
+    then have him01: "h ` topspace X \<subseteq> {0..1}"
+      by (meson continuous_map_in_subtopology)
+    obtain z where "z \<in> T"
+      using \<open>T \<noteq> {}\<close> by blast
+    define g' where "g' \<equiv> \<lambda>x. z + h x * (g x - z)"
+    show "\<exists>g. continuous_map X euclidean g \<and> g ` topspace X \<subseteq> T \<and> (\<forall>x\<in>S. g x = f x)"
+    proof (intro exI conjI)
+      show "continuous_map X euclideanreal g'"
+        unfolding g'_def using contg conth continuous_map_in_subtopology
+        by (intro continuous_intros) auto
+      show "g' ` topspace X \<subseteq> T"
+        unfolding g'_def 
+      proof clarify
+        fix x
+        assume "x \<in> topspace X"
+        show "z + h x * (g x - z) \<in> T"
+        proof (cases "g x \<in> T")
+          case True
+          define w where "w \<equiv> z + h x * (g x - z)"
+          have "\<bar>h x\<bar> * \<bar>g x - z\<bar> \<le> \<bar>g x - z\<bar>" "\<bar>1 - h x\<bar> * \<bar>g x - z\<bar> \<le> \<bar>g x - z\<bar>"
+            using him01 \<open>x \<in> topspace X\<close> by (force simp: intro: mult_left_le_one_le)+
+          then consider "z \<le> w \<and> w \<le> g x" | "g x \<le> w \<and> w \<le> z"
+            unfolding w_def by (smt (verit) left_diff_distrib mult_cancel_right2 mult_minus_right zero_less_mult_iff)
+          then show ?thesis
+            using \<open>is_interval T\<close> unfolding w_def is_interval_1 by (metis True \<open>z \<in> T\<close>)
+        next
+          case False
+          then have "g x \<in> closure T"
+            using \<open>x \<in> topspace X\<close> ab gim by blast
+          then have "h x = 0"
+            using him False \<open>x \<in> topspace X\<close> by (auto simp: W_def image_subset_iff)
+          then show ?thesis
+            by (simp add: \<open>z \<in> T\<close>)
+        qed
+      qed
+      show "\<forall>x\<in>S. g' x = f x"
+        using gf him by (auto simp: W_def g'_def)
+    qed 
+  qed
+  ultimately show thesis
+    using assms that unfolding \<Phi>_def by best
+qed
+
+lemma normal_space_iff_Tietze:
+   "normal_space X \<longleftrightarrow>
+    (\<forall>f S. closedin X S \<and>
+           continuous_map (subtopology X S) euclidean f
+           \<longrightarrow> (\<exists>g:: 'a \<Rightarrow> real. continuous_map X euclidean g \<and> (\<forall>x \<in> S. g x = f x)))" 
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume ?lhs 
+  then show ?rhs
+    by (metis Tietze_extension_realinterval empty_not_UNIV is_interval_univ subset_UNIV)
+next
+  assume R: ?rhs 
+  show ?lhs
+    unfolding normal_space_iff_Urysohn_alt
+  proof clarify
+    fix S T
+    assume "closedin X S"
+      and "closedin X T"
+      and "disjnt S T"
+    then have cloST: "closedin X (S \<union> T)"
+      by (simp add: closedin_Un)
+    moreover 
+    have "continuous_map (subtopology X (S \<union> T)) euclideanreal (\<lambda>x. if x \<in> S then 0 else 1)"
+      unfolding continuous_map_closedin
+    proof (intro conjI strip)
+      fix C :: "real set"
+      define D where "D \<equiv> {x \<in> topspace X. if x \<in> S then 0 \<in> C else x \<in> T \<and> 1 \<in> C}"
+      have "D \<in> {{}, S, T, S \<union> T}"
+        unfolding D_def
+        using closedin_subset [OF \<open>closedin X S\<close>] closedin_subset [OF \<open>closedin X T\<close>] \<open>disjnt S T\<close>
+        by (auto simp: disjnt_iff)
+      then have "closedin X D"
+        using \<open>closedin X S\<close> \<open>closedin X T\<close> closedin_empty by blast
+      with closedin_subset_topspace
+      show "closedin (subtopology X (S \<union> T)) {x \<in> topspace (subtopology X (S \<union> T)). (if x \<in> S then 0::real else 1) \<in> C}"
+        apply (simp add: D_def)
+        by (smt (verit, best) Collect_cong Collect_mono_iff Un_def closedin_subset_topspace)
+    qed auto
+    ultimately obtain g :: "'a \<Rightarrow> real"  where 
+      contg: "continuous_map X euclidean g" and gf: "\<forall>x \<in> S \<union> T. g x = (if x \<in> S then 0 else 1)"
+      using R by blast
+    then show "\<exists>f. continuous_map X euclideanreal f \<and> f ` S \<subseteq> {0} \<and> f ` T \<subseteq> {1}"
+      by (smt (verit) Un_iff \<open>disjnt S T\<close> disjnt_iff image_subset_iff insert_iff)
+  qed
+qed
+
+subsection \<open>random metric space stuff\<close>
+
+
+lemma metrizable_imp_k_space:
+  assumes "metrizable_space X"
+  shows "k_space X"
+proof -
+  obtain M d where "Metric_space M d" and Xeq: "X = Metric_space.mtopology M d"
+    using assms unfolding metrizable_space_def by metis
+  then interpret Metric_space M d 
+    by blast
+  show ?thesis
+    unfolding k_space Xeq
+  proof clarsimp
+    fix S
+    assume "S \<subseteq> M" and S: "\<forall>K. compactin mtopology K \<longrightarrow> closedin (subtopology mtopology K) (K \<inter> S)"
+    have "l \<in> S"
+      if \<sigma>: "range \<sigma> \<subseteq> S" and l: "limitin mtopology \<sigma> l sequentially" for \<sigma> l
+    proof -
+      define K where "K \<equiv> insert l (range \<sigma>)"
+      interpret Submetric M d K
+      proof
+        show "K \<subseteq> M"
+          unfolding K_def using l limitin_mspace \<open>S \<subseteq> M\<close> \<sigma> by blast
+      qed
+      have "compactin mtopology K"
+        unfolding K_def using \<open>S \<subseteq> M\<close> \<sigma>
+        by (force intro: compactin_sequence_with_limit [OF l])
+      then have *: "closedin sub.mtopology (K \<inter> S)"
+        by (simp add: S mtopology_submetric)
+      have "\<sigma> n \<in> K \<inter> S" for n
+        by (simp add: K_def range_subsetD \<sigma>)
+      moreover have "limitin sub.mtopology \<sigma> l sequentially"
+        using l 
+        unfolding sub.limit_metric_sequentially limit_metric_sequentially
+        by (force simp: K_def)
+      ultimately have "l \<in> K \<inter> S"
+        by (meson * \<sigma> image_subsetI sub.metric_closedin_iff_sequentially_closed) 
+      then show ?thesis
+        by simp
+    qed
+    then show "closedin mtopology S"
+      unfolding metric_closedin_iff_sequentially_closed
+      using \<open>S \<subseteq> M\<close> by blast
+  qed
+qed
+
+lemma (in Metric_space) k_space_mtopology: "k_space mtopology"
+  by (simp add: metrizable_imp_k_space metrizable_space_mtopology)
+
+lemma k_space_euclideanreal: "k_space (euclidean :: 'a::metric_space topology)"
+  using metrizable_imp_k_space metrizable_space_euclidean by auto
+
+
+subsection\<open>Hereditarily normal spaces\<close>
+
+lemma hereditarily_B:
+  assumes "\<And>S T. separatedin X S T
+      \<Longrightarrow> \<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+  shows "hereditarily normal_space X"
+  unfolding hereditarily_def
+proof (intro strip)
+  fix W
+  assume "W \<subseteq> topspace X"
+  show "normal_space (subtopology X W)"
+    unfolding normal_space_def
+  proof clarify
+    fix S T
+    assume clo: "closedin (subtopology X W) S" "closedin (subtopology X W) T"
+      and "disjnt S T"
+    then have "separatedin (subtopology X W) S T"
+      by (simp add: separatedin_closed_sets)
+    then obtain U V where "openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+      using assms [of S T] by (meson separatedin_subtopology)
+    then show "\<exists>U V. openin (subtopology X W) U \<and> openin (subtopology X W) V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+      apply (simp add: openin_subtopology_alt)
+      by (meson clo closedin_imp_subset disjnt_subset1 disjnt_subset2 inf_le2)
+  qed
+qed
+
+lemma hereditarily_C: 
+  assumes "separatedin X S T" and norm: "\<And>U. openin X U \<Longrightarrow> normal_space (subtopology X U)"
+  shows "\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+proof -
+  define ST where "ST \<equiv> X closure_of S \<inter> X closure_of T"
+  have subX: "S \<subseteq> topspace X" "T \<subseteq> topspace X"
+    by (meson \<open>separatedin X S T\<close> separation_closedin_Un_gen)+
+  have sub: "S \<subseteq> topspace X - ST" "T \<subseteq> topspace X - ST"
+    unfolding ST_def
+    by (metis Diff_mono Diff_triv \<open>separatedin X S T\<close> Int_lower1 Int_lower2 separatedin_def)+
+  have "normal_space (subtopology X (topspace X - ST))"
+    by (simp add: ST_def norm closedin_Int openin_diff)
+  moreover have " disjnt (subtopology X (topspace X - ST) closure_of S)
+                         (subtopology X (topspace X - ST) closure_of T)"
+    using Int_absorb1 ST_def sub by (fastforce simp: disjnt_iff closure_of_subtopology)
+  ultimately show ?thesis
+    using sub subX
+    apply (simp add: normal_space_closures)
+    by (metis ST_def closedin_Int closedin_closure_of closedin_def openin_trans_full)
+qed
+
+lemma hereditarily_normal_space: 
+  "hereditarily normal_space X \<longleftrightarrow> (\<forall>U. openin X U \<longrightarrow> normal_space(subtopology X U))"
+  by (metis hereditarily_B hereditarily_C hereditarily)
+
+lemma hereditarily_normal_separation:
+  "hereditarily normal_space X \<longleftrightarrow>
+        (\<forall>S T. separatedin X S T
+             \<longrightarrow> (\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V))"
+  by (metis hereditarily_B hereditarily_C hereditarily)
+
+
+lemma metrizable_imp_hereditarily_normal_space:
+   "metrizable_space X \<Longrightarrow> hereditarily normal_space X"
+  by (simp add: hereditarily metrizable_imp_normal_space metrizable_space_subtopology)
+
+lemma metrizable_space_separation:
+   "\<lbrakk>metrizable_space X; separatedin X S T\<rbrakk>
+    \<Longrightarrow> \<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+  by (metis hereditarily hereditarily_C metrizable_imp_hereditarily_normal_space)
+
+lemma hereditarily_normal_separation_pairwise:
+   "hereditarily normal_space X \<longleftrightarrow>
+    (\<forall>\<U>. finite \<U> \<and> (\<forall>S \<in> \<U>. S \<subseteq> topspace X) \<and> pairwise (separatedin X) \<U>
+        \<longrightarrow> (\<exists>\<F>. (\<forall>S \<in> \<U>. openin X (\<F> S) \<and> S \<subseteq> \<F> S) \<and>
+                pairwise (\<lambda>S T. disjnt (\<F> S) (\<F> T)) \<U>))"
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume L: ?lhs 
+  show ?rhs
+  proof clarify
+    fix \<U>
+    assume "finite \<U>" and \<U>: "\<forall>S\<in>\<U>. S \<subseteq> topspace X" 
+      and pw\<U>: "pairwise (separatedin X) \<U>"
+    have "\<exists>V W. openin X V \<and> openin X W \<and> S \<subseteq> V \<and>
+                    (\<forall>T. T \<in> \<U> \<and> T \<noteq> S \<longrightarrow> T \<subseteq> W) \<and> disjnt V W" 
+      if "S \<in> \<U>" for S
+    proof -
+      have "separatedin X S (\<Union>(\<U> - {S}))"
+        by (metis \<U> \<open>finite \<U>\<close> pw\<U> finite_Diff pairwise_alt separatedin_Union(1) that)
+      with L show ?thesis
+        unfolding hereditarily_normal_separation
+        by (smt (verit) Diff_iff UnionI empty_iff insert_iff subset_iff)
+    qed
+    then obtain \<F> \<G> 
+        where *: "\<And>S. S \<in> \<U> \<Longrightarrow> S \<subseteq> \<F> S \<and> (\<forall>T. T \<in> \<U> \<and> T \<noteq> S \<longrightarrow> T \<subseteq> \<G> S)" 
+        and ope: "\<And>S. S \<in> \<U> \<Longrightarrow> openin X (\<F> S) \<and> openin X (\<G> S)" 
+        and dis: "\<And>S. S \<in> \<U> \<Longrightarrow> disjnt (\<F> S) (\<G> S)" 
+      by metis
+    define \<H> where "\<H> \<equiv> \<lambda>S. \<F> S \<inter> (\<Inter>T \<in> \<U> - {S}. \<G> T)"
+    show "\<exists>\<F>. (\<forall>S\<in>\<U>. openin X (\<F> S) \<and> S \<subseteq> \<F> S) \<and> pairwise (\<lambda>S T. disjnt (\<F> S) (\<F> T)) \<U>"
+    proof (intro exI conjI strip)
+      show "openin X (\<H> S)" if "S \<in> \<U>" for S
+        unfolding \<H>_def 
+        by (smt (verit) ope that DiffD1 \<open>finite \<U>\<close> finite_Diff finite_imageI imageE openin_Int_Inter)
+      show "S \<subseteq> \<H> S" if "S \<in> \<U>" for S
+        unfolding \<H>_def using "*" that by auto 
+    show "pairwise (\<lambda>S T. disjnt (\<H> S) (\<H> T)) \<U>"
+      using dis by (fastforce simp: disjnt_iff pairwise_alt \<H>_def)
+    qed
+  qed
+next
+  assume R: ?rhs 
+  show ?lhs
+    unfolding hereditarily_normal_separation
+  proof (intro strip)
+    fix S T
+    assume "separatedin X S T"
+    show "\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+    proof (cases "T=S")
+      case True
+      then show ?thesis
+        using \<open>separatedin X S T\<close> by force
+    next
+      case False
+      have "pairwise (separatedin X) {S, T}"
+        by (simp add: \<open>separatedin X S T\<close> pairwise_insert separatedin_sym)
+      moreover have "\<forall>S\<in>{S, T}. S \<subseteq> topspace X"
+        by (metis \<open>separatedin X S T\<close> insertE separatedin_def singletonD)
+        ultimately show ?thesis
+        using R by (smt (verit) False finite.emptyI finite.insertI insertCI pairwiseD)
+    qed
+  qed
+qed
+
+lemma hereditarily_normal_space_perfect_map_image:
+   "\<lbrakk>hereditarily normal_space X; perfect_map X Y f\<rbrakk> \<Longrightarrow> hereditarily normal_space Y"
+  unfolding perfect_map_def proper_map_def
+  by (meson hereditarily_normal_space_continuous_closed_map_image)
+
+lemma regular_second_countable_imp_hereditarily_normal_space:
+  assumes "regular_space X \<and> second_countable X"
+  shows  "hereditarily normal_space X"
+  unfolding hereditarily
+  proof (intro regular_Lindelof_imp_normal_space strip)
+  show "regular_space (subtopology X S)" for S
+    by (simp add: assms regular_space_subtopology)
+  show "Lindelof_space (subtopology X S)" for S
+    using assms by (simp add: second_countable_imp_Lindelof_space second_countable_subtopology)
+qed
+
+
+subsection\<open>Completely regular spaces\<close>
+
+definition completely_regular_space where
+ "completely_regular_space X \<equiv>
+    \<forall>S x. closedin X S \<and> x \<in> topspace X - S
+          \<longrightarrow> (\<exists>f::'a\<Rightarrow>real. continuous_map X (top_of_set {0..1}) f \<and>
+                  f x = 0 \<and> (f ` S \<subseteq> {1}))"
+
+lemma homeomorphic_completely_regular_space_aux:
+  assumes X: "completely_regular_space X" and hom: "X homeomorphic_space Y"
+  shows "completely_regular_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)"
+    using assms X homeomorphic_maps_map homeomorphic_space_def by fastforce
+  show ?thesis
+    unfolding completely_regular_space_def
+  proof clarify
+    fix S x
+    assume A: "closedin Y S" and x: "x \<in> topspace Y" and "x \<notin> S"
+    then have "closedin X (g`S)"
+      using hmg homeomorphic_map_closedness_eq by blast
+    moreover have "g x \<notin> g`S"
+      by (meson A x \<open>x \<notin> S\<close> closedin_subset hmg homeomorphic_imp_injective_map inj_on_image_mem_iff)
+    ultimately obtain \<phi> where \<phi>: "continuous_map X (top_of_set {0..1::real}) \<phi> \<and> \<phi> (g x) = 0 \<and> \<phi> ` g`S \<subseteq> {1}"
+      by (metis DiffI X completely_regular_space_def hmg homeomorphic_imp_surjective_map image_eqI x)
+    then have "continuous_map Y (top_of_set {0..1::real}) (\<phi> \<circ> g)"
+      by (meson continuous_map_compose hmg homeomorphic_imp_continuous_map)
+    then show "\<exists>\<psi>. continuous_map Y (top_of_set {0..1::real}) \<psi> \<and> \<psi> x = 0 \<and> \<psi> ` S \<subseteq> {1}"
+      by (metis \<phi> comp_apply image_comp)
+  qed
+qed
+
+lemma homeomorphic_completely_regular_space:
+  assumes "X homeomorphic_space Y"
+  shows "completely_regular_space X \<longleftrightarrow> completely_regular_space Y"
+  by (meson assms homeomorphic_completely_regular_space_aux homeomorphic_space_sym)
+
+lemma completely_regular_space_alt:
+   "completely_regular_space X \<longleftrightarrow>
+     (\<forall>S x. closedin X S \<longrightarrow> x \<in> topspace X - S
+           \<longrightarrow> (\<exists>f. continuous_map X euclideanreal f \<and> f x = 0 \<and> f ` S \<subseteq> {1}))"
+proof -
+  have "\<exists>f. continuous_map X (top_of_set {0..1::real}) f \<and> f x = 0 \<and> f ` S \<subseteq> {1}" 
+    if "closedin X S" "x \<in> topspace X - S" and f: "continuous_map X euclideanreal f \<and> f x = 0 \<and> f ` S \<subseteq> {1}"
+    for S x f
+  proof (intro exI conjI)
+    show "continuous_map X (top_of_set {0..1}) (\<lambda>x. max 0 (min (f x) 1))"
+      using that
+      by (auto simp: continuous_map_in_subtopology intro!: continuous_map_real_max continuous_map_real_min)
+  qed (use that in auto)
+  with continuous_map_in_subtopology show ?thesis
+    unfolding completely_regular_space_def by metis 
+qed
+
+text \<open>As above, but with @{term openin}\<close>
+lemma completely_regular_space_alt':
+   "completely_regular_space X \<longleftrightarrow>
+     (\<forall>S x. openin X S \<longrightarrow> x \<in> S
+           \<longrightarrow> (\<exists>f. continuous_map X euclideanreal f \<and> f x = 0 \<and> f ` (topspace X - S) \<subseteq> {1}))"
+  apply (simp add: completely_regular_space_alt all_closedin)
+  by (meson openin_subset subsetD)
+
+lemma completely_regular_space_gen_alt:
+  fixes a b::real
+  assumes "a \<noteq> b"
+  shows "completely_regular_space X \<longleftrightarrow>
+         (\<forall>S x. closedin X S \<longrightarrow> x \<in> topspace X - S
+               \<longrightarrow> (\<exists>f. continuous_map X euclidean f \<and> f x = a \<and> (f ` S \<subseteq> {b})))"
+proof -
+  have "\<exists>f. continuous_map X euclideanreal f \<and> f x = 0 \<and> f ` S \<subseteq> {1}" 
+    if "closedin X S" "x \<in> topspace X - S" 
+        and f: "continuous_map X euclidean f \<and> f x = a \<and> f ` S \<subseteq> {b}"
+    for S x f
+  proof (intro exI conjI)
+    show "continuous_map X euclideanreal ((\<lambda>x. inverse(b - a) * (x - a)) \<circ> f)"
+      using that by (intro continuous_intros) auto
+  qed (use that assms in auto)
+  moreover
+  have "\<exists>f. continuous_map X euclidean f \<and> f x = a \<and> f ` S \<subseteq> {b}" 
+    if "closedin X S" "x \<in> topspace X - S" 
+        and f: "continuous_map X euclideanreal f \<and> f x = 0 \<and> f ` S \<subseteq> {1}"
+    for S x f
+  proof (intro exI conjI)
+    show "continuous_map X euclideanreal ((\<lambda>x. a + (b - a) * x) \<circ> f)"
+      using that by (intro continuous_intros) auto
+  qed (use that in auto)
+  ultimately show ?thesis
+    unfolding completely_regular_space_alt by meson
+qed
+
+text \<open>As above, but with @{term openin}\<close>
+lemma completely_regular_space_gen_alt':
+  fixes a b::real
+  assumes "a \<noteq> b"
+  shows "completely_regular_space X \<longleftrightarrow>
+         (\<forall>S x. openin X S \<longrightarrow> x \<in> S
+               \<longrightarrow> (\<exists>f. continuous_map X euclidean f \<and> f x = a \<and> (f ` (topspace X - S) \<subseteq> {b})))"
+  apply (simp add: completely_regular_space_gen_alt[OF assms] all_closedin)
+  by (meson openin_subset subsetD)
+
+lemma completely_regular_space_gen:
+  fixes a b::real
+  assumes "a < b"
+  shows "completely_regular_space X \<longleftrightarrow>
+         (\<forall>S x. closedin X S \<and> x \<in> topspace X - S
+               \<longrightarrow> (\<exists>f. continuous_map X (top_of_set {a..b}) f \<and> f x = a \<and> f ` S \<subseteq> {b}))"
+proof -
+  have "\<exists>f. continuous_map X (top_of_set {a..b}) f \<and> f x = a \<and> f ` S \<subseteq> {b}" 
+    if "closedin X S" "x \<in> topspace X - S" 
+      and f: "continuous_map X euclidean f \<and> f x = a \<and> f ` S \<subseteq> {b}"
+    for S x f
+  proof (intro exI conjI)
+    show "continuous_map X (top_of_set {a..b}) (\<lambda>x. max a (min (f x) b))"
+      using that assms
+      by (auto simp: continuous_map_in_subtopology intro!: continuous_map_real_max continuous_map_real_min)
+  qed (use that assms in auto)
+  with continuous_map_in_subtopology assms show ?thesis
+    using completely_regular_space_gen_alt [of a b]
+    by (smt (verit) atLeastAtMost_singleton atLeastatMost_empty singletonI)
+qed
+
+lemma normal_imp_completely_regular_space_A:
+  assumes "normal_space X" "t1_space X"
+  shows "completely_regular_space X"
+  unfolding completely_regular_space_alt
+proof clarify
+  fix x S
+  assume A: "closedin X S" "x \<notin> S"
+  assume "x \<in> topspace X" 
+  then have "closedin X {x}"
+    by (simp add: \<open>t1_space X\<close> closedin_t1_singleton)
+  with A \<open>normal_space X\<close> have "\<exists>f. continuous_map X euclideanreal f \<and> f ` {x} \<subseteq> {0} \<and> f ` S \<subseteq> {1}"
+    using assms unfolding normal_space_iff_Urysohn_alt disjnt_iff by blast
+  then show "\<exists>f. continuous_map X euclideanreal f \<and> f x = 0 \<and> f ` S \<subseteq> {1}"
+    by auto
+qed
+
+lemma normal_imp_completely_regular_space_B:
+  assumes "normal_space X" "regular_space X"
+  shows "completely_regular_space X"
+  unfolding completely_regular_space_alt
+proof clarify
+  fix x S
+  assume "closedin X S" "x \<notin> S" "x \<in> topspace X" 
+  then obtain U C where "openin X U" "closedin X C" "x \<in> U" "U \<subseteq> C" "C \<subseteq> topspace X - S"
+    using assms
+    unfolding neighbourhood_base_of_closedin [symmetric] neighbourhood_base_of closedin_def by (metis Diff_iff)
+  then obtain f where "continuous_map X euclideanreal f \<and> f ` C \<subseteq> {0} \<and> f ` S \<subseteq> {1}"
+    using assms unfolding normal_space_iff_Urysohn_alt
+    by (metis Diff_iff \<open>closedin X S\<close> disjnt_iff subsetD)
+  then show "\<exists>f. continuous_map X euclideanreal f \<and> f x = 0 \<and> f ` S \<subseteq> {1}"
+    by (meson \<open>U \<subseteq> C\<close> \<open>x \<in> U\<close> image_subset_iff singletonD subsetD)
+qed
+
+lemma normal_imp_completely_regular_space_gen:
+   "\<lbrakk>normal_space X; t1_space X \<or> Hausdorff_space X \<or> regular_space X\<rbrakk> \<Longrightarrow> completely_regular_space X"
+  using normal_imp_completely_regular_space_A normal_imp_completely_regular_space_B t1_or_Hausdorff_space by blast
+
+lemma normal_imp_completely_regular_space:
+   "\<lbrakk>normal_space X; Hausdorff_space X \<or> regular_space X\<rbrakk> \<Longrightarrow> completely_regular_space X"
+  by (simp add: normal_imp_completely_regular_space_gen)
+
+lemma (in Metric_space) completely_regular_space_mtopology:
+   "completely_regular_space mtopology"
+  by (simp add: normal_imp_completely_regular_space normal_space_mtopology regular_space_mtopology)
+
+lemma metrizable_imp_completely_regular_space:
+   "metrizable_space X \<Longrightarrow> completely_regular_space X"
+  by (simp add: metrizable_imp_normal_space metrizable_imp_regular_space normal_imp_completely_regular_space)
+
+lemma completely_regular_space_discrete_topology:
+   "completely_regular_space(discrete_topology U)"
+  by (simp add: normal_imp_completely_regular_space normal_space_discrete_topology)
+
+lemma completely_regular_space_subtopology:
+  assumes "completely_regular_space X"
+  shows "completely_regular_space (subtopology X S)"
+  unfolding completely_regular_space_def
+proof clarify
+  fix A x
+  assume "closedin (subtopology X S) A" and x: "x \<in> topspace (subtopology X S)" and "x \<notin> A"
+  then obtain T where "closedin X T" "A = S \<inter> T" "x \<in> topspace X" "x \<in> S"
+    by (force simp: closedin_subtopology_alt image_iff)
+  then show "\<exists>f. continuous_map (subtopology X S) (top_of_set {0::real..1}) f \<and> f x = 0 \<and> f ` A \<subseteq> {1}"
+    using assms \<open>x \<notin> A\<close>  
+    apply (simp add: completely_regular_space_def continuous_map_from_subtopology)
+    using continuous_map_from_subtopology by fastforce
+qed
+
+lemma completely_regular_space_retraction_map_image:
+   " \<lbrakk>retraction_map X Y r; completely_regular_space X\<rbrakk> \<Longrightarrow> completely_regular_space Y"
+  using completely_regular_space_subtopology hereditary_imp_retractive_property homeomorphic_completely_regular_space by blast
+
+lemma completely_regular_imp_regular_space:
+  assumes "completely_regular_space X" 
+  shows "regular_space X"
+proof -
+  have *: "\<exists>U V. openin X U \<and> openin X V \<and> a \<in> U \<and> C \<subseteq> V \<and> disjnt U V"
+    if contf: "continuous_map X euclideanreal f" and a: "a \<in> topspace X - C" and "closedin X C"
+      and fim: "f ` topspace X \<subseteq> {0..1}" and f0: "f a = 0" and f1: "f ` C \<subseteq> {1}"
+    for C a f
+  proof (intro exI conjI)
+    show "openin X {x \<in> topspace X. f x \<in> {..<1 / 2}}" "openin X {x \<in> topspace X. f x \<in> {1 / 2<..}}"
+      using openin_continuous_map_preimage [OF contf]
+      by (meson open_lessThan open_greaterThan open_openin)+
+    show "a \<in> {x \<in> topspace X. f x \<in> {..<1 / 2}}"
+      using a f0 by auto
+    show "C \<subseteq> {x \<in> topspace X. f x \<in> {1 / 2<..}}"
+      using \<open>closedin X C\<close> f1 closedin_subset by auto
+  qed (auto simp: disjnt_iff)
+  show ?thesis
+    using assms
+    unfolding completely_regular_space_def regular_space_def continuous_map_in_subtopology
+    by (meson "*")
+qed
+
+
+lemma locally_compact_regular_imp_completely_regular_space:
+  assumes "locally_compact_space X" "Hausdorff_space X \<or> regular_space X"
+  shows "completely_regular_space X"
+  unfolding completely_regular_space_def
+proof clarify
+  fix S x
+  assume "closedin X S" and "x \<in> topspace X" and "x \<notin> S"
+  have "regular_space X"
+    using assms locally_compact_Hausdorff_imp_regular_space by blast
+  then have nbase: "neighbourhood_base_of (\<lambda>C. compactin X C \<and> closedin X C) X"
+    using assms(1) locally_compact_regular_space_neighbourhood_base by blast
+  then obtain U M where "openin X U" "compactin X M" "closedin X M" "x \<in> U" "U \<subseteq> M" "M \<subseteq> topspace X - S"
+    unfolding neighbourhood_base_of by (metis (no_types, lifting) Diff_iff \<open>closedin X S\<close> \<open>x \<in> topspace X\<close> \<open>x \<notin> S\<close> closedin_def)
+  then have "M \<subseteq> topspace X"
+    by blast
+  obtain V K where "openin X V" "closedin X K" "x \<in> V" "V \<subseteq> K" "K \<subseteq> U"
+    by (metis (no_types, lifting) \<open>openin X U\<close> \<open>x \<in> U\<close> neighbourhood_base_of nbase)
+  have "compact_space (subtopology X M)"
+    by (simp add: \<open>compactin X M\<close> compact_space_subtopology)
+  then have "normal_space (subtopology X M)"
+    by (simp add: \<open>regular_space X\<close> compact_Hausdorff_or_regular_imp_normal_space regular_space_subtopology)
+  moreover have "closedin (subtopology X M) K"
+    using \<open>K \<subseteq> U\<close> \<open>U \<subseteq> M\<close> \<open>closedin X K\<close> closedin_subset_topspace by fastforce
+  moreover have "closedin (subtopology X M) (M - U)"
+    by (simp add: \<open>closedin X M\<close> \<open>openin X U\<close> closedin_diff closedin_subset_topspace)
+  moreover have "disjnt K (M - U)"
+    by (meson DiffD2 \<open>K \<subseteq> U\<close> disjnt_iff subsetD)
+  ultimately obtain f::"'a\<Rightarrow>real" where contf: "continuous_map (subtopology X M) (top_of_set {0..1}) f" 
+    and f0: "f ` K \<subseteq> {0}" and f1: "f ` (M - U) \<subseteq> {1}"
+    using Urysohn_lemma [of "subtopology X M" K "M-U" 0 1] by auto
+  then obtain g::"'a\<Rightarrow>real" where contg: "continuous_map (subtopology X M) euclidean g" and gim: "g ` M \<subseteq> {0..1}"
+    and g0: "\<And>x. x \<in> K \<Longrightarrow> g x = 0" and g1: "\<And>x. \<lbrakk>x \<in> M; x \<notin> U\<rbrakk> \<Longrightarrow> g x = 1"
+    using \<open>M \<subseteq> topspace X\<close> by (force simp add: continuous_map_in_subtopology image_subset_iff)
+  show "\<exists>f::'a\<Rightarrow>real. continuous_map X (top_of_set {0..1}) f \<and> f x = 0 \<and> f ` S \<subseteq> {1}"
+  proof (intro exI conjI)
+    show "continuous_map X (top_of_set {0..1}) (\<lambda>x. if x \<in> M then g x else 1)"
+      unfolding continuous_map_closedin
+    proof (intro strip conjI)
+      fix C
+      assume C: "closedin (top_of_set {0::real..1}) C"
+      have eq: "{x \<in> topspace X. (if x \<in> M then g x else 1) \<in> C} = {x \<in> M. g x \<in> C} \<union> (if 1 \<in> C then topspace X - U else {})"
+        using \<open>U \<subseteq> M\<close> \<open>M \<subseteq> topspace X\<close> g1 by auto
+      show "closedin X {x \<in> topspace X. (if x \<in> M then g x else 1) \<in> C}"
+        unfolding eq
+      proof (intro closedin_Un)
+        have "closedin euclidean C"
+          using C closed_closedin closedin_closed_trans by blast
+        then have "closedin (subtopology X M) {x \<in> M. g x \<in> C}"
+          using closedin_continuous_map_preimage_gen [OF contg] \<open>M \<subseteq> topspace X\<close> by auto
+        then show "closedin X {x \<in> M. g x \<in> C}"
+          using \<open>closedin X M\<close> closedin_trans_full by blast
+      qed (use \<open>openin X U\<close> in force)
+    qed (use gim in force)
+    show "(if x \<in> M then g x else 1) = 0"
+      using \<open>U \<subseteq> M\<close> \<open>V \<subseteq> K\<close> g0 \<open>x \<in> U\<close> \<open>x \<in> V\<close> by auto
+    show "(\<lambda>x. if x \<in> M then g x else 1) ` S \<subseteq> {1}"
+      using \<open>M \<subseteq> topspace X - S\<close> by auto
+  qed
+qed
+
+lemma completely_regular_eq_regular_space:
+   "locally_compact_space X
+        \<Longrightarrow> (completely_regular_space X \<longleftrightarrow> regular_space X)"
+  using completely_regular_imp_regular_space locally_compact_regular_imp_completely_regular_space 
+  by blast
+
+lemma completely_regular_space_prod_topology:
+   "completely_regular_space (prod_topology X Y) \<longleftrightarrow>
+      topspace (prod_topology X Y) = {} \<or>
+      completely_regular_space X \<and> completely_regular_space Y" (is "?lhs=?rhs")
+proof
+  assume ?lhs then show ?rhs
+    by (rule topological_property_of_prod_component) 
+       (auto simp: completely_regular_space_subtopology homeomorphic_completely_regular_space)
+next
+  assume R: ?rhs
+  show ?lhs
+  proof (cases "topspace(prod_topology X Y) = {}")
+    case False
+    then have X: "completely_regular_space X" and Y: "completely_regular_space Y"
+      using R by blast+
+    show ?thesis
+      unfolding completely_regular_space_alt'
+    proof clarify
+      fix W x y
+      assume "openin (prod_topology X Y) W" and "(x, y) \<in> W"
+      then obtain U V where "openin X U" "openin Y V" "x \<in> U" "y \<in> V" "U\<times>V \<subseteq> W"
+        by (force simp: openin_prod_topology_alt)
+      then have "x \<in> topspace X" "y \<in> topspace Y"
+        using openin_subset by fastforce+
+      obtain f where contf: "continuous_map X euclideanreal f" and "f x = 0" 
+        and f1: "\<And>x. x \<in> topspace X \<Longrightarrow> x \<notin> U \<Longrightarrow> f x = 1"
+        using X \<open>openin X U\<close> \<open>x \<in> U\<close> unfolding completely_regular_space_alt'
+        by (smt (verit, best) Diff_iff image_subset_iff singletonD)
+      obtain g where contg: "continuous_map Y euclideanreal g" and "g y = 0" 
+        and g1: "\<And>y. y \<in> topspace Y \<Longrightarrow> y \<notin> V \<Longrightarrow> g y = 1"
+        using Y \<open>openin Y V\<close> \<open>y \<in> V\<close> unfolding completely_regular_space_alt'
+        by (smt (verit, best) Diff_iff image_subset_iff singletonD)
+      define h where "h \<equiv> \<lambda>(x,y). 1 - (1 - f x) * (1 - g y)"
+      show "\<exists>h. continuous_map (prod_topology X Y) euclideanreal h \<and> h (x,y) = 0 \<and> h ` (topspace (prod_topology X Y) - W) \<subseteq> {1}"
+      proof (intro exI conjI)
+        have "continuous_map (prod_topology X Y) euclideanreal (f \<circ> fst)"
+          using contf continuous_map_of_fst by blast
+        moreover
+        have "continuous_map (prod_topology X Y) euclideanreal (g \<circ> snd)"
+          using contg continuous_map_of_snd by blast
+        ultimately
+        show "continuous_map (prod_topology X Y) euclideanreal h"
+          unfolding o_def h_def case_prod_unfold
+          by (intro continuous_intros) auto
+        show "h (x, y) = 0"
+          by (simp add: h_def \<open>f x = 0\<close> \<open>g y = 0\<close>)
+        show "h ` (topspace (prod_topology X Y) - W) \<subseteq> {1}"
+          using \<open>U \<times> V \<subseteq> W\<close> f1 g1 by (force simp: h_def)
+      qed
+    qed
+  qed (force simp: completely_regular_space_def)
+qed
+
+
+lemma completely_regular_space_product_topology:
+   "completely_regular_space (product_topology X I) \<longleftrightarrow>
+    (\<Pi>\<^sub>E i\<in>I. topspace(X i)) = {} \<or> (\<forall>i \<in> I. completely_regular_space (X i))" 
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume ?lhs then show ?rhs
+    by (rule topological_property_of_product_component) 
+       (auto simp: completely_regular_space_subtopology homeomorphic_completely_regular_space)
+next
+  assume R: ?rhs
+  show ?lhs
+  proof (cases "(\<Pi>\<^sub>E i\<in>I. topspace(X i)) = {}")
+    case False
+    show ?thesis
+      unfolding completely_regular_space_alt'
+    proof clarify
+      fix W x
+      assume W: "openin (product_topology X I) W" and "x \<in> W"
+      then obtain U where finU: "finite {i \<in> I. U i \<noteq> topspace (X i)}" 
+             and ope: "\<And>i. i\<in>I \<Longrightarrow> openin (X i) (U i)" 
+             and x: "x \<in> Pi\<^sub>E I U" and "Pi\<^sub>E I U \<subseteq> W"
+        by (auto simp: openin_product_topology_alt)
+      have "\<forall>i \<in> I. openin (X i) (U i) \<and> x i \<in> U i
+              \<longrightarrow> (\<exists>f. continuous_map (X i) euclideanreal f \<and>
+                       f (x i) = 0 \<and> (\<forall>x \<in> topspace(X i). x \<notin> U i \<longrightarrow> f x = 1))"
+        using R unfolding completely_regular_space_alt'
+        by (smt (verit) DiffI False image_subset_iff singletonD)
+      with ope x have "\<And>i. \<exists>f. i \<in> I \<longrightarrow> continuous_map (X i) euclideanreal f \<and>
+              f (x i) = 0 \<and> (\<forall>x \<in> topspace (X i). x \<notin> U i \<longrightarrow> f x = 1)"
+        by auto
+      then obtain f where f: "\<And>i. i \<in> I \<Longrightarrow> continuous_map (X i) euclideanreal (f i) \<and>
+                                             f i (x i) = 0 \<and> (\<forall>x \<in> topspace (X i). x \<notin> U i \<longrightarrow> f i x = 1)"
+        by metis
+      define h where "h \<equiv> \<lambda>z. 1 - prod (\<lambda>i. 1 - f i (z i)) {i\<in>I. U i \<noteq> topspace(X i)}"
+      show "\<exists>h. continuous_map (product_topology X I) euclideanreal h \<and> h x = 0 \<and>
+                     h ` (topspace (product_topology X I) - W) \<subseteq> {1}"
+      proof (intro conjI exI)
+        have "continuous_map (product_topology X I) euclidean (f i \<circ> (\<lambda>x. x i))" if "i\<in>I" for i
+          using f that
+          by (blast intro: continuous_intros continuous_map_product_projection)
+        then show "continuous_map (product_topology X I) euclideanreal h"
+          unfolding h_def o_def by (intro continuous_intros) (auto simp: finU)
+        show "h x = 0"
+          by (simp add: h_def f)
+        show "h ` (topspace (product_topology X I) - W) \<subseteq> {1}"
+          proof -
+          have "\<exists>i. i \<in> I \<and> U i \<noteq> topspace (X i) \<and> f i (x' i) = 1"
+            if "x' \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))" "x' \<notin> W" for x'
+            using that \<open>Pi\<^sub>E I U \<subseteq> W\<close> by (smt (verit, best) PiE_iff f in_mono)
+          then show ?thesis
+            by (auto simp: f h_def finU)
+        qed
+      qed
+    qed      
+  qed (force simp: completely_regular_space_def)
+qed
+
+
+lemma (in Metric_space) t1_space_mtopology:
+   "t1_space mtopology"
+  using Hausdorff_space_mtopology t1_or_Hausdorff_space by blast
+
+
+subsection\<open>More generally, the k-ification functor\<close>
+
+definition kification_open 
+  where "kification_open \<equiv> 
+          \<lambda>X S. S \<subseteq> topspace X \<and> (\<forall>K. compactin X K \<longrightarrow> openin (subtopology X K) (K \<inter> S))"
+
+definition kification 
+  where "kification X \<equiv> topology (kification_open X)"
+
+lemma istopology_kification_open: "istopology (kification_open X)"
+  unfolding istopology_def
+proof (intro conjI strip)
+  show "kification_open X (S \<inter> T)"
+    if "kification_open X S" and "kification_open X T" for S T
+    using that unfolding kification_open_def
+    by (smt (verit, best) inf.idem inf_commute inf_left_commute le_infI2 openin_Int)
+  show "kification_open X (\<Union> \<K>)" if "\<forall>K\<in>\<K>. kification_open X K" for \<K>
+    using that unfolding kification_open_def Int_Union by blast
+qed
+
+lemma openin_kification:
+   "openin (kification X) U \<longleftrightarrow>
+        U \<subseteq> topspace X \<and>
+        (\<forall>K. compactin X K \<longrightarrow> openin (subtopology X K) (K \<inter> U))"
+  by (metis topology_inverse' kification_def istopology_kification_open kification_open_def)
+
+lemma openin_kification_finer:
+   "openin X S \<Longrightarrow> openin (kification X) S"
+  by (simp add: openin_kification openin_subset openin_subtopology_Int2)
+
+lemma topspace_kification [simp]:
+   "topspace(kification X) = topspace X"
+  by (meson openin_kification openin_kification_finer openin_topspace subset_antisym)
+
+lemma closedin_kification:
+   "closedin (kification X) U \<longleftrightarrow>
+      U \<subseteq> topspace X \<and>
+      (\<forall>K. compactin X K \<longrightarrow> closedin (subtopology X K) (K \<inter> U))"
+proof (cases "U \<subseteq> topspace X")
+  case True
+  then show ?thesis
+    by (simp add: closedin_def Diff_Int_distrib inf_commute le_infI2 openin_kification)
+qed (simp add: closedin_def)
+
+lemma closedin_kification_finer: "closedin X S \<Longrightarrow> closedin (kification X) S"
+  by (simp add: closedin_def openin_kification_finer)
+
+lemma kification_eq_self: "kification X = X \<longleftrightarrow> k_space X"
+  unfolding fun_eq_iff openin_kification k_space_alt openin_inject [symmetric]
+  by (metis openin_closedin_eq)
+
+lemma compactin_kification [simp]:
+   "compactin (kification X) K \<longleftrightarrow> compactin X K" (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume ?lhs then show ?rhs
+    by (simp add: compactin_contractive openin_kification_finer)
+next
+  assume R: ?rhs
+  show ?lhs
+    unfolding compactin_def
+  proof (intro conjI strip)
+    show "K \<subseteq> topspace (kification X)"
+      by (simp add: R compactin_subset_topspace)
+    fix \<U>
+    assume \<U>: "Ball \<U> (openin (kification X)) \<and> K \<subseteq> \<Union> \<U>"
+    then have *: "\<And>U. U \<in> \<U> \<Longrightarrow> U \<subseteq> topspace X \<and> openin (subtopology X K) (K \<inter> U)"
+      by (simp add: R openin_kification)
+    have "K \<subseteq> topspace X" "compact_space (subtopology X K)"
+      using R compactin_subspace by force+
+    then have "\<exists>V. finite V \<and> V \<subseteq> (\<lambda>U. K \<inter> U) ` \<U> \<and> \<Union> V = topspace (subtopology X K)"
+      unfolding compact_space
+      by (smt (verit, del_insts) Int_Union \<U> * image_iff inf.order_iff inf_commute topspace_subtopology)
+    then show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union> \<F>"
+      by (metis Int_Union \<open>K \<subseteq> topspace X\<close> finite_subset_image inf.orderI topspace_subtopology_subset)
+  qed
+qed
+
+lemma compact_space_kification [simp]:
+   "compact_space(kification X) \<longleftrightarrow> compact_space X"
+  by (simp add: compact_space_def)
+
+lemma kification_kification [simp]:
+   "kification(kification X) = kification X"
+  unfolding openin_inject [symmetric]
+proof
+  fix U
+  show "openin (kification (kification X)) U = openin (kification X) U"
+  proof
+    show "openin (kification (kification X)) U \<Longrightarrow> openin (kification X) U"
+      by (metis compactin_kification inf_commute openin_kification openin_subtopology topspace_kification)
+  qed (simp add: openin_kification_finer)
+qed
+
+lemma k_space_kification [iff]: "k_space(kification X)"
+  using kification_eq_self by fastforce
+
+lemma continuous_map_into_kification:
+  assumes "k_space X"
+  shows "continuous_map X (kification Y) f \<longleftrightarrow> continuous_map X Y f" (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume ?lhs then show ?rhs
+    by (simp add: continuous_map_def openin_kification_finer)
+next
+  assume R: ?rhs
+  have "openin X {x \<in> topspace X. f x \<in> V}" if V: "openin (kification Y) V" for V
+  proof -
+    have "openin (subtopology X K) (K \<inter> {x \<in> topspace X. f x \<in> V})"
+      if "compactin X K" for K
+    proof -
+      have "compactin Y (f ` K)"
+        using R image_compactin that by blast
+      then have "openin (subtopology Y (f ` K)) (f ` K \<inter> V)"
+        by (meson V openin_kification)
+      then obtain U where U: "openin Y U" "f`K \<inter> V = U \<inter> f`K"
+        by (meson openin_subtopology)
+      show ?thesis
+        unfolding openin_subtopology
+      proof (intro conjI exI)
+        show "openin X {x \<in> topspace X. f x \<in> U}"
+          using R U openin_continuous_map_preimage_gen by (simp add: continuous_map_def)
+      qed (use U in auto)
+    qed
+    then show ?thesis
+      by (metis (full_types) Collect_subset assms k_space_open)
+  qed
+  with R show ?lhs
+    by (simp add: continuous_map_def)
+qed
+
+lemma continuous_map_from_kification:
+   "continuous_map X Y f \<Longrightarrow> continuous_map (kification X) Y f"
+  by (simp add: continuous_map_openin_preimage_eq openin_kification_finer)
+
+lemma continuous_map_kification:
+   "continuous_map X Y f \<Longrightarrow> continuous_map (kification X) (kification Y) f"
+  by (simp add: continuous_map_from_kification continuous_map_into_kification)
+
+lemma subtopology_kification_compact:
+  assumes "compactin X K"
+  shows "subtopology (kification X) K = subtopology X K"
+  unfolding openin_inject [symmetric]
+proof
+  fix U
+  show "openin (subtopology (kification X) K) U = openin (subtopology X K) U"
+    by (metis assms inf_commute openin_kification openin_subset openin_subtopology)
+qed
+
+
+lemma subtopology_kification_finer:
+  assumes "openin (subtopology (kification X) S) U"
+  shows "openin (kification (subtopology X S)) U"
+  using assms 
+  by (fastforce simp: openin_subtopology_alt image_iff openin_kification subtopology_subtopology compactin_subtopology)
+
+lemma proper_map_from_kification:
+  assumes "k_space Y"
+  shows "proper_map (kification X) Y f \<longleftrightarrow> proper_map X Y f"   (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume ?lhs then show ?rhs
+    by (simp add: closed_map_def closedin_kification_finer proper_map_alt)
+next
+  assume R: ?rhs
+  have "compactin Y K \<Longrightarrow> compactin X {x \<in> topspace X. f x \<in> K}" for K
+    using R proper_map_alt by auto
+  with R show ?lhs
+    by (simp add: assms proper_map_into_k_space_eq subtopology_kification_compact)
+qed
+
+lemma perfect_map_from_kification:
+   "\<lbrakk>k_space Y; perfect_map X Y f\<rbrakk> \<Longrightarrow> perfect_map(kification X) Y f"
+  by (simp add: continuous_map_from_kification perfect_map_def proper_map_from_kification)
+
+lemma k_space_perfect_map_image_eq:
+  assumes "Hausdorff_space X" "perfect_map X Y f"
+  shows "k_space X \<longleftrightarrow> k_space Y"
+proof
+  show "k_space X \<Longrightarrow> k_space Y"
+    using k_space_perfect_map_image assms by blast
+  assume "k_space Y"
+  have "homeomorphic_map (kification X) X id"
+    unfolding homeomorphic_eq_injective_perfect_map
+    proof (intro conjI perfect_map_from_composition_right [where f = id])
+  show "perfect_map (kification X) Y (f \<circ> id)"
+    by (simp add: \<open>k_space Y\<close> assms(2) perfect_map_from_kification)
+  show "continuous_map (kification X) X id"
+    by (simp add: continuous_map_from_kification)
+qed (use assms perfect_map_def in auto)
+  then show "k_space X"
+    using homeomorphic_k_space homeomorphic_space by blast 
+qed
+
+
+subsection\<open>One-point compactifications and the Alexandroff extension construction\<close>
+
+lemma one_point_compactification_dense:
+   "\<lbrakk>compact_space X; \<not> compactin X (topspace X - {a})\<rbrakk> \<Longrightarrow> X closure_of (topspace X - {a}) = topspace X"
+  unfolding closure_of_complement
+  by (metis Diff_empty closedin_compact_space interior_of_eq_empty openin_closedin_eq subset_singletonD)
+
+lemma one_point_compactification_interior:
+   "\<lbrakk>compact_space X; \<not> compactin X (topspace X - {a})\<rbrakk> \<Longrightarrow> X interior_of {a} = {}"
+  by (simp add: interior_of_eq_empty_complement one_point_compactification_dense)
+
+lemma kc_space_one_point_compactification_gen:
+  assumes "compact_space X"
+  shows "kc_space X \<longleftrightarrow>
+         openin X (topspace X - {a}) \<and> (\<forall>K. compactin X K \<and> a\<notin>K \<longrightarrow> closedin X K) \<and>
+         k_space (subtopology X (topspace X - {a})) \<and> kc_space (subtopology X (topspace X - {a}))"
+ (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume L: ?lhs show ?rhs
+  proof (intro conjI strip)
+    show "openin X (topspace X - {a})"
+      using L kc_imp_t1_space t1_space_openin_delete_alt by auto
+    then show "k_space (subtopology X (topspace X - {a}))"
+      by (simp add: L assms k_space_open_subtopology_aux)
+    show "closedin X k" if "compactin X k \<and> a \<notin> k" for k :: "'a set"
+      using L kc_space_def that by blast
+    show "kc_space (subtopology X (topspace X - {a}))"
+      by (simp add: L kc_space_subtopology)
+  qed
+next
+  assume R: ?rhs
+  show ?lhs
+    unfolding kc_space_def
+  proof (intro strip)
+    fix S
+    assume "compactin X S"
+    then have "S \<subseteq>topspace X"
+      by (simp add: compactin_subset_topspace)
+    show "closedin X S"
+    proof (cases "a \<in> S")
+      case True
+      then have "topspace X - S = topspace X - {a} - (S - {a})"
+        by auto
+      moreover have "openin X (topspace X - {a} - (S - {a}))"
+      proof (rule openin_trans_full)
+        show "openin (subtopology X (topspace X - {a})) (topspace X - {a} - (S - {a}))"
+        proof
+          show "openin (subtopology X (topspace X - {a})) (topspace X - {a})"
+            using R openin_open_subtopology by blast
+          have "closedin (subtopology X ((topspace X - {a}) \<inter> K)) (K \<inter> (S - {a}))"
+            if "compactin X K" "K \<subseteq> topspace X - {a}" for K
+          proof (intro closedin_subset_topspace)
+            show "closedin X (K \<inter> (S - {a}))"
+              using that
+              by (metis IntD1 Int_insert_right_if0 R True \<open>compactin X S\<close> closed_Int_compactin insert_Diff subset_Diff_insert)
+          qed (use that in auto)
+          moreover have "k_space (subtopology X (topspace X - {a}))"
+            using R by blast
+          moreover have "S-{a} \<subseteq> topspace X \<and> S-{a} \<subseteq> topspace X - {a}"
+            using \<open>S \<subseteq> topspace X\<close> by auto
+          ultimately show "closedin (subtopology X (topspace X - {a})) (S - {a})"
+            using \<open>S \<subseteq> topspace X\<close> True
+            by (simp add: k_space_def compactin_subtopology subtopology_subtopology)
+        qed 
+        show "openin X (topspace X - {a})"
+          by (simp add: R)
+      qed
+      ultimately show ?thesis
+        by (simp add: \<open>S \<subseteq> topspace X\<close> closedin_def)
+    next
+      case False
+      then show ?thesis
+        by (simp add: R \<open>compactin X S\<close>)
+    qed
+  qed
+qed
+
+  
+inductive Alexandroff_open for X where
+  base: "openin X U \<Longrightarrow> Alexandroff_open X (Some ` U)"
+| ext: "\<lbrakk>compactin X C; closedin X C\<rbrakk> \<Longrightarrow> Alexandroff_open X (insert None (Some ` (topspace X - C)))"
+
+hide_fact (open) base ext
+
+lemma Alexandroff_open_iff: "Alexandroff_open X S \<longleftrightarrow>
+   (\<exists>U. (S = Some ` U \<and> openin X U) \<or> (S = insert None (Some ` (topspace X - U)) \<and> compactin X U \<and> closedin X U))"
+  by (meson Alexandroff_open.cases Alexandroff_open.ext Alexandroff_open.base)
+
+lemma Alexandroff_open_Un_aux:
+  assumes U: "openin X U" and "Alexandroff_open X T"
+  shows  "Alexandroff_open X (Some ` U \<union> T)"
+  using \<open>Alexandroff_open X T\<close>
+proof (induction rule: Alexandroff_open.induct)
+  case (base V)
+  then show ?case
+    by (metis Alexandroff_open.base U image_Un openin_Un)
+next
+  case (ext C)
+  have "U \<subseteq> topspace X"
+    by (simp add: U openin_subset)
+  then have eq: "Some ` U \<union> insert None (Some ` (topspace X - C)) = insert None (Some ` (topspace X - (C \<inter> (topspace X - U))))"
+    by force
+  have "closedin X (C \<inter> (topspace X - U))"
+    using U ext.hyps(2) by blast
+  moreover
+  have "compactin X (C \<inter> (topspace X - U))"
+    using U compact_Int_closedin ext.hyps(1) by blast
+  ultimately show ?case
+    unfolding eq using Alexandroff_open.ext by blast
+qed
+
+lemma Alexandroff_open_Un:
+  assumes "Alexandroff_open X S" and "Alexandroff_open X T"
+  shows "Alexandroff_open X (S \<union> T)"
+  using assms
+proof (induction rule: Alexandroff_open.induct)
+  case (base U)
+  then show ?case
+    by (simp add: Alexandroff_open_Un_aux)
+next
+  case (ext C)
+  then show ?case
+    by (smt (verit, best) Alexandroff_open_Un_aux Alexandroff_open_iff Un_commute Un_insert_left closedin_def insert_absorb2)
+qed
+
+lemma Alexandroff_open_Int_aux:
+  assumes U: "openin X U" and "Alexandroff_open X T"
+  shows  "Alexandroff_open X (Some ` U \<inter> T)"
+  using \<open>Alexandroff_open X T\<close>
+proof (induction rule: Alexandroff_open.induct)
+  case (base V)
+  then show ?case
+    by (metis Alexandroff_open.base U image_Int inj_Some openin_Int)
+next
+  case (ext C)
+  have eq: "Some ` U \<inter> insert None (Some ` (topspace X - C)) = Some ` (topspace X - (C \<union> (topspace X - U)))"
+    by force
+  have "openin X (topspace X - (C \<union> (topspace X - U)))"
+    using U ext.hyps(2) by blast
+  then show ?case
+    unfolding eq using Alexandroff_open.base by blast
+qed
+
+lemma istopology_Alexandroff_open: "istopology (Alexandroff_open X)"
+  unfolding istopology_def
+proof (intro conjI strip)
+  fix S T
+  assume "Alexandroff_open X S" and "Alexandroff_open X T"
+  then show "Alexandroff_open X (S \<inter> T)"
+  proof (induction rule: Alexandroff_open.induct)
+    case (base U)
+    then show ?case
+      using Alexandroff_open_Int_aux by blast
+  next
+    case EC: (ext C)
+    show ?case
+      using \<open>Alexandroff_open X T\<close>
+    proof (induction rule: Alexandroff_open.induct)
+      case (base V)
+      then show ?case
+        by (metis Alexandroff_open.ext Alexandroff_open_Int_aux EC.hyps inf_commute)
+    next
+      case (ext D)
+      have eq: "insert None (Some ` (topspace X - C)) \<inter> insert None (Some ` (topspace X - D))
+              = insert None (Some ` (topspace X - (C \<union> D)))"
+        by auto
+      show ?case
+        unfolding eq
+        by (simp add: Alexandroff_open.ext EC.hyps closedin_Un compactin_Un ext.hyps)
+    qed
+  qed
+next
+  fix \<K>
+  assume \<section>: "\<forall>K\<in>\<K>. Alexandroff_open X K"
+  show "Alexandroff_open X (\<Union>\<K>)"
+  proof (cases "None \<in> \<Union>\<K>")
+    case True
+    have "\<forall>K\<in>\<K>. \<exists>U. (openin X U \<and> K = Some ` U) \<or> (K = insert None (Some ` (topspace X - U)) \<and> compactin X U \<and> closedin X U)"
+      by (metis \<section> Alexandroff_open_iff)
+    then obtain U where U: 
+      "\<And>K. K \<in> \<K> \<Longrightarrow> openin X (U K) \<and> K = Some ` (U K) 
+                    \<or> (K = insert None (Some ` (topspace X - U K)) \<and> compactin X (U K) \<and> closedin X (U K))"
+      by metis
+    define \<K>N where "\<K>N \<equiv> {K \<in> \<K>. None \<in> K}"
+    define A where "A \<equiv> \<Union>K\<in>\<K>-\<K>N. U K"
+    define B where "B \<equiv> \<Inter>K\<in>\<K>N. U K"
+    have U1: "\<And>K. K \<in> \<K>-\<K>N \<Longrightarrow> openin X (U K) \<and> K = Some ` (U K)"
+      using U \<K>N_def by auto
+    have U2: "\<And>K. K \<in> \<K>N \<Longrightarrow> K = insert None (Some ` (topspace X - U K)) \<and> compactin X (U K) \<and> closedin X (U K)"
+      using U \<K>N_def by auto
+    have eqA: "\<Union>(\<K>-\<K>N) = Some ` A"
+    proof
+      show "\<Union> (\<K> - \<K>N) \<subseteq> Some ` A"
+        by (metis A_def Sup_le_iff U1 UN_upper subset_image_iff)
+      show "Some ` A \<subseteq> \<Union> (\<K> - \<K>N)"
+        using A_def U1 by blast
+    qed
+    have eqB: "\<Union>\<K>N = insert None (Some ` (topspace X - B))"
+      using U2 True
+      by (auto simp: B_def image_iff \<K>N_def)
+    have "\<Union>\<K> = \<Union>\<K>N \<union> \<Union>(\<K>-\<K>N)"
+      by (auto simp: \<K>N_def)
+    then have eq: "\<Union>\<K> = (Some ` A) \<union> (insert None (Some ` (topspace X - B)))"
+      by (simp add: eqA eqB Un_commute)
+    show ?thesis
+      unfolding eq
+    proof (intro Alexandroff_open_Un Alexandroff_open.intros)
+      show "openin X A"
+        using A_def U1 by blast
+      show "closedin X B"
+        unfolding B_def using U2 True \<K>N_def by auto
+      show "compactin X B"
+        by (metis B_def U2 eqB Inf_lower Union_iff \<open>closedin X B\<close> closed_compactin imageI insertI1)
+    qed
+  next
+    case False
+    then have "\<forall>K\<in>\<K>. \<exists>U. openin X U \<and> K = Some ` U"
+      by (metis Alexandroff_open.simps UnionI \<section> insertCI)
+    then obtain U where U: "\<forall>K\<in>\<K>. openin X (U K) \<and> K = Some ` (U K)"
+      by metis
+    then have eq: "\<Union>\<K> = Some ` (\<Union> K\<in>\<K>. U K)"
+      using image_iff by fastforce
+    show ?thesis
+      unfolding eq by (simp add: U Alexandroff_open.base openin_clauses(3))
+  qed
+qed
+
+
+definition Alexandroff_compactification where
+  "Alexandroff_compactification X \<equiv> topology (Alexandroff_open X)"
+
+lemma openin_Alexandroff_compactification:
+   "openin(Alexandroff_compactification X) V \<longleftrightarrow>
+        (\<exists>U. openin X U \<and> V = Some ` U) \<or>
+        (\<exists>C. compactin X C \<and> closedin X C \<and> V = insert None (Some ` (topspace X - C)))"
+  by (auto simp: Alexandroff_compactification_def istopology_Alexandroff_open Alexandroff_open.simps)
+
+
+lemma topspace_Alexandroff_compactification [simp]:
+   "topspace(Alexandroff_compactification X) = insert None (Some ` topspace X)"
+   (is "?lhs = ?rhs")
+proof
+  show "?lhs \<subseteq> ?rhs"
+    by (force simp add: topspace_def openin_Alexandroff_compactification)
+  have "None \<in> topspace (Alexandroff_compactification X)"
+    by (meson closedin_empty compactin_empty insert_subset openin_Alexandroff_compactification openin_subset)
+  moreover have "Some x \<in> topspace (Alexandroff_compactification X)"
+    if "x \<in> topspace X" for x 
+    by (meson that imageI openin_Alexandroff_compactification openin_subset openin_topspace subsetD)
+  ultimately show "?rhs \<subseteq> ?lhs"
+    by (auto simp: image_subset_iff)
+qed
+
+lemma closedin_Alexandroff_compactification:
+   "closedin (Alexandroff_compactification X) C \<longleftrightarrow>
+      (\<exists>K. compactin X K \<and> closedin X K \<and> C = Some ` K) \<or>
+      (\<exists>U. openin X U \<and> C = topspace(Alexandroff_compactification X) - Some ` U)"
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof 
+  show "?lhs \<Longrightarrow> ?rhs"
+    apply (clarsimp simp: closedin_def openin_Alexandroff_compactification)
+    by (smt (verit) Diff_Diff_Int None_notin_image_Some image_set_diff inf.absorb_iff2 inj_Some insert_Diff_if subset_insert)
+  show "?rhs \<Longrightarrow> ?lhs"
+    using openin_subset 
+    by (fastforce simp: closedin_def openin_Alexandroff_compactification)
+qed
+
+lemma openin_Alexandroff_compactification_image_Some [simp]:
+   "openin(Alexandroff_compactification X) (Some ` U) \<longleftrightarrow> openin X U"
+  by (auto simp: openin_Alexandroff_compactification inj_image_eq_iff)
+
+lemma closedin_Alexandroff_compactification_image_Some [simp]:
+   "closedin (Alexandroff_compactification X) (Some ` K) \<longleftrightarrow> compactin X K \<and> closedin X K"
+  by (auto simp: closedin_Alexandroff_compactification inj_image_eq_iff)
+
+lemma open_map_Some: "open_map X (Alexandroff_compactification X) Some"
+  using open_map_def openin_Alexandroff_compactification by blast
+
+lemma continuous_map_Some: "continuous_map X (Alexandroff_compactification X) Some"
+  unfolding continuous_map_def 
+proof (intro conjI strip)
+  fix U
+  assume "openin (Alexandroff_compactification X) U"
+  then consider V where "openin X V" "U = Some ` V" 
+    | C where "compactin X C" "closedin X C" "U = insert None (Some ` (topspace X - C))" 
+    by (auto simp: openin_Alexandroff_compactification)
+  then show "openin X {x \<in> topspace X. Some x \<in> U}"
+  proof cases
+    case 1
+    then show ?thesis
+      using openin_subopen openin_subset by fastforce
+  next
+    case 2
+    then show ?thesis
+      by (simp add: closedin_def image_iff set_diff_eq)
+  qed
+qed auto
+
+
+lemma embedding_map_Some: "embedding_map X (Alexandroff_compactification X) Some"
+  by (simp add: continuous_map_Some injective_open_imp_embedding_map open_map_Some)
+
+lemma compact_space_Alexandroff_compactification [simp]:
+   "compact_space(Alexandroff_compactification X)"
+proof (clarsimp simp: compact_space_alt image_subset_iff)
+  fix \<U> U
+  assume ope [rule_format]: "\<forall>U\<in>\<U>. openin (Alexandroff_compactification X) U"
+      and cover: "\<forall>x\<in>topspace X. \<exists>X\<in>\<U>. Some x \<in> X"
+      and "U \<in> \<U>" "None \<in> U"
+  then have Usub: "U \<subseteq> insert None (Some ` topspace X)"
+    by (metis openin_subset topspace_Alexandroff_compactification)
+  with ope [OF \<open>U \<in> \<U>\<close>] \<open>None \<in> U\<close>
+  obtain C where C: "compactin X C \<and> closedin X C \<and>
+          insert None (Some ` topspace X) - U = Some ` C"
+    by (auto simp: openin_closedin closedin_Alexandroff_compactification)
+  then have D: "compactin (Alexandroff_compactification X) (insert None (Some ` topspace X) - U)"
+    by (metis continuous_map_Some image_compactin)
+  consider V where "openin X V" "U = Some ` V" 
+    | C where "compactin X C" "closedin X C" "U = insert None (Some ` (topspace X - C))" 
+    using ope [OF \<open>U \<in> \<U>\<close>] by (auto simp: openin_Alexandroff_compactification)
+  then show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> (\<exists>X\<in>\<F>. None \<in> X) \<and> (\<forall>x\<in>topspace X. \<exists>X\<in>\<F>. Some x \<in> X)"
+  proof cases
+    case 1
+    then show ?thesis
+      using \<open>None \<in> U\<close> by blast      
+  next
+    case 2
+    obtain \<F> where "finite \<F>" "\<F> \<subseteq> \<U>" "insert None (Some ` topspace X) - U \<subseteq> \<Union>\<F>"
+      by (smt (verit, del_insts) C D Union_iff compactinD compactin_subset_topspace cover image_subset_iff ope subsetD)
+    with \<open>U \<in> \<U>\<close> show ?thesis
+      by (rule_tac x="insert U \<F>" in exI) auto
+  qed
+qed
+
+lemma topspace_Alexandroff_compactification_delete:
+   "topspace(Alexandroff_compactification X) - {None} = Some ` topspace X"
+  by simp
+
+lemma Alexandroff_compactification_dense:
+  assumes "\<not> compact_space X"
+  shows "(Alexandroff_compactification X) closure_of (Some ` topspace X) =
+         topspace(Alexandroff_compactification X)"
+  unfolding topspace_Alexandroff_compactification_delete [symmetric]
+proof (intro one_point_compactification_dense)
+  show "\<not> compactin (Alexandroff_compactification X) (topspace (Alexandroff_compactification X) - {None})"
+    using assms compact_space_proper_map_preimage compact_space_subtopology embedding_map_Some embedding_map_def homeomorphic_imp_proper_map by fastforce
+qed auto
+
+
+lemma t0_space_one_point_compactification:
+  assumes "compact_space X \<and> openin X (topspace X - {a})"
+  shows "t0_space X \<longleftrightarrow> t0_space (subtopology X (topspace X - {a}))"
+   (is "?lhs \<longleftrightarrow> ?rhs")
+proof 
+  show "?lhs \<Longrightarrow> ?rhs"
+    using t0_space_subtopology by blast
+  show "?rhs \<Longrightarrow> ?lhs"
+    using assms
+    unfolding t0_space_def by (bestsimp simp flip: Int_Diff dest: openin_trans_full)
+qed
+
+lemma t0_space_Alexandroff_compactification [simp]:
+   "t0_space (Alexandroff_compactification X) \<longleftrightarrow> t0_space X"
+  using t0_space_one_point_compactification [of "Alexandroff_compactification X" None]
+  using embedding_map_Some embedding_map_imp_homeomorphic_space homeomorphic_t0_space by fastforce
+
+lemma t1_space_one_point_compactification:
+  assumes Xa: "openin X (topspace X - {a})"
+    and \<section>: "\<And>K. \<lbrakk>compactin (subtopology X (topspace X - {a})) K; closedin (subtopology X (topspace X - {a})) K\<rbrakk> \<Longrightarrow> closedin X K"
+  shows "t1_space X \<longleftrightarrow> t1_space (subtopology X (topspace X - {a}))"  (is "?lhs \<longleftrightarrow> ?rhs")
+proof 
+  show "?lhs \<Longrightarrow> ?rhs"
+    using t1_space_subtopology by blast
+  assume R: ?rhs
+  show ?lhs
+    unfolding t1_space_closedin_singleton
+  proof (intro strip)
+    fix x
+    assume "x \<in> topspace X"
+    show "closedin X {x}"
+    proof (cases "x=a")
+      case True
+      then show ?thesis
+        using \<open>x \<in> topspace X\<close> Xa closedin_def by blast
+    next
+      case False
+      show ?thesis
+        by (simp add: "\<section>" False R \<open>x \<in> topspace X\<close> closedin_t1_singleton)
+    qed
+  qed
+qed
+
+lemma closedin_Alexandroff_I: 
+  assumes "compactin (Alexandroff_compactification X) K" "K \<subseteq> Some ` topspace X"
+          "closedin (Alexandroff_compactification X) T" "K = T \<inter> Some ` topspace X"
+  shows "closedin (Alexandroff_compactification X) K"
+proof -
+  obtain S where S: "S \<subseteq> topspace X" "K = Some ` S"
+    by (meson \<open>K \<subseteq> Some ` topspace X\<close> subset_imageE)
+  with assms have "compactin X S"
+    by (metis compactin_subtopology embedding_map_Some embedding_map_def homeomorphic_map_compactness)
+  moreover have "closedin X S"
+    using assms S
+    by (metis closedin_subtopology embedding_map_Some embedding_map_def homeomorphic_map_closedness)
+  ultimately show ?thesis
+    by (simp add: S)
+qed
+
+
+lemma t1_space_Alexandroff_compactification [simp]:
+  "t1_space(Alexandroff_compactification X) \<longleftrightarrow> t1_space X"
+proof -
+  have "openin (Alexandroff_compactification X) (topspace (Alexandroff_compactification X) - {None})"
+    by auto
+  then show ?thesis
+    using t1_space_one_point_compactification [of "Alexandroff_compactification X" None]
+    using embedding_map_Some embedding_map_imp_homeomorphic_space homeomorphic_t1_space 
+    by (fastforce simp add: compactin_subtopology closedin_Alexandroff_I closedin_subtopology)
+qed
+
+
+lemma kc_space_one_point_compactification:
+  assumes "compact_space X"
+    and ope: "openin X (topspace X - {a})"
+    and \<section>: "\<And>K. \<lbrakk>compactin (subtopology X (topspace X - {a})) K; closedin (subtopology X (topspace X - {a})) K\<rbrakk>
+                \<Longrightarrow> closedin X K"
+  shows "kc_space X \<longleftrightarrow>
+         k_space (subtopology X (topspace X - {a})) \<and> kc_space (subtopology X (topspace X - {a}))"
+proof -
+  have "closedin X K"
+    if "kc_space (subtopology X (topspace X - {a}))" and "compactin X K" "a \<notin> K" for K
+    using that unfolding kc_space_def 
+    by (metis "\<section>" Diff_empty compactin_subspace compactin_subtopology subset_Diff_insert)
+  then show ?thesis
+    by (metis \<open>compact_space X\<close> kc_space_one_point_compactification_gen ope)
+qed
+
+lemma kc_space_Alexandroff_compactification:
+  "kc_space(Alexandroff_compactification X) \<longleftrightarrow> (k_space X \<and> kc_space X)" (is "kc_space ?Y = _")
+proof -
+  have "kc_space (Alexandroff_compactification X) \<longleftrightarrow>
+      (k_space (subtopology ?Y (topspace ?Y - {None})) \<and> kc_space (subtopology ?Y (topspace ?Y - {None})))"
+    by (rule kc_space_one_point_compactification) (auto simp: compactin_subtopology closedin_subtopology closedin_Alexandroff_I)
+  also have "... \<longleftrightarrow> k_space X \<and> kc_space X"
+    using embedding_map_Some embedding_map_imp_homeomorphic_space homeomorphic_k_space homeomorphic_kc_space by simp blast
+  finally show ?thesis .
+qed
+
+
+lemma regular_space_one_point_compactification:
+  assumes "compact_space X" and ope: "openin X (topspace X - {a})"
+    and \<section>: "\<And>K. \<lbrakk>compactin (subtopology X (topspace X - {a})) K; closedin (subtopology X (topspace X - {a})) K\<rbrakk> \<Longrightarrow> closedin X K"
+  shows "regular_space X \<longleftrightarrow>
+           regular_space (subtopology X (topspace X - {a})) \<and> locally_compact_space (subtopology X (topspace X - {a}))" 
+    (is "?lhs \<longleftrightarrow> ?rhs")
+proof 
+  show "?lhs \<Longrightarrow> ?rhs"
+    using assms(1) compact_imp_locally_compact_space locally_compact_space_open_subset ope regular_space_subtopology by blast
+  assume R: ?rhs
+  let ?Xa = "subtopology X (topspace X - {a})"
+  show ?lhs
+    unfolding neighbourhood_base_of_closedin [symmetric] neighbourhood_base_of imp_conjL
+  proof (intro strip)
+    fix W x
+    assume "openin X W" and "x \<in> W"
+    show "\<exists>U V. openin X U \<and> closedin X V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W"
+    proof (cases "x=a")
+      case True
+      have "compactin ?Xa (topspace X - W)"
+        using \<open>openin X W\<close> assms(1) closedin_compact_space
+        by (metis Diff_mono True \<open>x \<in> W\<close> compactin_subtopology empty_subsetI insert_subset openin_closedin_eq order_refl)
+      then obtain V K where V: "openin ?Xa V" and K: "compactin ?Xa K" "closedin ?Xa K" and "topspace X - W \<subseteq> V" "V \<subseteq> K"
+        by (metis locally_compact_space_compact_closed_compact R)
+      show ?thesis
+      proof (intro exI conjI)
+        show "openin X (topspace X - K)"
+          using "\<section>" K by blast
+        show "closedin X (topspace X - V)"
+          using V ope openin_trans_full by blast
+        show "x \<in> topspace X - K"
+        proof (rule)
+          show "x \<in> topspace X"
+            using \<open>openin X W\<close> \<open>x \<in> W\<close> openin_subset by blast
+          show "x \<notin> K"
+            using K True closedin_imp_subset by blast
+        qed
+        show "topspace X - K \<subseteq> topspace X - V"
+          by (simp add: Diff_mono \<open>V \<subseteq> K\<close>)
+        show "topspace X - V \<subseteq> W"
+          using \<open>topspace X - W \<subseteq> V\<close> by auto
+      qed
+    next
+      case False
+      have "openin ?Xa ((topspace X - {a}) \<inter> W)"
+        using \<open>openin X W\<close> openin_subtopology_Int2 by blast
+      moreover have "x \<in> (topspace X - {a}) \<inter> W"
+        using \<open>openin X W\<close> \<open>x \<in> W\<close> openin_subset False by blast
+      ultimately obtain U V where "openin ?Xa U" "compactin ?Xa V" "closedin ?Xa V"
+               "x \<in> U" "U \<subseteq> V" "V \<subseteq> (topspace X - {a}) \<inter> W"
+        using R locally_compact_regular_space_neighbourhood_base neighbourhood_base_of
+        by (metis (no_types, lifting))
+      then show ?thesis
+        by (meson "\<section>" le_infE ope openin_trans_full)
+    qed
+  qed
+qed
+
+
+lemma regular_space_Alexandroff_compactification:
+  "regular_space(Alexandroff_compactification X) \<longleftrightarrow> regular_space X \<and> locally_compact_space X" 
+  (is "regular_space ?Y = ?rhs")
+proof -
+  have "regular_space ?Y \<longleftrightarrow>
+        regular_space (subtopology ?Y (topspace ?Y - {None})) \<and> locally_compact_space (subtopology ?Y (topspace ?Y - {None}))"
+    by (rule regular_space_one_point_compactification) (auto simp: compactin_subtopology closedin_subtopology closedin_Alexandroff_I)
+  also have "... \<longleftrightarrow> regular_space X \<and> locally_compact_space X"
+    using embedding_map_Some embedding_map_imp_homeomorphic_space homeomorphic_locally_compact_space homeomorphic_regular_space 
+      by fastforce
+  finally show ?thesis .
+qed
+
+
+lemma Hausdorff_space_one_point_compactification:
+  assumes "compact_space X" and  "openin X (topspace X - {a})"
+    and "\<And>K. \<lbrakk>compactin (subtopology X (topspace X - {a})) K; closedin (subtopology X (topspace X - {a})) K\<rbrakk> \<Longrightarrow> closedin X K"
+  shows "Hausdorff_space X \<longleftrightarrow>
+           Hausdorff_space (subtopology X (topspace X - {a})) \<and> locally_compact_space (subtopology X (topspace X - {a}))" 
+    (is "?lhs \<longleftrightarrow> ?rhs")
+proof 
+  show ?rhs if ?lhs
+  proof -
+    have "locally_compact_space (subtopology X (topspace X - {a}))"
+      using assms that compact_imp_locally_compact_space locally_compact_space_open_subset 
+      by blast
+    with that show ?rhs
+      by (simp add: Hausdorff_space_subtopology)
+  qed
+next
+  show "?rhs \<Longrightarrow> ?lhs"
+    by (metis assms locally_compact_Hausdorff_or_regular regular_space_one_point_compactification
+        regular_t1_eq_Hausdorff_space t1_space_one_point_compactification)
+qed
+
+lemma Hausdorff_space_Alexandroff_compactification:
+   "Hausdorff_space(Alexandroff_compactification X) \<longleftrightarrow> Hausdorff_space X \<and> locally_compact_space X"
+  by (meson compact_Hausdorff_imp_regular_space compact_space_Alexandroff_compactification 
+      locally_compact_Hausdorff_or_regular regular_space_Alexandroff_compactification 
+      regular_t1_eq_Hausdorff_space t1_space_Alexandroff_compactification)
+
+lemma completely_regular_space_Alexandroff_compactification:
+   "completely_regular_space(Alexandroff_compactification X) \<longleftrightarrow>
+        completely_regular_space X \<and> locally_compact_space X"
+  by (metis regular_space_Alexandroff_compactification completely_regular_eq_regular_space
+      compact_imp_locally_compact_space compact_space_Alexandroff_compactification)
+
+lemma Hausdorff_space_one_point_compactification_asymmetric_prod:
+  assumes "compact_space X"
+  shows "Hausdorff_space X \<longleftrightarrow>
+         kc_space (prod_topology X (subtopology X (topspace X - {a}))) \<and>
+         k_space (prod_topology X (subtopology X (topspace X - {a})))"  (is "?lhs \<longleftrightarrow> ?rhs")
+proof (cases "a \<in> topspace X")
+  case True
+  show ?thesis
+  proof 
+    show ?rhs if ?lhs
+    proof
+      show "kc_space (prod_topology X (subtopology X (topspace X - {a})))"
+        using Hausdorff_imp_kc_space kc_space_prod_topology_right kc_space_subtopology that by blast
+      show "k_space (prod_topology X (subtopology X (topspace X - {a})))"
+        by (meson Hausdorff_imp_kc_space assms compact_imp_locally_compact_space k_space_prod_topology_left 
+            kc_space_one_point_compactification_gen that)
+    qed
+  next
+    assume R: ?rhs
+    define D where "D \<equiv> (\<lambda>x. (x,x)) ` (topspace X - {a})"
+    show ?lhs
+    proof (cases "topspace X = {a}")
+      case True
+      then show ?thesis
+        by (simp add: Hausdorff_space_def)
+    next
+      case False
+      then have "kc_space X"
+        using kc_space_retraction_map_image [of "prod_topology X (subtopology X (topspace X - {a}))" X fst]
+        by (metis Diff_subset R True insert_Diff retraction_map_fst topspace_subtopology_subset)
+      have "closedin (subtopology (prod_topology X (subtopology X (topspace X - {a}))) K) (K \<inter> D)" 
+        if "compactin (prod_topology X (subtopology X (topspace X - {a}))) K" for K
+      proof (intro closedin_subtopology_Int_subset[where V=K] closedin_subset_topspace)
+        show "fst ` K \<times> snd ` K \<inter> D \<subseteq> fst ` K \<times> snd ` K" "K \<subseteq> fst ` K \<times> snd ` K"
+          by force+
+        have eq: "(fst ` K \<times> snd ` K \<inter> D) = ((\<lambda>x. (x,x)) ` (fst ` K \<inter> snd ` K))"
+          using compactin_subset_topspace that by (force simp: D_def image_iff)
+        have "compactin (prod_topology X (subtopology X (topspace X - {a}))) (fst ` K \<times> snd ` K \<inter> D)"
+          unfolding eq
+        proof (rule image_compactin [of "subtopology X (topspace X - {a})"])
+          have "compactin X (fst ` K)" "compactin X (snd ` K)"
+            by (meson compactin_subtopology continuous_map_fst continuous_map_snd image_compactin that)+
+          moreover have "fst ` K \<inter> snd ` K \<subseteq> topspace X - {a}"
+            using compactin_subset_topspace that by force
+          ultimately
+          show "compactin (subtopology X (topspace X - {a})) (fst ` K \<inter> snd ` K)"
+            unfolding compactin_subtopology
+            by (meson \<open>kc_space X\<close> closed_Int_compactin kc_space_def)
+          show "continuous_map (subtopology X (topspace X - {a})) (prod_topology X (subtopology X (topspace X - {a}))) (\<lambda>x. (x,x))"
+            by (simp add: continuous_map_paired)
+        qed
+        then show "closedin (prod_topology X (subtopology X (topspace X - {a}))) (fst ` K \<times> snd ` K \<inter> D)"
+          using R compactin_imp_closedin_gen by blast
+      qed
+      moreover have "D \<subseteq> topspace X \<times> (topspace X \<inter> (topspace X - {a}))"
+        by (auto simp: D_def)
+      ultimately have *: "closedin (prod_topology X (subtopology X (topspace X - {a}))) D"
+        using R by (auto simp: k_space)
+      have "x=y"
+        if "x \<in> topspace X" "y \<in> topspace X" 
+          and \<section>: "\<And>T. \<lbrakk>(x,y) \<in> T; openin (prod_topology X X) T\<rbrakk> \<Longrightarrow> \<exists>z \<in> topspace X. (z,z) \<in> T" for x y
+      proof (cases "x=a \<and> y=a")
+        case False
+        then consider "x\<noteq>a" | "y\<noteq>a"
+          by blast
+        then show ?thesis
+        proof cases
+          case 1
+          have "\<exists>z \<in> topspace X - {a}. (z,z) \<in> T"
+            if "(y,x) \<in> T" "openin (prod_topology X (subtopology X (topspace X - {a}))) T" for T
+          proof -
+            have "(x,y) \<in> {z \<in> topspace (prod_topology X X). (snd z,fst z) \<in> T \<inter> topspace X \<times> (topspace X - {a})}"
+              by (simp add: "1" \<open>x \<in> topspace X\<close> \<open>y \<in> topspace X\<close> that)
+            moreover have "openin (prod_topology X X) {z \<in> topspace (prod_topology X X). (snd z,fst z) \<in> T \<inter> topspace X \<times> (topspace X - {a})}"
+            proof (rule openin_continuous_map_preimage)
+              show "continuous_map (prod_topology X X) (prod_topology X X) (\<lambda>x. (snd x, fst x))"
+                by (simp add: continuous_map_fst continuous_map_pairedI continuous_map_snd)
+              have "openin (prod_topology X X) (topspace X \<times> (topspace X - {a}))"
+                using \<open>kc_space X\<close> assms kc_space_one_point_compactification_gen openin_prod_Times_iff by fastforce
+              moreover have "openin (prod_topology X X) T"
+                using kc_space_one_point_compactification_gen [OF \<open>compact_space X\<close>] \<open>kc_space X\<close> that
+                by (metis openin_prod_Times_iff openin_topspace openin_trans_full prod_topology_subtopology(2))
+              ultimately show "openin (prod_topology X X) (T \<inter> topspace X \<times> (topspace X - {a}))"
+                by blast
+            qed
+            ultimately show ?thesis
+              by (smt (verit) \<section> Int_iff fst_conv mem_Collect_eq mem_Sigma_iff snd_conv)
+          qed
+          then have "(y,x) \<in> prod_topology X (subtopology X (topspace X - {a})) closure_of D"
+            by (simp add: "1" D_def in_closure_of that)
+          then show ?thesis
+            using that "*" D_def closure_of_closedin by fastforce
+        next
+          case 2
+          have "\<exists>z \<in> topspace X - {a}. (z,z) \<in> T"
+            if "(x,y) \<in> T" "openin (prod_topology X (subtopology X (topspace X - {a}))) T" for T
+          proof -
+            have "openin (prod_topology X X) (topspace X \<times> (topspace X - {a}))"
+              using \<open>kc_space X\<close> assms kc_space_one_point_compactification_gen openin_prod_Times_iff by fastforce
+            moreover have XXT: "openin (prod_topology X X) T"
+              using kc_space_one_point_compactification_gen [OF \<open>compact_space X\<close>] \<open>kc_space X\<close> that
+              by (metis openin_prod_Times_iff openin_topspace openin_trans_full prod_topology_subtopology(2))
+            ultimately have "openin (prod_topology X X) (T \<inter> topspace X \<times> (topspace X - {a}))"
+              by blast
+            then show ?thesis
+              by (smt (verit) "\<section>" Diff_subset XXT mem_Sigma_iff openin_subset subsetD that topspace_prod_topology topspace_subtopology_subset)
+          qed
+          then have "(x,y) \<in> prod_topology X (subtopology X (topspace X - {a})) closure_of D"
+            by (simp add: "2" D_def in_closure_of that)
+          then show ?thesis
+            using that "*" D_def closure_of_closedin by fastforce
+        qed
+      qed auto
+      then show ?thesis
+        unfolding Hausdorff_space_closedin_diagonal closure_of_subset_eq [symmetric] 
+          by (force simp add: closure_of_def)
+    qed
+  qed
+next
+  case False
+  then show ?thesis
+    by (simp add: assms compact_imp_k_space compact_space_prod_topology kc_space_compact_prod_topology)
+qed
+
+
+lemma Hausdorff_space_Alexandroff_compactification_asymmetric_prod:
+   "Hausdorff_space(Alexandroff_compactification X) \<longleftrightarrow>
+        kc_space(prod_topology (Alexandroff_compactification X) X) \<and>
+        k_space(prod_topology (Alexandroff_compactification X) X)"
+    (is "Hausdorff_space ?Y = ?rhs")
+proof -
+  have *: "subtopology (Alexandroff_compactification X)
+     (topspace (Alexandroff_compactification X) -
+      {None}) homeomorphic_space X"
+    using embedding_map_Some embedding_map_imp_homeomorphic_space homeomorphic_space_sym by fastforce
+  have "Hausdorff_space (Alexandroff_compactification X) \<longleftrightarrow>
+      (kc_space (prod_topology ?Y (subtopology ?Y (topspace ?Y - {None}))) \<and>
+       k_space (prod_topology ?Y (subtopology ?Y (topspace ?Y - {None}))))"
+    by (rule Hausdorff_space_one_point_compactification_asymmetric_prod) (auto simp: compactin_subtopology closedin_subtopology closedin_Alexandroff_I)
+  also have "... \<longleftrightarrow> ?rhs"
+    using homeomorphic_k_space homeomorphic_kc_space homeomorphic_space_prod_topology 
+          homeomorphic_space_refl * by blast
+  finally show ?thesis .
+qed
+
+lemma kc_space_as_compactification_unique:
+  assumes "kc_space X" "compact_space X"
+  shows "openin X U \<longleftrightarrow>
+         (if a \<in> U then U \<subseteq> topspace X \<and> compactin X (topspace X - U)
+                   else openin (subtopology X (topspace X - {a})) U)"
+proof (cases "a \<in> U")
+  case True
+  then show ?thesis
+    by (meson assms closedin_compact_space compactin_imp_closedin_gen openin_closedin_eq)
+next
+  case False
+  then show ?thesis
+  by (metis Diff_empty kc_space_one_point_compactification_gen openin_open_subtopology openin_subset subset_Diff_insert assms)
+qed
+
+lemma kc_space_as_compactification_unique_explicit:
+  assumes "kc_space X" "compact_space X"
+  shows "openin X U \<longleftrightarrow>
+         (if a \<in> U then U \<subseteq> topspace X \<and>
+                     compactin (subtopology X (topspace X - {a})) (topspace X - U) \<and>
+                     closedin (subtopology X (topspace X - {a})) (topspace X - U)
+                else openin (subtopology X (topspace X - {a})) U)"
+  apply (simp add: kc_space_subtopology compactin_imp_closedin_gen assms compactin_subtopology cong: conj_cong)
+  by (metis Diff_mono assms bot.extremum insert_subset kc_space_as_compactification_unique subset_refl)
+
+lemma Alexandroff_compactification_unique:
+  assumes "kc_space X" "compact_space X" and a: "a \<in> topspace X"
+  shows "Alexandroff_compactification (subtopology X (topspace X - {a})) homeomorphic_space X"
+        (is "?Y homeomorphic_space X")
+proof -
+  have [simp]: "topspace X \<inter> (topspace X - {a}) = topspace X - {a}"  
+    by auto
+  have [simp]: "insert None (Some ` A) = insert None (Some ` B) \<longleftrightarrow> A = B" 
+               "insert None (Some ` A) \<noteq> Some ` B" for A B
+    by auto
+  have "quotient_map X ?Y (\<lambda>x. if x = a then None else Some x)"
+    unfolding quotient_map_def
+  proof (intro conjI strip)
+    show "(\<lambda>x. if x = a then None else Some x) ` topspace X = topspace ?Y"
+      using \<open>a \<in> topspace X\<close>  by force
+    show "openin X {x \<in> topspace X. (if x = a then None else Some x) \<in> U} = openin ?Y U" (is "?L = ?R")
+      if "U \<subseteq> topspace ?Y" for U
+    proof (cases "None \<in> U")
+      case True
+      then obtain T where T[simp]: "U = insert None (Some ` T)"
+        by (metis Int_insert_right UNIV_I UNIV_option_conv inf.orderE inf_le2 subsetI subset_imageE)
+      have Tsub: "T \<subseteq> topspace X - {a}"
+        using in_these_eq that by auto
+      then have "{x \<in> topspace X. (if x = a then None else Some x) \<in> U} = insert a T"
+        by (auto simp: a image_iff cong: conj_cong)
+      then have "?L \<longleftrightarrow> openin X (insert a T)"
+        by metis
+      also have "\<dots> \<longleftrightarrow> ?R"
+        using Tsub assms
+        apply (simp add: openin_Alexandroff_compactification kc_space_as_compactification_unique_explicit [where a=a])
+        by (smt (verit, best) Diff_insert2 Diff_subset closedin_imp_subset double_diff)
+      finally show ?thesis .
+    next
+      case False
+      then obtain T where [simp]: "U = Some ` T"
+        by (metis Int_insert_right UNIV_I UNIV_option_conv inf.orderE inf_le2 subsetI subset_imageE)
+      have **: "\<And>V. openin X V \<Longrightarrow> openin X (V - {a})"
+        by (simp add: assms compactin_imp_closedin_gen openin_diff)
+      have Tsub: "T \<subseteq> topspace X - {a}"
+        using in_these_eq that by auto
+      then have "{x \<in> topspace X. (if x = a then None else Some x) \<in> U} = T"
+        by (auto simp: image_iff cong: conj_cong)
+      then show ?thesis
+        by (simp add: "**" Tsub openin_open_subtopology)
+    qed
+  qed
+  moreover have "inj_on (\<lambda>x. if x = a then None else Some x) (topspace X)"
+    by (auto simp: inj_on_def)
+  ultimately show ?thesis
+    using homeomorphic_space_sym homeomorphic_space homeomorphic_map_def by blast
+qed
+
+end
diff --git a/src/HOL/NthRoot.thy b/src/HOL/NthRoot.thy
--- a/src/HOL/NthRoot.thy
+++ b/src/HOL/NthRoot.thy
@@ -1,824 +1,824 @@
 (*  Title:      HOL/NthRoot.thy
     Author:     Jacques D. Fleuriot, 1998
     Author:     Lawrence C Paulson, 2004
 *)
 
 section \<open>Nth Roots of Real Numbers\<close>
 
 theory NthRoot
   imports Deriv
 begin
 
 
 subsection \<open>Existence of Nth Root\<close>
 
 text \<open>Existence follows from the Intermediate Value Theorem\<close>
 
 lemma realpow_pos_nth:
   fixes a :: real
   assumes n: "0 < n"
     and a: "0 < a"
   shows "\<exists>r>0. r ^ n = a"
 proof -
   have "\<exists>r\<ge>0. r \<le> (max 1 a) \<and> r ^ n = a"
   proof (rule IVT)
     show "0 ^ n \<le> a"
       using n a by (simp add: power_0_left)
     show "0 \<le> max 1 a"
       by simp
     from n have n1: "1 \<le> n"
       by simp
     have "a \<le> max 1 a ^ 1"
       by simp
     also have "max 1 a ^ 1 \<le> max 1 a ^ n"
       using n1 by (rule power_increasing) simp
     finally show "a \<le> max 1 a ^ n" .
     show "\<forall>r. 0 \<le> r \<and> r \<le> max 1 a \<longrightarrow> isCont (\<lambda>x. x ^ n) r"
       by simp
   qed
   then obtain r where r: "0 \<le> r \<and> r ^ n = a"
     by fast
   with n a have "r \<noteq> 0"
     by (auto simp add: power_0_left)
   with r have "0 < r \<and> r ^ n = a"
     by simp
   then show ?thesis ..
 qed
 
 (* Used by Integration/RealRandVar.thy in AFP *)
 lemma realpow_pos_nth2: "(0::real) < a \<Longrightarrow> \<exists>r>0. r ^ Suc n = a"
   by (blast intro: realpow_pos_nth)
 
 text \<open>Uniqueness of nth positive root.\<close>
 lemma realpow_pos_nth_unique: "0 < n \<Longrightarrow> 0 < a \<Longrightarrow> \<exists>!r. 0 < r \<and> r ^ n = a" for a :: real
   by (auto intro!: realpow_pos_nth simp: power_eq_iff_eq_base)
 
 
 subsection \<open>Nth Root\<close>
 
 text \<open>
   We define roots of negative reals such that \<open>root n (- x) = - root n x\<close>.
   This allows us to omit side conditions from many theorems.
 \<close>
 
 lemma inj_sgn_power:
   assumes "0 < n"
   shows "inj (\<lambda>y. sgn y * \<bar>y\<bar>^n :: real)"
     (is "inj ?f")
 proof (rule injI)
   have x: "(0 < a \<and> b < 0) \<or> (a < 0 \<and> 0 < b) \<Longrightarrow> a \<noteq> b" for a b :: real
     by auto
   fix x y
   assume "?f x = ?f y"
   with power_eq_iff_eq_base[of n "\<bar>x\<bar>" "\<bar>y\<bar>"] \<open>0 < n\<close> show "x = y"
     by (cases rule: linorder_cases[of 0 x, case_product linorder_cases[of 0 y]])
        (simp_all add: x)
 qed
 
 lemma sgn_power_injE:
   "sgn a * \<bar>a\<bar> ^ n = x \<Longrightarrow> x = sgn b * \<bar>b\<bar> ^ n \<Longrightarrow> 0 < n \<Longrightarrow> a = b"
   for a b :: real
   using inj_sgn_power[THEN injD, of n a b] by simp
 
 definition root :: "nat \<Rightarrow> real \<Rightarrow> real"
   where "root n x = (if n = 0 then 0 else the_inv (\<lambda>y. sgn y * \<bar>y\<bar>^n) x)"
 
 lemma root_0 [simp]: "root 0 x = 0"
   by (simp add: root_def)
 
 lemma root_sgn_power: "0 < n \<Longrightarrow> root n (sgn y * \<bar>y\<bar>^n) = y"
   using the_inv_f_f[OF inj_sgn_power] by (simp add: root_def)
 
 lemma sgn_power_root:
   assumes "0 < n"
   shows "sgn (root n x) * \<bar>(root n x)\<bar>^n = x"
     (is "?f (root n x) = x")
 proof (cases "x = 0")
   case True
   with assms root_sgn_power[of n 0] show ?thesis
     by simp
 next
   case False
   with realpow_pos_nth[OF \<open>0 < n\<close>, of "\<bar>x\<bar>"]
   obtain r where "0 < r" "r ^ n = \<bar>x\<bar>"
     by auto
   with \<open>x \<noteq> 0\<close> have S: "x \<in> range ?f"
     by (intro image_eqI[of _ _ "sgn x * r"])
        (auto simp: abs_mult sgn_mult power_mult_distrib abs_sgn_eq mult_sgn_abs)
   from \<open>0 < n\<close> f_the_inv_into_f[OF inj_sgn_power[OF \<open>0 < n\<close>] this]  show ?thesis
     by (simp add: root_def)
 qed
 
 lemma split_root: "P (root n x) \<longleftrightarrow> (n = 0 \<longrightarrow> P 0) \<and> (0 < n \<longrightarrow> (\<forall>y. sgn y * \<bar>y\<bar>^n = x \<longrightarrow> P y))"
 proof (cases "n = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then show ?thesis
     by simp (metis root_sgn_power sgn_power_root)
 qed
 
 lemma real_root_zero [simp]: "root n 0 = 0"
   by (simp split: split_root add: sgn_zero_iff)
 
 lemma real_root_minus: "root n (- x) = - root n x"
   by (clarsimp split: split_root elim!: sgn_power_injE simp: sgn_minus)
 
 lemma real_root_less_mono: "0 < n \<Longrightarrow> x < y \<Longrightarrow> root n x < root n y"
 proof (clarsimp split: split_root)
   have *: "0 < b \<Longrightarrow> a < 0 \<Longrightarrow> \<not> a > b" for a b :: real
     by auto
   fix a b :: real
   assume "0 < n" "sgn a * \<bar>a\<bar> ^ n < sgn b * \<bar>b\<bar> ^ n"
   then show "a < b"
     using power_less_imp_less_base[of a n b]
       power_less_imp_less_base[of "- b" n "- a"]
     by (simp add: sgn_real_def * [of "a ^ n" "- ((- b) ^ n)"]
         split: if_split_asm)
 qed
 
 lemma real_root_gt_zero: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> 0 < root n x"
   using real_root_less_mono[of n 0 x] by simp
 
 lemma real_root_ge_zero: "0 \<le> x \<Longrightarrow> 0 \<le> root n x"
   using real_root_gt_zero[of n x]
   by (cases "n = 0") (auto simp add: le_less)
 
 lemma real_root_pow_pos: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x ^ n = x"  (* TODO: rename *)
   using sgn_power_root[of n x] real_root_gt_zero[of n x] by simp
 
 lemma real_root_pow_pos2 [simp]: "0 < n \<Longrightarrow> 0 \<le> x \<Longrightarrow> root n x ^ n = x"  (* TODO: rename *)
   by (auto simp add: order_le_less real_root_pow_pos)
 
 lemma sgn_root: "0 < n \<Longrightarrow> sgn (root n x) = sgn x"
   by (auto split: split_root simp: sgn_real_def)
 
 lemma odd_real_root_pow: "odd n \<Longrightarrow> root n x ^ n = x"
   using sgn_power_root[of n x]
   by (simp add: odd_pos sgn_real_def split: if_split_asm)
 
 lemma real_root_power_cancel: "0 < n \<Longrightarrow> 0 \<le> x \<Longrightarrow> root n (x ^ n) = x"
   using root_sgn_power[of n x] by (auto simp add: le_less power_0_left)
 
 lemma odd_real_root_power_cancel: "odd n \<Longrightarrow> root n (x ^ n) = x"
   using root_sgn_power[of n x]
   by (simp add: odd_pos sgn_real_def power_0_left split: if_split_asm)
 
 lemma real_root_pos_unique: "0 < n \<Longrightarrow> 0 \<le> y \<Longrightarrow> y ^ n = x \<Longrightarrow> root n x = y"
   using root_sgn_power[of n y] by (auto simp add: le_less power_0_left)
 
 lemma odd_real_root_unique: "odd n \<Longrightarrow> y ^ n = x \<Longrightarrow> root n x = y"
   by (erule subst, rule odd_real_root_power_cancel)
 
 lemma real_root_one [simp]: "0 < n \<Longrightarrow> root n 1 = 1"
   by (simp add: real_root_pos_unique)
 
 text \<open>Root function is strictly monotonic, hence injective.\<close>
 
 lemma real_root_le_mono: "0 < n \<Longrightarrow> x \<le> y \<Longrightarrow> root n x \<le> root n y"
   by (auto simp add: order_le_less real_root_less_mono)
 
 lemma real_root_less_iff [simp]: "0 < n \<Longrightarrow> root n x < root n y \<longleftrightarrow> x < y"
   by (cases "x < y") (simp_all add: real_root_less_mono linorder_not_less real_root_le_mono)
 
 lemma real_root_le_iff [simp]: "0 < n \<Longrightarrow> root n x \<le> root n y \<longleftrightarrow> x \<le> y"
   by (cases "x \<le> y") (simp_all add: real_root_le_mono linorder_not_le real_root_less_mono)
 
 lemma real_root_eq_iff [simp]: "0 < n \<Longrightarrow> root n x = root n y \<longleftrightarrow> x = y"
   by (simp add: order_eq_iff)
 
 lemmas real_root_gt_0_iff [simp] = real_root_less_iff [where x=0, simplified]
 lemmas real_root_lt_0_iff [simp] = real_root_less_iff [where y=0, simplified]
 lemmas real_root_ge_0_iff [simp] = real_root_le_iff [where x=0, simplified]
 lemmas real_root_le_0_iff [simp] = real_root_le_iff [where y=0, simplified]
 lemmas real_root_eq_0_iff [simp] = real_root_eq_iff [where y=0, simplified]
 
 lemma real_root_gt_1_iff [simp]: "0 < n \<Longrightarrow> 1 < root n y \<longleftrightarrow> 1 < y"
   using real_root_less_iff [where x=1] by simp
 
 lemma real_root_lt_1_iff [simp]: "0 < n \<Longrightarrow> root n x < 1 \<longleftrightarrow> x < 1"
   using real_root_less_iff [where y=1] by simp
 
 lemma real_root_ge_1_iff [simp]: "0 < n \<Longrightarrow> 1 \<le> root n y \<longleftrightarrow> 1 \<le> y"
   using real_root_le_iff [where x=1] by simp
 
 lemma real_root_le_1_iff [simp]: "0 < n \<Longrightarrow> root n x \<le> 1 \<longleftrightarrow> x \<le> 1"
   using real_root_le_iff [where y=1] by simp
 
 lemma real_root_eq_1_iff [simp]: "0 < n \<Longrightarrow> root n x = 1 \<longleftrightarrow> x = 1"
   using real_root_eq_iff [where y=1] by simp
 
 
 text \<open>Roots of multiplication and division.\<close>
 
 lemma real_root_mult: "root n (x * y) = root n x * root n y"
   by (auto split: split_root elim!: sgn_power_injE
       simp: sgn_mult abs_mult power_mult_distrib)
 
 lemma real_root_inverse: "root n (inverse x) = inverse (root n x)"
   by (auto split: split_root elim!: sgn_power_injE
       simp: power_inverse)
 
 lemma real_root_divide: "root n (x / y) = root n x / root n y"
   by (simp add: divide_inverse real_root_mult real_root_inverse)
 
 lemma real_root_abs: "0 < n \<Longrightarrow> root n \<bar>x\<bar> = \<bar>root n x\<bar>"
   by (simp add: abs_if real_root_minus)
 
 lemma root_abs_power: "n > 0 \<Longrightarrow> abs (root n (y ^n)) = abs y"
   using root_sgn_power [of n]
   by (metis abs_ge_zero power_abs real_root_abs real_root_power_cancel)
 
 lemma real_root_power: "0 < n \<Longrightarrow> root n (x ^ k) = root n x ^ k"
   by (induct k) (simp_all add: real_root_mult)
 
 
 text \<open>Roots of roots.\<close>
 
 lemma real_root_Suc_0 [simp]: "root (Suc 0) x = x"
   by (simp add: odd_real_root_unique)
 
 lemma real_root_mult_exp: "root (m * n) x = root m (root n x)"
   by (auto split: split_root elim!: sgn_power_injE
       simp: sgn_zero_iff sgn_mult power_mult[symmetric]
       abs_mult power_mult_distrib abs_sgn_eq)
 
 lemma real_root_commute: "root m (root n x) = root n (root m x)"
   by (simp add: real_root_mult_exp [symmetric] mult.commute)
 
 
 text \<open>Monotonicity in first argument.\<close>
 
 lemma real_root_strict_decreasing:
   assumes "0 < n" "n < N" "1 < x"
   shows "root N x < root n x"
 proof -
   from assms have "root n (root N x) ^ n < root N (root n x) ^ N"
     by (simp add: real_root_commute power_strict_increasing del: real_root_pow_pos2)
   with assms show ?thesis by simp
 qed
 
 lemma real_root_strict_increasing:
   assumes "0 < n" "n < N" "0 < x" "x < 1"
   shows "root n x < root N x"
 proof -
   from assms have "root N (root n x) ^ N < root n (root N x) ^ n"
     by (simp add: real_root_commute power_strict_decreasing del: real_root_pow_pos2)
   with assms show ?thesis by simp
 qed
 
 lemma real_root_decreasing: "0 < n \<Longrightarrow> n \<le> N \<Longrightarrow> 1 \<le> x \<Longrightarrow> root N x \<le> root n x"
   by (auto simp add: order_le_less real_root_strict_decreasing)
 
 lemma real_root_increasing: "0 < n \<Longrightarrow> n \<le> N \<Longrightarrow> 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> root n x \<le> root N x"
   by (auto simp add: order_le_less real_root_strict_increasing)
 
 
 text \<open>Continuity and derivatives.\<close>
 
 lemma isCont_real_root: "isCont (root n) x"
 proof (cases "n > 0")
   case True
   let ?f = "\<lambda>y::real. sgn y * \<bar>y\<bar>^n"
   have "continuous_on ({0..} \<union> {.. 0}) (\<lambda>x. if 0 < x then x ^ n else - ((-x) ^ n) :: real)"
     using True by (intro continuous_on_If continuous_intros) auto
   then have "continuous_on UNIV ?f"
     by (rule continuous_on_cong[THEN iffD1, rotated 2]) (auto simp: not_less le_less True)
   then have [simp]: "isCont ?f x" for x
     by (simp add: continuous_on_eq_continuous_at)
   have "isCont (root n) (?f (root n x))"
     by (rule isCont_inverse_function [where f="?f" and d=1]) (auto simp: root_sgn_power True)
   then show ?thesis
     by (simp add: sgn_power_root True)
 next
   case False
   then show ?thesis
     by (simp add: root_def[abs_def])
 qed
 
 lemma tendsto_real_root [tendsto_intros]:
   "(f \<longlongrightarrow> x) F \<Longrightarrow> ((\<lambda>x. root n (f x)) \<longlongrightarrow> root n x) F"
   using isCont_tendsto_compose[OF isCont_real_root, of f x F] .
 
 lemma continuous_real_root [continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F (\<lambda>x. root n (f x))"
   unfolding continuous_def by (rule tendsto_real_root)
 
 lemma continuous_on_real_root [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. root n (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_real_root)
 
 lemma DERIV_real_root:
   assumes n: "0 < n"
     and x: "0 < x"
   shows "DERIV (root n) x :> inverse (real n * root n x ^ (n - Suc 0))"
 proof (rule DERIV_inverse_function)
   show "0 < x"
     using x .
   show "x < x + 1"
     by simp
   show "DERIV (\<lambda>x. x ^ n) (root n x) :> real n * root n x ^ (n - Suc 0)"
     by (rule DERIV_pow)
   show "real n * root n x ^ (n - Suc 0) \<noteq> 0"
     using n x by simp
   show "isCont (root n) x"
     by (rule isCont_real_root)
 qed (use n in auto)
 
 lemma DERIV_odd_real_root:
   assumes n: "odd n"
     and x: "x \<noteq> 0"
   shows "DERIV (root n) x :> inverse (real n * root n x ^ (n - Suc 0))"
 proof (rule DERIV_inverse_function)
   show "x - 1 < x" "x < x + 1"
     by auto
   show "DERIV (\<lambda>x. x ^ n) (root n x) :> real n * root n x ^ (n - Suc 0)"
     by (rule DERIV_pow)
   show "real n * root n x ^ (n - Suc 0) \<noteq> 0"
     using odd_pos [OF n] x by simp
   show "isCont (root n) x"
     by (rule isCont_real_root)
 qed (use n odd_real_root_pow in auto)
 
 lemma DERIV_even_real_root:
   assumes n: "0 < n"
     and "even n"
     and x: "x < 0"
   shows "DERIV (root n) x :> inverse (- real n * root n x ^ (n - Suc 0))"
 proof (rule DERIV_inverse_function)
   show "x - 1 < x"
     by simp
   show "x < 0"
     using x .
   show "- (root n y ^ n) = y" if "x - 1 < y" and "y < 0" for y
   proof -
     have "root n (-y) ^ n = -y" 
       using that \<open>0 < n\<close> by simp
     with real_root_minus and \<open>even n\<close>
     show "- (root n y ^ n) = y" by simp
   qed
   show "DERIV (\<lambda>x. - (x ^ n)) (root n x) :> - real n * root n x ^ (n - Suc 0)"
     by  (auto intro!: derivative_eq_intros)
   show "- real n * root n x ^ (n - Suc 0) \<noteq> 0"
     using n x by simp
   show "isCont (root n) x"
     by (rule isCont_real_root)
 qed
 
 lemma DERIV_real_root_generic:
   assumes "0 < n"
     and "x \<noteq> 0"
     and "even n \<Longrightarrow> 0 < x \<Longrightarrow> D = inverse (real n * root n x ^ (n - Suc 0))"
     and "even n \<Longrightarrow> x < 0 \<Longrightarrow> D = - inverse (real n * root n x ^ (n - Suc 0))"
     and "odd n \<Longrightarrow> D = inverse (real n * root n x ^ (n - Suc 0))"
   shows "DERIV (root n) x :> D"
   using assms
   by (cases "even n", cases "0 < x")
     (auto intro: DERIV_real_root[THEN DERIV_cong]
       DERIV_odd_real_root[THEN DERIV_cong]
       DERIV_even_real_root[THEN DERIV_cong])
 
 lemma power_tendsto_0_iff [simp]:
   fixes f :: "'a \<Rightarrow> real"
   assumes "n > 0"
   shows "((\<lambda>x. f x ^ n) \<longlongrightarrow> 0) F \<longleftrightarrow> (f \<longlongrightarrow> 0) F"
 proof -
   have "((\<lambda>x. \<bar>root n (f x ^ n)\<bar>) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> 0) F"
     by (auto simp: assms root_abs_power tendsto_rabs_zero_iff)
   then have "((\<lambda>x. f x ^ n) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> 0) F"
     by (metis tendsto_real_root abs_0 real_root_zero tendsto_rabs)
   with assms show ?thesis
     by (auto simp: tendsto_null_power)
 qed
 
 subsection \<open>Square Root\<close>
 
 definition sqrt :: "real \<Rightarrow> real"
   where "sqrt = root 2"
 
 lemma pos2: "0 < (2::nat)"
   by simp
 
 lemma real_sqrt_unique: "y\<^sup>2 = x \<Longrightarrow> 0 \<le> y \<Longrightarrow> sqrt x = y"
   unfolding sqrt_def by (rule real_root_pos_unique [OF pos2])
 
 lemma real_sqrt_abs [simp]: "sqrt (x\<^sup>2) = \<bar>x\<bar>"
   by (metis power2_abs abs_ge_zero real_sqrt_unique)
 
 lemma real_sqrt_pow2 [simp]: "0 \<le> x \<Longrightarrow> (sqrt x)\<^sup>2 = x"
   unfolding sqrt_def by (rule real_root_pow_pos2 [OF pos2])
 
 lemma real_sqrt_pow2_iff [simp]: "(sqrt x)\<^sup>2 = x \<longleftrightarrow> 0 \<le> x"
   by (metis real_sqrt_pow2 zero_le_power2)
 
 lemma real_sqrt_zero [simp]: "sqrt 0 = 0"
   unfolding sqrt_def by (rule real_root_zero)
 
 lemma real_sqrt_one [simp]: "sqrt 1 = 1"
   unfolding sqrt_def by (rule real_root_one [OF pos2])
 
 lemma real_sqrt_four [simp]: "sqrt 4 = 2"
   using real_sqrt_abs[of 2] by simp
 
 lemma real_sqrt_minus: "sqrt (- x) = - sqrt x"
   unfolding sqrt_def by (rule real_root_minus)
 
 lemma real_sqrt_mult: "sqrt (x * y) = sqrt x * sqrt y"
   unfolding sqrt_def by (rule real_root_mult)
 
 lemma real_sqrt_mult_self[simp]: "sqrt a * sqrt a = \<bar>a\<bar>"
   using real_sqrt_abs[of a] unfolding power2_eq_square real_sqrt_mult .
 
 lemma real_sqrt_inverse: "sqrt (inverse x) = inverse (sqrt x)"
   unfolding sqrt_def by (rule real_root_inverse)
 
 lemma real_sqrt_divide: "sqrt (x / y) = sqrt x / sqrt y"
   unfolding sqrt_def by (rule real_root_divide)
 
 lemma real_sqrt_power: "sqrt (x ^ k) = sqrt x ^ k"
   unfolding sqrt_def by (rule real_root_power [OF pos2])
 
 lemma real_sqrt_gt_zero: "0 < x \<Longrightarrow> 0 < sqrt x"
   unfolding sqrt_def by (rule real_root_gt_zero [OF pos2])
 
 lemma real_sqrt_ge_zero: "0 \<le> x \<Longrightarrow> 0 \<le> sqrt x"
   unfolding sqrt_def by (rule real_root_ge_zero)
 
 lemma real_sqrt_less_mono: "x < y \<Longrightarrow> sqrt x < sqrt y"
   unfolding sqrt_def by (rule real_root_less_mono [OF pos2])
 
 lemma real_sqrt_le_mono: "x \<le> y \<Longrightarrow> sqrt x \<le> sqrt y"
   unfolding sqrt_def by (rule real_root_le_mono [OF pos2])
 
 lemma real_sqrt_less_iff [simp]: "sqrt x < sqrt y \<longleftrightarrow> x < y"
   unfolding sqrt_def by (rule real_root_less_iff [OF pos2])
 
 lemma real_sqrt_le_iff [simp]: "sqrt x \<le> sqrt y \<longleftrightarrow> x \<le> y"
   unfolding sqrt_def by (rule real_root_le_iff [OF pos2])
 
 lemma real_sqrt_eq_iff [simp]: "sqrt x = sqrt y \<longleftrightarrow> x = y"
   unfolding sqrt_def by (rule real_root_eq_iff [OF pos2])
 
-lemma real_less_lsqrt: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> x < y\<^sup>2 \<Longrightarrow> sqrt x < y"
+lemma real_less_lsqrt: "0 \<le> y \<Longrightarrow> x < y\<^sup>2 \<Longrightarrow> sqrt x < y"
   using real_sqrt_less_iff[of x "y\<^sup>2"] by simp
 
-lemma real_le_lsqrt: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> x \<le> y\<^sup>2 \<Longrightarrow> sqrt x \<le> y"
+lemma real_le_lsqrt: "0 \<le> y \<Longrightarrow> x \<le> y\<^sup>2 \<Longrightarrow> sqrt x \<le> y"
   using real_sqrt_le_iff[of x "y\<^sup>2"] by simp
 
 lemma real_le_rsqrt: "x\<^sup>2 \<le> y \<Longrightarrow> x \<le> sqrt y"
   using real_sqrt_le_mono[of "x\<^sup>2" y] by simp
 
 lemma real_less_rsqrt: "x\<^sup>2 < y \<Longrightarrow> x < sqrt y"
   using real_sqrt_less_mono[of "x\<^sup>2" y] by simp
 
 lemma real_sqrt_power_even:
   assumes "even n" "x \<ge> 0"
   shows   "sqrt x ^ n = x ^ (n div 2)"
 proof -
   from assms obtain k where "n = 2*k" by (auto elim!: evenE)
   with assms show ?thesis by (simp add: power_mult)
 qed
 
 lemma sqrt_le_D: "sqrt x \<le> y \<Longrightarrow> x \<le> y\<^sup>2"
   by (meson not_le real_less_rsqrt)
 
 lemma sqrt_ge_absD: "\<bar>x\<bar> \<le> sqrt y \<Longrightarrow> x\<^sup>2 \<le> y"
   using real_sqrt_le_iff[of "x\<^sup>2"] by simp
 
 lemma sqrt_even_pow2:
   assumes n: "even n"
   shows "sqrt (2 ^ n) = 2 ^ (n div 2)"
 proof -
   from n obtain m where m: "n = 2 * m" ..
   from m have "sqrt (2 ^ n) = sqrt ((2 ^ m)\<^sup>2)"
     by (simp only: power_mult[symmetric] mult.commute)
   then show ?thesis
     using m by simp
 qed
 
 lemmas real_sqrt_gt_0_iff [simp] = real_sqrt_less_iff [where x=0, unfolded real_sqrt_zero]
 lemmas real_sqrt_lt_0_iff [simp] = real_sqrt_less_iff [where y=0, unfolded real_sqrt_zero]
 lemmas real_sqrt_ge_0_iff [simp] = real_sqrt_le_iff [where x=0, unfolded real_sqrt_zero]
 lemmas real_sqrt_le_0_iff [simp] = real_sqrt_le_iff [where y=0, unfolded real_sqrt_zero]
 lemmas real_sqrt_eq_0_iff [simp] = real_sqrt_eq_iff [where y=0, unfolded real_sqrt_zero]
 
 lemmas real_sqrt_gt_1_iff [simp] = real_sqrt_less_iff [where x=1, unfolded real_sqrt_one]
 lemmas real_sqrt_lt_1_iff [simp] = real_sqrt_less_iff [where y=1, unfolded real_sqrt_one]
 lemmas real_sqrt_ge_1_iff [simp] = real_sqrt_le_iff [where x=1, unfolded real_sqrt_one]
 lemmas real_sqrt_le_1_iff [simp] = real_sqrt_le_iff [where y=1, unfolded real_sqrt_one]
 lemmas real_sqrt_eq_1_iff [simp] = real_sqrt_eq_iff [where y=1, unfolded real_sqrt_one]
 
 lemma sqrt_add_le_add_sqrt:
   assumes "0 \<le> x" "0 \<le> y"
   shows "sqrt (x + y) \<le> sqrt x + sqrt y"
   by (rule power2_le_imp_le) (simp_all add: power2_sum assms)
 
 lemma isCont_real_sqrt: "isCont sqrt x"
   unfolding sqrt_def by (rule isCont_real_root)
 
 lemma tendsto_real_sqrt [tendsto_intros]:
   "(f \<longlongrightarrow> x) F \<Longrightarrow> ((\<lambda>x. sqrt (f x)) \<longlongrightarrow> sqrt x) F"
   unfolding sqrt_def by (rule tendsto_real_root)
 
 lemma continuous_real_sqrt [continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sqrt (f x))"
   unfolding sqrt_def by (rule continuous_real_root)
 
 lemma continuous_on_real_sqrt [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sqrt (f x))"
   unfolding sqrt_def by (rule continuous_on_real_root)
 
 lemma DERIV_real_sqrt_generic:
   assumes "x \<noteq> 0"
     and "x > 0 \<Longrightarrow> D = inverse (sqrt x) / 2"
     and "x < 0 \<Longrightarrow> D = - inverse (sqrt x) / 2"
   shows "DERIV sqrt x :> D"
   using assms unfolding sqrt_def
   by (auto intro!: DERIV_real_root_generic)
 
 lemma DERIV_real_sqrt: "0 < x \<Longrightarrow> DERIV sqrt x :> inverse (sqrt x) / 2"
   using DERIV_real_sqrt_generic by simp
 
 declare
   DERIV_real_sqrt_generic[THEN DERIV_chain2, derivative_intros]
   DERIV_real_root_generic[THEN DERIV_chain2, derivative_intros]
 
 lemmas has_derivative_real_sqrt[derivative_intros] = DERIV_real_sqrt[THEN DERIV_compose_FDERIV]
 
 lemma not_real_square_gt_zero [simp]: "\<not> 0 < x * x \<longleftrightarrow> x = 0"
   for x :: real
   apply auto
   using linorder_less_linear [where x = x and y = 0]
   apply (simp add: zero_less_mult_iff)
   done
 
 lemma real_sqrt_abs2 [simp]: "sqrt (x * x) = \<bar>x\<bar>"
   apply (subst power2_eq_square [symmetric])
   apply (rule real_sqrt_abs)
   done
 
 lemma real_inv_sqrt_pow2: "0 < x \<Longrightarrow> (inverse (sqrt x))\<^sup>2 = inverse x"
   by (simp add: power_inverse)
 
 lemma real_sqrt_eq_zero_cancel: "0 \<le> x \<Longrightarrow> sqrt x = 0 \<Longrightarrow> x = 0"
   by simp
 
 lemma real_sqrt_ge_one: "1 \<le> x \<Longrightarrow> 1 \<le> sqrt x"
   by simp
 
 lemma sqrt_divide_self_eq:
   assumes nneg: "0 \<le> x"
   shows "sqrt x / x = inverse (sqrt x)"
 proof (cases "x = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have pos: "0 < x"
     using nneg by arith
   show ?thesis
   proof (rule right_inverse_eq [THEN iffD1, symmetric])
     show "sqrt x / x \<noteq> 0"
       by (simp add: divide_inverse nneg False)
     show "inverse (sqrt x) / (sqrt x / x) = 1"
       by (simp add: divide_inverse mult.assoc [symmetric]
           power2_eq_square [symmetric] real_inv_sqrt_pow2 pos False)
   qed
 qed
 
 lemma real_div_sqrt: "0 \<le> x \<Longrightarrow> x / sqrt x = sqrt x"
   by (cases "x = 0") (simp_all add: sqrt_divide_self_eq [of x] field_simps)
 
 lemma real_divide_square_eq [simp]: "(r * a) / (r * r) = a / r"
   for a r :: real
   by (cases "r = 0") (simp_all add: divide_inverse ac_simps)
 
 lemma lemma_real_divide_sqrt_less: "0 < u \<Longrightarrow> u / sqrt 2 < u"
   by (simp add: divide_less_eq)
 
 lemma four_x_squared: "4 * x\<^sup>2 = (2 * x)\<^sup>2"
   for x :: real
   by (simp add: power2_eq_square)
 
 lemma sqrt_at_top: "LIM x at_top. sqrt x :: real :> at_top"
   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. True" and P="\<lambda>x. 0 < x" and g="power2"])
      (auto intro: eventually_gt_at_top)
 
 
 subsection \<open>Square Root of Sum of Squares\<close>
 
 lemma sum_squares_bound: "2 * x * y \<le> x\<^sup>2 + y\<^sup>2"
   for x y :: "'a::linordered_field"
 proof -
   have "(x - y)\<^sup>2 = x * x - 2 * x * y + y * y"
     by algebra
   then have "0 \<le> x\<^sup>2 - 2 * x * y + y\<^sup>2"
     by (metis sum_power2_ge_zero zero_le_double_add_iff_zero_le_single_add power2_eq_square)
   then show ?thesis
     by arith
 qed
 
 lemma arith_geo_mean:
   fixes u :: "'a::linordered_field"
   assumes "u\<^sup>2 = x * y" "x \<ge> 0" "y \<ge> 0"
   shows "u \<le> (x + y)/2"
   apply (rule power2_le_imp_le)
   using sum_squares_bound assms
   apply (auto simp: zero_le_mult_iff)
   apply (auto simp: algebra_simps power2_eq_square)
   done
 
 lemma arith_geo_mean_sqrt:
   fixes x :: real
   assumes "x \<ge> 0" "y \<ge> 0"
   shows "sqrt (x * y) \<le> (x + y)/2"
   apply (rule arith_geo_mean)
   using assms
   apply (auto simp: zero_le_mult_iff)
   done
 
 lemma real_sqrt_sum_squares_mult_ge_zero [simp]: "0 \<le> sqrt ((x\<^sup>2 + y\<^sup>2) * (xa\<^sup>2 + ya\<^sup>2))"
   by (metis real_sqrt_ge_0_iff split_mult_pos_le sum_power2_ge_zero)
 
 lemma real_sqrt_sum_squares_mult_squared_eq [simp]:
   "(sqrt ((x\<^sup>2 + y\<^sup>2) * (xa\<^sup>2 + ya\<^sup>2)))\<^sup>2 = (x\<^sup>2 + y\<^sup>2) * (xa\<^sup>2 + ya\<^sup>2)"
   by (simp add: zero_le_mult_iff)
 
 lemma real_sqrt_sum_squares_eq_cancel: "sqrt (x\<^sup>2 + y\<^sup>2) = x \<Longrightarrow> y = 0"
   by (drule arg_cong [where f = "\<lambda>x. x\<^sup>2"]) simp
 
 lemma real_sqrt_sum_squares_eq_cancel2: "sqrt (x\<^sup>2 + y\<^sup>2) = y \<Longrightarrow> x = 0"
   by (drule arg_cong [where f = "\<lambda>x. x\<^sup>2"]) simp
 
 lemma real_sqrt_sum_squares_ge1 [simp]: "x \<le> sqrt (x\<^sup>2 + y\<^sup>2)"
   by (rule power2_le_imp_le) simp_all
 
 lemma real_sqrt_sum_squares_ge2 [simp]: "y \<le> sqrt (x\<^sup>2 + y\<^sup>2)"
   by (rule power2_le_imp_le) simp_all
 
 lemma real_sqrt_ge_abs1 [simp]: "\<bar>x\<bar> \<le> sqrt (x\<^sup>2 + y\<^sup>2)"
   by (rule power2_le_imp_le) simp_all
 
 lemma real_sqrt_ge_abs2 [simp]: "\<bar>y\<bar> \<le> sqrt (x\<^sup>2 + y\<^sup>2)"
   by (rule power2_le_imp_le) simp_all
 
 lemma le_real_sqrt_sumsq [simp]: "x \<le> sqrt (x * x + y * y)"
   by (simp add: power2_eq_square [symmetric])
 
 lemma sqrt_sum_squares_le_sum:
   "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<^sup>2 + y\<^sup>2) \<le> x + y"
   by (rule power2_le_imp_le) (simp_all add: power2_sum)
 
 lemma L2_set_mult_ineq_lemma:
   fixes a b c d :: real
   shows "2 * (a * c) * (b * d) \<le> a\<^sup>2 * d\<^sup>2 + b\<^sup>2 * c\<^sup>2"
 proof -
   have "0 \<le> (a * d - b * c)\<^sup>2" by simp
   also have "\<dots> = a\<^sup>2 * d\<^sup>2 + b\<^sup>2 * c\<^sup>2 - 2 * (a * d) * (b * c)"
     by (simp only: power2_diff power_mult_distrib)
   also have "\<dots> = a\<^sup>2 * d\<^sup>2 + b\<^sup>2 * c\<^sup>2 - 2 * (a * c) * (b * d)"
     by simp
   finally show "2 * (a * c) * (b * d) \<le> a\<^sup>2 * d\<^sup>2 + b\<^sup>2 * c\<^sup>2"
     by simp
 qed
 
 lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<^sup>2 + y\<^sup>2) \<le> \<bar>x\<bar> + \<bar>y\<bar>"
   by (rule power2_le_imp_le) (simp_all add: power2_sum)
 
 lemma real_sqrt_sum_squares_triangle_ineq:
   "sqrt ((a + c)\<^sup>2 + (b + d)\<^sup>2) \<le> sqrt (a\<^sup>2 + b\<^sup>2) + sqrt (c\<^sup>2 + d\<^sup>2)"
 proof -
   have "(a * c + b * d) \<le> (sqrt (a\<^sup>2 + b\<^sup>2) * sqrt (c\<^sup>2 + d\<^sup>2))"
     by (rule power2_le_imp_le) (simp_all add: power2_sum power_mult_distrib ring_distribs L2_set_mult_ineq_lemma add.commute)
   then have "(a + c)\<^sup>2 + (b + d)\<^sup>2 \<le> (sqrt (a\<^sup>2 + b\<^sup>2) + sqrt (c\<^sup>2 + d\<^sup>2))\<^sup>2"
     by (simp add: power2_sum)
   then show ?thesis
     by (auto intro: power2_le_imp_le)
 qed
 
 lemma real_sqrt_sum_squares_less: "\<bar>x\<bar> < u / sqrt 2 \<Longrightarrow> \<bar>y\<bar> < u / sqrt 2 \<Longrightarrow> sqrt (x\<^sup>2 + y\<^sup>2) < u"
   apply (rule power2_less_imp_less)
    apply simp
    apply (drule power_strict_mono [OF _ abs_ge_zero pos2])
    apply (drule power_strict_mono [OF _ abs_ge_zero pos2])
    apply (simp add: power_divide)
   apply (drule order_le_less_trans [OF abs_ge_zero])
   apply (simp add: zero_less_divide_iff)
   done
 
 lemma sqrt2_less_2: "sqrt 2 < (2::real)"
   by (metis not_less not_less_iff_gr_or_eq numeral_less_iff real_sqrt_four
       real_sqrt_le_iff semiring_norm(75) semiring_norm(78) semiring_norm(85))
 
 lemma sqrt_sum_squares_half_less:
   "x < u/2 \<Longrightarrow> y < u/2 \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> sqrt (x\<^sup>2 + y\<^sup>2) < u"
   apply (rule real_sqrt_sum_squares_less)
    apply (auto simp add: abs_if field_simps)
    apply (rule le_less_trans [where y = "x*2"])
   using less_eq_real_def sqrt2_less_2 apply force
    apply assumption
   apply (rule le_less_trans [where y = "y*2"])
   using less_eq_real_def sqrt2_less_2 mult_le_cancel_left
    apply auto
   done
 
 lemma LIMSEQ_root: "(\<lambda>n. root n n) \<longlonglongrightarrow> 1"
 proof -
   define x where "x n = root n n - 1" for n
   have "x \<longlonglongrightarrow> sqrt 0"
   proof (rule tendsto_sandwich[OF _ _ tendsto_const])
     show "(\<lambda>x. sqrt (2 / x)) \<longlonglongrightarrow> sqrt 0"
       by (intro tendsto_intros tendsto_divide_0[OF tendsto_const] filterlim_mono[OF filterlim_real_sequentially])
          (simp_all add: at_infinity_eq_at_top_bot)
     have "x n \<le> sqrt (2 / real n)" if "2 < n" for n :: nat
     proof -
       have "1 + (real (n - 1) * n) / 2 * (x n)\<^sup>2 = 1 + of_nat (n choose 2) * (x n)\<^sup>2"
         by (auto simp add: choose_two field_char_0_class.of_nat_div mod_eq_0_iff_dvd)
       also have "\<dots> \<le> (\<Sum>k\<in>{0, 2}. of_nat (n choose k) * x n^k)"
         by (simp add: x_def)
       also have "\<dots> \<le> (\<Sum>k\<le>n. of_nat (n choose k) * x n^k)"
         using \<open>2 < n\<close>
         by (intro sum_mono2) (auto intro!: mult_nonneg_nonneg zero_le_power simp: x_def le_diff_eq)
       also have "\<dots> = (x n + 1) ^ n"
         by (simp add: binomial_ring)
       also have "\<dots> = n"
         using \<open>2 < n\<close> by (simp add: x_def)
       finally have "real (n - 1) * (real n / 2 * (x n)\<^sup>2) \<le> real (n - 1) * 1"
         by simp
       then have "(x n)\<^sup>2 \<le> 2 / real n"
         using \<open>2 < n\<close> unfolding mult_le_cancel_left by (simp add: field_simps)
       from real_sqrt_le_mono[OF this] show ?thesis
         by simp
     qed
     then show "eventually (\<lambda>n. x n \<le> sqrt (2 / real n)) sequentially"
       by (auto intro!: exI[of _ 3] simp: eventually_sequentially)
     show "eventually (\<lambda>n. sqrt 0 \<le> x n) sequentially"
       by (auto intro!: exI[of _ 1] simp: eventually_sequentially le_diff_eq x_def)
   qed
   from tendsto_add[OF this tendsto_const[of 1]] show ?thesis
     by (simp add: x_def)
 qed
 
 lemma LIMSEQ_root_const:
   assumes "0 < c"
   shows "(\<lambda>n. root n c) \<longlonglongrightarrow> 1"
 proof -
   have ge_1: "(\<lambda>n. root n c) \<longlonglongrightarrow> 1" if "1 \<le> c" for c :: real
   proof -
     define x where "x n = root n c - 1" for n
     have "x \<longlonglongrightarrow> 0"
     proof (rule tendsto_sandwich[OF _ _ tendsto_const])
       show "(\<lambda>n. c / n) \<longlonglongrightarrow> 0"
         by (intro tendsto_divide_0[OF tendsto_const] filterlim_mono[OF filterlim_real_sequentially])
           (simp_all add: at_infinity_eq_at_top_bot)
       have "x n \<le> c / n" if "1 < n" for n :: nat
       proof -
         have "1 + x n * n = 1 + of_nat (n choose 1) * x n^1"
           by (simp add: choose_one)
         also have "\<dots> \<le> (\<Sum>k\<in>{0, 1}. of_nat (n choose k) * x n^k)"
           by (simp add: x_def)
         also have "\<dots> \<le> (\<Sum>k\<le>n. of_nat (n choose k) * x n^k)"
           using \<open>1 < n\<close> \<open>1 \<le> c\<close>
           by (intro sum_mono2)
             (auto intro!: mult_nonneg_nonneg zero_le_power simp: x_def le_diff_eq)
         also have "\<dots> = (x n + 1) ^ n"
           by (simp add: binomial_ring)
         also have "\<dots> = c"
           using \<open>1 < n\<close> \<open>1 \<le> c\<close> by (simp add: x_def)
         finally show ?thesis
           using \<open>1 \<le> c\<close> \<open>1 < n\<close> by (simp add: field_simps)
       qed
       then show "eventually (\<lambda>n. x n \<le> c / n) sequentially"
         by (auto intro!: exI[of _ 3] simp: eventually_sequentially)
       show "eventually (\<lambda>n. 0 \<le> x n) sequentially"
         using \<open>1 \<le> c\<close>
         by (auto intro!: exI[of _ 1] simp: eventually_sequentially le_diff_eq x_def)
     qed
     from tendsto_add[OF this tendsto_const[of 1]] show ?thesis
       by (simp add: x_def)
   qed
   show ?thesis
   proof (cases "1 \<le> c")
     case True
     with ge_1 show ?thesis by blast
   next
     case False
     with \<open>0 < c\<close> have "1 \<le> 1 / c"
       by simp
     then have "(\<lambda>n. 1 / root n (1 / c)) \<longlonglongrightarrow> 1 / 1"
       by (intro tendsto_divide tendsto_const ge_1 \<open>1 \<le> 1 / c\<close> one_neq_zero)
     then show ?thesis
       by (rule filterlim_cong[THEN iffD1, rotated 3])
         (auto intro!: exI[of _ 1] simp: eventually_sequentially real_root_divide)
   qed
 qed
 
 
 text "Legacy theorem names:"
 lemmas real_root_pos2 = real_root_power_cancel
 lemmas real_root_pos_pos = real_root_gt_zero [THEN order_less_imp_le]
 lemmas real_root_pos_pos_le = real_root_ge_zero
 lemmas real_sqrt_eq_zero_cancel_iff = real_sqrt_eq_0_iff
 
 end