# HG changeset patch
# User paulson <lp15@cam.ac.uk>
# Date 1567607224 -3600
# Node ID de9c4ed2d5df9794f4ad8c5cd5dd50fa3167eb79
# Parent  0e2a065d6f315c90eb8d32e9e3b597395c408eb9
Half of Brouwer_Fixpoint split off to form a separate theory: Retracts.

diff -r 0e2a065d6f31 -r de9c4ed2d5df src/HOL/Analysis/Brouwer_Fixpoint.thy
--- a/src/HOL/Analysis/Brouwer_Fixpoint.thy	Wed Sep 04 14:16:27 2019 +0100
+++ b/src/HOL/Analysis/Brouwer_Fixpoint.thy	Wed Sep 04 15:27:04 2019 +0100
@@ -221,1323 +221,6 @@
   qed
 qed
 
-subsection \<open>Absolute Retracts, Absolute Neighbourhood Retracts and Euclidean Neighbourhood Retracts\<close>
-
-text \<open>Absolute retracts (AR), absolute neighbourhood retracts (ANR) and also Euclidean neighbourhood
-retracts (ENR). We define AR and ANR by specializing the standard definitions for a set to embedding
-in spaces of higher dimension.
-
-John Harrison writes: "This turns out to be sufficient (since any set in \<open>\<real>\<^sup>n\<close> can be
-embedded as a closed subset of a convex subset of \<open>\<real>\<^sup>n\<^sup>+\<^sup>1\<close>) to derive the usual
-definitions, but we need to split them into two implications because of the lack of type
-quantifiers. Then ENR turns out to be equivalent to ANR plus local compactness."\<close>
-
-definition\<^marker>\<open>tag important\<close> AR :: "'a::topological_space set \<Rightarrow> bool" where
-"AR S \<equiv> \<forall>U. \<forall>S'::('a * real) set.
-  S homeomorphic S' \<and> closedin (top_of_set U) S' \<longrightarrow> S' retract_of U"
-
-definition\<^marker>\<open>tag important\<close> ANR :: "'a::topological_space set \<Rightarrow> bool" where
-"ANR S \<equiv> \<forall>U. \<forall>S'::('a * real) set.
-  S homeomorphic S' \<and> closedin (top_of_set U) S'
-  \<longrightarrow> (\<exists>T. openin (top_of_set U) T \<and> S' retract_of T)"
-
-definition\<^marker>\<open>tag important\<close> ENR :: "'a::topological_space set \<Rightarrow> bool" where
-"ENR S \<equiv> \<exists>U. open U \<and> S retract_of U"
-
-text \<open>First, show that we do indeed get the "usual" properties of ARs and ANRs.\<close>
-
-lemma AR_imp_absolute_extensor:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes "AR S" and contf: "continuous_on T f" and "f ` T \<subseteq> S"
-      and cloUT: "closedin (top_of_set U) T"
-  obtains g where "continuous_on U g" "g ` U \<subseteq> S" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
-proof -
-  have "aff_dim S < int (DIM('b \<times> real))"
-    using aff_dim_le_DIM [of S] by simp
-  then obtain C and S' :: "('b * real) set"
-          where C: "convex C" "C \<noteq> {}"
-            and cloCS: "closedin (top_of_set C) S'"
-            and hom: "S homeomorphic S'"
-    by (metis that homeomorphic_closedin_convex)
-  then have "S' retract_of C"
-    using \<open>AR S\<close> by (simp add: AR_def)
-  then obtain r where "S' \<subseteq> C" and contr: "continuous_on C r"
-                  and "r ` C \<subseteq> S'" and rid: "\<And>x. x\<in>S' \<Longrightarrow> r x = x"
-    by (auto simp: retraction_def retract_of_def)
-  obtain g h where "homeomorphism S S' g h"
-    using hom by (force simp: homeomorphic_def)
-  then have "continuous_on (f ` T) g"
-    by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def)
-  then have contgf: "continuous_on T (g \<circ> f)"
-    by (metis continuous_on_compose contf)
-  have gfTC: "(g \<circ> f) ` T \<subseteq> C"
-  proof -
-    have "g ` S = S'"
-      by (metis (no_types) \<open>homeomorphism S S' g h\<close> homeomorphism_def)
-    with \<open>S' \<subseteq> C\<close> \<open>f ` T \<subseteq> S\<close> show ?thesis by force
-  qed
-  obtain f' where f': "continuous_on U f'"  "f' ` U \<subseteq> C"
-                      "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x"
-    by (metis Dugundji [OF C cloUT contgf gfTC])
-  show ?thesis
-  proof (rule_tac g = "h \<circ> r \<circ> f'" in that)
-    show "continuous_on U (h \<circ> r \<circ> f')"
-      apply (intro continuous_on_compose f')
-       using continuous_on_subset contr f' apply blast
-      by (meson \<open>homeomorphism S S' g h\<close> \<open>r ` C \<subseteq> S'\<close> continuous_on_subset \<open>f' ` U \<subseteq> C\<close> homeomorphism_def image_mono)
-    show "(h \<circ> r \<circ> f') ` U \<subseteq> S"
-      using \<open>homeomorphism S S' g h\<close> \<open>r ` C \<subseteq> S'\<close> \<open>f' ` U \<subseteq> C\<close>
-      by (fastforce simp: homeomorphism_def)
-    show "\<And>x. x \<in> T \<Longrightarrow> (h \<circ> r \<circ> f') x = f x"
-      using \<open>homeomorphism S S' g h\<close> \<open>f ` T \<subseteq> S\<close> f'
-      by (auto simp: rid homeomorphism_def)
-  qed
-qed
-
-lemma AR_imp_absolute_retract:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "AR S" "S homeomorphic S'"
-      and clo: "closedin (top_of_set U) S'"
-    shows "S' retract_of U"
-proof -
-  obtain g h where hom: "homeomorphism S S' g h"
-    using assms by (force simp: homeomorphic_def)
-  have h: "continuous_on S' h" " h ` S' \<subseteq> S"
-    using hom homeomorphism_def apply blast
-    apply (metis hom equalityE homeomorphism_def)
-    done
-  obtain h' where h': "continuous_on U h'" "h' ` U \<subseteq> S"
-              and h'h: "\<And>x. x \<in> S' \<Longrightarrow> h' x = h x"
-    by (blast intro: AR_imp_absolute_extensor [OF \<open>AR S\<close> h clo])
-  have [simp]: "S' \<subseteq> U" using clo closedin_limpt by blast
-  show ?thesis
-  proof (simp add: retraction_def retract_of_def, intro exI conjI)
-    show "continuous_on U (g \<circ> h')"
-      apply (intro continuous_on_compose h')
-      apply (meson hom continuous_on_subset h' homeomorphism_cont1)
-      done
-    show "(g \<circ> h') ` U \<subseteq> S'"
-      using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
-    show "\<forall>x\<in>S'. (g \<circ> h') x = x"
-      by clarsimp (metis h'h hom homeomorphism_def)
-  qed
-qed
-
-lemma AR_imp_absolute_retract_UNIV:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "AR S" and hom: "S homeomorphic S'"
-      and clo: "closed S'"
-    shows "S' retract_of UNIV"
-apply (rule AR_imp_absolute_retract [OF \<open>AR S\<close> hom])
-using clo closed_closedin by auto
-
-lemma absolute_extensor_imp_AR:
-  fixes S :: "'a::euclidean_space set"
-  assumes "\<And>f :: 'a * real \<Rightarrow> 'a.
-           \<And>U T. \<lbrakk>continuous_on T f;  f ` T \<subseteq> S;
-                  closedin (top_of_set U) T\<rbrakk>
-                 \<Longrightarrow> \<exists>g. continuous_on U g \<and> g ` U \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)"
-  shows "AR S"
-proof (clarsimp simp: AR_def)
-  fix U and T :: "('a * real) set"
-  assume "S homeomorphic T" and clo: "closedin (top_of_set U) T"
-  then obtain g h where hom: "homeomorphism S T g h"
-    by (force simp: homeomorphic_def)
-  have h: "continuous_on T h" " h ` T \<subseteq> S"
-    using hom homeomorphism_def apply blast
-    apply (metis hom equalityE homeomorphism_def)
-    done
-  obtain h' where h': "continuous_on U h'" "h' ` U \<subseteq> S"
-              and h'h: "\<forall>x\<in>T. h' x = h x"
-    using assms [OF h clo] by blast
-  have [simp]: "T \<subseteq> U"
-    using clo closedin_imp_subset by auto
-  show "T retract_of U"
-  proof (simp add: retraction_def retract_of_def, intro exI conjI)
-    show "continuous_on U (g \<circ> h')"
-      apply (intro continuous_on_compose h')
-      apply (meson hom continuous_on_subset h' homeomorphism_cont1)
-      done
-    show "(g \<circ> h') ` U \<subseteq> T"
-      using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
-    show "\<forall>x\<in>T. (g \<circ> h') x = x"
-      by clarsimp (metis h'h hom homeomorphism_def)
-  qed
-qed
-
-lemma AR_eq_absolute_extensor:
-  fixes S :: "'a::euclidean_space set"
-  shows "AR S \<longleftrightarrow>
-       (\<forall>f :: 'a * real \<Rightarrow> 'a.
-        \<forall>U T. continuous_on T f \<longrightarrow> f ` T \<subseteq> S \<longrightarrow>
-               closedin (top_of_set U) T \<longrightarrow>
-                (\<exists>g. continuous_on U g \<and> g ` U \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)))"
-apply (rule iffI)
- apply (metis AR_imp_absolute_extensor)
-apply (simp add: absolute_extensor_imp_AR)
-done
-
-lemma AR_imp_retract:
-  fixes S :: "'a::euclidean_space set"
-  assumes "AR S \<and> closedin (top_of_set U) S"
-    shows "S retract_of U"
-using AR_imp_absolute_retract assms homeomorphic_refl by blast
-
-lemma AR_homeomorphic_AR:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "AR T" "S homeomorphic T"
-    shows "AR S"
-unfolding AR_def
-by (metis assms AR_imp_absolute_retract homeomorphic_trans [of _ S] homeomorphic_sym)
-
-lemma homeomorphic_AR_iff_AR:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  shows "S homeomorphic T \<Longrightarrow> AR S \<longleftrightarrow> AR T"
-by (metis AR_homeomorphic_AR homeomorphic_sym)
-
-
-lemma ANR_imp_absolute_neighbourhood_extensor:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes "ANR S" and contf: "continuous_on T f" and "f ` T \<subseteq> S"
-      and cloUT: "closedin (top_of_set U) T"
-  obtains V g where "T \<subseteq> V" "openin (top_of_set U) V"
-                    "continuous_on V g"
-                    "g ` V \<subseteq> S" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
-proof -
-  have "aff_dim S < int (DIM('b \<times> real))"
-    using aff_dim_le_DIM [of S] by simp
-  then obtain C and S' :: "('b * real) set"
-          where C: "convex C" "C \<noteq> {}"
-            and cloCS: "closedin (top_of_set C) S'"
-            and hom: "S homeomorphic S'"
-    by (metis that homeomorphic_closedin_convex)
-  then obtain D where opD: "openin (top_of_set C) D" and "S' retract_of D"
-    using \<open>ANR S\<close> by (auto simp: ANR_def)
-  then obtain r where "S' \<subseteq> D" and contr: "continuous_on D r"
-                  and "r ` D \<subseteq> S'" and rid: "\<And>x. x \<in> S' \<Longrightarrow> r x = x"
-    by (auto simp: retraction_def retract_of_def)
-  obtain g h where homgh: "homeomorphism S S' g h"
-    using hom by (force simp: homeomorphic_def)
-  have "continuous_on (f ` T) g"
-    by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def homgh)
-  then have contgf: "continuous_on T (g \<circ> f)"
-    by (intro continuous_on_compose contf)
-  have gfTC: "(g \<circ> f) ` T \<subseteq> C"
-  proof -
-    have "g ` S = S'"
-      by (metis (no_types) homeomorphism_def homgh)
-    then show ?thesis
-      by (metis (no_types) assms(3) cloCS closedin_def image_comp image_mono order.trans topspace_euclidean_subtopology)
-  qed
-  obtain f' where contf': "continuous_on U f'"
-              and "f' ` U \<subseteq> C"
-              and eq: "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x"
-    by (metis Dugundji [OF C cloUT contgf gfTC])
-  show ?thesis
-  proof (rule_tac V = "U \<inter> f' -` D" and g = "h \<circ> r \<circ> f'" in that)
-    show "T \<subseteq> U \<inter> f' -` D"
-      using cloUT closedin_imp_subset \<open>S' \<subseteq> D\<close> \<open>f ` T \<subseteq> S\<close> eq homeomorphism_image1 homgh
-      by fastforce
-    show ope: "openin (top_of_set U) (U \<inter> f' -` D)"
-      using  \<open>f' ` U \<subseteq> C\<close> by (auto simp: opD contf' continuous_openin_preimage)
-    have conth: "continuous_on (r ` f' ` (U \<inter> f' -` D)) h"
-      apply (rule continuous_on_subset [of S'])
-      using homeomorphism_def homgh apply blast
-      using \<open>r ` D \<subseteq> S'\<close> by blast
-    show "continuous_on (U \<inter> f' -` D) (h \<circ> r \<circ> f')"
-      apply (intro continuous_on_compose conth
-                   continuous_on_subset [OF contr] continuous_on_subset [OF contf'], auto)
-      done
-    show "(h \<circ> r \<circ> f') ` (U \<inter> f' -` D) \<subseteq> S"
-      using \<open>homeomorphism S S' g h\<close>  \<open>f' ` U \<subseteq> C\<close>  \<open>r ` D \<subseteq> S'\<close>
-      by (auto simp: homeomorphism_def)
-    show "\<And>x. x \<in> T \<Longrightarrow> (h \<circ> r \<circ> f') x = f x"
-      using \<open>homeomorphism S S' g h\<close> \<open>f ` T \<subseteq> S\<close> eq
-      by (auto simp: rid homeomorphism_def)
-  qed
-qed
-
-
-corollary ANR_imp_absolute_neighbourhood_retract:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "ANR S" "S homeomorphic S'"
-      and clo: "closedin (top_of_set U) S'"
-  obtains V where "openin (top_of_set U) V" "S' retract_of V"
-proof -
-  obtain g h where hom: "homeomorphism S S' g h"
-    using assms by (force simp: homeomorphic_def)
-  have h: "continuous_on S' h" " h ` S' \<subseteq> S"
-    using hom homeomorphism_def apply blast
-    apply (metis hom equalityE homeomorphism_def)
-    done
-    from ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo]
-  obtain V h' where "S' \<subseteq> V" and opUV: "openin (top_of_set U) V"
-                and h': "continuous_on V h'" "h' ` V \<subseteq> S"
-                and h'h:"\<And>x. x \<in> S' \<Longrightarrow> h' x = h x"
-    by (blast intro: ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo])
-  have "S' retract_of V"
-  proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>S' \<subseteq> V\<close>)
-    show "continuous_on V (g \<circ> h')"
-      apply (intro continuous_on_compose h')
-      apply (meson hom continuous_on_subset h' homeomorphism_cont1)
-      done
-    show "(g \<circ> h') ` V \<subseteq> S'"
-      using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
-    show "\<forall>x\<in>S'. (g \<circ> h') x = x"
-      by clarsimp (metis h'h hom homeomorphism_def)
-  qed
-  then show ?thesis
-    by (rule that [OF opUV])
-qed
-
-corollary ANR_imp_absolute_neighbourhood_retract_UNIV:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "ANR S" and hom: "S homeomorphic S'" and clo: "closed S'"
-  obtains V where "open V" "S' retract_of V"
-  using ANR_imp_absolute_neighbourhood_retract [OF \<open>ANR S\<close> hom]
-by (metis clo closed_closedin open_openin subtopology_UNIV)
-
-corollary neighbourhood_extension_into_ANR:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> T" and "ANR T" "closed S"
-  obtains V g where "S \<subseteq> V" "open V" "continuous_on V g"
-                    "g ` V \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
-  using ANR_imp_absolute_neighbourhood_extensor [OF  \<open>ANR T\<close> contf fim]
-  by (metis \<open>closed S\<close> closed_closedin open_openin subtopology_UNIV)
-
-lemma absolute_neighbourhood_extensor_imp_ANR:
-  fixes S :: "'a::euclidean_space set"
-  assumes "\<And>f :: 'a * real \<Rightarrow> 'a.
-           \<And>U T. \<lbrakk>continuous_on T f;  f ` T \<subseteq> S;
-                  closedin (top_of_set U) T\<rbrakk>
-                 \<Longrightarrow> \<exists>V g. T \<subseteq> V \<and> openin (top_of_set U) V \<and>
-                       continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)"
-  shows "ANR S"
-proof (clarsimp simp: ANR_def)
-  fix U and T :: "('a * real) set"
-  assume "S homeomorphic T" and clo: "closedin (top_of_set U) T"
-  then obtain g h where hom: "homeomorphism S T g h"
-    by (force simp: homeomorphic_def)
-  have h: "continuous_on T h" " h ` T \<subseteq> S"
-    using hom homeomorphism_def apply blast
-    apply (metis hom equalityE homeomorphism_def)
-    done
-  obtain V h' where "T \<subseteq> V" and opV: "openin (top_of_set U) V"
-                and h': "continuous_on V h'" "h' ` V \<subseteq> S"
-              and h'h: "\<forall>x\<in>T. h' x = h x"
-    using assms [OF h clo] by blast
-  have [simp]: "T \<subseteq> U"
-    using clo closedin_imp_subset by auto
-  have "T retract_of V"
-  proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>T \<subseteq> V\<close>)
-    show "continuous_on V (g \<circ> h')"
-      apply (intro continuous_on_compose h')
-      apply (meson hom continuous_on_subset h' homeomorphism_cont1)
-      done
-    show "(g \<circ> h') ` V \<subseteq> T"
-      using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
-    show "\<forall>x\<in>T. (g \<circ> h') x = x"
-      by clarsimp (metis h'h hom homeomorphism_def)
-  qed
-  then show "\<exists>V. openin (top_of_set U) V \<and> T retract_of V"
-    using opV by blast
-qed
-
-lemma ANR_eq_absolute_neighbourhood_extensor:
-  fixes S :: "'a::euclidean_space set"
-  shows "ANR S \<longleftrightarrow>
-         (\<forall>f :: 'a * real \<Rightarrow> 'a.
-          \<forall>U T. continuous_on T f \<longrightarrow> f ` T \<subseteq> S \<longrightarrow>
-                closedin (top_of_set U) T \<longrightarrow>
-               (\<exists>V g. T \<subseteq> V \<and> openin (top_of_set U) V \<and>
-                       continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)))"
-apply (rule iffI)
- apply (metis ANR_imp_absolute_neighbourhood_extensor)
-apply (simp add: absolute_neighbourhood_extensor_imp_ANR)
-done
-
-lemma ANR_imp_neighbourhood_retract:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ANR S" "closedin (top_of_set U) S"
-  obtains V where "openin (top_of_set U) V" "S retract_of V"
-using ANR_imp_absolute_neighbourhood_retract assms homeomorphic_refl by blast
-
-lemma ANR_imp_absolute_closed_neighbourhood_retract:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "ANR S" "S homeomorphic S'" and US': "closedin (top_of_set U) S'"
-  obtains V W
-    where "openin (top_of_set U) V"
-          "closedin (top_of_set U) W"
-          "S' \<subseteq> V" "V \<subseteq> W" "S' retract_of W"
-proof -
-  obtain Z where "openin (top_of_set U) Z" and S'Z: "S' retract_of Z"
-    by (blast intro: assms ANR_imp_absolute_neighbourhood_retract)
-  then have UUZ: "closedin (top_of_set U) (U - Z)"
-    by auto
-  have "S' \<inter> (U - Z) = {}"
-    using \<open>S' retract_of Z\<close> closedin_retract closedin_subtopology by fastforce
-  then obtain V W
-      where "openin (top_of_set U) V"
-        and "openin (top_of_set U) W"
-        and "S' \<subseteq> V" "U - Z \<subseteq> W" "V \<inter> W = {}"
-      using separation_normal_local [OF US' UUZ]  by auto
-  moreover have "S' retract_of U - W"
-    apply (rule retract_of_subset [OF S'Z])
-    using US' \<open>S' \<subseteq> V\<close> \<open>V \<inter> W = {}\<close> closedin_subset apply fastforce
-    using Diff_subset_conv \<open>U - Z \<subseteq> W\<close> by blast
-  ultimately show ?thesis
-    apply (rule_tac V=V and W = "U-W" in that)
-    using openin_imp_subset apply force+
-    done
-qed
-
-lemma ANR_imp_closed_neighbourhood_retract:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ANR S" "closedin (top_of_set U) S"
-  obtains V W where "openin (top_of_set U) V"
-                    "closedin (top_of_set U) W"
-                    "S \<subseteq> V" "V \<subseteq> W" "S retract_of W"
-by (meson ANR_imp_absolute_closed_neighbourhood_retract assms homeomorphic_refl)
-
-lemma ANR_homeomorphic_ANR:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "ANR T" "S homeomorphic T"
-    shows "ANR S"
-unfolding ANR_def
-by (metis assms ANR_imp_absolute_neighbourhood_retract homeomorphic_trans [of _ S] homeomorphic_sym)
-
-lemma homeomorphic_ANR_iff_ANR:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  shows "S homeomorphic T \<Longrightarrow> ANR S \<longleftrightarrow> ANR T"
-by (metis ANR_homeomorphic_ANR homeomorphic_sym)
-
-subsubsection \<open>Analogous properties of ENRs\<close>
-
-lemma ENR_imp_absolute_neighbourhood_retract:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "ENR S" and hom: "S homeomorphic S'"
-      and "S' \<subseteq> U"
-  obtains V where "openin (top_of_set U) V" "S' retract_of V"
-proof -
-  obtain X where "open X" "S retract_of X"
-    using \<open>ENR S\<close> by (auto simp: ENR_def)
-  then obtain r where "retraction X S r"
-    by (auto simp: retract_of_def)
-  have "locally compact S'"
-    using retract_of_locally_compact open_imp_locally_compact
-          homeomorphic_local_compactness \<open>S retract_of X\<close> \<open>open X\<close> hom by blast
-  then obtain W where UW: "openin (top_of_set U) W"
-                  and WS': "closedin (top_of_set W) S'"
-    apply (rule locally_compact_closedin_open)
-    apply (rename_tac W)
-    apply (rule_tac W = "U \<inter> W" in that, blast)
-    by (simp add: \<open>S' \<subseteq> U\<close> closedin_limpt)
-  obtain f g where hom: "homeomorphism S S' f g"
-    using assms by (force simp: homeomorphic_def)
-  have contg: "continuous_on S' g"
-    using hom homeomorphism_def by blast
-  moreover have "g ` S' \<subseteq> S" by (metis hom equalityE homeomorphism_def)
-  ultimately obtain h where conth: "continuous_on W h" and hg: "\<And>x. x \<in> S' \<Longrightarrow> h x = g x"
-    using Tietze_unbounded [of S' g W] WS' by blast
-  have "W \<subseteq> U" using UW openin_open by auto
-  have "S' \<subseteq> W" using WS' closedin_closed by auto
-  have him: "\<And>x. x \<in> S' \<Longrightarrow> h x \<in> X"
-    by (metis (no_types) \<open>S retract_of X\<close> hg hom homeomorphism_def image_insert insert_absorb insert_iff retract_of_imp_subset subset_eq)
-  have "S' retract_of (W \<inter> h -` X)"
-  proof (simp add: retraction_def retract_of_def, intro exI conjI)
-    show "S' \<subseteq> W" "S' \<subseteq> h -` X"
-      using him WS' closedin_imp_subset by blast+
-    show "continuous_on (W \<inter> h -` X) (f \<circ> r \<circ> h)"
-    proof (intro continuous_on_compose)
-      show "continuous_on (W \<inter> h -` X) h"
-        by (meson conth continuous_on_subset inf_le1)
-      show "continuous_on (h ` (W \<inter> h -` X)) r"
-      proof -
-        have "h ` (W \<inter> h -` X) \<subseteq> X"
-          by blast
-        then show "continuous_on (h ` (W \<inter> h -` X)) r"
-          by (meson \<open>retraction X S r\<close> continuous_on_subset retraction)
-      qed
-      show "continuous_on (r ` h ` (W \<inter> h -` X)) f"
-        apply (rule continuous_on_subset [of S])
-         using hom homeomorphism_def apply blast
-        apply clarify
-        apply (meson \<open>retraction X S r\<close> subsetD imageI retraction_def)
-        done
-    qed
-    show "(f \<circ> r \<circ> h) ` (W \<inter> h -` X) \<subseteq> S'"
-      using \<open>retraction X S r\<close> hom
-      by (auto simp: retraction_def homeomorphism_def)
-    show "\<forall>x\<in>S'. (f \<circ> r \<circ> h) x = x"
-      using \<open>retraction X S r\<close> hom by (auto simp: retraction_def homeomorphism_def hg)
-  qed
-  then show ?thesis
-    apply (rule_tac V = "W \<inter> h -` X" in that)
-     apply (rule openin_trans [OF _ UW])
-     using \<open>continuous_on W h\<close> \<open>open X\<close> continuous_openin_preimage_eq apply blast+
-     done
-qed
-
-corollary ENR_imp_absolute_neighbourhood_retract_UNIV:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "ENR S" "S homeomorphic S'"
-  obtains T' where "open T'" "S' retract_of T'"
-by (metis ENR_imp_absolute_neighbourhood_retract UNIV_I assms(1) assms(2) open_openin subsetI subtopology_UNIV)
-
-lemma ENR_homeomorphic_ENR:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "ENR T" "S homeomorphic T"
-    shows "ENR S"
-unfolding ENR_def
-by (meson ENR_imp_absolute_neighbourhood_retract_UNIV assms homeomorphic_sym)
-
-lemma homeomorphic_ENR_iff_ENR:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "S homeomorphic T"
-    shows "ENR S \<longleftrightarrow> ENR T"
-by (meson ENR_homeomorphic_ENR assms homeomorphic_sym)
-
-lemma ENR_translation:
-  fixes S :: "'a::euclidean_space set"
-  shows "ENR(image (\<lambda>x. a + x) S) \<longleftrightarrow> ENR S"
-by (meson homeomorphic_sym homeomorphic_translation homeomorphic_ENR_iff_ENR)
-
-lemma ENR_linear_image_eq:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes "linear f" "inj f"
-  shows "ENR (image f S) \<longleftrightarrow> ENR S"
-apply (rule homeomorphic_ENR_iff_ENR)
-using assms homeomorphic_sym linear_homeomorphic_image by auto
-
-text \<open>Some relations among the concepts. We also relate AR to being a retract of UNIV, which is
-often a more convenient proxy in the closed case.\<close>
-
-lemma AR_imp_ANR: "AR S \<Longrightarrow> ANR S"
-  using ANR_def AR_def by fastforce
-
-lemma ENR_imp_ANR:
-  fixes S :: "'a::euclidean_space set"
-  shows "ENR S \<Longrightarrow> ANR S"
-apply (simp add: ANR_def)
-by (metis ENR_imp_absolute_neighbourhood_retract closedin_imp_subset)
-
-lemma ENR_ANR:
-  fixes S :: "'a::euclidean_space set"
-  shows "ENR S \<longleftrightarrow> ANR S \<and> locally compact S"
-proof
-  assume "ENR S"
-  then have "locally compact S"
-    using ENR_def open_imp_locally_compact retract_of_locally_compact by auto
-  then show "ANR S \<and> locally compact S"
-    using ENR_imp_ANR \<open>ENR S\<close> by blast
-next
-  assume "ANR S \<and> locally compact S"
-  then have "ANR S" "locally compact S" by auto
-  then obtain T :: "('a * real) set" where "closed T" "S homeomorphic T"
-    using locally_compact_homeomorphic_closed
-    by (metis DIM_prod DIM_real Suc_eq_plus1 lessI)
-  then show "ENR S"
-    using \<open>ANR S\<close>
-    apply (simp add: ANR_def)
-    apply (drule_tac x=UNIV in spec)
-    apply (drule_tac x=T in spec, clarsimp)
-    apply (meson ENR_def ENR_homeomorphic_ENR open_openin)
-    done
-qed
-
-
-lemma AR_ANR:
-  fixes S :: "'a::euclidean_space set"
-  shows "AR S \<longleftrightarrow> ANR S \<and> contractible S \<and> S \<noteq> {}"
-        (is "?lhs = ?rhs")
-proof
-  assume ?lhs
-  obtain C and S' :: "('a * real) set"
-    where "convex C" "C \<noteq> {}" "closedin (top_of_set C) S'" "S homeomorphic S'"
-      apply (rule homeomorphic_closedin_convex [of S, where 'n = "'a * real"])
-      using aff_dim_le_DIM [of S] by auto
-  with \<open>AR S\<close> have "contractible S"
-    apply (simp add: AR_def)
-    apply (drule_tac x=C in spec)
-    apply (drule_tac x="S'" in spec, simp)
-    using convex_imp_contractible homeomorphic_contractible_eq retract_of_contractible by fastforce
-  with \<open>AR S\<close> show ?rhs
-    apply (auto simp: AR_imp_ANR)
-    apply (force simp: AR_def)
-    done
-next
-  assume ?rhs
-  then obtain a and h:: "real \<times> 'a \<Rightarrow> 'a"
-      where conth: "continuous_on ({0..1} \<times> S) h"
-        and hS: "h ` ({0..1} \<times> S) \<subseteq> S"
-        and [simp]: "\<And>x. h(0, x) = x"
-        and [simp]: "\<And>x. h(1, x) = a"
-        and "ANR S" "S \<noteq> {}"
-    by (auto simp: contractible_def homotopic_with_def)
-  then have "a \<in> S"
-    by (metis all_not_in_conv atLeastAtMost_iff image_subset_iff mem_Sigma_iff order_refl zero_le_one)
-  have "\<exists>g. continuous_on W g \<and> g ` W \<subseteq> S \<and> (\<forall>x\<in>T. g x = f x)"
-         if      f: "continuous_on T f" "f ` T \<subseteq> S"
-            and WT: "closedin (top_of_set W) T"
-         for W T and f :: "'a \<times> real \<Rightarrow> 'a"
-  proof -
-    obtain U g
-      where "T \<subseteq> U" and WU: "openin (top_of_set W) U"
-        and contg: "continuous_on U g"
-        and "g ` U \<subseteq> S" and gf: "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
-      using iffD1 [OF ANR_eq_absolute_neighbourhood_extensor \<open>ANR S\<close>, rule_format, OF f WT]
-      by auto
-    have WWU: "closedin (top_of_set W) (W - U)"
-      using WU closedin_diff by fastforce
-    moreover have "(W - U) \<inter> T = {}"
-      using \<open>T \<subseteq> U\<close> by auto
-    ultimately obtain V V'
-      where WV': "openin (top_of_set W) V'"
-        and WV: "openin (top_of_set W) V"
-        and "W - U \<subseteq> V'" "T \<subseteq> V" "V' \<inter> V = {}"
-      using separation_normal_local [of W "W-U" T] WT by blast
-    then have WVT: "T \<inter> (W - V) = {}"
-      by auto
-    have WWV: "closedin (top_of_set W) (W - V)"
-      using WV closedin_diff by fastforce
-    obtain j :: " 'a \<times> real \<Rightarrow> real"
-      where contj: "continuous_on W j"
-        and j:  "\<And>x. x \<in> W \<Longrightarrow> j x \<in> {0..1}"
-        and j0: "\<And>x. x \<in> W - V \<Longrightarrow> j x = 1"
-        and j1: "\<And>x. x \<in> T \<Longrightarrow> j x = 0"
-      by (rule Urysohn_local [OF WT WWV WVT, of 0 "1::real"]) (auto simp: in_segment)
-    have Weq: "W = (W - V) \<union> (W - V')"
-      using \<open>V' \<inter> V = {}\<close> by force
-    show ?thesis
-    proof (intro conjI exI)
-      have *: "continuous_on (W - V') (\<lambda>x. h (j x, g x))"
-        apply (rule continuous_on_compose2 [OF conth continuous_on_Pair])
-          apply (rule continuous_on_subset [OF contj Diff_subset])
-         apply (rule continuous_on_subset [OF contg])
-         apply (metis Diff_subset_conv Un_commute \<open>W - U \<subseteq> V'\<close>)
-        using j \<open>g ` U \<subseteq> S\<close> \<open>W - U \<subseteq> V'\<close> apply fastforce
-        done
-      show "continuous_on W (\<lambda>x. if x \<in> W - V then a else h (j x, g x))"
-        apply (subst Weq)
-        apply (rule continuous_on_cases_local)
-            apply (simp_all add: Weq [symmetric] WWV continuous_on_const *)
-          using WV' closedin_diff apply fastforce
-         apply (auto simp: j0 j1)
-        done
-    next
-      have "h (j (x, y), g (x, y)) \<in> S" if "(x, y) \<in> W" "(x, y) \<in> V" for x y
-      proof -
-        have "j(x, y) \<in> {0..1}"
-          using j that by blast
-        moreover have "g(x, y) \<in> S"
-          using \<open>V' \<inter> V = {}\<close> \<open>W - U \<subseteq> V'\<close> \<open>g ` U \<subseteq> S\<close> that by fastforce
-        ultimately show ?thesis
-          using hS by blast
-      qed
-      with \<open>a \<in> S\<close> \<open>g ` U \<subseteq> S\<close>
-      show "(\<lambda>x. if x \<in> W - V then a else h (j x, g x)) ` W \<subseteq> S"
-        by auto
-    next
-      show "\<forall>x\<in>T. (if x \<in> W - V then a else h (j x, g x)) = f x"
-        using \<open>T \<subseteq> V\<close> by (auto simp: j0 j1 gf)
-    qed
-  qed
-  then show ?lhs
-    by (simp add: AR_eq_absolute_extensor)
-qed
-
-
-lemma ANR_retract_of_ANR:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ANR T" "S retract_of T"
-  shows "ANR S"
-using assms
-apply (simp add: ANR_eq_absolute_neighbourhood_extensor retract_of_def retraction_def)
-apply (clarsimp elim!: all_forward)
-apply (erule impCE, metis subset_trans)
-apply (clarsimp elim!: ex_forward)
-apply (rule_tac x="r \<circ> g" in exI)
-by (metis comp_apply continuous_on_compose continuous_on_subset subsetD imageI image_comp image_mono subset_trans)
-
-lemma AR_retract_of_AR:
-  fixes S :: "'a::euclidean_space set"
-  shows "\<lbrakk>AR T; S retract_of T\<rbrakk> \<Longrightarrow> AR S"
-using ANR_retract_of_ANR AR_ANR retract_of_contractible by fastforce
-
-lemma ENR_retract_of_ENR:
-   "\<lbrakk>ENR T; S retract_of T\<rbrakk> \<Longrightarrow> ENR S"
-by (meson ENR_def retract_of_trans)
-
-lemma retract_of_UNIV:
-  fixes S :: "'a::euclidean_space set"
-  shows "S retract_of UNIV \<longleftrightarrow> AR S \<and> closed S"
-by (metis AR_ANR AR_imp_retract ENR_def ENR_imp_ANR closed_UNIV closed_closedin contractible_UNIV empty_not_UNIV open_UNIV retract_of_closed retract_of_contractible retract_of_empty(1) subtopology_UNIV)
-
-lemma compact_AR:
-  fixes S :: "'a::euclidean_space set"
-  shows "compact S \<and> AR S \<longleftrightarrow> compact S \<and> S retract_of UNIV"
-using compact_imp_closed retract_of_UNIV by blast
-
-text \<open>More properties of ARs, ANRs and ENRs\<close>
-
-lemma not_AR_empty [simp]: "\<not> AR({})"
-  by (auto simp: AR_def)
-
-lemma ENR_empty [simp]: "ENR {}"
-  by (simp add: ENR_def)
-
-lemma ANR_empty [simp]: "ANR ({} :: 'a::euclidean_space set)"
-  by (simp add: ENR_imp_ANR)
-
-lemma convex_imp_AR:
-  fixes S :: "'a::euclidean_space set"
-  shows "\<lbrakk>convex S; S \<noteq> {}\<rbrakk> \<Longrightarrow> AR S"
-apply (rule absolute_extensor_imp_AR)
-apply (rule Dugundji, assumption+)
-by blast
-
-lemma convex_imp_ANR:
-  fixes S :: "'a::euclidean_space set"
-  shows "convex S \<Longrightarrow> ANR S"
-using ANR_empty AR_imp_ANR convex_imp_AR by blast
-
-lemma ENR_convex_closed:
-  fixes S :: "'a::euclidean_space set"
-  shows "\<lbrakk>closed S; convex S\<rbrakk> \<Longrightarrow> ENR S"
-using ENR_def ENR_empty convex_imp_AR retract_of_UNIV by blast
-
-lemma AR_UNIV [simp]: "AR (UNIV :: 'a::euclidean_space set)"
-  using retract_of_UNIV by auto
-
-lemma ANR_UNIV [simp]: "ANR (UNIV :: 'a::euclidean_space set)"
-  by (simp add: AR_imp_ANR)
-
-lemma ENR_UNIV [simp]:"ENR UNIV"
-  using ENR_def by blast
-
-lemma AR_singleton:
-    fixes a :: "'a::euclidean_space"
-    shows "AR {a}"
-  using retract_of_UNIV by blast
-
-lemma ANR_singleton:
-    fixes a :: "'a::euclidean_space"
-    shows "ANR {a}"
-  by (simp add: AR_imp_ANR AR_singleton)
-
-lemma ENR_singleton: "ENR {a}"
-  using ENR_def by blast
-
-text \<open>ARs closed under union\<close>
-
-lemma AR_closed_Un_local_aux:
-  fixes U :: "'a::euclidean_space set"
-  assumes "closedin (top_of_set U) S"
-          "closedin (top_of_set U) T"
-          "AR S" "AR T" "AR(S \<inter> T)"
-  shows "(S \<union> T) retract_of U"
-proof -
-  have "S \<inter> T \<noteq> {}"
-    using assms AR_def by fastforce
-  have "S \<subseteq> U" "T \<subseteq> U"
-    using assms by (auto simp: closedin_imp_subset)
-  define S' where "S' \<equiv> {x \<in> U. setdist {x} S \<le> setdist {x} T}"
-  define T' where "T' \<equiv> {x \<in> U. setdist {x} T \<le> setdist {x} S}"
-  define W  where "W \<equiv> {x \<in> U. setdist {x} S = setdist {x} T}"
-  have US': "closedin (top_of_set U) S'"
-    using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} S - setdist {x} T" "{..0}"]
-    by (simp add: S'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
-  have UT': "closedin (top_of_set U) T'"
-    using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} T - setdist {x} S" "{..0}"]
-    by (simp add: T'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
-  have "S \<subseteq> S'"
-    using S'_def \<open>S \<subseteq> U\<close> setdist_sing_in_set by fastforce
-  have "T \<subseteq> T'"
-    using T'_def \<open>T \<subseteq> U\<close> setdist_sing_in_set by fastforce
-  have "S \<inter> T \<subseteq> W" "W \<subseteq> U"
-    using \<open>S \<subseteq> U\<close> by (auto simp: W_def setdist_sing_in_set)
-  have "(S \<inter> T) retract_of W"
-    apply (rule AR_imp_absolute_retract [OF \<open>AR(S \<inter> T)\<close>])
-     apply (simp add: homeomorphic_refl)
-    apply (rule closedin_subset_trans [of U])
-    apply (simp_all add: assms closedin_Int \<open>S \<inter> T \<subseteq> W\<close> \<open>W \<subseteq> U\<close>)
-    done
-  then obtain r0
-    where "S \<inter> T \<subseteq> W" and contr0: "continuous_on W r0"
-      and "r0 ` W \<subseteq> S \<inter> T"
-      and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x"
-      by (auto simp: retract_of_def retraction_def)
-  have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x
-    using setdist_eq_0_closedin \<open>S \<inter> T \<noteq> {}\<close> assms
-    by (force simp: W_def setdist_sing_in_set)
-  have "S' \<inter> T' = W"
-    by (auto simp: S'_def T'_def W_def)
-  then have cloUW: "closedin (top_of_set U) W"
-    using closedin_Int US' UT' by blast
-  define r where "r \<equiv> \<lambda>x. if x \<in> W then r0 x else x"
-  have "r ` (W \<union> S) \<subseteq> S" "r ` (W \<union> T) \<subseteq> T"
-    using \<open>r0 ` W \<subseteq> S \<inter> T\<close> r_def by auto
-  have contr: "continuous_on (W \<union> (S \<union> T)) r"
-  unfolding r_def
-  proof (rule continuous_on_cases_local [OF _ _ contr0 continuous_on_id])
-    show "closedin (top_of_set (W \<union> (S \<union> T))) W"
-      using \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W \<subseteq> U\<close> \<open>closedin (top_of_set U) W\<close> closedin_subset_trans by fastforce
-    show "closedin (top_of_set (W \<union> (S \<union> T))) (S \<union> T)"
-      by (meson \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W \<subseteq> U\<close> assms closedin_Un closedin_subset_trans sup.bounded_iff sup.cobounded2)
-    show "\<And>x. x \<in> W \<and> x \<notin> W \<or> x \<in> S \<union> T \<and> x \<in> W \<Longrightarrow> r0 x = x"
-      by (auto simp: ST)
-  qed
-  have cloUWS: "closedin (top_of_set U) (W \<union> S)"
-    by (simp add: cloUW assms closedin_Un)
-  obtain g where contg: "continuous_on U g"
-             and "g ` U \<subseteq> S" and geqr: "\<And>x. x \<in> W \<union> S \<Longrightarrow> g x = r x"
-    apply (rule AR_imp_absolute_extensor [OF \<open>AR S\<close> _ _ cloUWS])
-      apply (rule continuous_on_subset [OF contr])
-      using \<open>r ` (W \<union> S) \<subseteq> S\<close> apply auto
-    done
-  have cloUWT: "closedin (top_of_set U) (W \<union> T)"
-    by (simp add: cloUW assms closedin_Un)
-  obtain h where conth: "continuous_on U h"
-             and "h ` U \<subseteq> T" and heqr: "\<And>x. x \<in> W \<union> T \<Longrightarrow> h x = r x"
-    apply (rule AR_imp_absolute_extensor [OF \<open>AR T\<close> _ _ cloUWT])
-      apply (rule continuous_on_subset [OF contr])
-      using \<open>r ` (W \<union> T) \<subseteq> T\<close> apply auto
-    done
-  have "U = S' \<union> T'"
-    by (force simp: S'_def T'_def)
-  then have cont: "continuous_on U (\<lambda>x. if x \<in> S' then g x else h x)"
-    apply (rule ssubst)
-    apply (rule continuous_on_cases_local)
-    using US' UT' \<open>S' \<inter> T' = W\<close> \<open>U = S' \<union> T'\<close>
-          contg conth continuous_on_subset geqr heqr apply auto
-    done
-  have UST: "(\<lambda>x. if x \<in> S' then g x else h x) ` U \<subseteq> S \<union> T"
-    using \<open>g ` U \<subseteq> S\<close> \<open>h ` U \<subseteq> T\<close> by auto
-  show ?thesis
-    apply (simp add: retract_of_def retraction_def \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close>)
-    apply (rule_tac x="\<lambda>x. if x \<in> S' then g x else h x" in exI)
-    apply (intro conjI cont UST)
-    by (metis IntI ST Un_iff \<open>S \<subseteq> S'\<close> \<open>S' \<inter> T' = W\<close> \<open>T \<subseteq> T'\<close> subsetD geqr heqr r0 r_def)
-qed
-
-
-lemma AR_closed_Un_local:
-  fixes S :: "'a::euclidean_space set"
-  assumes STS: "closedin (top_of_set (S \<union> T)) S"
-      and STT: "closedin (top_of_set (S \<union> T)) T"
-      and "AR S" "AR T" "AR(S \<inter> T)"
-    shows "AR(S \<union> T)"
-proof -
-  have "C retract_of U"
-       if hom: "S \<union> T homeomorphic C" and UC: "closedin (top_of_set U) C"
-       for U and C :: "('a * real) set"
-  proof -
-    obtain f g where hom: "homeomorphism (S \<union> T) C f g"
-      using hom by (force simp: homeomorphic_def)
-    have US: "closedin (top_of_set U) (C \<inter> g -` S)"
-      apply (rule closedin_trans [OF _ UC])
-      apply (rule continuous_closedin_preimage_gen [OF _ _ STS])
-      using hom homeomorphism_def apply blast
-      apply (metis hom homeomorphism_def set_eq_subset)
-      done
-    have UT: "closedin (top_of_set U) (C \<inter> g -` T)"
-      apply (rule closedin_trans [OF _ UC])
-      apply (rule continuous_closedin_preimage_gen [OF _ _ STT])
-      using hom homeomorphism_def apply blast
-      apply (metis hom homeomorphism_def set_eq_subset)
-      done
-    have ARS: "AR (C \<inter> g -` S)"
-      apply (rule AR_homeomorphic_AR [OF \<open>AR S\<close>])
-      apply (simp add: homeomorphic_def)
-      apply (rule_tac x=g in exI)
-      apply (rule_tac x=f in exI)
-      using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
-      apply (rule_tac x="f x" in image_eqI, auto)
-      done
-    have ART: "AR (C \<inter> g -` T)"
-      apply (rule AR_homeomorphic_AR [OF \<open>AR T\<close>])
-      apply (simp add: homeomorphic_def)
-      apply (rule_tac x=g in exI)
-      apply (rule_tac x=f in exI)
-      using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
-      apply (rule_tac x="f x" in image_eqI, auto)
-      done
-    have ARI: "AR ((C \<inter> g -` S) \<inter> (C \<inter> g -` T))"
-      apply (rule AR_homeomorphic_AR [OF \<open>AR (S \<inter> T)\<close>])
-      apply (simp add: homeomorphic_def)
-      apply (rule_tac x=g in exI)
-      apply (rule_tac x=f in exI)
-      using hom
-      apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
-      apply (rule_tac x="f x" in image_eqI, auto)
-      done
-    have "C = (C \<inter> g -` S) \<union> (C \<inter> g -` T)"
-      using hom  by (auto simp: homeomorphism_def)
-    then show ?thesis
-      by (metis AR_closed_Un_local_aux [OF US UT ARS ART ARI])
-  qed
-  then show ?thesis
-    by (force simp: AR_def)
-qed
-
-corollary AR_closed_Un:
-  fixes S :: "'a::euclidean_space set"
-  shows "\<lbrakk>closed S; closed T; AR S; AR T; AR (S \<inter> T)\<rbrakk> \<Longrightarrow> AR (S \<union> T)"
-by (metis AR_closed_Un_local_aux closed_closedin retract_of_UNIV subtopology_UNIV)
-
-text \<open>ANRs closed under union\<close>
-
-lemma ANR_closed_Un_local_aux:
-  fixes U :: "'a::euclidean_space set"
-  assumes US: "closedin (top_of_set U) S"
-      and UT: "closedin (top_of_set U) T"
-      and "ANR S" "ANR T" "ANR(S \<inter> T)"
-  obtains V where "openin (top_of_set U) V" "(S \<union> T) retract_of V"
-proof (cases "S = {} \<or> T = {}")
-  case True with assms that show ?thesis
-    by (metis ANR_imp_neighbourhood_retract Un_commute inf_bot_right sup_inf_absorb)
-next
-  case False
-  then have [simp]: "S \<noteq> {}" "T \<noteq> {}" by auto
-  have "S \<subseteq> U" "T \<subseteq> U"
-    using assms by (auto simp: closedin_imp_subset)
-  define S' where "S' \<equiv> {x \<in> U. setdist {x} S \<le> setdist {x} T}"
-  define T' where "T' \<equiv> {x \<in> U. setdist {x} T \<le> setdist {x} S}"
-  define W  where "W \<equiv> {x \<in> U. setdist {x} S = setdist {x} T}"
-  have cloUS': "closedin (top_of_set U) S'"
-    using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} S - setdist {x} T" "{..0}"]
-    by (simp add: S'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
-  have cloUT': "closedin (top_of_set U) T'"
-    using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} T - setdist {x} S" "{..0}"]
-    by (simp add: T'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
-  have "S \<subseteq> S'"
-    using S'_def \<open>S \<subseteq> U\<close> setdist_sing_in_set by fastforce
-  have "T \<subseteq> T'"
-    using T'_def \<open>T \<subseteq> U\<close> setdist_sing_in_set by fastforce
-  have "S' \<union> T' = U"
-    by (auto simp: S'_def T'_def)
-  have "W \<subseteq> S'"
-    by (simp add: Collect_mono S'_def W_def)
-  have "W \<subseteq> T'"
-    by (simp add: Collect_mono T'_def W_def)
-  have ST_W: "S \<inter> T \<subseteq> W" and "W \<subseteq> U"
-    using \<open>S \<subseteq> U\<close> by (force simp: W_def setdist_sing_in_set)+
-  have "S' \<inter> T' = W"
-    by (auto simp: S'_def T'_def W_def)
-  then have cloUW: "closedin (top_of_set U) W"
-    using closedin_Int cloUS' cloUT' by blast
-  obtain W' W0 where "openin (top_of_set W) W'"
-                 and cloWW0: "closedin (top_of_set W) W0"
-                 and "S \<inter> T \<subseteq> W'" "W' \<subseteq> W0"
-                 and ret: "(S \<inter> T) retract_of W0"
-    apply (rule ANR_imp_closed_neighbourhood_retract [OF \<open>ANR(S \<inter> T)\<close>])
-    apply (rule closedin_subset_trans [of U, OF _ ST_W \<open>W \<subseteq> U\<close>])
-    apply (blast intro: assms)+
-    done
-  then obtain U0 where opeUU0: "openin (top_of_set U) U0"
-                   and U0: "S \<inter> T \<subseteq> U0" "U0 \<inter> W \<subseteq> W0"
-    unfolding openin_open  using \<open>W \<subseteq> U\<close> by blast
-  have "W0 \<subseteq> U"
-    using \<open>W \<subseteq> U\<close> cloWW0 closedin_subset by fastforce
-  obtain r0
-    where "S \<inter> T \<subseteq> W0" and contr0: "continuous_on W0 r0" and "r0 ` W0 \<subseteq> S \<inter> T"
-      and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x"
-    using ret  by (force simp: retract_of_def retraction_def)
-  have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x
-    using assms by (auto simp: W_def setdist_sing_in_set dest!: setdist_eq_0_closedin)
-  define r where "r \<equiv> \<lambda>x. if x \<in> W0 then r0 x else x"
-  have "r ` (W0 \<union> S) \<subseteq> S" "r ` (W0 \<union> T) \<subseteq> T"
-    using \<open>r0 ` W0 \<subseteq> S \<inter> T\<close> r_def by auto
-  have contr: "continuous_on (W0 \<union> (S \<union> T)) r"
-  unfolding r_def
-  proof (rule continuous_on_cases_local [OF _ _ contr0 continuous_on_id])
-    show "closedin (top_of_set (W0 \<union> (S \<union> T))) W0"
-      apply (rule closedin_subset_trans [of U])
-      using cloWW0 cloUW closedin_trans \<open>W0 \<subseteq> U\<close> \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> apply blast+
-      done
-    show "closedin (top_of_set (W0 \<union> (S \<union> T))) (S \<union> T)"
-      by (meson \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W0 \<subseteq> U\<close> assms closedin_Un closedin_subset_trans sup.bounded_iff sup.cobounded2)
-    show "\<And>x. x \<in> W0 \<and> x \<notin> W0 \<or> x \<in> S \<union> T \<and> x \<in> W0 \<Longrightarrow> r0 x = x"
-      using ST cloWW0 closedin_subset by fastforce
-  qed
-  have cloS'WS: "closedin (top_of_set S') (W0 \<union> S)"
-    by (meson closedin_subset_trans US cloUS' \<open>S \<subseteq> S'\<close> \<open>W \<subseteq> S'\<close> cloUW cloWW0 
-              closedin_Un closedin_imp_subset closedin_trans)
-  obtain W1 g where "W0 \<union> S \<subseteq> W1" and contg: "continuous_on W1 g"
-                and opeSW1: "openin (top_of_set S') W1"
-                and "g ` W1 \<subseteq> S" and geqr: "\<And>x. x \<in> W0 \<union> S \<Longrightarrow> g x = r x"
-    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> _ \<open>r ` (W0 \<union> S) \<subseteq> S\<close> cloS'WS])
-     apply (rule continuous_on_subset [OF contr], blast+)
-    done
-  have cloT'WT: "closedin (top_of_set T') (W0 \<union> T)"
-    by (meson closedin_subset_trans UT cloUT' \<open>T \<subseteq> T'\<close> \<open>W \<subseteq> T'\<close> cloUW cloWW0 
-              closedin_Un closedin_imp_subset closedin_trans)
-  obtain W2 h where "W0 \<union> T \<subseteq> W2" and conth: "continuous_on W2 h"
-                and opeSW2: "openin (top_of_set T') W2"
-                and "h ` W2 \<subseteq> T" and heqr: "\<And>x. x \<in> W0 \<union> T \<Longrightarrow> h x = r x"
-    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> _ \<open>r ` (W0 \<union> T) \<subseteq> T\<close> cloT'WT])
-     apply (rule continuous_on_subset [OF contr], blast+)
-    done
-  have "S' \<inter> T' = W"
-    by (force simp: S'_def T'_def W_def)
-  obtain O1 O2 where "open O1" "W1 = S' \<inter> O1" "open O2" "W2 = T' \<inter> O2"
-    using opeSW1 opeSW2 by (force simp: openin_open)
-  show ?thesis
-  proof
-    have eq: "W1 - (W - U0) \<union> (W2 - (W - U0)) =
-         ((U - T') \<inter> O1 \<union> (U - S') \<inter> O2 \<union> U \<inter> O1 \<inter> O2) - (W - U0)"
-     using \<open>U0 \<inter> W \<subseteq> W0\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close>
-      by (auto simp: \<open>S' \<union> T' = U\<close> [symmetric] \<open>S' \<inter> T' = W\<close> [symmetric] \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close>)
-    show "openin (top_of_set U) (W1 - (W - U0) \<union> (W2 - (W - U0)))"
-      apply (subst eq)
-      apply (intro openin_Un openin_Int_open openin_diff closedin_diff cloUW opeUU0 cloUS' cloUT' \<open>open O1\<close> \<open>open O2\<close>, simp_all)
-      done
-    have cloW1: "closedin (top_of_set (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W1 - (W - U0))"
-      using cloUS' apply (simp add: closedin_closed)
-      apply (erule ex_forward)
-      using U0 \<open>W0 \<union> S \<subseteq> W1\<close>
-      apply (auto simp: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
-      done
-    have cloW2: "closedin (top_of_set (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W2 - (W - U0))"
-      using cloUT' apply (simp add: closedin_closed)
-      apply (erule ex_forward)
-      using U0 \<open>W0 \<union> T \<subseteq> W2\<close>
-      apply (auto simp: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
-      done
-    have *: "\<forall>x\<in>S \<union> T. (if x \<in> S' then g x else h x) = x"
-      using ST \<open>S' \<inter> T' = W\<close> cloT'WT closedin_subset geqr heqr 
-      apply (auto simp: r_def, fastforce)
-      using \<open>S \<subseteq> S'\<close> \<open>T \<subseteq> T'\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W1 = S' \<inter> O1\<close>  by auto
-    have "\<exists>r. continuous_on (W1 - (W - U0) \<union> (W2 - (W - U0))) r \<and>
-              r ` (W1 - (W - U0) \<union> (W2 - (W - U0))) \<subseteq> S \<union> T \<and> 
-              (\<forall>x\<in>S \<union> T. r x = x)"
-      apply (rule_tac x = "\<lambda>x. if  x \<in> S' then g x else h x" in exI)
-      apply (intro conjI *)
-      apply (rule continuous_on_cases_local 
-                  [OF cloW1 cloW2 continuous_on_subset [OF contg] continuous_on_subset [OF conth]])
-      using \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<inter> T' = W\<close>
-            \<open>g ` W1 \<subseteq> S\<close> \<open>h ` W2 \<subseteq> T\<close> apply auto
-      using \<open>U0 \<inter> W \<subseteq> W0\<close> \<open>W0 \<union> S \<subseteq> W1\<close> apply (fastforce simp add: geqr heqr)+
-      done
-    then show "S \<union> T retract_of W1 - (W - U0) \<union> (W2 - (W - U0))"
-      using  \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close> ST opeUU0 U0
-      by (auto simp: retract_of_def retraction_def)
-  qed
-qed
-
-
-lemma ANR_closed_Un_local:
-  fixes S :: "'a::euclidean_space set"
-  assumes STS: "closedin (top_of_set (S \<union> T)) S"
-      and STT: "closedin (top_of_set (S \<union> T)) T"
-      and "ANR S" "ANR T" "ANR(S \<inter> T)" 
-    shows "ANR(S \<union> T)"
-proof -
-  have "\<exists>T. openin (top_of_set U) T \<and> C retract_of T"
-       if hom: "S \<union> T homeomorphic C" and UC: "closedin (top_of_set U) C"
-       for U and C :: "('a * real) set"
-  proof -
-    obtain f g where hom: "homeomorphism (S \<union> T) C f g"
-      using hom by (force simp: homeomorphic_def)
-    have US: "closedin (top_of_set U) (C \<inter> g -` S)"
-      apply (rule closedin_trans [OF _ UC])
-      apply (rule continuous_closedin_preimage_gen [OF _ _ STS])
-      using hom [unfolded homeomorphism_def] apply blast
-      apply (metis hom homeomorphism_def set_eq_subset)
-      done
-    have UT: "closedin (top_of_set U) (C \<inter> g -` T)"
-      apply (rule closedin_trans [OF _ UC])
-      apply (rule continuous_closedin_preimage_gen [OF _ _ STT])
-      using hom [unfolded homeomorphism_def] apply blast
-      apply (metis hom homeomorphism_def set_eq_subset)
-      done
-    have ANRS: "ANR (C \<inter> g -` S)"
-      apply (rule ANR_homeomorphic_ANR [OF \<open>ANR S\<close>])
-      apply (simp add: homeomorphic_def)
-      apply (rule_tac x=g in exI)
-      apply (rule_tac x=f in exI)
-      using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
-      apply (rule_tac x="f x" in image_eqI, auto)
-      done
-    have ANRT: "ANR (C \<inter> g -` T)"
-      apply (rule ANR_homeomorphic_ANR [OF \<open>ANR T\<close>])
-      apply (simp add: homeomorphic_def)
-      apply (rule_tac x=g in exI)
-      apply (rule_tac x=f in exI)
-      using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
-      apply (rule_tac x="f x" in image_eqI, auto)
-      done
-    have ANRI: "ANR ((C \<inter> g -` S) \<inter> (C \<inter> g -` T))"
-      apply (rule ANR_homeomorphic_ANR [OF \<open>ANR (S \<inter> T)\<close>])
-      apply (simp add: homeomorphic_def)
-      apply (rule_tac x=g in exI)
-      apply (rule_tac x=f in exI)
-      using hom
-      apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
-      apply (rule_tac x="f x" in image_eqI, auto)
-      done
-    have "C = (C \<inter> g -` S) \<union> (C \<inter> g -` T)"
-      using hom by (auto simp: homeomorphism_def)
-    then show ?thesis
-      by (metis ANR_closed_Un_local_aux [OF US UT ANRS ANRT ANRI])
-  qed
-  then show ?thesis
-    by (auto simp: ANR_def)
-qed    
-
-corollary ANR_closed_Un:
-  fixes S :: "'a::euclidean_space set"
-  shows "\<lbrakk>closed S; closed T; ANR S; ANR T; ANR (S \<inter> T)\<rbrakk> \<Longrightarrow> ANR (S \<union> T)"
-by (simp add: ANR_closed_Un_local closedin_def diff_eq open_Compl openin_open_Int)
-
-lemma ANR_openin:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ANR T" and opeTS: "openin (top_of_set T) S"
-  shows "ANR S"
-proof (clarsimp simp only: ANR_eq_absolute_neighbourhood_extensor)
-  fix f :: "'a \<times> real \<Rightarrow> 'a" and U C
-  assume contf: "continuous_on C f" and fim: "f ` C \<subseteq> S"
-     and cloUC: "closedin (top_of_set U) C"
-  have "f ` C \<subseteq> T"
-    using fim opeTS openin_imp_subset by blast
-  obtain W g where "C \<subseteq> W"
-               and UW: "openin (top_of_set U) W"
-               and contg: "continuous_on W g"
-               and gim: "g ` W \<subseteq> T"
-               and geq: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
-    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> contf \<open>f ` C \<subseteq> T\<close> cloUC])
-    using fim by auto
-  show "\<exists>V g. C \<subseteq> V \<and> openin (top_of_set U) V \<and> continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x\<in>C. g x = f x)"
-  proof (intro exI conjI)
-    show "C \<subseteq> W \<inter> g -` S"
-      using \<open>C \<subseteq> W\<close> fim geq by blast
-    show "openin (top_of_set U) (W \<inter> g -` S)"
-      by (metis (mono_tags, lifting) UW contg continuous_openin_preimage gim opeTS openin_trans)
-    show "continuous_on (W \<inter> g -` S) g"
-      by (blast intro: continuous_on_subset [OF contg])
-    show "g ` (W \<inter> g -` S) \<subseteq> S"
-      using gim by blast
-    show "\<forall>x\<in>C. g x = f x"
-      using geq by blast
-  qed
-qed
-
-lemma ENR_openin:
-    fixes S :: "'a::euclidean_space set"
-    assumes "ENR T" and opeTS: "openin (top_of_set T) S"
-    shows "ENR S"
-  using assms apply (simp add: ENR_ANR)
-  using ANR_openin locally_open_subset by blast
-
-lemma ANR_neighborhood_retract:
-    fixes S :: "'a::euclidean_space set"
-    assumes "ANR U" "S retract_of T" "openin (top_of_set U) T"
-    shows "ANR S"
-  using ANR_openin ANR_retract_of_ANR assms by blast
-
-lemma ENR_neighborhood_retract:
-    fixes S :: "'a::euclidean_space set"
-    assumes "ENR U" "S retract_of T" "openin (top_of_set U) T"
-    shows "ENR S"
-  using ENR_openin ENR_retract_of_ENR assms by blast
-
-lemma ANR_rel_interior:
-  fixes S :: "'a::euclidean_space set"
-  shows "ANR S \<Longrightarrow> ANR(rel_interior S)"
-   by (blast intro: ANR_openin openin_set_rel_interior)
-
-lemma ANR_delete:
-  fixes S :: "'a::euclidean_space set"
-  shows "ANR S \<Longrightarrow> ANR(S - {a})"
-   by (blast intro: ANR_openin openin_delete openin_subtopology_self)
-
-lemma ENR_rel_interior:
-  fixes S :: "'a::euclidean_space set"
-  shows "ENR S \<Longrightarrow> ENR(rel_interior S)"
-   by (blast intro: ENR_openin openin_set_rel_interior)
-
-lemma ENR_delete:
-  fixes S :: "'a::euclidean_space set"
-  shows "ENR S \<Longrightarrow> ENR(S - {a})"
-   by (blast intro: ENR_openin openin_delete openin_subtopology_self)
-
-lemma open_imp_ENR: "open S \<Longrightarrow> ENR S"
-    using ENR_def by blast
-
-lemma open_imp_ANR:
-    fixes S :: "'a::euclidean_space set"
-    shows "open S \<Longrightarrow> ANR S"
-  by (simp add: ENR_imp_ANR open_imp_ENR)
-
-lemma ANR_ball [iff]:
-    fixes a :: "'a::euclidean_space"
-    shows "ANR(ball a r)"
-  by (simp add: convex_imp_ANR)
-
-lemma ENR_ball [iff]: "ENR(ball a r)"
-  by (simp add: open_imp_ENR)
-
-lemma AR_ball [simp]:
-    fixes a :: "'a::euclidean_space"
-    shows "AR(ball a r) \<longleftrightarrow> 0 < r"
-  by (auto simp: AR_ANR convex_imp_contractible)
-
-lemma ANR_cball [iff]:
-    fixes a :: "'a::euclidean_space"
-    shows "ANR(cball a r)"
-  by (simp add: convex_imp_ANR)
-
-lemma ENR_cball:
-    fixes a :: "'a::euclidean_space"
-    shows "ENR(cball a r)"
-  using ENR_convex_closed by blast
-
-lemma AR_cball [simp]:
-    fixes a :: "'a::euclidean_space"
-    shows "AR(cball a r) \<longleftrightarrow> 0 \<le> r"
-  by (auto simp: AR_ANR convex_imp_contractible)
-
-lemma ANR_box [iff]:
-    fixes a :: "'a::euclidean_space"
-    shows "ANR(cbox a b)" "ANR(box a b)"
-  by (auto simp: convex_imp_ANR open_imp_ANR)
-
-lemma ENR_box [iff]:
-    fixes a :: "'a::euclidean_space"
-    shows "ENR(cbox a b)" "ENR(box a b)"
-apply (simp add: ENR_convex_closed closed_cbox)
-by (simp add: open_box open_imp_ENR)
-
-lemma AR_box [simp]:
-    "AR(cbox a b) \<longleftrightarrow> cbox a b \<noteq> {}" "AR(box a b) \<longleftrightarrow> box a b \<noteq> {}"
-  by (auto simp: AR_ANR convex_imp_contractible)
-
-lemma ANR_interior:
-     fixes S :: "'a::euclidean_space set"
-     shows "ANR(interior S)"
-  by (simp add: open_imp_ANR)
-
-lemma ENR_interior:
-     fixes S :: "'a::euclidean_space set"
-     shows "ENR(interior S)"
-  by (simp add: open_imp_ENR)
-
-lemma AR_imp_contractible:
-    fixes S :: "'a::euclidean_space set"
-    shows "AR S \<Longrightarrow> contractible S"
-  by (simp add: AR_ANR)
-
-lemma ENR_imp_locally_compact:
-    fixes S :: "'a::euclidean_space set"
-    shows "ENR S \<Longrightarrow> locally compact S"
-  by (simp add: ENR_ANR)
-
-lemma ANR_imp_locally_path_connected:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ANR S"
-    shows "locally path_connected S"
-proof -
-  obtain U and T :: "('a \<times> real) set"
-     where "convex U" "U \<noteq> {}"
-       and UT: "closedin (top_of_set U) T"
-       and "S homeomorphic T"
-    apply (rule homeomorphic_closedin_convex [of S])
-    using aff_dim_le_DIM [of S] apply auto
-    done
-  then have "locally path_connected T"
-    by (meson ANR_imp_absolute_neighbourhood_retract
-        assms convex_imp_locally_path_connected locally_open_subset retract_of_locally_path_connected)
-  then have S: "locally path_connected S"
-      if "openin (top_of_set U) V" "T retract_of V" "U \<noteq> {}" for V
-    using \<open>S homeomorphic T\<close> homeomorphic_locally homeomorphic_path_connectedness by blast
-  show ?thesis
-    using assms
-    apply (clarsimp simp: ANR_def)
-    apply (drule_tac x=U in spec)
-    apply (drule_tac x=T in spec)
-    using \<open>S homeomorphic T\<close> \<open>U \<noteq> {}\<close> UT  apply (blast intro: S)
-    done
-qed
-
-lemma ANR_imp_locally_connected:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ANR S"
-    shows "locally connected S"
-using locally_path_connected_imp_locally_connected ANR_imp_locally_path_connected assms by auto
-
-lemma AR_imp_locally_path_connected:
-  fixes S :: "'a::euclidean_space set"
-  assumes "AR S"
-    shows "locally path_connected S"
-by (simp add: ANR_imp_locally_path_connected AR_imp_ANR assms)
-
-lemma AR_imp_locally_connected:
-  fixes S :: "'a::euclidean_space set"
-  assumes "AR S"
-    shows "locally connected S"
-using ANR_imp_locally_connected AR_ANR assms by blast
-
-lemma ENR_imp_locally_path_connected:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ENR S"
-    shows "locally path_connected S"
-by (simp add: ANR_imp_locally_path_connected ENR_imp_ANR assms)
-
-lemma ENR_imp_locally_connected:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ENR S"
-    shows "locally connected S"
-using ANR_imp_locally_connected ENR_ANR assms by blast
-
-lemma ANR_Times:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "ANR S" "ANR T" shows "ANR(S \<times> T)"
-proof (clarsimp simp only: ANR_eq_absolute_neighbourhood_extensor)
-  fix f :: " ('a \<times> 'b) \<times> real \<Rightarrow> 'a \<times> 'b" and U C
-  assume "continuous_on C f" and fim: "f ` C \<subseteq> S \<times> T"
-     and cloUC: "closedin (top_of_set U) C"
-  have contf1: "continuous_on C (fst \<circ> f)"
-    by (simp add: \<open>continuous_on C f\<close> continuous_on_fst)
-  obtain W1 g where "C \<subseteq> W1"
-               and UW1: "openin (top_of_set U) W1"
-               and contg: "continuous_on W1 g"
-               and gim: "g ` W1 \<subseteq> S"
-               and geq: "\<And>x. x \<in> C \<Longrightarrow> g x = (fst \<circ> f) x"
-    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> contf1 _ cloUC])
-    using fim apply auto
-    done
-  have contf2: "continuous_on C (snd \<circ> f)"
-    by (simp add: \<open>continuous_on C f\<close> continuous_on_snd)
-  obtain W2 h where "C \<subseteq> W2"
-               and UW2: "openin (top_of_set U) W2"
-               and conth: "continuous_on W2 h"
-               and him: "h ` W2 \<subseteq> T"
-               and heq: "\<And>x. x \<in> C \<Longrightarrow> h x = (snd \<circ> f) x"
-    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> contf2 _ cloUC])
-    using fim apply auto
-    done
-  show "\<exists>V g. C \<subseteq> V \<and>
-               openin (top_of_set U) V \<and>
-               continuous_on V g \<and> g ` V \<subseteq> S \<times> T \<and> (\<forall>x\<in>C. g x = f x)"
-  proof (intro exI conjI)
-    show "C \<subseteq> W1 \<inter> W2"
-      by (simp add: \<open>C \<subseteq> W1\<close> \<open>C \<subseteq> W2\<close>)
-    show "openin (top_of_set U) (W1 \<inter> W2)"
-      by (simp add: UW1 UW2 openin_Int)
-    show  "continuous_on (W1 \<inter> W2) (\<lambda>x. (g x, h x))"
-      by (metis (no_types) contg conth continuous_on_Pair continuous_on_subset inf_commute inf_le1)
-    show  "(\<lambda>x. (g x, h x)) ` (W1 \<inter> W2) \<subseteq> S \<times> T"
-      using gim him by blast
-    show  "(\<forall>x\<in>C. (g x, h x) = f x)"
-      using geq heq by auto
-  qed
-qed
-
-lemma AR_Times:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "AR S" "AR T" shows "AR(S \<times> T)"
-using assms by (simp add: AR_ANR ANR_Times contractible_Times)
-
 subsection \<open>Kuhn Simplices\<close>
 
 lemma bij_betw_singleton_eq:
@@ -3681,1262 +2364,6 @@
     by blast
 qed
 
-subsubsection  \<open>We continue with ANRs and ENRs\<close>
-
-lemma ENR_rel_frontier_convex:
-  fixes S :: "'a::euclidean_space set"
-  assumes "bounded S" "convex S"
-    shows "ENR(rel_frontier S)"
-proof (cases "S = {}")
-  case True then show ?thesis
-    by simp
-next
-  case False
-  with assms have "rel_interior S \<noteq> {}"
-    by (simp add: rel_interior_eq_empty)
-  then obtain a where a: "a \<in> rel_interior S"
-    by auto
-  have ahS: "affine hull S - {a} \<subseteq> {x. closest_point (affine hull S) x \<noteq> a}"
-    by (auto simp: closest_point_self)
-  have "rel_frontier S retract_of affine hull S - {a}"
-    by (simp add: assms a rel_frontier_retract_of_punctured_affine_hull)
-  also have "\<dots> retract_of {x. closest_point (affine hull S) x \<noteq> a}"
-    apply (simp add: retract_of_def retraction_def ahS)
-    apply (rule_tac x="closest_point (affine hull S)" in exI)
-    apply (auto simp: False closest_point_self affine_imp_convex closest_point_in_set continuous_on_closest_point)
-    done
-  finally have "rel_frontier S retract_of {x. closest_point (affine hull S) x \<noteq> a}" .
-  moreover have "openin (top_of_set UNIV) (UNIV \<inter> closest_point (affine hull S) -` (- {a}))"
-    apply (rule continuous_openin_preimage_gen)
-    apply (auto simp: False affine_imp_convex continuous_on_closest_point)
-    done
-  ultimately show ?thesis
-    unfolding ENR_def
-    apply (rule_tac x = "closest_point (affine hull S) -` (- {a})" in exI)
-    apply (simp add: vimage_def)
-    done
-qed
-
-lemma ANR_rel_frontier_convex:
-                 fixes S :: "'a::euclidean_space set"
-  assumes "bounded S" "convex S"
-    shows "ANR(rel_frontier S)"
-by (simp add: ENR_imp_ANR ENR_rel_frontier_convex assms)
-    
-lemma ENR_closedin_Un_local:
-  fixes S :: "'a::euclidean_space set"
-  shows "\<lbrakk>ENR S; ENR T; ENR(S \<inter> T);
-          closedin (top_of_set (S \<union> T)) S; closedin (top_of_set (S \<union> T)) T\<rbrakk>
-        \<Longrightarrow> ENR(S \<union> T)"
-by (simp add: ENR_ANR ANR_closed_Un_local locally_compact_closedin_Un)
-
-lemma ENR_closed_Un:
-  fixes S :: "'a::euclidean_space set"
-  shows "\<lbrakk>closed S; closed T; ENR S; ENR T; ENR(S \<inter> T)\<rbrakk> \<Longrightarrow> ENR(S \<union> T)"
-by (auto simp: closed_subset ENR_closedin_Un_local)
-
-lemma absolute_retract_Un:
-  fixes S :: "'a::euclidean_space set"
-  shows "\<lbrakk>S retract_of UNIV; T retract_of UNIV; (S \<inter> T) retract_of UNIV\<rbrakk>
-         \<Longrightarrow> (S \<union> T) retract_of UNIV"
-  by (meson AR_closed_Un_local_aux closed_subset retract_of_UNIV retract_of_imp_subset)
-
-lemma retract_from_Un_Int:
-  fixes S :: "'a::euclidean_space set"
-  assumes clS: "closedin (top_of_set (S \<union> T)) S"
-      and clT: "closedin (top_of_set (S \<union> T)) T"
-      and Un: "(S \<union> T) retract_of U" and Int: "(S \<inter> T) retract_of T"
-    shows "S retract_of U"
-proof -
-  obtain r where r: "continuous_on T r" "r ` T \<subseteq> S \<inter> T" "\<forall>x\<in>S \<inter> T. r x = x"
-    using Int by (auto simp: retraction_def retract_of_def)
-  have "S retract_of S \<union> T"
-    unfolding retraction_def retract_of_def
-  proof (intro exI conjI)
-    show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then x else r x)"
-      apply (rule continuous_on_cases_local [OF clS clT])
-      using r by (auto simp: continuous_on_id)
-  qed (use r in auto)
-  also have "\<dots> retract_of U"
-    by (rule Un)
-  finally show ?thesis .
-qed
-
-lemma AR_from_Un_Int_local:
-  fixes S :: "'a::euclidean_space set"
-  assumes clS: "closedin (top_of_set (S \<union> T)) S"
-      and clT: "closedin (top_of_set (S \<union> T)) T"
-      and Un: "AR(S \<union> T)" and Int: "AR(S \<inter> T)"
-    shows "AR S"
-  apply (rule AR_retract_of_AR [OF Un])
-  by (meson AR_imp_retract clS clT closedin_closed_subset local.Int retract_from_Un_Int retract_of_refl sup_ge2)
-
-lemma AR_from_Un_Int_local':
-  fixes S :: "'a::euclidean_space set"
-  assumes "closedin (top_of_set (S \<union> T)) S"
-      and "closedin (top_of_set (S \<union> T)) T"
-      and "AR(S \<union> T)" "AR(S \<inter> T)"
-    shows "AR T"
-  using AR_from_Un_Int_local [of T S] assms by (simp add: Un_commute Int_commute)
-
-lemma AR_from_Un_Int:
-  fixes S :: "'a::euclidean_space set"
-  assumes clo: "closed S" "closed T" and Un: "AR(S \<union> T)" and Int: "AR(S \<inter> T)"
-  shows "AR S"
-  by (metis AR_from_Un_Int_local [OF _ _ Un Int] Un_commute clo closed_closedin closedin_closed_subset inf_sup_absorb subtopology_UNIV top_greatest)
-
-lemma ANR_from_Un_Int_local:
-  fixes S :: "'a::euclidean_space set"
-  assumes clS: "closedin (top_of_set (S \<union> T)) S"
-      and clT: "closedin (top_of_set (S \<union> T)) T"
-      and Un: "ANR(S \<union> T)" and Int: "ANR(S \<inter> T)"
-    shows "ANR S"
-proof -
-  obtain V where clo: "closedin (top_of_set (S \<union> T)) (S \<inter> T)"
-             and ope: "openin (top_of_set (S \<union> T)) V"
-             and ret: "S \<inter> T retract_of V"
-    using ANR_imp_neighbourhood_retract [OF Int] by (metis clS clT closedin_Int)
-  then obtain r where r: "continuous_on V r" and rim: "r ` V \<subseteq> S \<inter> T" and req: "\<forall>x\<in>S \<inter> T. r x = x"
-    by (auto simp: retraction_def retract_of_def)
-  have Vsub: "V \<subseteq> S \<union> T"
-    by (meson ope openin_contains_cball)
-  have Vsup: "S \<inter> T \<subseteq> V"
-    by (simp add: retract_of_imp_subset ret)
-  then have eq: "S \<union> V = ((S \<union> T) - T) \<union> V"
-    by auto
-  have eq': "S \<union> V = S \<union> (V \<inter> T)"
-    using Vsub by blast
-  have "continuous_on (S \<union> V \<inter> T) (\<lambda>x. if x \<in> S then x else r x)"
-  proof (rule continuous_on_cases_local)
-    show "closedin (top_of_set (S \<union> V \<inter> T)) S"
-      using clS closedin_subset_trans inf.boundedE by blast
-    show "closedin (top_of_set (S \<union> V \<inter> T)) (V \<inter> T)"
-      using clT Vsup by (auto simp: closedin_closed)
-    show "continuous_on (V \<inter> T) r"
-      by (meson Int_lower1 continuous_on_subset r)
-  qed (use req continuous_on_id in auto)
-  with rim have "S retract_of S \<union> V"
-    unfolding retraction_def retract_of_def
-    apply (rule_tac x="\<lambda>x. if x \<in> S then x else r x" in exI)
-    apply (auto simp: eq')
-    done
-  then show ?thesis
-    using ANR_neighborhood_retract [OF Un]
-    using \<open>S \<union> V = S \<union> T - T \<union> V\<close> clT ope by fastforce
-qed
-
-lemma ANR_from_Un_Int:
-  fixes S :: "'a::euclidean_space set"
-  assumes clo: "closed S" "closed T" and Un: "ANR(S \<union> T)" and Int: "ANR(S \<inter> T)"
-  shows "ANR S"
-  by (metis ANR_from_Un_Int_local [OF _ _ Un Int] Un_commute clo closed_closedin closedin_closed_subset inf_sup_absorb subtopology_UNIV top_greatest)
-
-lemma ANR_finite_Union_convex_closed:
-  fixes \<T> :: "'a::euclidean_space set set"
-  assumes \<T>: "finite \<T>" and clo: "\<And>C. C \<in> \<T> \<Longrightarrow> closed C" and con: "\<And>C. C \<in> \<T> \<Longrightarrow> convex C"
-  shows "ANR(\<Union>\<T>)"
-proof -
-  have "ANR(\<Union>\<T>)" if "card \<T> < n" for n
-  using assms that
-  proof (induction n arbitrary: \<T>)
-    case 0 then show ?case by simp
-  next
-    case (Suc n)
-    have "ANR(\<Union>\<U>)" if "finite \<U>" "\<U> \<subseteq> \<T>" for \<U>
-      using that
-    proof (induction \<U>)
-      case empty
-      then show ?case  by simp
-    next
-      case (insert C \<U>)
-      have "ANR (C \<union> \<Union>\<U>)"
-      proof (rule ANR_closed_Un)
-        show "ANR (C \<inter> \<Union>\<U>)"
-          unfolding Int_Union
-        proof (rule Suc)
-          show "finite ((\<inter>) C ` \<U>)"
-            by (simp add: insert.hyps(1))
-          show "\<And>Ca. Ca \<in> (\<inter>) C ` \<U> \<Longrightarrow> closed Ca"
-            by (metis (no_types, hide_lams) Suc.prems(2) closed_Int subsetD imageE insert.prems insertI1 insertI2)
-          show "\<And>Ca. Ca \<in> (\<inter>) C ` \<U> \<Longrightarrow> convex Ca"
-            by (metis (mono_tags, lifting) Suc.prems(3) convex_Int imageE insert.prems insert_subset subsetCE)
-          show "card ((\<inter>) C ` \<U>) < n"
-          proof -
-            have "card \<T> \<le> n"
-              by (meson Suc.prems(4) not_less not_less_eq)
-            then show ?thesis
-              by (metis Suc.prems(1) card_image_le card_seteq insert.hyps insert.prems insert_subset le_trans not_less)
-          qed
-        qed
-        show "closed (\<Union>\<U>)"
-          using Suc.prems(2) insert.hyps(1) insert.prems by blast
-      qed (use Suc.prems convex_imp_ANR insert.prems insert.IH in auto)
-      then show ?case
-        by simp
-    qed
-    then show ?case
-      using Suc.prems(1) by blast
-  qed
-  then show ?thesis
-    by blast
-qed
-
-
-lemma finite_imp_ANR:
-  fixes S :: "'a::euclidean_space set"
-  assumes "finite S"
-  shows "ANR S"
-proof -
-  have "ANR(\<Union>x \<in> S. {x})"
-    by (blast intro: ANR_finite_Union_convex_closed assms)
-  then show ?thesis
-    by simp
-qed
-
-lemma ANR_insert:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ANR S" "closed S"
-  shows "ANR(insert a S)"
-  by (metis ANR_closed_Un ANR_empty ANR_singleton Diff_disjoint Diff_insert_absorb assms closed_singleton insert_absorb insert_is_Un)
-
-lemma ANR_path_component_ANR:
-  fixes S :: "'a::euclidean_space set"
-  shows "ANR S \<Longrightarrow> ANR(path_component_set S x)"
-  using ANR_imp_locally_path_connected ANR_openin openin_path_component_locally_path_connected by blast
-
-lemma ANR_connected_component_ANR:
-  fixes S :: "'a::euclidean_space set"
-  shows "ANR S \<Longrightarrow> ANR(connected_component_set S x)"
-  by (metis ANR_openin openin_connected_component_locally_connected ANR_imp_locally_connected)
-
-lemma ANR_component_ANR:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ANR S" "c \<in> components S"
-  shows "ANR c"
-  by (metis ANR_connected_component_ANR assms componentsE)
-
-subsubsection\<open>Original ANR material, now for ENRs\<close>
-
-lemma ENR_bounded:
-  fixes S :: "'a::euclidean_space set"
-  assumes "bounded S"
-  shows "ENR S \<longleftrightarrow> (\<exists>U. open U \<and> bounded U \<and> S retract_of U)"
-         (is "?lhs = ?rhs")
-proof
-  obtain r where "0 < r" and r: "S \<subseteq> ball 0 r"
-    using bounded_subset_ballD assms by blast
-  assume ?lhs
-  then show ?rhs
-    apply (clarsimp simp: ENR_def)
-    apply (rule_tac x="ball 0 r \<inter> U" in exI, auto)
-    using r retract_of_imp_subset retract_of_subset by fastforce
-next
-  assume ?rhs
-  then show ?lhs
-    using ENR_def by blast
-qed
-
-lemma absolute_retract_imp_AR_gen:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "S retract_of T" "convex T" "T \<noteq> {}" "S homeomorphic S'" "closedin (top_of_set U) S'"
-  shows "S' retract_of U"
-proof -
-  have "AR T"
-    by (simp add: assms convex_imp_AR)
-  then have "AR S"
-    using AR_retract_of_AR assms by auto
-  then show ?thesis
-    using assms AR_imp_absolute_retract by metis
-qed
-
-lemma absolute_retract_imp_AR:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "S retract_of UNIV" "S homeomorphic S'" "closed S'"
-  shows "S' retract_of UNIV"
-  using AR_imp_absolute_retract_UNIV assms retract_of_UNIV by blast
-
-lemma homeomorphic_compact_arness:
-  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
-  assumes "S homeomorphic S'"
-  shows "compact S \<and> S retract_of UNIV \<longleftrightarrow> compact S' \<and> S' retract_of UNIV"
-  using assms homeomorphic_compactness
-  apply auto
-   apply (meson assms compact_AR homeomorphic_AR_iff_AR homeomorphic_compactness)+
-  done
-
-lemma absolute_retract_from_Un_Int:
-  fixes S :: "'a::euclidean_space set"
-  assumes "(S \<union> T) retract_of UNIV" "(S \<inter> T) retract_of UNIV" "closed S" "closed T"
-  shows "S retract_of UNIV"
-  using AR_from_Un_Int assms retract_of_UNIV by auto
-
-lemma ENR_from_Un_Int_gen:
-  fixes S :: "'a::euclidean_space set"
-  assumes "closedin (top_of_set (S \<union> T)) S" "closedin (top_of_set (S \<union> T)) T" "ENR(S \<union> T)" "ENR(S \<inter> T)"
-  shows "ENR S"
-  apply (simp add: ENR_ANR)
-  using ANR_from_Un_Int_local ENR_ANR assms locally_compact_closedin by blast
-
-
-lemma ENR_from_Un_Int:
-  fixes S :: "'a::euclidean_space set"
-  assumes "closed S" "closed T" "ENR(S \<union> T)" "ENR(S \<inter> T)"
-  shows "ENR S"
-  by (meson ENR_from_Un_Int_gen assms closed_subset sup_ge1 sup_ge2)
-
-
-lemma ENR_finite_Union_convex_closed:
-  fixes \<T> :: "'a::euclidean_space set set"
-  assumes \<T>: "finite \<T>" and clo: "\<And>C. C \<in> \<T> \<Longrightarrow> closed C" and con: "\<And>C. C \<in> \<T> \<Longrightarrow> convex C"
-  shows "ENR(\<Union> \<T>)"
-  by (simp add: ENR_ANR ANR_finite_Union_convex_closed \<T> clo closed_Union closed_imp_locally_compact con)
-
-lemma finite_imp_ENR:
-  fixes S :: "'a::euclidean_space set"
-  shows "finite S \<Longrightarrow> ENR S"
-  by (simp add: ENR_ANR finite_imp_ANR finite_imp_closed closed_imp_locally_compact)
-
-lemma ENR_insert:
-  fixes S :: "'a::euclidean_space set"
-  assumes "closed S" "ENR S"
-  shows "ENR(insert a S)"
-proof -
-  have "ENR ({a} \<union> S)"
-    by (metis ANR_insert ENR_ANR Un_commute Un_insert_right assms closed_imp_locally_compact closed_insert sup_bot_right)
-  then show ?thesis
-    by auto
-qed
-
-lemma ENR_path_component_ENR:
-  fixes S :: "'a::euclidean_space set"
-  assumes "ENR S"
-  shows "ENR(path_component_set S x)"
-  by (metis ANR_imp_locally_path_connected ENR_empty ENR_imp_ANR ENR_openin assms
-            locally_path_connected_2 openin_subtopology_self path_component_eq_empty)
-
-(*UNUSED
-lemma ENR_Times:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "ENR S" "ENR T" shows "ENR(S \<times> T)"
-using assms apply (simp add: ENR_ANR ANR_Times)
-thm locally_compact_Times
-oops
-  SIMP_TAC[ENR_ANR; ANR_PCROSS; LOCALLY_COMPACT_PCROSS]);;
-*)
-
-subsubsection\<open>Finally, spheres are ANRs and ENRs\<close>
-
-lemma absolute_retract_homeomorphic_convex_compact:
-  fixes S :: "'a::euclidean_space set" and U :: "'b::euclidean_space set"
-  assumes "S homeomorphic U" "S \<noteq> {}" "S \<subseteq> T" "convex U" "compact U"
-  shows "S retract_of T"
-  by (metis UNIV_I assms compact_AR convex_imp_AR homeomorphic_AR_iff_AR homeomorphic_compactness homeomorphic_empty(1) retract_of_subset subsetI)
-
-lemma frontier_retract_of_punctured_universe:
-  fixes S :: "'a::euclidean_space set"
-  assumes "convex S" "bounded S" "a \<in> interior S"
-  shows "(frontier S) retract_of (- {a})"
-  using rel_frontier_retract_of_punctured_affine_hull
-  by (metis Compl_eq_Diff_UNIV affine_hull_nonempty_interior assms empty_iff rel_frontier_frontier rel_interior_nonempty_interior)
-
-lemma sphere_retract_of_punctured_universe_gen:
-  fixes a :: "'a::euclidean_space"
-  assumes "b \<in> ball a r"
-  shows  "sphere a r retract_of (- {b})"
-proof -
-  have "frontier (cball a r) retract_of (- {b})"
-    apply (rule frontier_retract_of_punctured_universe)
-    using assms by auto
-  then show ?thesis
-    by simp
-qed
-
-lemma sphere_retract_of_punctured_universe:
-  fixes a :: "'a::euclidean_space"
-  assumes "0 < r"
-  shows "sphere a r retract_of (- {a})"
-  by (simp add: assms sphere_retract_of_punctured_universe_gen)
-
-lemma ENR_sphere:
-  fixes a :: "'a::euclidean_space"
-  shows "ENR(sphere a r)"
-proof (cases "0 < r")
-  case True
-  then have "sphere a r retract_of -{a}"
-    by (simp add: sphere_retract_of_punctured_universe)
-  with open_delete show ?thesis
-    by (auto simp: ENR_def)
-next
-  case False
-  then show ?thesis
-    using finite_imp_ENR
-    by (metis finite_insert infinite_imp_nonempty less_linear sphere_eq_empty sphere_trivial)
-qed
-
-corollary\<^marker>\<open>tag unimportant\<close> ANR_sphere:
-  fixes a :: "'a::euclidean_space"
-  shows "ANR(sphere a r)"
-  by (simp add: ENR_imp_ANR ENR_sphere)
-
-subsubsection\<open>Spheres are connected, etc\<close>
-
-lemma locally_path_connected_sphere_gen:
-  fixes S :: "'a::euclidean_space set"
-  assumes "bounded S" and "convex S" 
-  shows "locally path_connected (rel_frontier S)"
-proof (cases "rel_interior S = {}")
-  case True
-  with assms show ?thesis
-    by (simp add: rel_interior_eq_empty)
-next
-  case False
-  then obtain a where a: "a \<in> rel_interior S"
-    by blast
-  show ?thesis
-  proof (rule retract_of_locally_path_connected)
-    show "locally path_connected (affine hull S - {a})"
-      by (meson convex_affine_hull convex_imp_locally_path_connected locally_open_subset openin_delete openin_subtopology_self)
-    show "rel_frontier S retract_of affine hull S - {a}"
-      using a assms rel_frontier_retract_of_punctured_affine_hull by blast
-  qed
-qed
-
-lemma locally_connected_sphere_gen:
-  fixes S :: "'a::euclidean_space set"
-  assumes "bounded S" and "convex S" 
-  shows "locally connected (rel_frontier S)"
-  by (simp add: ANR_imp_locally_connected ANR_rel_frontier_convex assms)
-
-lemma locally_path_connected_sphere:
-  fixes a :: "'a::euclidean_space"
-  shows "locally path_connected (sphere a r)"
-  using ENR_imp_locally_path_connected ENR_sphere by blast
-
-lemma locally_connected_sphere:
-  fixes a :: "'a::euclidean_space"
-  shows "locally connected(sphere a r)"
-  using ANR_imp_locally_connected ANR_sphere by blast
-
-subsubsection\<open>Borsuk homotopy extension theorem\<close>
-
-text\<open>It's only this late so we can use the concept of retraction,
-  saying that the domain sets or range set are ENRs.\<close>
-
-theorem Borsuk_homotopy_extension_homotopic:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes cloTS: "closedin (top_of_set T) S"
-      and anr: "(ANR S \<and> ANR T) \<or> ANR U"
-      and contf: "continuous_on T f"
-      and "f ` T \<subseteq> U"
-      and "homotopic_with_canon (\<lambda>x. True) S U f g"
-   obtains g' where "homotopic_with_canon (\<lambda>x. True) T U f g'"
-                    "continuous_on T g'" "image g' T \<subseteq> U"
-                    "\<And>x. x \<in> S \<Longrightarrow> g' x = g x"
-proof -
-  have "S \<subseteq> T" using assms closedin_imp_subset by blast
-  obtain h where conth: "continuous_on ({0..1} \<times> S) h"
-             and him: "h ` ({0..1} \<times> S) \<subseteq> U"
-             and [simp]: "\<And>x. h(0, x) = f x" "\<And>x. h(1::real, x) = g x"
-       using assms by (auto simp: homotopic_with_def)
-  define h' where "h' \<equiv>  \<lambda>z. if snd z \<in> S then h z else (f \<circ> snd) z"
-  define B where "B \<equiv> {0::real} \<times> T \<union> {0..1} \<times> S"
-  have clo0T: "closedin (top_of_set ({0..1} \<times> T)) ({0::real} \<times> T)"
-    by (simp add: Abstract_Topology.closedin_Times)
-  moreover have cloT1S: "closedin (top_of_set ({0..1} \<times> T)) ({0..1} \<times> S)"
-    by (simp add: Abstract_Topology.closedin_Times assms)
-  ultimately have clo0TB:"closedin (top_of_set ({0..1} \<times> T)) B"
-    by (auto simp: B_def)
-  have cloBS: "closedin (top_of_set B) ({0..1} \<times> S)"
-    by (metis (no_types) Un_subset_iff B_def closedin_subset_trans [OF cloT1S] clo0TB closedin_imp_subset closedin_self)
-  moreover have cloBT: "closedin (top_of_set B) ({0} \<times> T)"
-    using \<open>S \<subseteq> T\<close> closedin_subset_trans [OF clo0T]
-    by (metis B_def Un_upper1 clo0TB closedin_closed inf_le1)
-  moreover have "continuous_on ({0} \<times> T) (f \<circ> snd)"
-    apply (rule continuous_intros)+
-    apply (simp add: contf)
-    done
-  ultimately have conth': "continuous_on B h'"
-    apply (simp add: h'_def B_def Un_commute [of "{0} \<times> T"])
-    apply (auto intro!: continuous_on_cases_local conth)
-    done
-  have "image h' B \<subseteq> U"
-    using \<open>f ` T \<subseteq> U\<close> him by (auto simp: h'_def B_def)
-  obtain V k where "B \<subseteq> V" and opeTV: "openin (top_of_set ({0..1} \<times> T)) V"
-               and contk: "continuous_on V k" and kim: "k ` V \<subseteq> U"
-               and keq: "\<And>x. x \<in> B \<Longrightarrow> k x = h' x"
-  using anr
-  proof
-    assume ST: "ANR S \<and> ANR T"
-    have eq: "({0} \<times> T \<inter> {0..1} \<times> S) = {0::real} \<times> S"
-      using \<open>S \<subseteq> T\<close> by auto
-    have "ANR B"
-      apply (simp add: B_def)
-      apply (rule ANR_closed_Un_local)
-          apply (metis cloBT B_def)
-         apply (metis Un_commute cloBS B_def)
-        apply (simp_all add: ANR_Times convex_imp_ANR ANR_singleton ST eq)
-      done
-    note Vk = that
-    have *: thesis if "openin (top_of_set ({0..1::real} \<times> T)) V"
-                      "retraction V B r" for V r
-      using that
-      apply (clarsimp simp add: retraction_def)
-      apply (rule Vk [of V "h' \<circ> r"], assumption+)
-        apply (metis continuous_on_compose conth' continuous_on_subset) 
-      using \<open>h' ` B \<subseteq> U\<close> apply force+
-      done
-    show thesis
-        apply (rule ANR_imp_neighbourhood_retract [OF \<open>ANR B\<close> clo0TB])
-        apply (auto simp: ANR_Times ANR_singleton ST retract_of_def *)
-        done
-  next
-    assume "ANR U"
-    with ANR_imp_absolute_neighbourhood_extensor \<open>h' ` B \<subseteq> U\<close> clo0TB conth' that
-    show ?thesis by blast
-  qed
-  define S' where "S' \<equiv> {x. \<exists>u::real. u \<in> {0..1} \<and> (u, x::'a) \<in> {0..1} \<times> T - V}"
-  have "closedin (top_of_set T) S'"
-    unfolding S'_def
-    apply (rule closedin_compact_projection, blast)
-    using closedin_self opeTV by blast
-  have S'_def: "S' = {x. \<exists>u::real.  (u, x::'a) \<in> {0..1} \<times> T - V}"
-    by (auto simp: S'_def)
-  have cloTS': "closedin (top_of_set T) S'"
-    using S'_def \<open>closedin (top_of_set T) S'\<close> by blast
-  have "S \<inter> S' = {}"
-    using S'_def B_def \<open>B \<subseteq> V\<close> by force
-  obtain a :: "'a \<Rightarrow> real" where conta: "continuous_on T a"
-      and "\<And>x. x \<in> T \<Longrightarrow> a x \<in> closed_segment 1 0"
-      and a1: "\<And>x. x \<in> S \<Longrightarrow> a x = 1"
-      and a0: "\<And>x. x \<in> S' \<Longrightarrow> a x = 0"
-    apply (rule Urysohn_local [OF cloTS cloTS' \<open>S \<inter> S' = {}\<close>, of 1 0], blast)
-    done
-  then have ain: "\<And>x. x \<in> T \<Longrightarrow> a x \<in> {0..1}"
-    using closed_segment_eq_real_ivl by auto
-  have inV: "(u * a t, t) \<in> V" if "t \<in> T" "0 \<le> u" "u \<le> 1" for t u
-  proof (rule ccontr)
-    assume "(u * a t, t) \<notin> V"
-    with ain [OF \<open>t \<in> T\<close>] have "a t = 0"
-      apply simp
-      apply (rule a0)
-      by (metis (no_types, lifting) Diff_iff S'_def SigmaI atLeastAtMost_iff mem_Collect_eq mult_le_one mult_nonneg_nonneg that)
-    show False
-      using B_def \<open>(u * a t, t) \<notin> V\<close> \<open>B \<subseteq> V\<close> \<open>a t = 0\<close> that by auto
-  qed
-  show ?thesis
-  proof
-    show hom: "homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. k (a x, x))"
-    proof (simp add: homotopic_with, intro exI conjI)
-      show "continuous_on ({0..1} \<times> T) (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z)))"
-        apply (intro continuous_on_compose continuous_intros)
-        apply (rule continuous_on_subset [OF conta], force)
-        apply (rule continuous_on_subset [OF contk])
-        apply (force intro: inV)
-        done
-      show "(k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) ` ({0..1} \<times> T) \<subseteq> U"
-        using inV kim by auto
-      show "\<forall>x\<in>T. (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) (0, x) = f x"
-        by (simp add: B_def h'_def keq)
-      show "\<forall>x\<in>T. (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) (1, x) = k (a x, x)"
-        by auto
-    qed
-  show "continuous_on T (\<lambda>x. k (a x, x))"
-    using homotopic_with_imp_continuous_maps [OF hom] by auto
-  show "(\<lambda>x. k (a x, x)) ` T \<subseteq> U"
-  proof clarify
-    fix t
-    assume "t \<in> T"
-    show "k (a t, t) \<in> U"
-      by (metis \<open>t \<in> T\<close> image_subset_iff inV kim not_one_le_zero linear mult_cancel_right1)
-  qed
-  show "\<And>x. x \<in> S \<Longrightarrow> k (a x, x) = g x"
-    by (simp add: B_def a1 h'_def keq)
-  qed
-qed
-
-
-corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_ANR_extension:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes "closed S"
-      and contf: "continuous_on S f"
-      and "ANR T"
-      and fim: "f ` S \<subseteq> T"
-      and "S \<noteq> {}"
-   shows "(\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)) \<longleftrightarrow>
-          (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> T \<and> (\<forall>x \<in> S. g x = f x))"
-       (is "?lhs = ?rhs")
-proof
-  assume ?lhs
-  then obtain c where c: "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. c) f"
-    by (blast intro: homotopic_with_symD)
-  have "closedin (top_of_set UNIV) S"
-    using \<open>closed S\<close> closed_closedin by fastforce
-  then obtain g where "continuous_on UNIV g" "range g \<subseteq> T"
-                      "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
-    apply (rule Borsuk_homotopy_extension_homotopic [OF _ _ continuous_on_const _ c, where T=UNIV])
-    using \<open>ANR T\<close> \<open>S \<noteq> {}\<close> c homotopic_with_imp_subset1 apply fastforce+
-    done
-  then show ?rhs by blast
-next
-  assume ?rhs
-  then obtain g where "continuous_on UNIV g" "range g \<subseteq> T" "\<And>x. x\<in>S \<Longrightarrow> g x = f x"
-    by blast
-  then obtain c where "homotopic_with_canon (\<lambda>h. True) UNIV T g (\<lambda>x. c)"
-    using nullhomotopic_from_contractible [of UNIV g T] contractible_UNIV by blast
-  then have "homotopic_with_canon (\<lambda>x. True) S T g (\<lambda>x. c)"
-    by (simp add: homotopic_from_subtopology)
-  then show ?lhs
-    by (force elim: homotopic_with_eq [of _ _ _ g "\<lambda>x. c"] simp: \<open>\<And>x. x \<in> S \<Longrightarrow> g x = f x\<close>)
-qed
-
-corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_rel_frontier_extension:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes "closed S"
-      and contf: "continuous_on S f"
-      and "convex T" "bounded T"
-      and fim: "f ` S \<subseteq> rel_frontier T"
-      and "S \<noteq> {}"
-   shows "(\<exists>c. homotopic_with_canon (\<lambda>x. True) S (rel_frontier T) f (\<lambda>x. c)) \<longleftrightarrow>
-          (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> rel_frontier T \<and> (\<forall>x \<in> S. g x = f x))"
-by (simp add: nullhomotopic_into_ANR_extension assms ANR_rel_frontier_convex)
-
-corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_sphere_extension:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b :: euclidean_space"
-  assumes "closed S" and contf: "continuous_on S f"
-      and "S \<noteq> {}" and fim: "f ` S \<subseteq> sphere a r"
-    shows "((\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere a r) f (\<lambda>x. c)) \<longleftrightarrow>
-           (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> sphere a r \<and> (\<forall>x \<in> S. g x = f x)))"
-           (is "?lhs = ?rhs")
-proof (cases "r = 0")
-  case True with fim show ?thesis
-    apply auto
-    using fim continuous_on_const apply fastforce
-    by (metis contf contractible_sing nullhomotopic_into_contractible)
-next
-  case False
-  then have eq: "sphere a r = rel_frontier (cball a r)" by simp
-  show ?thesis
-    using fim unfolding eq
-    apply (rule nullhomotopic_into_rel_frontier_extension [OF \<open>closed S\<close> contf convex_cball bounded_cball])
-    apply (rule \<open>S \<noteq> {}\<close>)
-    done
-qed
-
-proposition\<^marker>\<open>tag unimportant\<close> Borsuk_map_essential_bounded_component:
-  fixes a :: "'a :: euclidean_space"
-  assumes "compact S" and "a \<notin> S"
-   shows "bounded (connected_component_set (- S) a) \<longleftrightarrow>
-          \<not>(\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
-                               (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) (\<lambda>x. c))"
-   (is "?lhs = ?rhs")
-proof (cases "S = {}")
-  case True then show ?thesis
-    by simp
-next
-  case False
-  have "closed S" "bounded S"
-    using \<open>compact S\<close> compact_eq_bounded_closed by auto
-  have s01: "(\<lambda>x. (x - a) /\<^sub>R norm (x - a)) ` S \<subseteq> sphere 0 1"
-    using \<open>a \<notin> S\<close>  by clarsimp (metis dist_eq_0_iff dist_norm mult.commute right_inverse)
-  have aincc: "a \<in> connected_component_set (- S) a"
-    by (simp add: \<open>a \<notin> S\<close>)
-  obtain r where "r>0" and r: "S \<subseteq> ball 0 r"
-    using bounded_subset_ballD \<open>bounded S\<close> by blast
-  have "\<not> ?rhs \<longleftrightarrow> \<not> ?lhs"
-  proof
-    assume notr: "\<not> ?rhs"
-    have nog: "\<nexists>g. continuous_on (S \<union> connected_component_set (- S) a) g \<and>
-                   g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1 \<and>
-                   (\<forall>x\<in>S. g x = (x - a) /\<^sub>R norm (x - a))"
-         if "bounded (connected_component_set (- S) a)"
-      apply (rule non_extensible_Borsuk_map [OF \<open>compact S\<close> componentsI _ aincc])
-      using  \<open>a \<notin> S\<close> that by auto
-    obtain g where "range g \<subseteq> sphere 0 1" "continuous_on UNIV g"
-                        "\<And>x. x \<in> S \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)"
-      using notr
-      by (auto simp: nullhomotopic_into_sphere_extension
-                 [OF \<open>closed S\<close> continuous_on_Borsuk_map [OF \<open>a \<notin> S\<close>] False s01])
-    with \<open>a \<notin> S\<close> show  "\<not> ?lhs"
-      apply (clarsimp simp: Borsuk_map_into_sphere [of a S, symmetric] dest!: nog)
-      apply (drule_tac x=g in spec)
-      using continuous_on_subset by fastforce 
-  next
-    assume "\<not> ?lhs"
-    then obtain b where b: "b \<in> connected_component_set (- S) a" and "r \<le> norm b"
-      using bounded_iff linear by blast
-    then have bnot: "b \<notin> ball 0 r"
-      by simp
-    have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
-                                                   (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
-      apply (rule Borsuk_maps_homotopic_in_path_component)
-      using \<open>closed S\<close> b open_Compl open_path_connected_component apply fastforce
-      done
-    moreover
-    obtain c where "homotopic_with_canon (\<lambda>x. True) (ball 0 r) (sphere 0 1)
-                                   (\<lambda>x. inverse (norm (x - b)) *\<^sub>R (x - b)) (\<lambda>x. c)"
-    proof (rule nullhomotopic_from_contractible)
-      show "contractible (ball (0::'a) r)"
-        by (metis convex_imp_contractible convex_ball)
-      show "continuous_on (ball 0 r) (\<lambda>x. inverse(norm (x - b)) *\<^sub>R (x - b))"
-        by (rule continuous_on_Borsuk_map [OF bnot])
-      show "(\<lambda>x. (x - b) /\<^sub>R norm (x - b)) ` ball 0 r \<subseteq> sphere 0 1"
-        using bnot Borsuk_map_into_sphere by blast
-    qed blast
-    ultimately have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. (x - a) /\<^sub>R norm (x - a)) (\<lambda>x. c)"
-      by (meson homotopic_with_subset_left homotopic_with_trans r)
-    then show "\<not> ?rhs"
-      by blast
-  qed
-  then show ?thesis by blast
-qed
-
-lemma homotopic_Borsuk_maps_in_bounded_component:
-  fixes a :: "'a :: euclidean_space"
-  assumes "compact S" and "a \<notin> S"and "b \<notin> S"
-      and boc: "bounded (connected_component_set (- S) a)"
-      and hom: "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
-                               (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
-                               (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
-   shows "connected_component (- S) a b"
-proof (rule ccontr)
-  assume notcc: "\<not> connected_component (- S) a b"
-  let ?T = "S \<union> connected_component_set (- S) a"
-  have "\<nexists>g. continuous_on (S \<union> connected_component_set (- S) a) g \<and>
-            g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1 \<and>
-            (\<forall>x\<in>S. g x = (x - a) /\<^sub>R norm (x - a))"
-    by (simp add: \<open>a \<notin> S\<close> componentsI non_extensible_Borsuk_map [OF \<open>compact S\<close> _ boc])
-  moreover obtain g where "continuous_on (S \<union> connected_component_set (- S) a) g"
-                          "g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1"
-                          "\<And>x. x \<in> S \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)"
-  proof (rule Borsuk_homotopy_extension_homotopic)
-    show "closedin (top_of_set ?T) S"
-      by (simp add: \<open>compact S\<close> closed_subset compact_imp_closed)
-    show "continuous_on ?T (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
-      by (simp add: \<open>b \<notin> S\<close> notcc continuous_on_Borsuk_map)
-    show "(\<lambda>x. (x - b) /\<^sub>R norm (x - b)) ` ?T \<subseteq> sphere 0 1"
-      by (simp add: \<open>b \<notin> S\<close> notcc Borsuk_map_into_sphere)
-    show "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
-             (\<lambda>x. (x - b) /\<^sub>R norm (x - b)) (\<lambda>x. (x - a) /\<^sub>R norm (x - a))"
-      by (simp add: hom homotopic_with_symD)
-    qed (auto simp: ANR_sphere intro: that)
-  ultimately show False by blast
-qed
-
-
-lemma Borsuk_maps_homotopic_in_connected_component_eq:
-  fixes a :: "'a :: euclidean_space"
-  assumes S: "compact S" "a \<notin> S" "b \<notin> S" and 2: "2 \<le> DIM('a)"
-    shows "(homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
-                   (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
-                   (\<lambda>x. (x - b) /\<^sub>R norm (x - b)) \<longleftrightarrow>
-           connected_component (- S) a b)"
-         (is "?lhs = ?rhs")
-proof
-  assume L: ?lhs
-  show ?rhs
-  proof (cases "bounded(connected_component_set (- S) a)")
-    case True
-    show ?thesis
-      by (rule homotopic_Borsuk_maps_in_bounded_component [OF S True L])
-  next
-    case not_bo_a: False
-    show ?thesis
-    proof (cases "bounded(connected_component_set (- S) b)")
-      case True
-      show ?thesis
-        using homotopic_Borsuk_maps_in_bounded_component [OF S]
-        by (simp add: L True assms connected_component_sym homotopic_Borsuk_maps_in_bounded_component homotopic_with_sym)
-    next
-      case False
-      then show ?thesis
-        using cobounded_unique_unbounded_component [of "-S" a b] \<open>compact S\<close> not_bo_a
-        by (auto simp: compact_eq_bounded_closed assms connected_component_eq_eq)
-    qed
-  qed
-next
-  assume R: ?rhs
-  then have "path_component (- S) a b"
-    using assms(1) compact_eq_bounded_closed open_Compl open_path_connected_component_set by fastforce
-  then show ?lhs
-    by (simp add: Borsuk_maps_homotopic_in_path_component)
-qed
-
-subsubsection\<open>More extension theorems\<close>
-
-lemma extension_from_clopen:
-  assumes ope: "openin (top_of_set S) T"
-      and clo: "closedin (top_of_set S) T"
-      and contf: "continuous_on T f" and fim: "f ` T \<subseteq> U" and null: "U = {} \<Longrightarrow> S = {}"
- obtains g where "continuous_on S g" "g ` S \<subseteq> U" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
-proof (cases "U = {}")
-  case True
-  then show ?thesis
-    by (simp add: null that)
-next
-  case False
-  then obtain a where "a \<in> U"
-    by auto
-  let ?g = "\<lambda>x. if x \<in> T then f x else a"
-  have Seq: "S = T \<union> (S - T)"
-    using clo closedin_imp_subset by fastforce
-  show ?thesis
-  proof
-    have "continuous_on (T \<union> (S - T)) ?g"
-      apply (rule continuous_on_cases_local)
-      using Seq clo ope by (auto simp: contf continuous_on_const intro: continuous_on_cases_local)
-    with Seq show "continuous_on S ?g"
-      by metis
-    show "?g ` S \<subseteq> U"
-      using \<open>a \<in> U\<close> fim by auto
-    show "\<And>x. x \<in> T \<Longrightarrow> ?g x = f x"
-      by auto
-  qed
-qed
-
-
-lemma extension_from_component:
-  fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
-  assumes S: "locally connected S \<or> compact S" and "ANR U"
-     and C: "C \<in> components S" and contf: "continuous_on C f" and fim: "f ` C \<subseteq> U"
- obtains g where "continuous_on S g" "g ` S \<subseteq> U" "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
-proof -
-  obtain T g where ope: "openin (top_of_set S) T"
-               and clo: "closedin (top_of_set S) T"
-               and "C \<subseteq> T" and contg: "continuous_on T g" and gim: "g ` T \<subseteq> U"
-               and gf: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
-    using S
-  proof
-    assume "locally connected S"
-    show ?thesis
-      by (metis C \<open>locally connected S\<close> openin_components_locally_connected closedin_component contf fim order_refl that)
-  next
-    assume "compact S"
-    then obtain W g where "C \<subseteq> W" and opeW: "openin (top_of_set S) W"
-                 and contg: "continuous_on W g"
-                 and gim: "g ` W \<subseteq> U" and gf: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
-      using ANR_imp_absolute_neighbourhood_extensor [of U C f S] C \<open>ANR U\<close> closedin_component contf fim by blast
-    then obtain V where "open V" and V: "W = S \<inter> V"
-      by (auto simp: openin_open)
-    moreover have "locally compact S"
-      by (simp add: \<open>compact S\<close> closed_imp_locally_compact compact_imp_closed)
-    ultimately obtain K where opeK: "openin (top_of_set S) K" and "compact K" "C \<subseteq> K" "K \<subseteq> V"
-      by (metis C Int_subset_iff \<open>C \<subseteq> W\<close> \<open>compact S\<close> compact_components Sura_Bura_clopen_subset)
-    show ?thesis
-    proof
-      show "closedin (top_of_set S) K"
-        by (meson \<open>compact K\<close> \<open>compact S\<close> closedin_compact_eq opeK openin_imp_subset)
-      show "continuous_on K g"
-        by (metis Int_subset_iff V \<open>K \<subseteq> V\<close> contg continuous_on_subset opeK openin_subtopology subset_eq)
-      show "g ` K \<subseteq> U"
-        using V \<open>K \<subseteq> V\<close> gim opeK openin_imp_subset by fastforce
-    qed (use opeK gf \<open>C \<subseteq> K\<close> in auto)
-  qed
-  obtain h where "continuous_on S h" "h ` S \<subseteq> U" "\<And>x. x \<in> T \<Longrightarrow> h x = g x"
-    using extension_from_clopen
-    by (metis C bot.extremum_uniqueI clo contg gim fim image_is_empty in_components_nonempty ope)
-  then show ?thesis
-    by (metis \<open>C \<subseteq> T\<close> gf subset_eq that)
-qed
-
-
-lemma tube_lemma:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "compact S" and S: "S \<noteq> {}" "(\<lambda>x. (x,a)) ` S \<subseteq> U" 
-      and ope: "openin (top_of_set (S \<times> T)) U"
-  obtains V where "openin (top_of_set T) V" "a \<in> V" "S \<times> V \<subseteq> U"
-proof -
-  let ?W = "{y. \<exists>x. x \<in> S \<and> (x, y) \<in> (S \<times> T - U)}"
-  have "U \<subseteq> S \<times> T" "closedin (top_of_set (S \<times> T)) (S \<times> T - U)"
-    using ope by (auto simp: openin_closedin_eq)
-  then have "closedin (top_of_set T) ?W"
-    using \<open>compact S\<close> closedin_compact_projection by blast
-  moreover have "a \<in> T - ?W"
-    using \<open>U \<subseteq> S \<times> T\<close> S by auto
-  moreover have "S \<times> (T - ?W) \<subseteq> U"
-    by auto
-  ultimately show ?thesis
-    by (metis (no_types, lifting) Sigma_cong closedin_def that topspace_euclidean_subtopology)
-qed
-
-lemma tube_lemma_gen:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes "compact S" "S \<noteq> {}" "T \<subseteq> T'" "S \<times> T \<subseteq> U"
-      and ope: "openin (top_of_set (S \<times> T')) U"
-  obtains V where "openin (top_of_set T') V" "T \<subseteq> V" "S \<times> V \<subseteq> U"
-proof -
-  have "\<And>x. x \<in> T \<Longrightarrow> \<exists>V. openin (top_of_set T') V \<and> x \<in> V \<and> S \<times> V \<subseteq> U"
-    using assms by (auto intro:  tube_lemma [OF \<open>compact S\<close>])
-  then obtain F where F: "\<And>x. x \<in> T \<Longrightarrow> openin (top_of_set T') (F x) \<and> x \<in> F x \<and> S \<times> F x \<subseteq> U"
-    by metis
-  show ?thesis
-  proof
-    show "openin (top_of_set T') (\<Union>(F ` T))"
-      using F by blast
-    show "T \<subseteq> \<Union>(F ` T)"
-      using F by blast
-    show "S \<times> \<Union>(F ` T) \<subseteq> U"
-      using F by auto
-  qed
-qed
-
-proposition\<^marker>\<open>tag unimportant\<close> homotopic_neighbourhood_extension:
-  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
-  assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> U"
-      and contg: "continuous_on S g" and gim: "g ` S \<subseteq> U"
-      and clo: "closedin (top_of_set S) T"
-      and "ANR U" and hom: "homotopic_with_canon (\<lambda>x. True) T U f g"
-    obtains V where "T \<subseteq> V" "openin (top_of_set S) V"
-                    "homotopic_with_canon (\<lambda>x. True) V U f g"
-proof -
-  have "T \<subseteq> S"
-    using clo closedin_imp_subset by blast
-  obtain h where conth: "continuous_on ({0..1::real} \<times> T) h"
-             and him: "h ` ({0..1} \<times> T) \<subseteq> U"
-             and h0: "\<And>x. h(0, x) = f x" and h1: "\<And>x. h(1, x) = g x"
-    using hom by (auto simp: homotopic_with_def)
-  define h' where "h' \<equiv> \<lambda>z. if fst z \<in> {0} then f(snd z)
-                             else if fst z \<in> {1} then g(snd z)
-                             else h z"
-  let ?S0 = "{0::real} \<times> S" and ?S1 = "{1::real} \<times> S"
-  have "continuous_on(?S0 \<union> (?S1 \<union> {0..1} \<times> T)) h'"
-    unfolding h'_def
-  proof (intro continuous_on_cases_local)
-    show "closedin (top_of_set (?S0 \<union> (?S1 \<union> {0..1} \<times> T))) ?S0"
-         "closedin (top_of_set (?S1 \<union> {0..1} \<times> T)) ?S1"
-      using \<open>T \<subseteq> S\<close> by (force intro: closedin_Times closedin_subset_trans [of "{0..1} \<times> S"])+
-    show "closedin (top_of_set (?S0 \<union> (?S1 \<union> {0..1} \<times> T))) (?S1 \<union> {0..1} \<times> T)"
-         "closedin (top_of_set (?S1 \<union> {0..1} \<times> T)) ({0..1} \<times> T)"
-      using \<open>T \<subseteq> S\<close> by (force intro: clo closedin_Times closedin_subset_trans [of "{0..1} \<times> S"])+
-    show "continuous_on (?S0) (\<lambda>x. f (snd x))"
-      by (intro continuous_intros continuous_on_compose2 [OF contf]) auto
-    show "continuous_on (?S1) (\<lambda>x. g (snd x))"
-      by (intro continuous_intros continuous_on_compose2 [OF contg]) auto
-  qed (use h0 h1 conth in auto)
-  then have "continuous_on ({0,1} \<times> S \<union> ({0..1} \<times> T)) h'"
-    by (metis Sigma_Un_distrib1 Un_assoc insert_is_Un) 
-  moreover have "h' ` ({0,1} \<times> S \<union> {0..1} \<times> T) \<subseteq> U"
-    using fim gim him \<open>T \<subseteq> S\<close> unfolding h'_def by force
-  moreover have "closedin (top_of_set ({0..1::real} \<times> S)) ({0,1} \<times> S \<union> {0..1::real} \<times> T)"
-    by (intro closedin_Times closedin_Un clo) (simp_all add: closed_subset)
-  ultimately
-  obtain W k where W: "({0,1} \<times> S) \<union> ({0..1} \<times> T) \<subseteq> W"
-               and opeW: "openin (top_of_set ({0..1} \<times> S)) W"
-               and contk: "continuous_on W k"
-               and kim: "k ` W \<subseteq> U"
-               and kh': "\<And>x. x \<in> ({0,1} \<times> S) \<union> ({0..1} \<times> T) \<Longrightarrow> k x = h' x"
-    by (metis ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR U\<close>, of "({0,1} \<times> S) \<union> ({0..1} \<times> T)" h' "{0..1} \<times> S"])
-  obtain T' where opeT': "openin (top_of_set S) T'" 
-              and "T \<subseteq> T'" and TW: "{0..1} \<times> T' \<subseteq> W"
-    using tube_lemma_gen [of "{0..1::real}" T S W] W \<open>T \<subseteq> S\<close> opeW by auto
-  moreover have "homotopic_with_canon (\<lambda>x. True) T' U f g"
-  proof (simp add: homotopic_with, intro exI conjI)
-    show "continuous_on ({0..1} \<times> T') k"
-      using TW continuous_on_subset contk by auto
-    show "k ` ({0..1} \<times> T') \<subseteq> U"
-      using TW kim by fastforce
-    have "T' \<subseteq> S"
-      by (meson opeT' subsetD openin_imp_subset)
-    then show "\<forall>x\<in>T'. k (0, x) = f x" "\<forall>x\<in>T'. k (1, x) = g x"
-      by (auto simp: kh' h'_def)
-  qed
-  ultimately show ?thesis
-    by (blast intro: that)
-qed
-
-text\<open> Homotopy on a union of closed-open sets.\<close>
-proposition\<^marker>\<open>tag unimportant\<close> homotopic_on_clopen_Union:
-  fixes \<F> :: "'a::euclidean_space set set"
-  assumes "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (top_of_set (\<Union>\<F>)) S"
-      and "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set (\<Union>\<F>)) S"
-      and "\<And>S. S \<in> \<F> \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) S T f g"
-  shows "homotopic_with_canon (\<lambda>x. True) (\<Union>\<F>) T f g"
-proof -
-  obtain \<V> where "\<V> \<subseteq> \<F>" "countable \<V>" and eqU: "\<Union>\<V> = \<Union>\<F>"
-    using Lindelof_openin assms by blast
-  show ?thesis
-  proof (cases "\<V> = {}")
-    case True
-    then show ?thesis
-      by (metis Union_empty eqU homotopic_with_canon_on_empty)
-  next
-    case False
-    then obtain V :: "nat \<Rightarrow> 'a set" where V: "range V = \<V>"
-      using range_from_nat_into \<open>countable \<V>\<close> by metis
-    with \<open>\<V> \<subseteq> \<F>\<close> have clo: "\<And>n. closedin (top_of_set (\<Union>\<F>)) (V n)"
-                  and ope: "\<And>n. openin (top_of_set (\<Union>\<F>)) (V n)"
-                  and hom: "\<And>n. homotopic_with_canon (\<lambda>x. True) (V n) T f g"
-      using assms by auto 
-    then obtain h where conth: "\<And>n. continuous_on ({0..1::real} \<times> V n) (h n)"
-                  and him: "\<And>n. h n ` ({0..1} \<times> V n) \<subseteq> T" 
-                  and h0: "\<And>n. \<And>x. x \<in> V n \<Longrightarrow> h n (0, x) = f x" 
-                  and h1: "\<And>n. \<And>x. x \<in> V n \<Longrightarrow> h n (1, x) = g x"
-      by (simp add: homotopic_with) metis
-    have wop: "b \<in> V x \<Longrightarrow> \<exists>k. b \<in> V k \<and> (\<forall>j<k. b \<notin> V j)" for b x
-        using nat_less_induct [where P = "\<lambda>i. b \<notin> V i"] by meson
-    obtain \<zeta> where cont: "continuous_on ({0..1} \<times> \<Union>(V ` UNIV)) \<zeta>"
-              and eq: "\<And>x i. \<lbrakk>x \<in> {0..1} \<times> \<Union>(V ` UNIV) \<inter>
-                                   {0..1} \<times> (V i - (\<Union>m<i. V m))\<rbrakk> \<Longrightarrow> \<zeta> x = h i x"
-    proof (rule pasting_lemma_exists)
-      let ?X = "top_of_set ({0..1::real} \<times> \<Union>(range V))"
-      show "topspace ?X \<subseteq> (\<Union>i. {0..1::real} \<times> (V i - (\<Union>m<i. V m)))"
-        by (force simp: Ball_def dest: wop)
-      show "openin (top_of_set ({0..1} \<times> \<Union>(V ` UNIV))) 
-                   ({0..1::real} \<times> (V i - (\<Union>m<i. V m)))" for i
-      proof (intro openin_Times openin_subtopology_self openin_diff)
-        show "openin (top_of_set (\<Union>(V ` UNIV))) (V i)"
-          using ope V eqU by auto
-        show "closedin (top_of_set (\<Union>(V ` UNIV))) (\<Union>m<i. V m)"
-          using V clo eqU by (force intro: closedin_Union)
-      qed
-      show "continuous_map (subtopology ?X ({0..1} \<times> (V i - \<Union> (V ` {..<i})))) euclidean (h i)"  for i
-        by (auto simp add: subtopology_subtopology intro!: continuous_on_subset [OF conth])
-      show "\<And>i j x. x \<in> topspace ?X \<inter> {0..1} \<times> (V i - (\<Union>m<i. V m)) \<inter> {0..1} \<times> (V j - (\<Union>m<j. V m))
-                    \<Longrightarrow> h i x = h j x"
-        by clarsimp (metis lessThan_iff linorder_neqE_nat)
-    qed auto
-    show ?thesis
-    proof (simp add: homotopic_with eqU [symmetric], intro exI conjI ballI)
-      show "continuous_on ({0..1} \<times> \<Union>\<V>) \<zeta>"
-        using V eqU by (blast intro!:  continuous_on_subset [OF cont])
-      show "\<zeta>` ({0..1} \<times> \<Union>\<V>) \<subseteq> T"
-      proof clarsimp
-        fix t :: real and y :: "'a" and X :: "'a set"
-        assume "y \<in> X" "X \<in> \<V>" and t: "0 \<le> t" "t \<le> 1"
-        then obtain k where "y \<in> V k" and j: "\<forall>j<k. y \<notin> V j"
-          by (metis image_iff V wop)
-        with him t show "\<zeta>(t, y) \<in> T"
-          by (subst eq) force+
-      qed
-      fix X y
-      assume "X \<in> \<V>" "y \<in> X"
-      then obtain k where "y \<in> V k" and j: "\<forall>j<k. y \<notin> V j"
-        by (metis image_iff V wop)
-      then show "\<zeta>(0, y) = f y" and "\<zeta>(1, y) = g y"
-        by (subst eq [where i=k]; force simp: h0 h1)+ 
-    qed
-  qed
-qed
-
-lemma homotopic_on_components_eq:
-  fixes S :: "'a :: euclidean_space set" and T :: "'b :: euclidean_space set"
-  assumes S: "locally connected S \<or> compact S" and "ANR T"
-  shows "homotopic_with_canon (\<lambda>x. True) S T f g \<longleftrightarrow>
-         (continuous_on S f \<and> f ` S \<subseteq> T \<and> continuous_on S g \<and> g ` S \<subseteq> T) \<and>
-         (\<forall>C \<in> components S. homotopic_with_canon (\<lambda>x. True) C T f g)"
-    (is "?lhs \<longleftrightarrow> ?C \<and> ?rhs")
-proof -
-  have "continuous_on S f" "f ` S \<subseteq> T" "continuous_on S g" "g ` S \<subseteq> T" if ?lhs
-    using homotopic_with_imp_continuous homotopic_with_imp_subset1 homotopic_with_imp_subset2 that by blast+
-  moreover have "?lhs \<longleftrightarrow> ?rhs"
-    if contf: "continuous_on S f" and fim: "f ` S \<subseteq> T" and contg: "continuous_on S g" and gim: "g ` S \<subseteq> T"
-  proof
-    assume ?lhs
-    with that show ?rhs
-      by (simp add: homotopic_with_subset_left in_components_subset)
-  next
-    assume R: ?rhs
-    have "\<exists>U. C \<subseteq> U \<and> closedin (top_of_set S) U \<and>
-              openin (top_of_set S) U \<and>
-              homotopic_with_canon (\<lambda>x. True) U T f g" if C: "C \<in> components S" for C
-    proof -
-      have "C \<subseteq> S"
-        by (simp add: in_components_subset that)
-      show ?thesis
-        using S
-      proof
-        assume "locally connected S"
-        show ?thesis
-        proof (intro exI conjI)
-          show "closedin (top_of_set S) C"
-            by (simp add: closedin_component that)
-          show "openin (top_of_set S) C"
-            by (simp add: \<open>locally connected S\<close> openin_components_locally_connected that)
-          show "homotopic_with_canon (\<lambda>x. True) C T f g"
-            by (simp add: R that)
-        qed auto
-      next
-        assume "compact S"
-        have hom: "homotopic_with_canon (\<lambda>x. True) C T f g"
-          using R that by blast
-        obtain U where "C \<subseteq> U" and opeU: "openin (top_of_set S) U"
-                  and hom: "homotopic_with_canon (\<lambda>x. True) U T f g"
-          using homotopic_neighbourhood_extension [OF contf fim contg gim _ \<open>ANR T\<close> hom]
-            \<open>C \<in> components S\<close> closedin_component by blast
-        then obtain V where "open V" and V: "U = S \<inter> V"
-          by (auto simp: openin_open)
-        moreover have "locally compact S"
-          by (simp add: \<open>compact S\<close> closed_imp_locally_compact compact_imp_closed)
-        ultimately obtain K where opeK: "openin (top_of_set S) K" and "compact K" "C \<subseteq> K" "K \<subseteq> V"
-          by (metis C Int_subset_iff Sura_Bura_clopen_subset \<open>C \<subseteq> U\<close> \<open>compact S\<close> compact_components)
-        show ?thesis
-        proof (intro exI conjI)
-          show "closedin (top_of_set S) K"
-            by (meson \<open>compact K\<close> \<open>compact S\<close> closedin_compact_eq opeK openin_imp_subset)
-          show "homotopic_with_canon (\<lambda>x. True) K T f g"
-            using V \<open>K \<subseteq> V\<close> hom homotopic_with_subset_left opeK openin_imp_subset by fastforce
-        qed (use opeK \<open>C \<subseteq> K\<close> in auto)
-      qed
-    qed
-    then obtain \<phi> where \<phi>: "\<And>C. C \<in> components S \<Longrightarrow> C \<subseteq> \<phi> C"
-                  and clo\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> closedin (top_of_set S) (\<phi> C)"
-                  and ope\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> openin (top_of_set S) (\<phi> C)"
-                  and hom\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) (\<phi> C) T f g"
-      by metis
-    have Seq: "S = \<Union> (\<phi> ` components S)"
-    proof
-      show "S \<subseteq> \<Union> (\<phi> ` components S)"
-        by (metis Sup_mono Union_components \<phi> imageI)
-      show "\<Union> (\<phi> ` components S) \<subseteq> S"
-        using ope\<phi> openin_imp_subset by fastforce
-    qed
-    show ?lhs
-      apply (subst Seq)
-      apply (rule homotopic_on_clopen_Union)
-      using Seq clo\<phi> ope\<phi> hom\<phi> by auto
-  qed
-  ultimately show ?thesis by blast
-qed
-
-
-lemma cohomotopically_trivial_on_components:
-  fixes S :: "'a :: euclidean_space set" and T :: "'b :: euclidean_space set"
-  assumes S: "locally connected S \<or> compact S" and "ANR T"
-  shows
-   "(\<forall>f g. continuous_on S f \<longrightarrow> f ` S \<subseteq> T \<longrightarrow> continuous_on S g \<longrightarrow> g ` S \<subseteq> T \<longrightarrow>
-           homotopic_with_canon (\<lambda>x. True) S T f g)
-    \<longleftrightarrow>
-    (\<forall>C\<in>components S.
-        \<forall>f g. continuous_on C f \<longrightarrow> f ` C \<subseteq> T \<longrightarrow> continuous_on C g \<longrightarrow> g ` C \<subseteq> T \<longrightarrow>
-              homotopic_with_canon (\<lambda>x. True) C T f g)"
-     (is "?lhs = ?rhs")
-proof
-  assume L[rule_format]: ?lhs
-  show ?rhs
-  proof clarify
-    fix C f g
-    assume contf: "continuous_on C f" and fim: "f ` C \<subseteq> T"
-       and contg: "continuous_on C g" and gim: "g ` C \<subseteq> T" and C: "C \<in> components S"
-    obtain f' where contf': "continuous_on S f'" and f'im: "f' ` S \<subseteq> T" and f'f: "\<And>x. x \<in> C \<Longrightarrow> f' x = f x"
-      using extension_from_component [OF S \<open>ANR T\<close> C contf fim] by metis
-    obtain g' where contg': "continuous_on S g'" and g'im: "g' ` S \<subseteq> T" and g'g: "\<And>x. x \<in> C \<Longrightarrow> g' x = g x"
-      using extension_from_component [OF S \<open>ANR T\<close> C contg gim] by metis
-    have "homotopic_with_canon (\<lambda>x. True) C T f' g'"
-      using L [OF contf' f'im contg' g'im] homotopic_with_subset_left C in_components_subset by fastforce
-    then show "homotopic_with_canon (\<lambda>x. True) C T f g"
-      using f'f g'g homotopic_with_eq by force
-  qed
-next
-  assume R [rule_format]: ?rhs
-  show ?lhs
-  proof clarify
-    fix f g
-    assume contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
-      and contg: "continuous_on S g" and gim: "g ` S \<subseteq> T"
-    moreover have "homotopic_with_canon (\<lambda>x. True) C T f g" if "C \<in> components S" for C
-      using R [OF that]
-      by (meson contf contg continuous_on_subset fim gim image_mono in_components_subset order.trans that)
-    ultimately show "homotopic_with_canon (\<lambda>x. True) S T f g"
-      by (subst homotopic_on_components_eq [OF S \<open>ANR T\<close>]) auto
-  qed
-qed
-
-subsubsection\<open>The complement of a set and path-connectedness\<close>
-
-text\<open>Complement in dimension N > 1 of set homeomorphic to any interval in
- any dimension is (path-)connected. This naively generalizes the argument
- in Ryuji Maehara's paper "The Jordan curve theorem via the Brouwer fixed point theorem",
-American Mathematical Monthly 1984.\<close>
-
-lemma unbounded_components_complement_absolute_retract:
-  fixes S :: "'a::euclidean_space set"
-  assumes C: "C \<in> components(- S)" and S: "compact S" "AR S"
-    shows "\<not> bounded C"
-proof -
-  obtain y where y: "C = connected_component_set (- S) y" and "y \<notin> S"
-    using C by (auto simp: components_def)
-  have "open(- S)"
-    using S by (simp add: closed_open compact_eq_bounded_closed)
-  have "S retract_of UNIV"
-    using S compact_AR by blast
-  then obtain r where contr: "continuous_on UNIV r" and ontor: "range r \<subseteq> S"
-                  and r: "\<And>x. x \<in> S \<Longrightarrow> r x = x"
-    by (auto simp: retract_of_def retraction_def)
-  show ?thesis
-  proof
-    assume "bounded C"
-    have "connected_component_set (- S) y \<subseteq> S"
-    proof (rule frontier_subset_retraction)
-      show "bounded (connected_component_set (- S) y)"
-        using \<open>bounded C\<close> y by blast
-      show "frontier (connected_component_set (- S) y) \<subseteq> S"
-        using C \<open>compact S\<close> compact_eq_bounded_closed frontier_of_components_closed_complement y by blast
-      show "continuous_on (closure (connected_component_set (- S) y)) r"
-        by (blast intro: continuous_on_subset [OF contr])
-    qed (use ontor r in auto)
-    with \<open>y \<notin> S\<close> show False by force
-  qed
-qed
-
-lemma connected_complement_absolute_retract:
-  fixes S :: "'a::euclidean_space set"
-  assumes S: "compact S" "AR S" and 2: "2 \<le> DIM('a)"
-    shows "connected(- S)"
-proof -
-  have "S retract_of UNIV"
-    using S compact_AR by blast
-  show ?thesis
-    apply (clarsimp simp: connected_iff_connected_component_eq)
-    apply (rule cobounded_unique_unbounded_component [OF _ 2])
-      apply (simp add: \<open>compact S\<close> compact_imp_bounded)
-     apply (meson ComplI S componentsI unbounded_components_complement_absolute_retract)+
-    done
-qed
-
-lemma path_connected_complement_absolute_retract:
-  fixes S :: "'a::euclidean_space set"
-  assumes "compact S" "AR S" "2 \<le> DIM('a)"
-    shows "path_connected(- S)"
-  using connected_complement_absolute_retract [OF assms]
-  using \<open>compact S\<close> compact_eq_bounded_closed connected_open_path_connected by blast
-
-theorem connected_complement_homeomorphic_convex_compact:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes hom: "S homeomorphic T" and T: "convex T" "compact T" and 2: "2 \<le> DIM('a)"
-    shows "connected(- S)"
-proof (cases "S = {}")
-  case True
-  then show ?thesis
-    by (simp add: connected_UNIV)
-next
-  case False
-  show ?thesis
-  proof (rule connected_complement_absolute_retract)
-    show "compact S"
-      using \<open>compact T\<close> hom homeomorphic_compactness by auto
-    show "AR S"
-      by (meson AR_ANR False \<open>convex T\<close> convex_imp_ANR convex_imp_contractible hom homeomorphic_ANR_iff_ANR homeomorphic_contractible_eq)
-  qed (rule 2)
-qed
-
-corollary path_connected_complement_homeomorphic_convex_compact:
-  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
-  assumes hom: "S homeomorphic T" "convex T" "compact T" "2 \<le> DIM('a)"
-    shows "path_connected(- S)"
-  using connected_complement_homeomorphic_convex_compact [OF assms]
-  using \<open>compact T\<close> compact_eq_bounded_closed connected_open_path_connected hom homeomorphic_compactness by blast
-
-lemma path_connected_complement_homeomorphic_interval:
-  fixes S :: "'a::euclidean_space set"
-  assumes "S homeomorphic cbox a b" "2 \<le> DIM('a)"
-  shows "path_connected(-S)"
-  using assms compact_cbox convex_box(1) path_connected_complement_homeomorphic_convex_compact by blast
-
-lemma connected_complement_homeomorphic_interval:
-  fixes S :: "'a::euclidean_space set"
-  assumes "S homeomorphic cbox a b" "2 \<le> DIM('a)"
-  shows "connected(-S)"
-  using assms path_connected_complement_homeomorphic_interval path_connected_imp_connected by blast
-
 subsubsection \<open>Proving surjectivity via Brouwer fixpoint theorem\<close>
 
 lemma brouwer_surjective:
diff -r 0e2a065d6f31 -r de9c4ed2d5df src/HOL/Analysis/Cauchy_Integral_Theorem.thy
--- a/src/HOL/Analysis/Cauchy_Integral_Theorem.thy	Wed Sep 04 14:16:27 2019 +0100
+++ b/src/HOL/Analysis/Cauchy_Integral_Theorem.thy	Wed Sep 04 15:27:04 2019 +0100
@@ -3,7 +3,7 @@
 text\<open>By John Harrison et al.  Ported from HOL Light by L C Paulson (2015)\<close>
 
 theory Cauchy_Integral_Theorem
-imports Complex_Transcendental Henstock_Kurzweil_Integration Weierstrass_Theorems Ordered_Euclidean_Space
+imports Complex_Transcendental Henstock_Kurzweil_Integration Weierstrass_Theorems Retracts
 begin
 
 lemma leibniz_rule_holomorphic:
diff -r 0e2a065d6f31 -r de9c4ed2d5df src/HOL/Analysis/Further_Topology.thy
--- a/src/HOL/Analysis/Further_Topology.thy	Wed Sep 04 14:16:27 2019 +0100
+++ b/src/HOL/Analysis/Further_Topology.thy	Wed Sep 04 15:27:04 2019 +0100
@@ -3,21 +3,9 @@
 text\<open>Ported from HOL Light (moretop.ml) by L C Paulson\<close>
 
 theory Further_Topology
-  imports Weierstrass_Theorems Polytope Complex_Transcendental Equivalence_Lebesgue_Henstock_Integration
+  imports Weierstrass_Theorems Polytope Complex_Transcendental Equivalence_Lebesgue_Henstock_Integration Retracts
 begin
 
-subsection\<^marker>\<open>tag unimportant\<close>\<open>Retracts and intervals in ordered euclidean space\<close>
-
-lemma ANR_interval [iff]:
-  fixes a :: "'a::ordered_euclidean_space"
-  shows "ANR{a..b}"
-  by (simp add: interval_cbox)
-
-lemma ENR_interval [iff]:
-  fixes a :: "'a::ordered_euclidean_space"
-  shows "ENR{a..b}"
-  by (auto simp: interval_cbox)
-
 subsection\<open>A map from a sphere to a higher dimensional sphere is nullhomotopic\<close>
 
 lemma spheremap_lemma1:
diff -r 0e2a065d6f31 -r de9c4ed2d5df src/HOL/Analysis/Retracts.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Analysis/Retracts.thy	Wed Sep 04 15:27:04 2019 +0100
@@ -0,0 +1,2591 @@
+section \<open>Absolute Retracts, Absolute Neighbourhood Retracts and Euclidean Neighbourhood Retracts\<close>
+
+theory Retracts
+  imports Brouwer_Fixpoint Ordered_Euclidean_Space
+begin
+
+
+text \<open>Absolute retracts (AR), absolute neighbourhood retracts (ANR) and also Euclidean neighbourhood
+retracts (ENR). We define AR and ANR by specializing the standard definitions for a set to embedding
+in spaces of higher dimension.
+
+John Harrison writes: "This turns out to be sufficient (since any set in \<open>\<real>\<^sup>n\<close> can be
+embedded as a closed subset of a convex subset of \<open>\<real>\<^sup>n\<^sup>+\<^sup>1\<close>) to derive the usual
+definitions, but we need to split them into two implications because of the lack of type
+quantifiers. Then ENR turns out to be equivalent to ANR plus local compactness."\<close>
+
+definition\<^marker>\<open>tag important\<close> AR :: "'a::topological_space set \<Rightarrow> bool" where
+"AR S \<equiv> \<forall>U. \<forall>S'::('a * real) set.
+  S homeomorphic S' \<and> closedin (top_of_set U) S' \<longrightarrow> S' retract_of U"
+
+definition\<^marker>\<open>tag important\<close> ANR :: "'a::topological_space set \<Rightarrow> bool" where
+"ANR S \<equiv> \<forall>U. \<forall>S'::('a * real) set.
+  S homeomorphic S' \<and> closedin (top_of_set U) S'
+  \<longrightarrow> (\<exists>T. openin (top_of_set U) T \<and> S' retract_of T)"
+
+definition\<^marker>\<open>tag important\<close> ENR :: "'a::topological_space set \<Rightarrow> bool" where
+"ENR S \<equiv> \<exists>U. open U \<and> S retract_of U"
+
+text \<open>First, show that we do indeed get the "usual" properties of ARs and ANRs.\<close>
+
+lemma AR_imp_absolute_extensor:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+  assumes "AR S" and contf: "continuous_on T f" and "f ` T \<subseteq> S"
+      and cloUT: "closedin (top_of_set U) T"
+  obtains g where "continuous_on U g" "g ` U \<subseteq> S" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
+proof -
+  have "aff_dim S < int (DIM('b \<times> real))"
+    using aff_dim_le_DIM [of S] by simp
+  then obtain C and S' :: "('b * real) set"
+          where C: "convex C" "C \<noteq> {}"
+            and cloCS: "closedin (top_of_set C) S'"
+            and hom: "S homeomorphic S'"
+    by (metis that homeomorphic_closedin_convex)
+  then have "S' retract_of C"
+    using \<open>AR S\<close> by (simp add: AR_def)
+  then obtain r where "S' \<subseteq> C" and contr: "continuous_on C r"
+                  and "r ` C \<subseteq> S'" and rid: "\<And>x. x\<in>S' \<Longrightarrow> r x = x"
+    by (auto simp: retraction_def retract_of_def)
+  obtain g h where "homeomorphism S S' g h"
+    using hom by (force simp: homeomorphic_def)
+  then have "continuous_on (f ` T) g"
+    by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def)
+  then have contgf: "continuous_on T (g \<circ> f)"
+    by (metis continuous_on_compose contf)
+  have gfTC: "(g \<circ> f) ` T \<subseteq> C"
+  proof -
+    have "g ` S = S'"
+      by (metis (no_types) \<open>homeomorphism S S' g h\<close> homeomorphism_def)
+    with \<open>S' \<subseteq> C\<close> \<open>f ` T \<subseteq> S\<close> show ?thesis by force
+  qed
+  obtain f' where f': "continuous_on U f'"  "f' ` U \<subseteq> C"
+                      "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x"
+    by (metis Dugundji [OF C cloUT contgf gfTC])
+  show ?thesis
+  proof (rule_tac g = "h \<circ> r \<circ> f'" in that)
+    show "continuous_on U (h \<circ> r \<circ> f')"
+      apply (intro continuous_on_compose f')
+       using continuous_on_subset contr f' apply blast
+      by (meson \<open>homeomorphism S S' g h\<close> \<open>r ` C \<subseteq> S'\<close> continuous_on_subset \<open>f' ` U \<subseteq> C\<close> homeomorphism_def image_mono)
+    show "(h \<circ> r \<circ> f') ` U \<subseteq> S"
+      using \<open>homeomorphism S S' g h\<close> \<open>r ` C \<subseteq> S'\<close> \<open>f' ` U \<subseteq> C\<close>
+      by (fastforce simp: homeomorphism_def)
+    show "\<And>x. x \<in> T \<Longrightarrow> (h \<circ> r \<circ> f') x = f x"
+      using \<open>homeomorphism S S' g h\<close> \<open>f ` T \<subseteq> S\<close> f'
+      by (auto simp: rid homeomorphism_def)
+  qed
+qed
+
+lemma AR_imp_absolute_retract:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "AR S" "S homeomorphic S'"
+      and clo: "closedin (top_of_set U) S'"
+    shows "S' retract_of U"
+proof -
+  obtain g h where hom: "homeomorphism S S' g h"
+    using assms by (force simp: homeomorphic_def)
+  have h: "continuous_on S' h" " h ` S' \<subseteq> S"
+    using hom homeomorphism_def apply blast
+    apply (metis hom equalityE homeomorphism_def)
+    done
+  obtain h' where h': "continuous_on U h'" "h' ` U \<subseteq> S"
+              and h'h: "\<And>x. x \<in> S' \<Longrightarrow> h' x = h x"
+    by (blast intro: AR_imp_absolute_extensor [OF \<open>AR S\<close> h clo])
+  have [simp]: "S' \<subseteq> U" using clo closedin_limpt by blast
+  show ?thesis
+  proof (simp add: retraction_def retract_of_def, intro exI conjI)
+    show "continuous_on U (g \<circ> h')"
+      apply (intro continuous_on_compose h')
+      apply (meson hom continuous_on_subset h' homeomorphism_cont1)
+      done
+    show "(g \<circ> h') ` U \<subseteq> S'"
+      using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
+    show "\<forall>x\<in>S'. (g \<circ> h') x = x"
+      by clarsimp (metis h'h hom homeomorphism_def)
+  qed
+qed
+
+lemma AR_imp_absolute_retract_UNIV:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "AR S" and hom: "S homeomorphic S'"
+      and clo: "closed S'"
+    shows "S' retract_of UNIV"
+apply (rule AR_imp_absolute_retract [OF \<open>AR S\<close> hom])
+using clo closed_closedin by auto
+
+lemma absolute_extensor_imp_AR:
+  fixes S :: "'a::euclidean_space set"
+  assumes "\<And>f :: 'a * real \<Rightarrow> 'a.
+           \<And>U T. \<lbrakk>continuous_on T f;  f ` T \<subseteq> S;
+                  closedin (top_of_set U) T\<rbrakk>
+                 \<Longrightarrow> \<exists>g. continuous_on U g \<and> g ` U \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)"
+  shows "AR S"
+proof (clarsimp simp: AR_def)
+  fix U and T :: "('a * real) set"
+  assume "S homeomorphic T" and clo: "closedin (top_of_set U) T"
+  then obtain g h where hom: "homeomorphism S T g h"
+    by (force simp: homeomorphic_def)
+  have h: "continuous_on T h" " h ` T \<subseteq> S"
+    using hom homeomorphism_def apply blast
+    apply (metis hom equalityE homeomorphism_def)
+    done
+  obtain h' where h': "continuous_on U h'" "h' ` U \<subseteq> S"
+              and h'h: "\<forall>x\<in>T. h' x = h x"
+    using assms [OF h clo] by blast
+  have [simp]: "T \<subseteq> U"
+    using clo closedin_imp_subset by auto
+  show "T retract_of U"
+  proof (simp add: retraction_def retract_of_def, intro exI conjI)
+    show "continuous_on U (g \<circ> h')"
+      apply (intro continuous_on_compose h')
+      apply (meson hom continuous_on_subset h' homeomorphism_cont1)
+      done
+    show "(g \<circ> h') ` U \<subseteq> T"
+      using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
+    show "\<forall>x\<in>T. (g \<circ> h') x = x"
+      by clarsimp (metis h'h hom homeomorphism_def)
+  qed
+qed
+
+lemma AR_eq_absolute_extensor:
+  fixes S :: "'a::euclidean_space set"
+  shows "AR S \<longleftrightarrow>
+       (\<forall>f :: 'a * real \<Rightarrow> 'a.
+        \<forall>U T. continuous_on T f \<longrightarrow> f ` T \<subseteq> S \<longrightarrow>
+               closedin (top_of_set U) T \<longrightarrow>
+                (\<exists>g. continuous_on U g \<and> g ` U \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)))"
+apply (rule iffI)
+ apply (metis AR_imp_absolute_extensor)
+apply (simp add: absolute_extensor_imp_AR)
+done
+
+lemma AR_imp_retract:
+  fixes S :: "'a::euclidean_space set"
+  assumes "AR S \<and> closedin (top_of_set U) S"
+    shows "S retract_of U"
+using AR_imp_absolute_retract assms homeomorphic_refl by blast
+
+lemma AR_homeomorphic_AR:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "AR T" "S homeomorphic T"
+    shows "AR S"
+unfolding AR_def
+by (metis assms AR_imp_absolute_retract homeomorphic_trans [of _ S] homeomorphic_sym)
+
+lemma homeomorphic_AR_iff_AR:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  shows "S homeomorphic T \<Longrightarrow> AR S \<longleftrightarrow> AR T"
+by (metis AR_homeomorphic_AR homeomorphic_sym)
+
+
+lemma ANR_imp_absolute_neighbourhood_extensor:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+  assumes "ANR S" and contf: "continuous_on T f" and "f ` T \<subseteq> S"
+      and cloUT: "closedin (top_of_set U) T"
+  obtains V g where "T \<subseteq> V" "openin (top_of_set U) V"
+                    "continuous_on V g"
+                    "g ` V \<subseteq> S" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
+proof -
+  have "aff_dim S < int (DIM('b \<times> real))"
+    using aff_dim_le_DIM [of S] by simp
+  then obtain C and S' :: "('b * real) set"
+          where C: "convex C" "C \<noteq> {}"
+            and cloCS: "closedin (top_of_set C) S'"
+            and hom: "S homeomorphic S'"
+    by (metis that homeomorphic_closedin_convex)
+  then obtain D where opD: "openin (top_of_set C) D" and "S' retract_of D"
+    using \<open>ANR S\<close> by (auto simp: ANR_def)
+  then obtain r where "S' \<subseteq> D" and contr: "continuous_on D r"
+                  and "r ` D \<subseteq> S'" and rid: "\<And>x. x \<in> S' \<Longrightarrow> r x = x"
+    by (auto simp: retraction_def retract_of_def)
+  obtain g h where homgh: "homeomorphism S S' g h"
+    using hom by (force simp: homeomorphic_def)
+  have "continuous_on (f ` T) g"
+    by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def homgh)
+  then have contgf: "continuous_on T (g \<circ> f)"
+    by (intro continuous_on_compose contf)
+  have gfTC: "(g \<circ> f) ` T \<subseteq> C"
+  proof -
+    have "g ` S = S'"
+      by (metis (no_types) homeomorphism_def homgh)
+    then show ?thesis
+      by (metis (no_types) assms(3) cloCS closedin_def image_comp image_mono order.trans topspace_euclidean_subtopology)
+  qed
+  obtain f' where contf': "continuous_on U f'"
+              and "f' ` U \<subseteq> C"
+              and eq: "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x"
+    by (metis Dugundji [OF C cloUT contgf gfTC])
+  show ?thesis
+  proof (rule_tac V = "U \<inter> f' -` D" and g = "h \<circ> r \<circ> f'" in that)
+    show "T \<subseteq> U \<inter> f' -` D"
+      using cloUT closedin_imp_subset \<open>S' \<subseteq> D\<close> \<open>f ` T \<subseteq> S\<close> eq homeomorphism_image1 homgh
+      by fastforce
+    show ope: "openin (top_of_set U) (U \<inter> f' -` D)"
+      using  \<open>f' ` U \<subseteq> C\<close> by (auto simp: opD contf' continuous_openin_preimage)
+    have conth: "continuous_on (r ` f' ` (U \<inter> f' -` D)) h"
+      apply (rule continuous_on_subset [of S'])
+      using homeomorphism_def homgh apply blast
+      using \<open>r ` D \<subseteq> S'\<close> by blast
+    show "continuous_on (U \<inter> f' -` D) (h \<circ> r \<circ> f')"
+      apply (intro continuous_on_compose conth
+                   continuous_on_subset [OF contr] continuous_on_subset [OF contf'], auto)
+      done
+    show "(h \<circ> r \<circ> f') ` (U \<inter> f' -` D) \<subseteq> S"
+      using \<open>homeomorphism S S' g h\<close>  \<open>f' ` U \<subseteq> C\<close>  \<open>r ` D \<subseteq> S'\<close>
+      by (auto simp: homeomorphism_def)
+    show "\<And>x. x \<in> T \<Longrightarrow> (h \<circ> r \<circ> f') x = f x"
+      using \<open>homeomorphism S S' g h\<close> \<open>f ` T \<subseteq> S\<close> eq
+      by (auto simp: rid homeomorphism_def)
+  qed
+qed
+
+
+corollary ANR_imp_absolute_neighbourhood_retract:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "ANR S" "S homeomorphic S'"
+      and clo: "closedin (top_of_set U) S'"
+  obtains V where "openin (top_of_set U) V" "S' retract_of V"
+proof -
+  obtain g h where hom: "homeomorphism S S' g h"
+    using assms by (force simp: homeomorphic_def)
+  have h: "continuous_on S' h" " h ` S' \<subseteq> S"
+    using hom homeomorphism_def apply blast
+    apply (metis hom equalityE homeomorphism_def)
+    done
+    from ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo]
+  obtain V h' where "S' \<subseteq> V" and opUV: "openin (top_of_set U) V"
+                and h': "continuous_on V h'" "h' ` V \<subseteq> S"
+                and h'h:"\<And>x. x \<in> S' \<Longrightarrow> h' x = h x"
+    by (blast intro: ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo])
+  have "S' retract_of V"
+  proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>S' \<subseteq> V\<close>)
+    show "continuous_on V (g \<circ> h')"
+      apply (intro continuous_on_compose h')
+      apply (meson hom continuous_on_subset h' homeomorphism_cont1)
+      done
+    show "(g \<circ> h') ` V \<subseteq> S'"
+      using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
+    show "\<forall>x\<in>S'. (g \<circ> h') x = x"
+      by clarsimp (metis h'h hom homeomorphism_def)
+  qed
+  then show ?thesis
+    by (rule that [OF opUV])
+qed
+
+corollary ANR_imp_absolute_neighbourhood_retract_UNIV:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "ANR S" and hom: "S homeomorphic S'" and clo: "closed S'"
+  obtains V where "open V" "S' retract_of V"
+  using ANR_imp_absolute_neighbourhood_retract [OF \<open>ANR S\<close> hom]
+by (metis clo closed_closedin open_openin subtopology_UNIV)
+
+corollary neighbourhood_extension_into_ANR:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+  assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> T" and "ANR T" "closed S"
+  obtains V g where "S \<subseteq> V" "open V" "continuous_on V g"
+                    "g ` V \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
+  using ANR_imp_absolute_neighbourhood_extensor [OF  \<open>ANR T\<close> contf fim]
+  by (metis \<open>closed S\<close> closed_closedin open_openin subtopology_UNIV)
+
+lemma absolute_neighbourhood_extensor_imp_ANR:
+  fixes S :: "'a::euclidean_space set"
+  assumes "\<And>f :: 'a * real \<Rightarrow> 'a.
+           \<And>U T. \<lbrakk>continuous_on T f;  f ` T \<subseteq> S;
+                  closedin (top_of_set U) T\<rbrakk>
+                 \<Longrightarrow> \<exists>V g. T \<subseteq> V \<and> openin (top_of_set U) V \<and>
+                       continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)"
+  shows "ANR S"
+proof (clarsimp simp: ANR_def)
+  fix U and T :: "('a * real) set"
+  assume "S homeomorphic T" and clo: "closedin (top_of_set U) T"
+  then obtain g h where hom: "homeomorphism S T g h"
+    by (force simp: homeomorphic_def)
+  have h: "continuous_on T h" " h ` T \<subseteq> S"
+    using hom homeomorphism_def apply blast
+    apply (metis hom equalityE homeomorphism_def)
+    done
+  obtain V h' where "T \<subseteq> V" and opV: "openin (top_of_set U) V"
+                and h': "continuous_on V h'" "h' ` V \<subseteq> S"
+              and h'h: "\<forall>x\<in>T. h' x = h x"
+    using assms [OF h clo] by blast
+  have [simp]: "T \<subseteq> U"
+    using clo closedin_imp_subset by auto
+  have "T retract_of V"
+  proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>T \<subseteq> V\<close>)
+    show "continuous_on V (g \<circ> h')"
+      apply (intro continuous_on_compose h')
+      apply (meson hom continuous_on_subset h' homeomorphism_cont1)
+      done
+    show "(g \<circ> h') ` V \<subseteq> T"
+      using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
+    show "\<forall>x\<in>T. (g \<circ> h') x = x"
+      by clarsimp (metis h'h hom homeomorphism_def)
+  qed
+  then show "\<exists>V. openin (top_of_set U) V \<and> T retract_of V"
+    using opV by blast
+qed
+
+lemma ANR_eq_absolute_neighbourhood_extensor:
+  fixes S :: "'a::euclidean_space set"
+  shows "ANR S \<longleftrightarrow>
+         (\<forall>f :: 'a * real \<Rightarrow> 'a.
+          \<forall>U T. continuous_on T f \<longrightarrow> f ` T \<subseteq> S \<longrightarrow>
+                closedin (top_of_set U) T \<longrightarrow>
+               (\<exists>V g. T \<subseteq> V \<and> openin (top_of_set U) V \<and>
+                       continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)))"
+apply (rule iffI)
+ apply (metis ANR_imp_absolute_neighbourhood_extensor)
+apply (simp add: absolute_neighbourhood_extensor_imp_ANR)
+done
+
+lemma ANR_imp_neighbourhood_retract:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ANR S" "closedin (top_of_set U) S"
+  obtains V where "openin (top_of_set U) V" "S retract_of V"
+using ANR_imp_absolute_neighbourhood_retract assms homeomorphic_refl by blast
+
+lemma ANR_imp_absolute_closed_neighbourhood_retract:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "ANR S" "S homeomorphic S'" and US': "closedin (top_of_set U) S'"
+  obtains V W
+    where "openin (top_of_set U) V"
+          "closedin (top_of_set U) W"
+          "S' \<subseteq> V" "V \<subseteq> W" "S' retract_of W"
+proof -
+  obtain Z where "openin (top_of_set U) Z" and S'Z: "S' retract_of Z"
+    by (blast intro: assms ANR_imp_absolute_neighbourhood_retract)
+  then have UUZ: "closedin (top_of_set U) (U - Z)"
+    by auto
+  have "S' \<inter> (U - Z) = {}"
+    using \<open>S' retract_of Z\<close> closedin_retract closedin_subtopology by fastforce
+  then obtain V W
+      where "openin (top_of_set U) V"
+        and "openin (top_of_set U) W"
+        and "S' \<subseteq> V" "U - Z \<subseteq> W" "V \<inter> W = {}"
+      using separation_normal_local [OF US' UUZ]  by auto
+  moreover have "S' retract_of U - W"
+    apply (rule retract_of_subset [OF S'Z])
+    using US' \<open>S' \<subseteq> V\<close> \<open>V \<inter> W = {}\<close> closedin_subset apply fastforce
+    using Diff_subset_conv \<open>U - Z \<subseteq> W\<close> by blast
+  ultimately show ?thesis
+    apply (rule_tac V=V and W = "U-W" in that)
+    using openin_imp_subset apply force+
+    done
+qed
+
+lemma ANR_imp_closed_neighbourhood_retract:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ANR S" "closedin (top_of_set U) S"
+  obtains V W where "openin (top_of_set U) V"
+                    "closedin (top_of_set U) W"
+                    "S \<subseteq> V" "V \<subseteq> W" "S retract_of W"
+by (meson ANR_imp_absolute_closed_neighbourhood_retract assms homeomorphic_refl)
+
+lemma ANR_homeomorphic_ANR:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "ANR T" "S homeomorphic T"
+    shows "ANR S"
+unfolding ANR_def
+by (metis assms ANR_imp_absolute_neighbourhood_retract homeomorphic_trans [of _ S] homeomorphic_sym)
+
+lemma homeomorphic_ANR_iff_ANR:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  shows "S homeomorphic T \<Longrightarrow> ANR S \<longleftrightarrow> ANR T"
+by (metis ANR_homeomorphic_ANR homeomorphic_sym)
+
+subsection \<open>Analogous properties of ENRs\<close>
+
+lemma ENR_imp_absolute_neighbourhood_retract:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "ENR S" and hom: "S homeomorphic S'"
+      and "S' \<subseteq> U"
+  obtains V where "openin (top_of_set U) V" "S' retract_of V"
+proof -
+  obtain X where "open X" "S retract_of X"
+    using \<open>ENR S\<close> by (auto simp: ENR_def)
+  then obtain r where "retraction X S r"
+    by (auto simp: retract_of_def)
+  have "locally compact S'"
+    using retract_of_locally_compact open_imp_locally_compact
+          homeomorphic_local_compactness \<open>S retract_of X\<close> \<open>open X\<close> hom by blast
+  then obtain W where UW: "openin (top_of_set U) W"
+                  and WS': "closedin (top_of_set W) S'"
+    apply (rule locally_compact_closedin_open)
+    apply (rename_tac W)
+    apply (rule_tac W = "U \<inter> W" in that, blast)
+    by (simp add: \<open>S' \<subseteq> U\<close> closedin_limpt)
+  obtain f g where hom: "homeomorphism S S' f g"
+    using assms by (force simp: homeomorphic_def)
+  have contg: "continuous_on S' g"
+    using hom homeomorphism_def by blast
+  moreover have "g ` S' \<subseteq> S" by (metis hom equalityE homeomorphism_def)
+  ultimately obtain h where conth: "continuous_on W h" and hg: "\<And>x. x \<in> S' \<Longrightarrow> h x = g x"
+    using Tietze_unbounded [of S' g W] WS' by blast
+  have "W \<subseteq> U" using UW openin_open by auto
+  have "S' \<subseteq> W" using WS' closedin_closed by auto
+  have him: "\<And>x. x \<in> S' \<Longrightarrow> h x \<in> X"
+    by (metis (no_types) \<open>S retract_of X\<close> hg hom homeomorphism_def image_insert insert_absorb insert_iff retract_of_imp_subset subset_eq)
+  have "S' retract_of (W \<inter> h -` X)"
+  proof (simp add: retraction_def retract_of_def, intro exI conjI)
+    show "S' \<subseteq> W" "S' \<subseteq> h -` X"
+      using him WS' closedin_imp_subset by blast+
+    show "continuous_on (W \<inter> h -` X) (f \<circ> r \<circ> h)"
+    proof (intro continuous_on_compose)
+      show "continuous_on (W \<inter> h -` X) h"
+        by (meson conth continuous_on_subset inf_le1)
+      show "continuous_on (h ` (W \<inter> h -` X)) r"
+      proof -
+        have "h ` (W \<inter> h -` X) \<subseteq> X"
+          by blast
+        then show "continuous_on (h ` (W \<inter> h -` X)) r"
+          by (meson \<open>retraction X S r\<close> continuous_on_subset retraction)
+      qed
+      show "continuous_on (r ` h ` (W \<inter> h -` X)) f"
+        apply (rule continuous_on_subset [of S])
+         using hom homeomorphism_def apply blast
+        apply clarify
+        apply (meson \<open>retraction X S r\<close> subsetD imageI retraction_def)
+        done
+    qed
+    show "(f \<circ> r \<circ> h) ` (W \<inter> h -` X) \<subseteq> S'"
+      using \<open>retraction X S r\<close> hom
+      by (auto simp: retraction_def homeomorphism_def)
+    show "\<forall>x\<in>S'. (f \<circ> r \<circ> h) x = x"
+      using \<open>retraction X S r\<close> hom by (auto simp: retraction_def homeomorphism_def hg)
+  qed
+  then show ?thesis
+    apply (rule_tac V = "W \<inter> h -` X" in that)
+     apply (rule openin_trans [OF _ UW])
+     using \<open>continuous_on W h\<close> \<open>open X\<close> continuous_openin_preimage_eq apply blast+
+     done
+qed
+
+corollary ENR_imp_absolute_neighbourhood_retract_UNIV:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "ENR S" "S homeomorphic S'"
+  obtains T' where "open T'" "S' retract_of T'"
+by (metis ENR_imp_absolute_neighbourhood_retract UNIV_I assms(1) assms(2) open_openin subsetI subtopology_UNIV)
+
+lemma ENR_homeomorphic_ENR:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "ENR T" "S homeomorphic T"
+    shows "ENR S"
+unfolding ENR_def
+by (meson ENR_imp_absolute_neighbourhood_retract_UNIV assms homeomorphic_sym)
+
+lemma homeomorphic_ENR_iff_ENR:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "S homeomorphic T"
+    shows "ENR S \<longleftrightarrow> ENR T"
+by (meson ENR_homeomorphic_ENR assms homeomorphic_sym)
+
+lemma ENR_translation:
+  fixes S :: "'a::euclidean_space set"
+  shows "ENR(image (\<lambda>x. a + x) S) \<longleftrightarrow> ENR S"
+by (meson homeomorphic_sym homeomorphic_translation homeomorphic_ENR_iff_ENR)
+
+lemma ENR_linear_image_eq:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+  assumes "linear f" "inj f"
+  shows "ENR (image f S) \<longleftrightarrow> ENR S"
+apply (rule homeomorphic_ENR_iff_ENR)
+using assms homeomorphic_sym linear_homeomorphic_image by auto
+
+text \<open>Some relations among the concepts. We also relate AR to being a retract of UNIV, which is
+often a more convenient proxy in the closed case.\<close>
+
+lemma AR_imp_ANR: "AR S \<Longrightarrow> ANR S"
+  using ANR_def AR_def by fastforce
+
+lemma ENR_imp_ANR:
+  fixes S :: "'a::euclidean_space set"
+  shows "ENR S \<Longrightarrow> ANR S"
+apply (simp add: ANR_def)
+by (metis ENR_imp_absolute_neighbourhood_retract closedin_imp_subset)
+
+lemma ENR_ANR:
+  fixes S :: "'a::euclidean_space set"
+  shows "ENR S \<longleftrightarrow> ANR S \<and> locally compact S"
+proof
+  assume "ENR S"
+  then have "locally compact S"
+    using ENR_def open_imp_locally_compact retract_of_locally_compact by auto
+  then show "ANR S \<and> locally compact S"
+    using ENR_imp_ANR \<open>ENR S\<close> by blast
+next
+  assume "ANR S \<and> locally compact S"
+  then have "ANR S" "locally compact S" by auto
+  then obtain T :: "('a * real) set" where "closed T" "S homeomorphic T"
+    using locally_compact_homeomorphic_closed
+    by (metis DIM_prod DIM_real Suc_eq_plus1 lessI)
+  then show "ENR S"
+    using \<open>ANR S\<close>
+    apply (simp add: ANR_def)
+    apply (drule_tac x=UNIV in spec)
+    apply (drule_tac x=T in spec, clarsimp)
+    apply (meson ENR_def ENR_homeomorphic_ENR open_openin)
+    done
+qed
+
+
+lemma AR_ANR:
+  fixes S :: "'a::euclidean_space set"
+  shows "AR S \<longleftrightarrow> ANR S \<and> contractible S \<and> S \<noteq> {}"
+        (is "?lhs = ?rhs")
+proof
+  assume ?lhs
+  obtain C and S' :: "('a * real) set"
+    where "convex C" "C \<noteq> {}" "closedin (top_of_set C) S'" "S homeomorphic S'"
+      apply (rule homeomorphic_closedin_convex [of S, where 'n = "'a * real"])
+      using aff_dim_le_DIM [of S] by auto
+  with \<open>AR S\<close> have "contractible S"
+    apply (simp add: AR_def)
+    apply (drule_tac x=C in spec)
+    apply (drule_tac x="S'" in spec, simp)
+    using convex_imp_contractible homeomorphic_contractible_eq retract_of_contractible by fastforce
+  with \<open>AR S\<close> show ?rhs
+    apply (auto simp: AR_imp_ANR)
+    apply (force simp: AR_def)
+    done
+next
+  assume ?rhs
+  then obtain a and h:: "real \<times> 'a \<Rightarrow> 'a"
+      where conth: "continuous_on ({0..1} \<times> S) h"
+        and hS: "h ` ({0..1} \<times> S) \<subseteq> S"
+        and [simp]: "\<And>x. h(0, x) = x"
+        and [simp]: "\<And>x. h(1, x) = a"
+        and "ANR S" "S \<noteq> {}"
+    by (auto simp: contractible_def homotopic_with_def)
+  then have "a \<in> S"
+    by (metis all_not_in_conv atLeastAtMost_iff image_subset_iff mem_Sigma_iff order_refl zero_le_one)
+  have "\<exists>g. continuous_on W g \<and> g ` W \<subseteq> S \<and> (\<forall>x\<in>T. g x = f x)"
+         if      f: "continuous_on T f" "f ` T \<subseteq> S"
+            and WT: "closedin (top_of_set W) T"
+         for W T and f :: "'a \<times> real \<Rightarrow> 'a"
+  proof -
+    obtain U g
+      where "T \<subseteq> U" and WU: "openin (top_of_set W) U"
+        and contg: "continuous_on U g"
+        and "g ` U \<subseteq> S" and gf: "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
+      using iffD1 [OF ANR_eq_absolute_neighbourhood_extensor \<open>ANR S\<close>, rule_format, OF f WT]
+      by auto
+    have WWU: "closedin (top_of_set W) (W - U)"
+      using WU closedin_diff by fastforce
+    moreover have "(W - U) \<inter> T = {}"
+      using \<open>T \<subseteq> U\<close> by auto
+    ultimately obtain V V'
+      where WV': "openin (top_of_set W) V'"
+        and WV: "openin (top_of_set W) V"
+        and "W - U \<subseteq> V'" "T \<subseteq> V" "V' \<inter> V = {}"
+      using separation_normal_local [of W "W-U" T] WT by blast
+    then have WVT: "T \<inter> (W - V) = {}"
+      by auto
+    have WWV: "closedin (top_of_set W) (W - V)"
+      using WV closedin_diff by fastforce
+    obtain j :: " 'a \<times> real \<Rightarrow> real"
+      where contj: "continuous_on W j"
+        and j:  "\<And>x. x \<in> W \<Longrightarrow> j x \<in> {0..1}"
+        and j0: "\<And>x. x \<in> W - V \<Longrightarrow> j x = 1"
+        and j1: "\<And>x. x \<in> T \<Longrightarrow> j x = 0"
+      by (rule Urysohn_local [OF WT WWV WVT, of 0 "1::real"]) (auto simp: in_segment)
+    have Weq: "W = (W - V) \<union> (W - V')"
+      using \<open>V' \<inter> V = {}\<close> by force
+    show ?thesis
+    proof (intro conjI exI)
+      have *: "continuous_on (W - V') (\<lambda>x. h (j x, g x))"
+        apply (rule continuous_on_compose2 [OF conth continuous_on_Pair])
+          apply (rule continuous_on_subset [OF contj Diff_subset])
+         apply (rule continuous_on_subset [OF contg])
+         apply (metis Diff_subset_conv Un_commute \<open>W - U \<subseteq> V'\<close>)
+        using j \<open>g ` U \<subseteq> S\<close> \<open>W - U \<subseteq> V'\<close> apply fastforce
+        done
+      show "continuous_on W (\<lambda>x. if x \<in> W - V then a else h (j x, g x))"
+        apply (subst Weq)
+        apply (rule continuous_on_cases_local)
+            apply (simp_all add: Weq [symmetric] WWV continuous_on_const *)
+          using WV' closedin_diff apply fastforce
+         apply (auto simp: j0 j1)
+        done
+    next
+      have "h (j (x, y), g (x, y)) \<in> S" if "(x, y) \<in> W" "(x, y) \<in> V" for x y
+      proof -
+        have "j(x, y) \<in> {0..1}"
+          using j that by blast
+        moreover have "g(x, y) \<in> S"
+          using \<open>V' \<inter> V = {}\<close> \<open>W - U \<subseteq> V'\<close> \<open>g ` U \<subseteq> S\<close> that by fastforce
+        ultimately show ?thesis
+          using hS by blast
+      qed
+      with \<open>a \<in> S\<close> \<open>g ` U \<subseteq> S\<close>
+      show "(\<lambda>x. if x \<in> W - V then a else h (j x, g x)) ` W \<subseteq> S"
+        by auto
+    next
+      show "\<forall>x\<in>T. (if x \<in> W - V then a else h (j x, g x)) = f x"
+        using \<open>T \<subseteq> V\<close> by (auto simp: j0 j1 gf)
+    qed
+  qed
+  then show ?lhs
+    by (simp add: AR_eq_absolute_extensor)
+qed
+
+
+lemma ANR_retract_of_ANR:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ANR T" "S retract_of T"
+  shows "ANR S"
+using assms
+apply (simp add: ANR_eq_absolute_neighbourhood_extensor retract_of_def retraction_def)
+apply (clarsimp elim!: all_forward)
+apply (erule impCE, metis subset_trans)
+apply (clarsimp elim!: ex_forward)
+apply (rule_tac x="r \<circ> g" in exI)
+by (metis comp_apply continuous_on_compose continuous_on_subset subsetD imageI image_comp image_mono subset_trans)
+
+lemma AR_retract_of_AR:
+  fixes S :: "'a::euclidean_space set"
+  shows "\<lbrakk>AR T; S retract_of T\<rbrakk> \<Longrightarrow> AR S"
+using ANR_retract_of_ANR AR_ANR retract_of_contractible by fastforce
+
+lemma ENR_retract_of_ENR:
+   "\<lbrakk>ENR T; S retract_of T\<rbrakk> \<Longrightarrow> ENR S"
+by (meson ENR_def retract_of_trans)
+
+lemma retract_of_UNIV:
+  fixes S :: "'a::euclidean_space set"
+  shows "S retract_of UNIV \<longleftrightarrow> AR S \<and> closed S"
+by (metis AR_ANR AR_imp_retract ENR_def ENR_imp_ANR closed_UNIV closed_closedin contractible_UNIV empty_not_UNIV open_UNIV retract_of_closed retract_of_contractible retract_of_empty(1) subtopology_UNIV)
+
+lemma compact_AR:
+  fixes S :: "'a::euclidean_space set"
+  shows "compact S \<and> AR S \<longleftrightarrow> compact S \<and> S retract_of UNIV"
+using compact_imp_closed retract_of_UNIV by blast
+
+text \<open>More properties of ARs, ANRs and ENRs\<close>
+
+lemma not_AR_empty [simp]: "\<not> AR({})"
+  by (auto simp: AR_def)
+
+lemma ENR_empty [simp]: "ENR {}"
+  by (simp add: ENR_def)
+
+lemma ANR_empty [simp]: "ANR ({} :: 'a::euclidean_space set)"
+  by (simp add: ENR_imp_ANR)
+
+lemma convex_imp_AR:
+  fixes S :: "'a::euclidean_space set"
+  shows "\<lbrakk>convex S; S \<noteq> {}\<rbrakk> \<Longrightarrow> AR S"
+apply (rule absolute_extensor_imp_AR)
+apply (rule Dugundji, assumption+)
+by blast
+
+lemma convex_imp_ANR:
+  fixes S :: "'a::euclidean_space set"
+  shows "convex S \<Longrightarrow> ANR S"
+using ANR_empty AR_imp_ANR convex_imp_AR by blast
+
+lemma ENR_convex_closed:
+  fixes S :: "'a::euclidean_space set"
+  shows "\<lbrakk>closed S; convex S\<rbrakk> \<Longrightarrow> ENR S"
+using ENR_def ENR_empty convex_imp_AR retract_of_UNIV by blast
+
+lemma AR_UNIV [simp]: "AR (UNIV :: 'a::euclidean_space set)"
+  using retract_of_UNIV by auto
+
+lemma ANR_UNIV [simp]: "ANR (UNIV :: 'a::euclidean_space set)"
+  by (simp add: AR_imp_ANR)
+
+lemma ENR_UNIV [simp]:"ENR UNIV"
+  using ENR_def by blast
+
+lemma AR_singleton:
+    fixes a :: "'a::euclidean_space"
+    shows "AR {a}"
+  using retract_of_UNIV by blast
+
+lemma ANR_singleton:
+    fixes a :: "'a::euclidean_space"
+    shows "ANR {a}"
+  by (simp add: AR_imp_ANR AR_singleton)
+
+lemma ENR_singleton: "ENR {a}"
+  using ENR_def by blast
+
+text \<open>ARs closed under union\<close>
+
+lemma AR_closed_Un_local_aux:
+  fixes U :: "'a::euclidean_space set"
+  assumes "closedin (top_of_set U) S"
+          "closedin (top_of_set U) T"
+          "AR S" "AR T" "AR(S \<inter> T)"
+  shows "(S \<union> T) retract_of U"
+proof -
+  have "S \<inter> T \<noteq> {}"
+    using assms AR_def by fastforce
+  have "S \<subseteq> U" "T \<subseteq> U"
+    using assms by (auto simp: closedin_imp_subset)
+  define S' where "S' \<equiv> {x \<in> U. setdist {x} S \<le> setdist {x} T}"
+  define T' where "T' \<equiv> {x \<in> U. setdist {x} T \<le> setdist {x} S}"
+  define W  where "W \<equiv> {x \<in> U. setdist {x} S = setdist {x} T}"
+  have US': "closedin (top_of_set U) S'"
+    using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} S - setdist {x} T" "{..0}"]
+    by (simp add: S'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
+  have UT': "closedin (top_of_set U) T'"
+    using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} T - setdist {x} S" "{..0}"]
+    by (simp add: T'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
+  have "S \<subseteq> S'"
+    using S'_def \<open>S \<subseteq> U\<close> setdist_sing_in_set by fastforce
+  have "T \<subseteq> T'"
+    using T'_def \<open>T \<subseteq> U\<close> setdist_sing_in_set by fastforce
+  have "S \<inter> T \<subseteq> W" "W \<subseteq> U"
+    using \<open>S \<subseteq> U\<close> by (auto simp: W_def setdist_sing_in_set)
+  have "(S \<inter> T) retract_of W"
+    apply (rule AR_imp_absolute_retract [OF \<open>AR(S \<inter> T)\<close>])
+     apply (simp add: homeomorphic_refl)
+    apply (rule closedin_subset_trans [of U])
+    apply (simp_all add: assms closedin_Int \<open>S \<inter> T \<subseteq> W\<close> \<open>W \<subseteq> U\<close>)
+    done
+  then obtain r0
+    where "S \<inter> T \<subseteq> W" and contr0: "continuous_on W r0"
+      and "r0 ` W \<subseteq> S \<inter> T"
+      and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x"
+      by (auto simp: retract_of_def retraction_def)
+  have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x
+    using setdist_eq_0_closedin \<open>S \<inter> T \<noteq> {}\<close> assms
+    by (force simp: W_def setdist_sing_in_set)
+  have "S' \<inter> T' = W"
+    by (auto simp: S'_def T'_def W_def)
+  then have cloUW: "closedin (top_of_set U) W"
+    using closedin_Int US' UT' by blast
+  define r where "r \<equiv> \<lambda>x. if x \<in> W then r0 x else x"
+  have "r ` (W \<union> S) \<subseteq> S" "r ` (W \<union> T) \<subseteq> T"
+    using \<open>r0 ` W \<subseteq> S \<inter> T\<close> r_def by auto
+  have contr: "continuous_on (W \<union> (S \<union> T)) r"
+  unfolding r_def
+  proof (rule continuous_on_cases_local [OF _ _ contr0 continuous_on_id])
+    show "closedin (top_of_set (W \<union> (S \<union> T))) W"
+      using \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W \<subseteq> U\<close> \<open>closedin (top_of_set U) W\<close> closedin_subset_trans by fastforce
+    show "closedin (top_of_set (W \<union> (S \<union> T))) (S \<union> T)"
+      by (meson \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W \<subseteq> U\<close> assms closedin_Un closedin_subset_trans sup.bounded_iff sup.cobounded2)
+    show "\<And>x. x \<in> W \<and> x \<notin> W \<or> x \<in> S \<union> T \<and> x \<in> W \<Longrightarrow> r0 x = x"
+      by (auto simp: ST)
+  qed
+  have cloUWS: "closedin (top_of_set U) (W \<union> S)"
+    by (simp add: cloUW assms closedin_Un)
+  obtain g where contg: "continuous_on U g"
+             and "g ` U \<subseteq> S" and geqr: "\<And>x. x \<in> W \<union> S \<Longrightarrow> g x = r x"
+    apply (rule AR_imp_absolute_extensor [OF \<open>AR S\<close> _ _ cloUWS])
+      apply (rule continuous_on_subset [OF contr])
+      using \<open>r ` (W \<union> S) \<subseteq> S\<close> apply auto
+    done
+  have cloUWT: "closedin (top_of_set U) (W \<union> T)"
+    by (simp add: cloUW assms closedin_Un)
+  obtain h where conth: "continuous_on U h"
+             and "h ` U \<subseteq> T" and heqr: "\<And>x. x \<in> W \<union> T \<Longrightarrow> h x = r x"
+    apply (rule AR_imp_absolute_extensor [OF \<open>AR T\<close> _ _ cloUWT])
+      apply (rule continuous_on_subset [OF contr])
+      using \<open>r ` (W \<union> T) \<subseteq> T\<close> apply auto
+    done
+  have "U = S' \<union> T'"
+    by (force simp: S'_def T'_def)
+  then have cont: "continuous_on U (\<lambda>x. if x \<in> S' then g x else h x)"
+    apply (rule ssubst)
+    apply (rule continuous_on_cases_local)
+    using US' UT' \<open>S' \<inter> T' = W\<close> \<open>U = S' \<union> T'\<close>
+          contg conth continuous_on_subset geqr heqr apply auto
+    done
+  have UST: "(\<lambda>x. if x \<in> S' then g x else h x) ` U \<subseteq> S \<union> T"
+    using \<open>g ` U \<subseteq> S\<close> \<open>h ` U \<subseteq> T\<close> by auto
+  show ?thesis
+    apply (simp add: retract_of_def retraction_def \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close>)
+    apply (rule_tac x="\<lambda>x. if x \<in> S' then g x else h x" in exI)
+    apply (intro conjI cont UST)
+    by (metis IntI ST Un_iff \<open>S \<subseteq> S'\<close> \<open>S' \<inter> T' = W\<close> \<open>T \<subseteq> T'\<close> subsetD geqr heqr r0 r_def)
+qed
+
+
+lemma AR_closed_Un_local:
+  fixes S :: "'a::euclidean_space set"
+  assumes STS: "closedin (top_of_set (S \<union> T)) S"
+      and STT: "closedin (top_of_set (S \<union> T)) T"
+      and "AR S" "AR T" "AR(S \<inter> T)"
+    shows "AR(S \<union> T)"
+proof -
+  have "C retract_of U"
+       if hom: "S \<union> T homeomorphic C" and UC: "closedin (top_of_set U) C"
+       for U and C :: "('a * real) set"
+  proof -
+    obtain f g where hom: "homeomorphism (S \<union> T) C f g"
+      using hom by (force simp: homeomorphic_def)
+    have US: "closedin (top_of_set U) (C \<inter> g -` S)"
+      apply (rule closedin_trans [OF _ UC])
+      apply (rule continuous_closedin_preimage_gen [OF _ _ STS])
+      using hom homeomorphism_def apply blast
+      apply (metis hom homeomorphism_def set_eq_subset)
+      done
+    have UT: "closedin (top_of_set U) (C \<inter> g -` T)"
+      apply (rule closedin_trans [OF _ UC])
+      apply (rule continuous_closedin_preimage_gen [OF _ _ STT])
+      using hom homeomorphism_def apply blast
+      apply (metis hom homeomorphism_def set_eq_subset)
+      done
+    have ARS: "AR (C \<inter> g -` S)"
+      apply (rule AR_homeomorphic_AR [OF \<open>AR S\<close>])
+      apply (simp add: homeomorphic_def)
+      apply (rule_tac x=g in exI)
+      apply (rule_tac x=f in exI)
+      using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
+      apply (rule_tac x="f x" in image_eqI, auto)
+      done
+    have ART: "AR (C \<inter> g -` T)"
+      apply (rule AR_homeomorphic_AR [OF \<open>AR T\<close>])
+      apply (simp add: homeomorphic_def)
+      apply (rule_tac x=g in exI)
+      apply (rule_tac x=f in exI)
+      using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
+      apply (rule_tac x="f x" in image_eqI, auto)
+      done
+    have ARI: "AR ((C \<inter> g -` S) \<inter> (C \<inter> g -` T))"
+      apply (rule AR_homeomorphic_AR [OF \<open>AR (S \<inter> T)\<close>])
+      apply (simp add: homeomorphic_def)
+      apply (rule_tac x=g in exI)
+      apply (rule_tac x=f in exI)
+      using hom
+      apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
+      apply (rule_tac x="f x" in image_eqI, auto)
+      done
+    have "C = (C \<inter> g -` S) \<union> (C \<inter> g -` T)"
+      using hom  by (auto simp: homeomorphism_def)
+    then show ?thesis
+      by (metis AR_closed_Un_local_aux [OF US UT ARS ART ARI])
+  qed
+  then show ?thesis
+    by (force simp: AR_def)
+qed
+
+corollary AR_closed_Un:
+  fixes S :: "'a::euclidean_space set"
+  shows "\<lbrakk>closed S; closed T; AR S; AR T; AR (S \<inter> T)\<rbrakk> \<Longrightarrow> AR (S \<union> T)"
+by (metis AR_closed_Un_local_aux closed_closedin retract_of_UNIV subtopology_UNIV)
+
+text \<open>ANRs closed under union\<close>
+
+lemma ANR_closed_Un_local_aux:
+  fixes U :: "'a::euclidean_space set"
+  assumes US: "closedin (top_of_set U) S"
+      and UT: "closedin (top_of_set U) T"
+      and "ANR S" "ANR T" "ANR(S \<inter> T)"
+  obtains V where "openin (top_of_set U) V" "(S \<union> T) retract_of V"
+proof (cases "S = {} \<or> T = {}")
+  case True with assms that show ?thesis
+    by (metis ANR_imp_neighbourhood_retract Un_commute inf_bot_right sup_inf_absorb)
+next
+  case False
+  then have [simp]: "S \<noteq> {}" "T \<noteq> {}" by auto
+  have "S \<subseteq> U" "T \<subseteq> U"
+    using assms by (auto simp: closedin_imp_subset)
+  define S' where "S' \<equiv> {x \<in> U. setdist {x} S \<le> setdist {x} T}"
+  define T' where "T' \<equiv> {x \<in> U. setdist {x} T \<le> setdist {x} S}"
+  define W  where "W \<equiv> {x \<in> U. setdist {x} S = setdist {x} T}"
+  have cloUS': "closedin (top_of_set U) S'"
+    using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} S - setdist {x} T" "{..0}"]
+    by (simp add: S'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
+  have cloUT': "closedin (top_of_set U) T'"
+    using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} T - setdist {x} S" "{..0}"]
+    by (simp add: T'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
+  have "S \<subseteq> S'"
+    using S'_def \<open>S \<subseteq> U\<close> setdist_sing_in_set by fastforce
+  have "T \<subseteq> T'"
+    using T'_def \<open>T \<subseteq> U\<close> setdist_sing_in_set by fastforce
+  have "S' \<union> T' = U"
+    by (auto simp: S'_def T'_def)
+  have "W \<subseteq> S'"
+    by (simp add: Collect_mono S'_def W_def)
+  have "W \<subseteq> T'"
+    by (simp add: Collect_mono T'_def W_def)
+  have ST_W: "S \<inter> T \<subseteq> W" and "W \<subseteq> U"
+    using \<open>S \<subseteq> U\<close> by (force simp: W_def setdist_sing_in_set)+
+  have "S' \<inter> T' = W"
+    by (auto simp: S'_def T'_def W_def)
+  then have cloUW: "closedin (top_of_set U) W"
+    using closedin_Int cloUS' cloUT' by blast
+  obtain W' W0 where "openin (top_of_set W) W'"
+                 and cloWW0: "closedin (top_of_set W) W0"
+                 and "S \<inter> T \<subseteq> W'" "W' \<subseteq> W0"
+                 and ret: "(S \<inter> T) retract_of W0"
+    apply (rule ANR_imp_closed_neighbourhood_retract [OF \<open>ANR(S \<inter> T)\<close>])
+    apply (rule closedin_subset_trans [of U, OF _ ST_W \<open>W \<subseteq> U\<close>])
+    apply (blast intro: assms)+
+    done
+  then obtain U0 where opeUU0: "openin (top_of_set U) U0"
+                   and U0: "S \<inter> T \<subseteq> U0" "U0 \<inter> W \<subseteq> W0"
+    unfolding openin_open  using \<open>W \<subseteq> U\<close> by blast
+  have "W0 \<subseteq> U"
+    using \<open>W \<subseteq> U\<close> cloWW0 closedin_subset by fastforce
+  obtain r0
+    where "S \<inter> T \<subseteq> W0" and contr0: "continuous_on W0 r0" and "r0 ` W0 \<subseteq> S \<inter> T"
+      and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x"
+    using ret  by (force simp: retract_of_def retraction_def)
+  have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x
+    using assms by (auto simp: W_def setdist_sing_in_set dest!: setdist_eq_0_closedin)
+  define r where "r \<equiv> \<lambda>x. if x \<in> W0 then r0 x else x"
+  have "r ` (W0 \<union> S) \<subseteq> S" "r ` (W0 \<union> T) \<subseteq> T"
+    using \<open>r0 ` W0 \<subseteq> S \<inter> T\<close> r_def by auto
+  have contr: "continuous_on (W0 \<union> (S \<union> T)) r"
+  unfolding r_def
+  proof (rule continuous_on_cases_local [OF _ _ contr0 continuous_on_id])
+    show "closedin (top_of_set (W0 \<union> (S \<union> T))) W0"
+      apply (rule closedin_subset_trans [of U])
+      using cloWW0 cloUW closedin_trans \<open>W0 \<subseteq> U\<close> \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> apply blast+
+      done
+    show "closedin (top_of_set (W0 \<union> (S \<union> T))) (S \<union> T)"
+      by (meson \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W0 \<subseteq> U\<close> assms closedin_Un closedin_subset_trans sup.bounded_iff sup.cobounded2)
+    show "\<And>x. x \<in> W0 \<and> x \<notin> W0 \<or> x \<in> S \<union> T \<and> x \<in> W0 \<Longrightarrow> r0 x = x"
+      using ST cloWW0 closedin_subset by fastforce
+  qed
+  have cloS'WS: "closedin (top_of_set S') (W0 \<union> S)"
+    by (meson closedin_subset_trans US cloUS' \<open>S \<subseteq> S'\<close> \<open>W \<subseteq> S'\<close> cloUW cloWW0 
+              closedin_Un closedin_imp_subset closedin_trans)
+  obtain W1 g where "W0 \<union> S \<subseteq> W1" and contg: "continuous_on W1 g"
+                and opeSW1: "openin (top_of_set S') W1"
+                and "g ` W1 \<subseteq> S" and geqr: "\<And>x. x \<in> W0 \<union> S \<Longrightarrow> g x = r x"
+    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> _ \<open>r ` (W0 \<union> S) \<subseteq> S\<close> cloS'WS])
+     apply (rule continuous_on_subset [OF contr], blast+)
+    done
+  have cloT'WT: "closedin (top_of_set T') (W0 \<union> T)"
+    by (meson closedin_subset_trans UT cloUT' \<open>T \<subseteq> T'\<close> \<open>W \<subseteq> T'\<close> cloUW cloWW0 
+              closedin_Un closedin_imp_subset closedin_trans)
+  obtain W2 h where "W0 \<union> T \<subseteq> W2" and conth: "continuous_on W2 h"
+                and opeSW2: "openin (top_of_set T') W2"
+                and "h ` W2 \<subseteq> T" and heqr: "\<And>x. x \<in> W0 \<union> T \<Longrightarrow> h x = r x"
+    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> _ \<open>r ` (W0 \<union> T) \<subseteq> T\<close> cloT'WT])
+     apply (rule continuous_on_subset [OF contr], blast+)
+    done
+  have "S' \<inter> T' = W"
+    by (force simp: S'_def T'_def W_def)
+  obtain O1 O2 where "open O1" "W1 = S' \<inter> O1" "open O2" "W2 = T' \<inter> O2"
+    using opeSW1 opeSW2 by (force simp: openin_open)
+  show ?thesis
+  proof
+    have eq: "W1 - (W - U0) \<union> (W2 - (W - U0)) =
+         ((U - T') \<inter> O1 \<union> (U - S') \<inter> O2 \<union> U \<inter> O1 \<inter> O2) - (W - U0)"
+     using \<open>U0 \<inter> W \<subseteq> W0\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close>
+      by (auto simp: \<open>S' \<union> T' = U\<close> [symmetric] \<open>S' \<inter> T' = W\<close> [symmetric] \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close>)
+    show "openin (top_of_set U) (W1 - (W - U0) \<union> (W2 - (W - U0)))"
+      apply (subst eq)
+      apply (intro openin_Un openin_Int_open openin_diff closedin_diff cloUW opeUU0 cloUS' cloUT' \<open>open O1\<close> \<open>open O2\<close>, simp_all)
+      done
+    have cloW1: "closedin (top_of_set (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W1 - (W - U0))"
+      using cloUS' apply (simp add: closedin_closed)
+      apply (erule ex_forward)
+      using U0 \<open>W0 \<union> S \<subseteq> W1\<close>
+      apply (auto simp: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
+      done
+    have cloW2: "closedin (top_of_set (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W2 - (W - U0))"
+      using cloUT' apply (simp add: closedin_closed)
+      apply (erule ex_forward)
+      using U0 \<open>W0 \<union> T \<subseteq> W2\<close>
+      apply (auto simp: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
+      done
+    have *: "\<forall>x\<in>S \<union> T. (if x \<in> S' then g x else h x) = x"
+      using ST \<open>S' \<inter> T' = W\<close> cloT'WT closedin_subset geqr heqr 
+      apply (auto simp: r_def, fastforce)
+      using \<open>S \<subseteq> S'\<close> \<open>T \<subseteq> T'\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W1 = S' \<inter> O1\<close>  by auto
+    have "\<exists>r. continuous_on (W1 - (W - U0) \<union> (W2 - (W - U0))) r \<and>
+              r ` (W1 - (W - U0) \<union> (W2 - (W - U0))) \<subseteq> S \<union> T \<and> 
+              (\<forall>x\<in>S \<union> T. r x = x)"
+      apply (rule_tac x = "\<lambda>x. if  x \<in> S' then g x else h x" in exI)
+      apply (intro conjI *)
+      apply (rule continuous_on_cases_local 
+                  [OF cloW1 cloW2 continuous_on_subset [OF contg] continuous_on_subset [OF conth]])
+      using \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<inter> T' = W\<close>
+            \<open>g ` W1 \<subseteq> S\<close> \<open>h ` W2 \<subseteq> T\<close> apply auto
+      using \<open>U0 \<inter> W \<subseteq> W0\<close> \<open>W0 \<union> S \<subseteq> W1\<close> apply (fastforce simp add: geqr heqr)+
+      done
+    then show "S \<union> T retract_of W1 - (W - U0) \<union> (W2 - (W - U0))"
+      using  \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close> ST opeUU0 U0
+      by (auto simp: retract_of_def retraction_def)
+  qed
+qed
+
+
+lemma ANR_closed_Un_local:
+  fixes S :: "'a::euclidean_space set"
+  assumes STS: "closedin (top_of_set (S \<union> T)) S"
+      and STT: "closedin (top_of_set (S \<union> T)) T"
+      and "ANR S" "ANR T" "ANR(S \<inter> T)" 
+    shows "ANR(S \<union> T)"
+proof -
+  have "\<exists>T. openin (top_of_set U) T \<and> C retract_of T"
+       if hom: "S \<union> T homeomorphic C" and UC: "closedin (top_of_set U) C"
+       for U and C :: "('a * real) set"
+  proof -
+    obtain f g where hom: "homeomorphism (S \<union> T) C f g"
+      using hom by (force simp: homeomorphic_def)
+    have US: "closedin (top_of_set U) (C \<inter> g -` S)"
+      apply (rule closedin_trans [OF _ UC])
+      apply (rule continuous_closedin_preimage_gen [OF _ _ STS])
+      using hom [unfolded homeomorphism_def] apply blast
+      apply (metis hom homeomorphism_def set_eq_subset)
+      done
+    have UT: "closedin (top_of_set U) (C \<inter> g -` T)"
+      apply (rule closedin_trans [OF _ UC])
+      apply (rule continuous_closedin_preimage_gen [OF _ _ STT])
+      using hom [unfolded homeomorphism_def] apply blast
+      apply (metis hom homeomorphism_def set_eq_subset)
+      done
+    have ANRS: "ANR (C \<inter> g -` S)"
+      apply (rule ANR_homeomorphic_ANR [OF \<open>ANR S\<close>])
+      apply (simp add: homeomorphic_def)
+      apply (rule_tac x=g in exI)
+      apply (rule_tac x=f in exI)
+      using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
+      apply (rule_tac x="f x" in image_eqI, auto)
+      done
+    have ANRT: "ANR (C \<inter> g -` T)"
+      apply (rule ANR_homeomorphic_ANR [OF \<open>ANR T\<close>])
+      apply (simp add: homeomorphic_def)
+      apply (rule_tac x=g in exI)
+      apply (rule_tac x=f in exI)
+      using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
+      apply (rule_tac x="f x" in image_eqI, auto)
+      done
+    have ANRI: "ANR ((C \<inter> g -` S) \<inter> (C \<inter> g -` T))"
+      apply (rule ANR_homeomorphic_ANR [OF \<open>ANR (S \<inter> T)\<close>])
+      apply (simp add: homeomorphic_def)
+      apply (rule_tac x=g in exI)
+      apply (rule_tac x=f in exI)
+      using hom
+      apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
+      apply (rule_tac x="f x" in image_eqI, auto)
+      done
+    have "C = (C \<inter> g -` S) \<union> (C \<inter> g -` T)"
+      using hom by (auto simp: homeomorphism_def)
+    then show ?thesis
+      by (metis ANR_closed_Un_local_aux [OF US UT ANRS ANRT ANRI])
+  qed
+  then show ?thesis
+    by (auto simp: ANR_def)
+qed    
+
+corollary ANR_closed_Un:
+  fixes S :: "'a::euclidean_space set"
+  shows "\<lbrakk>closed S; closed T; ANR S; ANR T; ANR (S \<inter> T)\<rbrakk> \<Longrightarrow> ANR (S \<union> T)"
+by (simp add: ANR_closed_Un_local closedin_def diff_eq open_Compl openin_open_Int)
+
+lemma ANR_openin:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ANR T" and opeTS: "openin (top_of_set T) S"
+  shows "ANR S"
+proof (clarsimp simp only: ANR_eq_absolute_neighbourhood_extensor)
+  fix f :: "'a \<times> real \<Rightarrow> 'a" and U C
+  assume contf: "continuous_on C f" and fim: "f ` C \<subseteq> S"
+     and cloUC: "closedin (top_of_set U) C"
+  have "f ` C \<subseteq> T"
+    using fim opeTS openin_imp_subset by blast
+  obtain W g where "C \<subseteq> W"
+               and UW: "openin (top_of_set U) W"
+               and contg: "continuous_on W g"
+               and gim: "g ` W \<subseteq> T"
+               and geq: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
+    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> contf \<open>f ` C \<subseteq> T\<close> cloUC])
+    using fim by auto
+  show "\<exists>V g. C \<subseteq> V \<and> openin (top_of_set U) V \<and> continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x\<in>C. g x = f x)"
+  proof (intro exI conjI)
+    show "C \<subseteq> W \<inter> g -` S"
+      using \<open>C \<subseteq> W\<close> fim geq by blast
+    show "openin (top_of_set U) (W \<inter> g -` S)"
+      by (metis (mono_tags, lifting) UW contg continuous_openin_preimage gim opeTS openin_trans)
+    show "continuous_on (W \<inter> g -` S) g"
+      by (blast intro: continuous_on_subset [OF contg])
+    show "g ` (W \<inter> g -` S) \<subseteq> S"
+      using gim by blast
+    show "\<forall>x\<in>C. g x = f x"
+      using geq by blast
+  qed
+qed
+
+lemma ENR_openin:
+    fixes S :: "'a::euclidean_space set"
+    assumes "ENR T" and opeTS: "openin (top_of_set T) S"
+    shows "ENR S"
+  using assms apply (simp add: ENR_ANR)
+  using ANR_openin locally_open_subset by blast
+
+lemma ANR_neighborhood_retract:
+    fixes S :: "'a::euclidean_space set"
+    assumes "ANR U" "S retract_of T" "openin (top_of_set U) T"
+    shows "ANR S"
+  using ANR_openin ANR_retract_of_ANR assms by blast
+
+lemma ENR_neighborhood_retract:
+    fixes S :: "'a::euclidean_space set"
+    assumes "ENR U" "S retract_of T" "openin (top_of_set U) T"
+    shows "ENR S"
+  using ENR_openin ENR_retract_of_ENR assms by blast
+
+lemma ANR_rel_interior:
+  fixes S :: "'a::euclidean_space set"
+  shows "ANR S \<Longrightarrow> ANR(rel_interior S)"
+   by (blast intro: ANR_openin openin_set_rel_interior)
+
+lemma ANR_delete:
+  fixes S :: "'a::euclidean_space set"
+  shows "ANR S \<Longrightarrow> ANR(S - {a})"
+   by (blast intro: ANR_openin openin_delete openin_subtopology_self)
+
+lemma ENR_rel_interior:
+  fixes S :: "'a::euclidean_space set"
+  shows "ENR S \<Longrightarrow> ENR(rel_interior S)"
+   by (blast intro: ENR_openin openin_set_rel_interior)
+
+lemma ENR_delete:
+  fixes S :: "'a::euclidean_space set"
+  shows "ENR S \<Longrightarrow> ENR(S - {a})"
+   by (blast intro: ENR_openin openin_delete openin_subtopology_self)
+
+lemma open_imp_ENR: "open S \<Longrightarrow> ENR S"
+    using ENR_def by blast
+
+lemma open_imp_ANR:
+    fixes S :: "'a::euclidean_space set"
+    shows "open S \<Longrightarrow> ANR S"
+  by (simp add: ENR_imp_ANR open_imp_ENR)
+
+lemma ANR_ball [iff]:
+    fixes a :: "'a::euclidean_space"
+    shows "ANR(ball a r)"
+  by (simp add: convex_imp_ANR)
+
+lemma ENR_ball [iff]: "ENR(ball a r)"
+  by (simp add: open_imp_ENR)
+
+lemma AR_ball [simp]:
+    fixes a :: "'a::euclidean_space"
+    shows "AR(ball a r) \<longleftrightarrow> 0 < r"
+  by (auto simp: AR_ANR convex_imp_contractible)
+
+lemma ANR_cball [iff]:
+    fixes a :: "'a::euclidean_space"
+    shows "ANR(cball a r)"
+  by (simp add: convex_imp_ANR)
+
+lemma ENR_cball:
+    fixes a :: "'a::euclidean_space"
+    shows "ENR(cball a r)"
+  using ENR_convex_closed by blast
+
+lemma AR_cball [simp]:
+    fixes a :: "'a::euclidean_space"
+    shows "AR(cball a r) \<longleftrightarrow> 0 \<le> r"
+  by (auto simp: AR_ANR convex_imp_contractible)
+
+lemma ANR_box [iff]:
+    fixes a :: "'a::euclidean_space"
+    shows "ANR(cbox a b)" "ANR(box a b)"
+  by (auto simp: convex_imp_ANR open_imp_ANR)
+
+lemma ENR_box [iff]:
+    fixes a :: "'a::euclidean_space"
+    shows "ENR(cbox a b)" "ENR(box a b)"
+apply (simp add: ENR_convex_closed closed_cbox)
+by (simp add: open_box open_imp_ENR)
+
+lemma AR_box [simp]:
+    "AR(cbox a b) \<longleftrightarrow> cbox a b \<noteq> {}" "AR(box a b) \<longleftrightarrow> box a b \<noteq> {}"
+  by (auto simp: AR_ANR convex_imp_contractible)
+
+lemma ANR_interior:
+     fixes S :: "'a::euclidean_space set"
+     shows "ANR(interior S)"
+  by (simp add: open_imp_ANR)
+
+lemma ENR_interior:
+     fixes S :: "'a::euclidean_space set"
+     shows "ENR(interior S)"
+  by (simp add: open_imp_ENR)
+
+lemma AR_imp_contractible:
+    fixes S :: "'a::euclidean_space set"
+    shows "AR S \<Longrightarrow> contractible S"
+  by (simp add: AR_ANR)
+
+lemma ENR_imp_locally_compact:
+    fixes S :: "'a::euclidean_space set"
+    shows "ENR S \<Longrightarrow> locally compact S"
+  by (simp add: ENR_ANR)
+
+lemma ANR_imp_locally_path_connected:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ANR S"
+    shows "locally path_connected S"
+proof -
+  obtain U and T :: "('a \<times> real) set"
+     where "convex U" "U \<noteq> {}"
+       and UT: "closedin (top_of_set U) T"
+       and "S homeomorphic T"
+    apply (rule homeomorphic_closedin_convex [of S])
+    using aff_dim_le_DIM [of S] apply auto
+    done
+  then have "locally path_connected T"
+    by (meson ANR_imp_absolute_neighbourhood_retract
+        assms convex_imp_locally_path_connected locally_open_subset retract_of_locally_path_connected)
+  then have S: "locally path_connected S"
+      if "openin (top_of_set U) V" "T retract_of V" "U \<noteq> {}" for V
+    using \<open>S homeomorphic T\<close> homeomorphic_locally homeomorphic_path_connectedness by blast
+  show ?thesis
+    using assms
+    apply (clarsimp simp: ANR_def)
+    apply (drule_tac x=U in spec)
+    apply (drule_tac x=T in spec)
+    using \<open>S homeomorphic T\<close> \<open>U \<noteq> {}\<close> UT  apply (blast intro: S)
+    done
+qed
+
+lemma ANR_imp_locally_connected:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ANR S"
+    shows "locally connected S"
+using locally_path_connected_imp_locally_connected ANR_imp_locally_path_connected assms by auto
+
+lemma AR_imp_locally_path_connected:
+  fixes S :: "'a::euclidean_space set"
+  assumes "AR S"
+    shows "locally path_connected S"
+by (simp add: ANR_imp_locally_path_connected AR_imp_ANR assms)
+
+lemma AR_imp_locally_connected:
+  fixes S :: "'a::euclidean_space set"
+  assumes "AR S"
+    shows "locally connected S"
+using ANR_imp_locally_connected AR_ANR assms by blast
+
+lemma ENR_imp_locally_path_connected:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ENR S"
+    shows "locally path_connected S"
+by (simp add: ANR_imp_locally_path_connected ENR_imp_ANR assms)
+
+lemma ENR_imp_locally_connected:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ENR S"
+    shows "locally connected S"
+using ANR_imp_locally_connected ENR_ANR assms by blast
+
+lemma ANR_Times:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "ANR S" "ANR T" shows "ANR(S \<times> T)"
+proof (clarsimp simp only: ANR_eq_absolute_neighbourhood_extensor)
+  fix f :: " ('a \<times> 'b) \<times> real \<Rightarrow> 'a \<times> 'b" and U C
+  assume "continuous_on C f" and fim: "f ` C \<subseteq> S \<times> T"
+     and cloUC: "closedin (top_of_set U) C"
+  have contf1: "continuous_on C (fst \<circ> f)"
+    by (simp add: \<open>continuous_on C f\<close> continuous_on_fst)
+  obtain W1 g where "C \<subseteq> W1"
+               and UW1: "openin (top_of_set U) W1"
+               and contg: "continuous_on W1 g"
+               and gim: "g ` W1 \<subseteq> S"
+               and geq: "\<And>x. x \<in> C \<Longrightarrow> g x = (fst \<circ> f) x"
+    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> contf1 _ cloUC])
+    using fim apply auto
+    done
+  have contf2: "continuous_on C (snd \<circ> f)"
+    by (simp add: \<open>continuous_on C f\<close> continuous_on_snd)
+  obtain W2 h where "C \<subseteq> W2"
+               and UW2: "openin (top_of_set U) W2"
+               and conth: "continuous_on W2 h"
+               and him: "h ` W2 \<subseteq> T"
+               and heq: "\<And>x. x \<in> C \<Longrightarrow> h x = (snd \<circ> f) x"
+    apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> contf2 _ cloUC])
+    using fim apply auto
+    done
+  show "\<exists>V g. C \<subseteq> V \<and>
+               openin (top_of_set U) V \<and>
+               continuous_on V g \<and> g ` V \<subseteq> S \<times> T \<and> (\<forall>x\<in>C. g x = f x)"
+  proof (intro exI conjI)
+    show "C \<subseteq> W1 \<inter> W2"
+      by (simp add: \<open>C \<subseteq> W1\<close> \<open>C \<subseteq> W2\<close>)
+    show "openin (top_of_set U) (W1 \<inter> W2)"
+      by (simp add: UW1 UW2 openin_Int)
+    show  "continuous_on (W1 \<inter> W2) (\<lambda>x. (g x, h x))"
+      by (metis (no_types) contg conth continuous_on_Pair continuous_on_subset inf_commute inf_le1)
+    show  "(\<lambda>x. (g x, h x)) ` (W1 \<inter> W2) \<subseteq> S \<times> T"
+      using gim him by blast
+    show  "(\<forall>x\<in>C. (g x, h x) = f x)"
+      using geq heq by auto
+  qed
+qed
+
+lemma AR_Times:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "AR S" "AR T" shows "AR(S \<times> T)"
+  using assms by (simp add: AR_ANR ANR_Times contractible_Times)
+
+subsection\<^marker>\<open>tag unimportant\<close>\<open>Retracts and intervals in ordered euclidean space\<close>
+
+lemma ANR_interval [iff]:
+  fixes a :: "'a::ordered_euclidean_space"
+  shows "ANR{a..b}"
+  by (simp add: interval_cbox)
+
+lemma ENR_interval [iff]:
+  fixes a :: "'a::ordered_euclidean_space"
+  shows "ENR{a..b}"
+  by (auto simp: interval_cbox)
+
+subsection \<open>More advanced properties of ANRs and ENRs\<close>
+
+lemma ENR_rel_frontier_convex:
+  fixes S :: "'a::euclidean_space set"
+  assumes "bounded S" "convex S"
+    shows "ENR(rel_frontier S)"
+proof (cases "S = {}")
+  case True then show ?thesis
+    by simp
+next
+  case False
+  with assms have "rel_interior S \<noteq> {}"
+    by (simp add: rel_interior_eq_empty)
+  then obtain a where a: "a \<in> rel_interior S"
+    by auto
+  have ahS: "affine hull S - {a} \<subseteq> {x. closest_point (affine hull S) x \<noteq> a}"
+    by (auto simp: closest_point_self)
+  have "rel_frontier S retract_of affine hull S - {a}"
+    by (simp add: assms a rel_frontier_retract_of_punctured_affine_hull)
+  also have "\<dots> retract_of {x. closest_point (affine hull S) x \<noteq> a}"
+    apply (simp add: retract_of_def retraction_def ahS)
+    apply (rule_tac x="closest_point (affine hull S)" in exI)
+    apply (auto simp: False closest_point_self affine_imp_convex closest_point_in_set continuous_on_closest_point)
+    done
+  finally have "rel_frontier S retract_of {x. closest_point (affine hull S) x \<noteq> a}" .
+  moreover have "openin (top_of_set UNIV) (UNIV \<inter> closest_point (affine hull S) -` (- {a}))"
+    apply (rule continuous_openin_preimage_gen)
+    apply (auto simp: False affine_imp_convex continuous_on_closest_point)
+    done
+  ultimately show ?thesis
+    unfolding ENR_def
+    apply (rule_tac x = "closest_point (affine hull S) -` (- {a})" in exI)
+    apply (simp add: vimage_def)
+    done
+qed
+
+lemma ANR_rel_frontier_convex:
+                 fixes S :: "'a::euclidean_space set"
+  assumes "bounded S" "convex S"
+    shows "ANR(rel_frontier S)"
+by (simp add: ENR_imp_ANR ENR_rel_frontier_convex assms)
+    
+lemma ENR_closedin_Un_local:
+  fixes S :: "'a::euclidean_space set"
+  shows "\<lbrakk>ENR S; ENR T; ENR(S \<inter> T);
+          closedin (top_of_set (S \<union> T)) S; closedin (top_of_set (S \<union> T)) T\<rbrakk>
+        \<Longrightarrow> ENR(S \<union> T)"
+by (simp add: ENR_ANR ANR_closed_Un_local locally_compact_closedin_Un)
+
+lemma ENR_closed_Un:
+  fixes S :: "'a::euclidean_space set"
+  shows "\<lbrakk>closed S; closed T; ENR S; ENR T; ENR(S \<inter> T)\<rbrakk> \<Longrightarrow> ENR(S \<union> T)"
+by (auto simp: closed_subset ENR_closedin_Un_local)
+
+lemma absolute_retract_Un:
+  fixes S :: "'a::euclidean_space set"
+  shows "\<lbrakk>S retract_of UNIV; T retract_of UNIV; (S \<inter> T) retract_of UNIV\<rbrakk>
+         \<Longrightarrow> (S \<union> T) retract_of UNIV"
+  by (meson AR_closed_Un_local_aux closed_subset retract_of_UNIV retract_of_imp_subset)
+
+lemma retract_from_Un_Int:
+  fixes S :: "'a::euclidean_space set"
+  assumes clS: "closedin (top_of_set (S \<union> T)) S"
+      and clT: "closedin (top_of_set (S \<union> T)) T"
+      and Un: "(S \<union> T) retract_of U" and Int: "(S \<inter> T) retract_of T"
+    shows "S retract_of U"
+proof -
+  obtain r where r: "continuous_on T r" "r ` T \<subseteq> S \<inter> T" "\<forall>x\<in>S \<inter> T. r x = x"
+    using Int by (auto simp: retraction_def retract_of_def)
+  have "S retract_of S \<union> T"
+    unfolding retraction_def retract_of_def
+  proof (intro exI conjI)
+    show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then x else r x)"
+      apply (rule continuous_on_cases_local [OF clS clT])
+      using r by (auto simp: continuous_on_id)
+  qed (use r in auto)
+  also have "\<dots> retract_of U"
+    by (rule Un)
+  finally show ?thesis .
+qed
+
+lemma AR_from_Un_Int_local:
+  fixes S :: "'a::euclidean_space set"
+  assumes clS: "closedin (top_of_set (S \<union> T)) S"
+      and clT: "closedin (top_of_set (S \<union> T)) T"
+      and Un: "AR(S \<union> T)" and Int: "AR(S \<inter> T)"
+    shows "AR S"
+  apply (rule AR_retract_of_AR [OF Un])
+  by (meson AR_imp_retract clS clT closedin_closed_subset local.Int retract_from_Un_Int retract_of_refl sup_ge2)
+
+lemma AR_from_Un_Int_local':
+  fixes S :: "'a::euclidean_space set"
+  assumes "closedin (top_of_set (S \<union> T)) S"
+      and "closedin (top_of_set (S \<union> T)) T"
+      and "AR(S \<union> T)" "AR(S \<inter> T)"
+    shows "AR T"
+  using AR_from_Un_Int_local [of T S] assms by (simp add: Un_commute Int_commute)
+
+lemma AR_from_Un_Int:
+  fixes S :: "'a::euclidean_space set"
+  assumes clo: "closed S" "closed T" and Un: "AR(S \<union> T)" and Int: "AR(S \<inter> T)"
+  shows "AR S"
+  by (metis AR_from_Un_Int_local [OF _ _ Un Int] Un_commute clo closed_closedin closedin_closed_subset inf_sup_absorb subtopology_UNIV top_greatest)
+
+lemma ANR_from_Un_Int_local:
+  fixes S :: "'a::euclidean_space set"
+  assumes clS: "closedin (top_of_set (S \<union> T)) S"
+      and clT: "closedin (top_of_set (S \<union> T)) T"
+      and Un: "ANR(S \<union> T)" and Int: "ANR(S \<inter> T)"
+    shows "ANR S"
+proof -
+  obtain V where clo: "closedin (top_of_set (S \<union> T)) (S \<inter> T)"
+             and ope: "openin (top_of_set (S \<union> T)) V"
+             and ret: "S \<inter> T retract_of V"
+    using ANR_imp_neighbourhood_retract [OF Int] by (metis clS clT closedin_Int)
+  then obtain r where r: "continuous_on V r" and rim: "r ` V \<subseteq> S \<inter> T" and req: "\<forall>x\<in>S \<inter> T. r x = x"
+    by (auto simp: retraction_def retract_of_def)
+  have Vsub: "V \<subseteq> S \<union> T"
+    by (meson ope openin_contains_cball)
+  have Vsup: "S \<inter> T \<subseteq> V"
+    by (simp add: retract_of_imp_subset ret)
+  then have eq: "S \<union> V = ((S \<union> T) - T) \<union> V"
+    by auto
+  have eq': "S \<union> V = S \<union> (V \<inter> T)"
+    using Vsub by blast
+  have "continuous_on (S \<union> V \<inter> T) (\<lambda>x. if x \<in> S then x else r x)"
+  proof (rule continuous_on_cases_local)
+    show "closedin (top_of_set (S \<union> V \<inter> T)) S"
+      using clS closedin_subset_trans inf.boundedE by blast
+    show "closedin (top_of_set (S \<union> V \<inter> T)) (V \<inter> T)"
+      using clT Vsup by (auto simp: closedin_closed)
+    show "continuous_on (V \<inter> T) r"
+      by (meson Int_lower1 continuous_on_subset r)
+  qed (use req continuous_on_id in auto)
+  with rim have "S retract_of S \<union> V"
+    unfolding retraction_def retract_of_def
+    apply (rule_tac x="\<lambda>x. if x \<in> S then x else r x" in exI)
+    apply (auto simp: eq')
+    done
+  then show ?thesis
+    using ANR_neighborhood_retract [OF Un]
+    using \<open>S \<union> V = S \<union> T - T \<union> V\<close> clT ope by fastforce
+qed
+
+lemma ANR_from_Un_Int:
+  fixes S :: "'a::euclidean_space set"
+  assumes clo: "closed S" "closed T" and Un: "ANR(S \<union> T)" and Int: "ANR(S \<inter> T)"
+  shows "ANR S"
+  by (metis ANR_from_Un_Int_local [OF _ _ Un Int] Un_commute clo closed_closedin closedin_closed_subset inf_sup_absorb subtopology_UNIV top_greatest)
+
+lemma ANR_finite_Union_convex_closed:
+  fixes \<T> :: "'a::euclidean_space set set"
+  assumes \<T>: "finite \<T>" and clo: "\<And>C. C \<in> \<T> \<Longrightarrow> closed C" and con: "\<And>C. C \<in> \<T> \<Longrightarrow> convex C"
+  shows "ANR(\<Union>\<T>)"
+proof -
+  have "ANR(\<Union>\<T>)" if "card \<T> < n" for n
+  using assms that
+  proof (induction n arbitrary: \<T>)
+    case 0 then show ?case by simp
+  next
+    case (Suc n)
+    have "ANR(\<Union>\<U>)" if "finite \<U>" "\<U> \<subseteq> \<T>" for \<U>
+      using that
+    proof (induction \<U>)
+      case empty
+      then show ?case  by simp
+    next
+      case (insert C \<U>)
+      have "ANR (C \<union> \<Union>\<U>)"
+      proof (rule ANR_closed_Un)
+        show "ANR (C \<inter> \<Union>\<U>)"
+          unfolding Int_Union
+        proof (rule Suc)
+          show "finite ((\<inter>) C ` \<U>)"
+            by (simp add: insert.hyps(1))
+          show "\<And>Ca. Ca \<in> (\<inter>) C ` \<U> \<Longrightarrow> closed Ca"
+            by (metis (no_types, hide_lams) Suc.prems(2) closed_Int subsetD imageE insert.prems insertI1 insertI2)
+          show "\<And>Ca. Ca \<in> (\<inter>) C ` \<U> \<Longrightarrow> convex Ca"
+            by (metis (mono_tags, lifting) Suc.prems(3) convex_Int imageE insert.prems insert_subset subsetCE)
+          show "card ((\<inter>) C ` \<U>) < n"
+          proof -
+            have "card \<T> \<le> n"
+              by (meson Suc.prems(4) not_less not_less_eq)
+            then show ?thesis
+              by (metis Suc.prems(1) card_image_le card_seteq insert.hyps insert.prems insert_subset le_trans not_less)
+          qed
+        qed
+        show "closed (\<Union>\<U>)"
+          using Suc.prems(2) insert.hyps(1) insert.prems by blast
+      qed (use Suc.prems convex_imp_ANR insert.prems insert.IH in auto)
+      then show ?case
+        by simp
+    qed
+    then show ?case
+      using Suc.prems(1) by blast
+  qed
+  then show ?thesis
+    by blast
+qed
+
+
+lemma finite_imp_ANR:
+  fixes S :: "'a::euclidean_space set"
+  assumes "finite S"
+  shows "ANR S"
+proof -
+  have "ANR(\<Union>x \<in> S. {x})"
+    by (blast intro: ANR_finite_Union_convex_closed assms)
+  then show ?thesis
+    by simp
+qed
+
+lemma ANR_insert:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ANR S" "closed S"
+  shows "ANR(insert a S)"
+  by (metis ANR_closed_Un ANR_empty ANR_singleton Diff_disjoint Diff_insert_absorb assms closed_singleton insert_absorb insert_is_Un)
+
+lemma ANR_path_component_ANR:
+  fixes S :: "'a::euclidean_space set"
+  shows "ANR S \<Longrightarrow> ANR(path_component_set S x)"
+  using ANR_imp_locally_path_connected ANR_openin openin_path_component_locally_path_connected by blast
+
+lemma ANR_connected_component_ANR:
+  fixes S :: "'a::euclidean_space set"
+  shows "ANR S \<Longrightarrow> ANR(connected_component_set S x)"
+  by (metis ANR_openin openin_connected_component_locally_connected ANR_imp_locally_connected)
+
+lemma ANR_component_ANR:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ANR S" "c \<in> components S"
+  shows "ANR c"
+  by (metis ANR_connected_component_ANR assms componentsE)
+
+subsection\<open>Original ANR material, now for ENRs\<close>
+
+lemma ENR_bounded:
+  fixes S :: "'a::euclidean_space set"
+  assumes "bounded S"
+  shows "ENR S \<longleftrightarrow> (\<exists>U. open U \<and> bounded U \<and> S retract_of U)"
+         (is "?lhs = ?rhs")
+proof
+  obtain r where "0 < r" and r: "S \<subseteq> ball 0 r"
+    using bounded_subset_ballD assms by blast
+  assume ?lhs
+  then show ?rhs
+    apply (clarsimp simp: ENR_def)
+    apply (rule_tac x="ball 0 r \<inter> U" in exI, auto)
+    using r retract_of_imp_subset retract_of_subset by fastforce
+next
+  assume ?rhs
+  then show ?lhs
+    using ENR_def by blast
+qed
+
+lemma absolute_retract_imp_AR_gen:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "S retract_of T" "convex T" "T \<noteq> {}" "S homeomorphic S'" "closedin (top_of_set U) S'"
+  shows "S' retract_of U"
+proof -
+  have "AR T"
+    by (simp add: assms convex_imp_AR)
+  then have "AR S"
+    using AR_retract_of_AR assms by auto
+  then show ?thesis
+    using assms AR_imp_absolute_retract by metis
+qed
+
+lemma absolute_retract_imp_AR:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "S retract_of UNIV" "S homeomorphic S'" "closed S'"
+  shows "S' retract_of UNIV"
+  using AR_imp_absolute_retract_UNIV assms retract_of_UNIV by blast
+
+lemma homeomorphic_compact_arness:
+  fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
+  assumes "S homeomorphic S'"
+  shows "compact S \<and> S retract_of UNIV \<longleftrightarrow> compact S' \<and> S' retract_of UNIV"
+  using assms homeomorphic_compactness
+  apply auto
+   apply (meson assms compact_AR homeomorphic_AR_iff_AR homeomorphic_compactness)+
+  done
+
+lemma absolute_retract_from_Un_Int:
+  fixes S :: "'a::euclidean_space set"
+  assumes "(S \<union> T) retract_of UNIV" "(S \<inter> T) retract_of UNIV" "closed S" "closed T"
+  shows "S retract_of UNIV"
+  using AR_from_Un_Int assms retract_of_UNIV by auto
+
+lemma ENR_from_Un_Int_gen:
+  fixes S :: "'a::euclidean_space set"
+  assumes "closedin (top_of_set (S \<union> T)) S" "closedin (top_of_set (S \<union> T)) T" "ENR(S \<union> T)" "ENR(S \<inter> T)"
+  shows "ENR S"
+  apply (simp add: ENR_ANR)
+  using ANR_from_Un_Int_local ENR_ANR assms locally_compact_closedin by blast
+
+
+lemma ENR_from_Un_Int:
+  fixes S :: "'a::euclidean_space set"
+  assumes "closed S" "closed T" "ENR(S \<union> T)" "ENR(S \<inter> T)"
+  shows "ENR S"
+  by (meson ENR_from_Un_Int_gen assms closed_subset sup_ge1 sup_ge2)
+
+
+lemma ENR_finite_Union_convex_closed:
+  fixes \<T> :: "'a::euclidean_space set set"
+  assumes \<T>: "finite \<T>" and clo: "\<And>C. C \<in> \<T> \<Longrightarrow> closed C" and con: "\<And>C. C \<in> \<T> \<Longrightarrow> convex C"
+  shows "ENR(\<Union> \<T>)"
+  by (simp add: ENR_ANR ANR_finite_Union_convex_closed \<T> clo closed_Union closed_imp_locally_compact con)
+
+lemma finite_imp_ENR:
+  fixes S :: "'a::euclidean_space set"
+  shows "finite S \<Longrightarrow> ENR S"
+  by (simp add: ENR_ANR finite_imp_ANR finite_imp_closed closed_imp_locally_compact)
+
+lemma ENR_insert:
+  fixes S :: "'a::euclidean_space set"
+  assumes "closed S" "ENR S"
+  shows "ENR(insert a S)"
+proof -
+  have "ENR ({a} \<union> S)"
+    by (metis ANR_insert ENR_ANR Un_commute Un_insert_right assms closed_imp_locally_compact closed_insert sup_bot_right)
+  then show ?thesis
+    by auto
+qed
+
+lemma ENR_path_component_ENR:
+  fixes S :: "'a::euclidean_space set"
+  assumes "ENR S"
+  shows "ENR(path_component_set S x)"
+  by (metis ANR_imp_locally_path_connected ENR_empty ENR_imp_ANR ENR_openin assms
+            locally_path_connected_2 openin_subtopology_self path_component_eq_empty)
+
+(*UNUSED
+lemma ENR_Times:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "ENR S" "ENR T" shows "ENR(S \<times> T)"
+using assms apply (simp add: ENR_ANR ANR_Times)
+thm locally_compact_Times
+oops
+  SIMP_TAC[ENR_ANR; ANR_PCROSS; LOCALLY_COMPACT_PCROSS]);;
+*)
+
+subsection\<open>Finally, spheres are ANRs and ENRs\<close>
+
+lemma absolute_retract_homeomorphic_convex_compact:
+  fixes S :: "'a::euclidean_space set" and U :: "'b::euclidean_space set"
+  assumes "S homeomorphic U" "S \<noteq> {}" "S \<subseteq> T" "convex U" "compact U"
+  shows "S retract_of T"
+  by (metis UNIV_I assms compact_AR convex_imp_AR homeomorphic_AR_iff_AR homeomorphic_compactness homeomorphic_empty(1) retract_of_subset subsetI)
+
+lemma frontier_retract_of_punctured_universe:
+  fixes S :: "'a::euclidean_space set"
+  assumes "convex S" "bounded S" "a \<in> interior S"
+  shows "(frontier S) retract_of (- {a})"
+  using rel_frontier_retract_of_punctured_affine_hull
+  by (metis Compl_eq_Diff_UNIV affine_hull_nonempty_interior assms empty_iff rel_frontier_frontier rel_interior_nonempty_interior)
+
+lemma sphere_retract_of_punctured_universe_gen:
+  fixes a :: "'a::euclidean_space"
+  assumes "b \<in> ball a r"
+  shows  "sphere a r retract_of (- {b})"
+proof -
+  have "frontier (cball a r) retract_of (- {b})"
+    apply (rule frontier_retract_of_punctured_universe)
+    using assms by auto
+  then show ?thesis
+    by simp
+qed
+
+lemma sphere_retract_of_punctured_universe:
+  fixes a :: "'a::euclidean_space"
+  assumes "0 < r"
+  shows "sphere a r retract_of (- {a})"
+  by (simp add: assms sphere_retract_of_punctured_universe_gen)
+
+lemma ENR_sphere:
+  fixes a :: "'a::euclidean_space"
+  shows "ENR(sphere a r)"
+proof (cases "0 < r")
+  case True
+  then have "sphere a r retract_of -{a}"
+    by (simp add: sphere_retract_of_punctured_universe)
+  with open_delete show ?thesis
+    by (auto simp: ENR_def)
+next
+  case False
+  then show ?thesis
+    using finite_imp_ENR
+    by (metis finite_insert infinite_imp_nonempty less_linear sphere_eq_empty sphere_trivial)
+qed
+
+corollary\<^marker>\<open>tag unimportant\<close> ANR_sphere:
+  fixes a :: "'a::euclidean_space"
+  shows "ANR(sphere a r)"
+  by (simp add: ENR_imp_ANR ENR_sphere)
+
+subsection\<open>Spheres are connected, etc\<close>
+
+lemma locally_path_connected_sphere_gen:
+  fixes S :: "'a::euclidean_space set"
+  assumes "bounded S" and "convex S" 
+  shows "locally path_connected (rel_frontier S)"
+proof (cases "rel_interior S = {}")
+  case True
+  with assms show ?thesis
+    by (simp add: rel_interior_eq_empty)
+next
+  case False
+  then obtain a where a: "a \<in> rel_interior S"
+    by blast
+  show ?thesis
+  proof (rule retract_of_locally_path_connected)
+    show "locally path_connected (affine hull S - {a})"
+      by (meson convex_affine_hull convex_imp_locally_path_connected locally_open_subset openin_delete openin_subtopology_self)
+    show "rel_frontier S retract_of affine hull S - {a}"
+      using a assms rel_frontier_retract_of_punctured_affine_hull by blast
+  qed
+qed
+
+lemma locally_connected_sphere_gen:
+  fixes S :: "'a::euclidean_space set"
+  assumes "bounded S" and "convex S" 
+  shows "locally connected (rel_frontier S)"
+  by (simp add: ANR_imp_locally_connected ANR_rel_frontier_convex assms)
+
+lemma locally_path_connected_sphere:
+  fixes a :: "'a::euclidean_space"
+  shows "locally path_connected (sphere a r)"
+  using ENR_imp_locally_path_connected ENR_sphere by blast
+
+lemma locally_connected_sphere:
+  fixes a :: "'a::euclidean_space"
+  shows "locally connected(sphere a r)"
+  using ANR_imp_locally_connected ANR_sphere by blast
+
+subsection\<open>Borsuk homotopy extension theorem\<close>
+
+text\<open>It's only this late so we can use the concept of retraction,
+  saying that the domain sets or range set are ENRs.\<close>
+
+theorem Borsuk_homotopy_extension_homotopic:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+  assumes cloTS: "closedin (top_of_set T) S"
+      and anr: "(ANR S \<and> ANR T) \<or> ANR U"
+      and contf: "continuous_on T f"
+      and "f ` T \<subseteq> U"
+      and "homotopic_with_canon (\<lambda>x. True) S U f g"
+   obtains g' where "homotopic_with_canon (\<lambda>x. True) T U f g'"
+                    "continuous_on T g'" "image g' T \<subseteq> U"
+                    "\<And>x. x \<in> S \<Longrightarrow> g' x = g x"
+proof -
+  have "S \<subseteq> T" using assms closedin_imp_subset by blast
+  obtain h where conth: "continuous_on ({0..1} \<times> S) h"
+             and him: "h ` ({0..1} \<times> S) \<subseteq> U"
+             and [simp]: "\<And>x. h(0, x) = f x" "\<And>x. h(1::real, x) = g x"
+       using assms by (auto simp: homotopic_with_def)
+  define h' where "h' \<equiv>  \<lambda>z. if snd z \<in> S then h z else (f \<circ> snd) z"
+  define B where "B \<equiv> {0::real} \<times> T \<union> {0..1} \<times> S"
+  have clo0T: "closedin (top_of_set ({0..1} \<times> T)) ({0::real} \<times> T)"
+    by (simp add: Abstract_Topology.closedin_Times)
+  moreover have cloT1S: "closedin (top_of_set ({0..1} \<times> T)) ({0..1} \<times> S)"
+    by (simp add: Abstract_Topology.closedin_Times assms)
+  ultimately have clo0TB:"closedin (top_of_set ({0..1} \<times> T)) B"
+    by (auto simp: B_def)
+  have cloBS: "closedin (top_of_set B) ({0..1} \<times> S)"
+    by (metis (no_types) Un_subset_iff B_def closedin_subset_trans [OF cloT1S] clo0TB closedin_imp_subset closedin_self)
+  moreover have cloBT: "closedin (top_of_set B) ({0} \<times> T)"
+    using \<open>S \<subseteq> T\<close> closedin_subset_trans [OF clo0T]
+    by (metis B_def Un_upper1 clo0TB closedin_closed inf_le1)
+  moreover have "continuous_on ({0} \<times> T) (f \<circ> snd)"
+    apply (rule continuous_intros)+
+    apply (simp add: contf)
+    done
+  ultimately have conth': "continuous_on B h'"
+    apply (simp add: h'_def B_def Un_commute [of "{0} \<times> T"])
+    apply (auto intro!: continuous_on_cases_local conth)
+    done
+  have "image h' B \<subseteq> U"
+    using \<open>f ` T \<subseteq> U\<close> him by (auto simp: h'_def B_def)
+  obtain V k where "B \<subseteq> V" and opeTV: "openin (top_of_set ({0..1} \<times> T)) V"
+               and contk: "continuous_on V k" and kim: "k ` V \<subseteq> U"
+               and keq: "\<And>x. x \<in> B \<Longrightarrow> k x = h' x"
+  using anr
+  proof
+    assume ST: "ANR S \<and> ANR T"
+    have eq: "({0} \<times> T \<inter> {0..1} \<times> S) = {0::real} \<times> S"
+      using \<open>S \<subseteq> T\<close> by auto
+    have "ANR B"
+      apply (simp add: B_def)
+      apply (rule ANR_closed_Un_local)
+          apply (metis cloBT B_def)
+         apply (metis Un_commute cloBS B_def)
+        apply (simp_all add: ANR_Times convex_imp_ANR ANR_singleton ST eq)
+      done
+    note Vk = that
+    have *: thesis if "openin (top_of_set ({0..1::real} \<times> T)) V"
+                      "retraction V B r" for V r
+      using that
+      apply (clarsimp simp add: retraction_def)
+      apply (rule Vk [of V "h' \<circ> r"], assumption+)
+        apply (metis continuous_on_compose conth' continuous_on_subset) 
+      using \<open>h' ` B \<subseteq> U\<close> apply force+
+      done
+    show thesis
+        apply (rule ANR_imp_neighbourhood_retract [OF \<open>ANR B\<close> clo0TB])
+        apply (auto simp: ANR_Times ANR_singleton ST retract_of_def *)
+        done
+  next
+    assume "ANR U"
+    with ANR_imp_absolute_neighbourhood_extensor \<open>h' ` B \<subseteq> U\<close> clo0TB conth' that
+    show ?thesis by blast
+  qed
+  define S' where "S' \<equiv> {x. \<exists>u::real. u \<in> {0..1} \<and> (u, x::'a) \<in> {0..1} \<times> T - V}"
+  have "closedin (top_of_set T) S'"
+    unfolding S'_def
+    apply (rule closedin_compact_projection, blast)
+    using closedin_self opeTV by blast
+  have S'_def: "S' = {x. \<exists>u::real.  (u, x::'a) \<in> {0..1} \<times> T - V}"
+    by (auto simp: S'_def)
+  have cloTS': "closedin (top_of_set T) S'"
+    using S'_def \<open>closedin (top_of_set T) S'\<close> by blast
+  have "S \<inter> S' = {}"
+    using S'_def B_def \<open>B \<subseteq> V\<close> by force
+  obtain a :: "'a \<Rightarrow> real" where conta: "continuous_on T a"
+      and "\<And>x. x \<in> T \<Longrightarrow> a x \<in> closed_segment 1 0"
+      and a1: "\<And>x. x \<in> S \<Longrightarrow> a x = 1"
+      and a0: "\<And>x. x \<in> S' \<Longrightarrow> a x = 0"
+    apply (rule Urysohn_local [OF cloTS cloTS' \<open>S \<inter> S' = {}\<close>, of 1 0], blast)
+    done
+  then have ain: "\<And>x. x \<in> T \<Longrightarrow> a x \<in> {0..1}"
+    using closed_segment_eq_real_ivl by auto
+  have inV: "(u * a t, t) \<in> V" if "t \<in> T" "0 \<le> u" "u \<le> 1" for t u
+  proof (rule ccontr)
+    assume "(u * a t, t) \<notin> V"
+    with ain [OF \<open>t \<in> T\<close>] have "a t = 0"
+      apply simp
+      apply (rule a0)
+      by (metis (no_types, lifting) Diff_iff S'_def SigmaI atLeastAtMost_iff mem_Collect_eq mult_le_one mult_nonneg_nonneg that)
+    show False
+      using B_def \<open>(u * a t, t) \<notin> V\<close> \<open>B \<subseteq> V\<close> \<open>a t = 0\<close> that by auto
+  qed
+  show ?thesis
+  proof
+    show hom: "homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. k (a x, x))"
+    proof (simp add: homotopic_with, intro exI conjI)
+      show "continuous_on ({0..1} \<times> T) (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z)))"
+        apply (intro continuous_on_compose continuous_intros)
+        apply (rule continuous_on_subset [OF conta], force)
+        apply (rule continuous_on_subset [OF contk])
+        apply (force intro: inV)
+        done
+      show "(k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) ` ({0..1} \<times> T) \<subseteq> U"
+        using inV kim by auto
+      show "\<forall>x\<in>T. (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) (0, x) = f x"
+        by (simp add: B_def h'_def keq)
+      show "\<forall>x\<in>T. (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) (1, x) = k (a x, x)"
+        by auto
+    qed
+  show "continuous_on T (\<lambda>x. k (a x, x))"
+    using homotopic_with_imp_continuous_maps [OF hom] by auto
+  show "(\<lambda>x. k (a x, x)) ` T \<subseteq> U"
+  proof clarify
+    fix t
+    assume "t \<in> T"
+    show "k (a t, t) \<in> U"
+      by (metis \<open>t \<in> T\<close> image_subset_iff inV kim not_one_le_zero linear mult_cancel_right1)
+  qed
+  show "\<And>x. x \<in> S \<Longrightarrow> k (a x, x) = g x"
+    by (simp add: B_def a1 h'_def keq)
+  qed
+qed
+
+
+corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_ANR_extension:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+  assumes "closed S"
+      and contf: "continuous_on S f"
+      and "ANR T"
+      and fim: "f ` S \<subseteq> T"
+      and "S \<noteq> {}"
+   shows "(\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)) \<longleftrightarrow>
+          (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> T \<and> (\<forall>x \<in> S. g x = f x))"
+       (is "?lhs = ?rhs")
+proof
+  assume ?lhs
+  then obtain c where c: "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. c) f"
+    by (blast intro: homotopic_with_symD)
+  have "closedin (top_of_set UNIV) S"
+    using \<open>closed S\<close> closed_closedin by fastforce
+  then obtain g where "continuous_on UNIV g" "range g \<subseteq> T"
+                      "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
+    apply (rule Borsuk_homotopy_extension_homotopic [OF _ _ continuous_on_const _ c, where T=UNIV])
+    using \<open>ANR T\<close> \<open>S \<noteq> {}\<close> c homotopic_with_imp_subset1 apply fastforce+
+    done
+  then show ?rhs by blast
+next
+  assume ?rhs
+  then obtain g where "continuous_on UNIV g" "range g \<subseteq> T" "\<And>x. x\<in>S \<Longrightarrow> g x = f x"
+    by blast
+  then obtain c where "homotopic_with_canon (\<lambda>h. True) UNIV T g (\<lambda>x. c)"
+    using nullhomotopic_from_contractible [of UNIV g T] contractible_UNIV by blast
+  then have "homotopic_with_canon (\<lambda>x. True) S T g (\<lambda>x. c)"
+    by (simp add: homotopic_from_subtopology)
+  then show ?lhs
+    by (force elim: homotopic_with_eq [of _ _ _ g "\<lambda>x. c"] simp: \<open>\<And>x. x \<in> S \<Longrightarrow> g x = f x\<close>)
+qed
+
+corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_rel_frontier_extension:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+  assumes "closed S"
+      and contf: "continuous_on S f"
+      and "convex T" "bounded T"
+      and fim: "f ` S \<subseteq> rel_frontier T"
+      and "S \<noteq> {}"
+   shows "(\<exists>c. homotopic_with_canon (\<lambda>x. True) S (rel_frontier T) f (\<lambda>x. c)) \<longleftrightarrow>
+          (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> rel_frontier T \<and> (\<forall>x \<in> S. g x = f x))"
+by (simp add: nullhomotopic_into_ANR_extension assms ANR_rel_frontier_convex)
+
+corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_sphere_extension:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b :: euclidean_space"
+  assumes "closed S" and contf: "continuous_on S f"
+      and "S \<noteq> {}" and fim: "f ` S \<subseteq> sphere a r"
+    shows "((\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere a r) f (\<lambda>x. c)) \<longleftrightarrow>
+           (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> sphere a r \<and> (\<forall>x \<in> S. g x = f x)))"
+           (is "?lhs = ?rhs")
+proof (cases "r = 0")
+  case True with fim show ?thesis
+    apply auto
+    using fim continuous_on_const apply fastforce
+    by (metis contf contractible_sing nullhomotopic_into_contractible)
+next
+  case False
+  then have eq: "sphere a r = rel_frontier (cball a r)" by simp
+  show ?thesis
+    using fim unfolding eq
+    apply (rule nullhomotopic_into_rel_frontier_extension [OF \<open>closed S\<close> contf convex_cball bounded_cball])
+    apply (rule \<open>S \<noteq> {}\<close>)
+    done
+qed
+
+proposition\<^marker>\<open>tag unimportant\<close> Borsuk_map_essential_bounded_component:
+  fixes a :: "'a :: euclidean_space"
+  assumes "compact S" and "a \<notin> S"
+   shows "bounded (connected_component_set (- S) a) \<longleftrightarrow>
+          \<not>(\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
+                               (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) (\<lambda>x. c))"
+   (is "?lhs = ?rhs")
+proof (cases "S = {}")
+  case True then show ?thesis
+    by simp
+next
+  case False
+  have "closed S" "bounded S"
+    using \<open>compact S\<close> compact_eq_bounded_closed by auto
+  have s01: "(\<lambda>x. (x - a) /\<^sub>R norm (x - a)) ` S \<subseteq> sphere 0 1"
+    using \<open>a \<notin> S\<close>  by clarsimp (metis dist_eq_0_iff dist_norm mult.commute right_inverse)
+  have aincc: "a \<in> connected_component_set (- S) a"
+    by (simp add: \<open>a \<notin> S\<close>)
+  obtain r where "r>0" and r: "S \<subseteq> ball 0 r"
+    using bounded_subset_ballD \<open>bounded S\<close> by blast
+  have "\<not> ?rhs \<longleftrightarrow> \<not> ?lhs"
+  proof
+    assume notr: "\<not> ?rhs"
+    have nog: "\<nexists>g. continuous_on (S \<union> connected_component_set (- S) a) g \<and>
+                   g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1 \<and>
+                   (\<forall>x\<in>S. g x = (x - a) /\<^sub>R norm (x - a))"
+         if "bounded (connected_component_set (- S) a)"
+      apply (rule non_extensible_Borsuk_map [OF \<open>compact S\<close> componentsI _ aincc])
+      using  \<open>a \<notin> S\<close> that by auto
+    obtain g where "range g \<subseteq> sphere 0 1" "continuous_on UNIV g"
+                        "\<And>x. x \<in> S \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)"
+      using notr
+      by (auto simp: nullhomotopic_into_sphere_extension
+                 [OF \<open>closed S\<close> continuous_on_Borsuk_map [OF \<open>a \<notin> S\<close>] False s01])
+    with \<open>a \<notin> S\<close> show  "\<not> ?lhs"
+      apply (clarsimp simp: Borsuk_map_into_sphere [of a S, symmetric] dest!: nog)
+      apply (drule_tac x=g in spec)
+      using continuous_on_subset by fastforce 
+  next
+    assume "\<not> ?lhs"
+    then obtain b where b: "b \<in> connected_component_set (- S) a" and "r \<le> norm b"
+      using bounded_iff linear by blast
+    then have bnot: "b \<notin> ball 0 r"
+      by simp
+    have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
+                                                   (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
+      apply (rule Borsuk_maps_homotopic_in_path_component)
+      using \<open>closed S\<close> b open_Compl open_path_connected_component apply fastforce
+      done
+    moreover
+    obtain c where "homotopic_with_canon (\<lambda>x. True) (ball 0 r) (sphere 0 1)
+                                   (\<lambda>x. inverse (norm (x - b)) *\<^sub>R (x - b)) (\<lambda>x. c)"
+    proof (rule nullhomotopic_from_contractible)
+      show "contractible (ball (0::'a) r)"
+        by (metis convex_imp_contractible convex_ball)
+      show "continuous_on (ball 0 r) (\<lambda>x. inverse(norm (x - b)) *\<^sub>R (x - b))"
+        by (rule continuous_on_Borsuk_map [OF bnot])
+      show "(\<lambda>x. (x - b) /\<^sub>R norm (x - b)) ` ball 0 r \<subseteq> sphere 0 1"
+        using bnot Borsuk_map_into_sphere by blast
+    qed blast
+    ultimately have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. (x - a) /\<^sub>R norm (x - a)) (\<lambda>x. c)"
+      by (meson homotopic_with_subset_left homotopic_with_trans r)
+    then show "\<not> ?rhs"
+      by blast
+  qed
+  then show ?thesis by blast
+qed
+
+lemma homotopic_Borsuk_maps_in_bounded_component:
+  fixes a :: "'a :: euclidean_space"
+  assumes "compact S" and "a \<notin> S"and "b \<notin> S"
+      and boc: "bounded (connected_component_set (- S) a)"
+      and hom: "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
+                               (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
+                               (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
+   shows "connected_component (- S) a b"
+proof (rule ccontr)
+  assume notcc: "\<not> connected_component (- S) a b"
+  let ?T = "S \<union> connected_component_set (- S) a"
+  have "\<nexists>g. continuous_on (S \<union> connected_component_set (- S) a) g \<and>
+            g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1 \<and>
+            (\<forall>x\<in>S. g x = (x - a) /\<^sub>R norm (x - a))"
+    by (simp add: \<open>a \<notin> S\<close> componentsI non_extensible_Borsuk_map [OF \<open>compact S\<close> _ boc])
+  moreover obtain g where "continuous_on (S \<union> connected_component_set (- S) a) g"
+                          "g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1"
+                          "\<And>x. x \<in> S \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)"
+  proof (rule Borsuk_homotopy_extension_homotopic)
+    show "closedin (top_of_set ?T) S"
+      by (simp add: \<open>compact S\<close> closed_subset compact_imp_closed)
+    show "continuous_on ?T (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
+      by (simp add: \<open>b \<notin> S\<close> notcc continuous_on_Borsuk_map)
+    show "(\<lambda>x. (x - b) /\<^sub>R norm (x - b)) ` ?T \<subseteq> sphere 0 1"
+      by (simp add: \<open>b \<notin> S\<close> notcc Borsuk_map_into_sphere)
+    show "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
+             (\<lambda>x. (x - b) /\<^sub>R norm (x - b)) (\<lambda>x. (x - a) /\<^sub>R norm (x - a))"
+      by (simp add: hom homotopic_with_symD)
+    qed (auto simp: ANR_sphere intro: that)
+  ultimately show False by blast
+qed
+
+
+lemma Borsuk_maps_homotopic_in_connected_component_eq:
+  fixes a :: "'a :: euclidean_space"
+  assumes S: "compact S" "a \<notin> S" "b \<notin> S" and 2: "2 \<le> DIM('a)"
+    shows "(homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
+                   (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
+                   (\<lambda>x. (x - b) /\<^sub>R norm (x - b)) \<longleftrightarrow>
+           connected_component (- S) a b)"
+         (is "?lhs = ?rhs")
+proof
+  assume L: ?lhs
+  show ?rhs
+  proof (cases "bounded(connected_component_set (- S) a)")
+    case True
+    show ?thesis
+      by (rule homotopic_Borsuk_maps_in_bounded_component [OF S True L])
+  next
+    case not_bo_a: False
+    show ?thesis
+    proof (cases "bounded(connected_component_set (- S) b)")
+      case True
+      show ?thesis
+        using homotopic_Borsuk_maps_in_bounded_component [OF S]
+        by (simp add: L True assms connected_component_sym homotopic_Borsuk_maps_in_bounded_component homotopic_with_sym)
+    next
+      case False
+      then show ?thesis
+        using cobounded_unique_unbounded_component [of "-S" a b] \<open>compact S\<close> not_bo_a
+        by (auto simp: compact_eq_bounded_closed assms connected_component_eq_eq)
+    qed
+  qed
+next
+  assume R: ?rhs
+  then have "path_component (- S) a b"
+    using assms(1) compact_eq_bounded_closed open_Compl open_path_connected_component_set by fastforce
+  then show ?lhs
+    by (simp add: Borsuk_maps_homotopic_in_path_component)
+qed
+
+subsection\<open>More extension theorems\<close>
+
+lemma extension_from_clopen:
+  assumes ope: "openin (top_of_set S) T"
+      and clo: "closedin (top_of_set S) T"
+      and contf: "continuous_on T f" and fim: "f ` T \<subseteq> U" and null: "U = {} \<Longrightarrow> S = {}"
+ obtains g where "continuous_on S g" "g ` S \<subseteq> U" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
+proof (cases "U = {}")
+  case True
+  then show ?thesis
+    by (simp add: null that)
+next
+  case False
+  then obtain a where "a \<in> U"
+    by auto
+  let ?g = "\<lambda>x. if x \<in> T then f x else a"
+  have Seq: "S = T \<union> (S - T)"
+    using clo closedin_imp_subset by fastforce
+  show ?thesis
+  proof
+    have "continuous_on (T \<union> (S - T)) ?g"
+      apply (rule continuous_on_cases_local)
+      using Seq clo ope by (auto simp: contf continuous_on_const intro: continuous_on_cases_local)
+    with Seq show "continuous_on S ?g"
+      by metis
+    show "?g ` S \<subseteq> U"
+      using \<open>a \<in> U\<close> fim by auto
+    show "\<And>x. x \<in> T \<Longrightarrow> ?g x = f x"
+      by auto
+  qed
+qed
+
+
+lemma extension_from_component:
+  fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
+  assumes S: "locally connected S \<or> compact S" and "ANR U"
+     and C: "C \<in> components S" and contf: "continuous_on C f" and fim: "f ` C \<subseteq> U"
+ obtains g where "continuous_on S g" "g ` S \<subseteq> U" "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
+proof -
+  obtain T g where ope: "openin (top_of_set S) T"
+               and clo: "closedin (top_of_set S) T"
+               and "C \<subseteq> T" and contg: "continuous_on T g" and gim: "g ` T \<subseteq> U"
+               and gf: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
+    using S
+  proof
+    assume "locally connected S"
+    show ?thesis
+      by (metis C \<open>locally connected S\<close> openin_components_locally_connected closedin_component contf fim order_refl that)
+  next
+    assume "compact S"
+    then obtain W g where "C \<subseteq> W" and opeW: "openin (top_of_set S) W"
+                 and contg: "continuous_on W g"
+                 and gim: "g ` W \<subseteq> U" and gf: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
+      using ANR_imp_absolute_neighbourhood_extensor [of U C f S] C \<open>ANR U\<close> closedin_component contf fim by blast
+    then obtain V where "open V" and V: "W = S \<inter> V"
+      by (auto simp: openin_open)
+    moreover have "locally compact S"
+      by (simp add: \<open>compact S\<close> closed_imp_locally_compact compact_imp_closed)
+    ultimately obtain K where opeK: "openin (top_of_set S) K" and "compact K" "C \<subseteq> K" "K \<subseteq> V"
+      by (metis C Int_subset_iff \<open>C \<subseteq> W\<close> \<open>compact S\<close> compact_components Sura_Bura_clopen_subset)
+    show ?thesis
+    proof
+      show "closedin (top_of_set S) K"
+        by (meson \<open>compact K\<close> \<open>compact S\<close> closedin_compact_eq opeK openin_imp_subset)
+      show "continuous_on K g"
+        by (metis Int_subset_iff V \<open>K \<subseteq> V\<close> contg continuous_on_subset opeK openin_subtopology subset_eq)
+      show "g ` K \<subseteq> U"
+        using V \<open>K \<subseteq> V\<close> gim opeK openin_imp_subset by fastforce
+    qed (use opeK gf \<open>C \<subseteq> K\<close> in auto)
+  qed
+  obtain h where "continuous_on S h" "h ` S \<subseteq> U" "\<And>x. x \<in> T \<Longrightarrow> h x = g x"
+    using extension_from_clopen
+    by (metis C bot.extremum_uniqueI clo contg gim fim image_is_empty in_components_nonempty ope)
+  then show ?thesis
+    by (metis \<open>C \<subseteq> T\<close> gf subset_eq that)
+qed
+
+
+lemma tube_lemma:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "compact S" and S: "S \<noteq> {}" "(\<lambda>x. (x,a)) ` S \<subseteq> U" 
+      and ope: "openin (top_of_set (S \<times> T)) U"
+  obtains V where "openin (top_of_set T) V" "a \<in> V" "S \<times> V \<subseteq> U"
+proof -
+  let ?W = "{y. \<exists>x. x \<in> S \<and> (x, y) \<in> (S \<times> T - U)}"
+  have "U \<subseteq> S \<times> T" "closedin (top_of_set (S \<times> T)) (S \<times> T - U)"
+    using ope by (auto simp: openin_closedin_eq)
+  then have "closedin (top_of_set T) ?W"
+    using \<open>compact S\<close> closedin_compact_projection by blast
+  moreover have "a \<in> T - ?W"
+    using \<open>U \<subseteq> S \<times> T\<close> S by auto
+  moreover have "S \<times> (T - ?W) \<subseteq> U"
+    by auto
+  ultimately show ?thesis
+    by (metis (no_types, lifting) Sigma_cong closedin_def that topspace_euclidean_subtopology)
+qed
+
+lemma tube_lemma_gen:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes "compact S" "S \<noteq> {}" "T \<subseteq> T'" "S \<times> T \<subseteq> U"
+      and ope: "openin (top_of_set (S \<times> T')) U"
+  obtains V where "openin (top_of_set T') V" "T \<subseteq> V" "S \<times> V \<subseteq> U"
+proof -
+  have "\<And>x. x \<in> T \<Longrightarrow> \<exists>V. openin (top_of_set T') V \<and> x \<in> V \<and> S \<times> V \<subseteq> U"
+    using assms by (auto intro:  tube_lemma [OF \<open>compact S\<close>])
+  then obtain F where F: "\<And>x. x \<in> T \<Longrightarrow> openin (top_of_set T') (F x) \<and> x \<in> F x \<and> S \<times> F x \<subseteq> U"
+    by metis
+  show ?thesis
+  proof
+    show "openin (top_of_set T') (\<Union>(F ` T))"
+      using F by blast
+    show "T \<subseteq> \<Union>(F ` T)"
+      using F by blast
+    show "S \<times> \<Union>(F ` T) \<subseteq> U"
+      using F by auto
+  qed
+qed
+
+proposition\<^marker>\<open>tag unimportant\<close> homotopic_neighbourhood_extension:
+  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+  assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> U"
+      and contg: "continuous_on S g" and gim: "g ` S \<subseteq> U"
+      and clo: "closedin (top_of_set S) T"
+      and "ANR U" and hom: "homotopic_with_canon (\<lambda>x. True) T U f g"
+    obtains V where "T \<subseteq> V" "openin (top_of_set S) V"
+                    "homotopic_with_canon (\<lambda>x. True) V U f g"
+proof -
+  have "T \<subseteq> S"
+    using clo closedin_imp_subset by blast
+  obtain h where conth: "continuous_on ({0..1::real} \<times> T) h"
+             and him: "h ` ({0..1} \<times> T) \<subseteq> U"
+             and h0: "\<And>x. h(0, x) = f x" and h1: "\<And>x. h(1, x) = g x"
+    using hom by (auto simp: homotopic_with_def)
+  define h' where "h' \<equiv> \<lambda>z. if fst z \<in> {0} then f(snd z)
+                             else if fst z \<in> {1} then g(snd z)
+                             else h z"
+  let ?S0 = "{0::real} \<times> S" and ?S1 = "{1::real} \<times> S"
+  have "continuous_on(?S0 \<union> (?S1 \<union> {0..1} \<times> T)) h'"
+    unfolding h'_def
+  proof (intro continuous_on_cases_local)
+    show "closedin (top_of_set (?S0 \<union> (?S1 \<union> {0..1} \<times> T))) ?S0"
+         "closedin (top_of_set (?S1 \<union> {0..1} \<times> T)) ?S1"
+      using \<open>T \<subseteq> S\<close> by (force intro: closedin_Times closedin_subset_trans [of "{0..1} \<times> S"])+
+    show "closedin (top_of_set (?S0 \<union> (?S1 \<union> {0..1} \<times> T))) (?S1 \<union> {0..1} \<times> T)"
+         "closedin (top_of_set (?S1 \<union> {0..1} \<times> T)) ({0..1} \<times> T)"
+      using \<open>T \<subseteq> S\<close> by (force intro: clo closedin_Times closedin_subset_trans [of "{0..1} \<times> S"])+
+    show "continuous_on (?S0) (\<lambda>x. f (snd x))"
+      by (intro continuous_intros continuous_on_compose2 [OF contf]) auto
+    show "continuous_on (?S1) (\<lambda>x. g (snd x))"
+      by (intro continuous_intros continuous_on_compose2 [OF contg]) auto
+  qed (use h0 h1 conth in auto)
+  then have "continuous_on ({0,1} \<times> S \<union> ({0..1} \<times> T)) h'"
+    by (metis Sigma_Un_distrib1 Un_assoc insert_is_Un) 
+  moreover have "h' ` ({0,1} \<times> S \<union> {0..1} \<times> T) \<subseteq> U"
+    using fim gim him \<open>T \<subseteq> S\<close> unfolding h'_def by force
+  moreover have "closedin (top_of_set ({0..1::real} \<times> S)) ({0,1} \<times> S \<union> {0..1::real} \<times> T)"
+    by (intro closedin_Times closedin_Un clo) (simp_all add: closed_subset)
+  ultimately
+  obtain W k where W: "({0,1} \<times> S) \<union> ({0..1} \<times> T) \<subseteq> W"
+               and opeW: "openin (top_of_set ({0..1} \<times> S)) W"
+               and contk: "continuous_on W k"
+               and kim: "k ` W \<subseteq> U"
+               and kh': "\<And>x. x \<in> ({0,1} \<times> S) \<union> ({0..1} \<times> T) \<Longrightarrow> k x = h' x"
+    by (metis ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR U\<close>, of "({0,1} \<times> S) \<union> ({0..1} \<times> T)" h' "{0..1} \<times> S"])
+  obtain T' where opeT': "openin (top_of_set S) T'" 
+              and "T \<subseteq> T'" and TW: "{0..1} \<times> T' \<subseteq> W"
+    using tube_lemma_gen [of "{0..1::real}" T S W] W \<open>T \<subseteq> S\<close> opeW by auto
+  moreover have "homotopic_with_canon (\<lambda>x. True) T' U f g"
+  proof (simp add: homotopic_with, intro exI conjI)
+    show "continuous_on ({0..1} \<times> T') k"
+      using TW continuous_on_subset contk by auto
+    show "k ` ({0..1} \<times> T') \<subseteq> U"
+      using TW kim by fastforce
+    have "T' \<subseteq> S"
+      by (meson opeT' subsetD openin_imp_subset)
+    then show "\<forall>x\<in>T'. k (0, x) = f x" "\<forall>x\<in>T'. k (1, x) = g x"
+      by (auto simp: kh' h'_def)
+  qed
+  ultimately show ?thesis
+    by (blast intro: that)
+qed
+
+text\<open> Homotopy on a union of closed-open sets.\<close>
+proposition\<^marker>\<open>tag unimportant\<close> homotopic_on_clopen_Union:
+  fixes \<F> :: "'a::euclidean_space set set"
+  assumes "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (top_of_set (\<Union>\<F>)) S"
+      and "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set (\<Union>\<F>)) S"
+      and "\<And>S. S \<in> \<F> \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) S T f g"
+  shows "homotopic_with_canon (\<lambda>x. True) (\<Union>\<F>) T f g"
+proof -
+  obtain \<V> where "\<V> \<subseteq> \<F>" "countable \<V>" and eqU: "\<Union>\<V> = \<Union>\<F>"
+    using Lindelof_openin assms by blast
+  show ?thesis
+  proof (cases "\<V> = {}")
+    case True
+    then show ?thesis
+      by (metis Union_empty eqU homotopic_with_canon_on_empty)
+  next
+    case False
+    then obtain V :: "nat \<Rightarrow> 'a set" where V: "range V = \<V>"
+      using range_from_nat_into \<open>countable \<V>\<close> by metis
+    with \<open>\<V> \<subseteq> \<F>\<close> have clo: "\<And>n. closedin (top_of_set (\<Union>\<F>)) (V n)"
+                  and ope: "\<And>n. openin (top_of_set (\<Union>\<F>)) (V n)"
+                  and hom: "\<And>n. homotopic_with_canon (\<lambda>x. True) (V n) T f g"
+      using assms by auto 
+    then obtain h where conth: "\<And>n. continuous_on ({0..1::real} \<times> V n) (h n)"
+                  and him: "\<And>n. h n ` ({0..1} \<times> V n) \<subseteq> T" 
+                  and h0: "\<And>n. \<And>x. x \<in> V n \<Longrightarrow> h n (0, x) = f x" 
+                  and h1: "\<And>n. \<And>x. x \<in> V n \<Longrightarrow> h n (1, x) = g x"
+      by (simp add: homotopic_with) metis
+    have wop: "b \<in> V x \<Longrightarrow> \<exists>k. b \<in> V k \<and> (\<forall>j<k. b \<notin> V j)" for b x
+        using nat_less_induct [where P = "\<lambda>i. b \<notin> V i"] by meson
+    obtain \<zeta> where cont: "continuous_on ({0..1} \<times> \<Union>(V ` UNIV)) \<zeta>"
+              and eq: "\<And>x i. \<lbrakk>x \<in> {0..1} \<times> \<Union>(V ` UNIV) \<inter>
+                                   {0..1} \<times> (V i - (\<Union>m<i. V m))\<rbrakk> \<Longrightarrow> \<zeta> x = h i x"
+    proof (rule pasting_lemma_exists)
+      let ?X = "top_of_set ({0..1::real} \<times> \<Union>(range V))"
+      show "topspace ?X \<subseteq> (\<Union>i. {0..1::real} \<times> (V i - (\<Union>m<i. V m)))"
+        by (force simp: Ball_def dest: wop)
+      show "openin (top_of_set ({0..1} \<times> \<Union>(V ` UNIV))) 
+                   ({0..1::real} \<times> (V i - (\<Union>m<i. V m)))" for i
+      proof (intro openin_Times openin_subtopology_self openin_diff)
+        show "openin (top_of_set (\<Union>(V ` UNIV))) (V i)"
+          using ope V eqU by auto
+        show "closedin (top_of_set (\<Union>(V ` UNIV))) (\<Union>m<i. V m)"
+          using V clo eqU by (force intro: closedin_Union)
+      qed
+      show "continuous_map (subtopology ?X ({0..1} \<times> (V i - \<Union> (V ` {..<i})))) euclidean (h i)"  for i
+        by (auto simp add: subtopology_subtopology intro!: continuous_on_subset [OF conth])
+      show "\<And>i j x. x \<in> topspace ?X \<inter> {0..1} \<times> (V i - (\<Union>m<i. V m)) \<inter> {0..1} \<times> (V j - (\<Union>m<j. V m))
+                    \<Longrightarrow> h i x = h j x"
+        by clarsimp (metis lessThan_iff linorder_neqE_nat)
+    qed auto
+    show ?thesis
+    proof (simp add: homotopic_with eqU [symmetric], intro exI conjI ballI)
+      show "continuous_on ({0..1} \<times> \<Union>\<V>) \<zeta>"
+        using V eqU by (blast intro!:  continuous_on_subset [OF cont])
+      show "\<zeta>` ({0..1} \<times> \<Union>\<V>) \<subseteq> T"
+      proof clarsimp
+        fix t :: real and y :: "'a" and X :: "'a set"
+        assume "y \<in> X" "X \<in> \<V>" and t: "0 \<le> t" "t \<le> 1"
+        then obtain k where "y \<in> V k" and j: "\<forall>j<k. y \<notin> V j"
+          by (metis image_iff V wop)
+        with him t show "\<zeta>(t, y) \<in> T"
+          by (subst eq) force+
+      qed
+      fix X y
+      assume "X \<in> \<V>" "y \<in> X"
+      then obtain k where "y \<in> V k" and j: "\<forall>j<k. y \<notin> V j"
+        by (metis image_iff V wop)
+      then show "\<zeta>(0, y) = f y" and "\<zeta>(1, y) = g y"
+        by (subst eq [where i=k]; force simp: h0 h1)+ 
+    qed
+  qed
+qed
+
+lemma homotopic_on_components_eq:
+  fixes S :: "'a :: euclidean_space set" and T :: "'b :: euclidean_space set"
+  assumes S: "locally connected S \<or> compact S" and "ANR T"
+  shows "homotopic_with_canon (\<lambda>x. True) S T f g \<longleftrightarrow>
+         (continuous_on S f \<and> f ` S \<subseteq> T \<and> continuous_on S g \<and> g ` S \<subseteq> T) \<and>
+         (\<forall>C \<in> components S. homotopic_with_canon (\<lambda>x. True) C T f g)"
+    (is "?lhs \<longleftrightarrow> ?C \<and> ?rhs")
+proof -
+  have "continuous_on S f" "f ` S \<subseteq> T" "continuous_on S g" "g ` S \<subseteq> T" if ?lhs
+    using homotopic_with_imp_continuous homotopic_with_imp_subset1 homotopic_with_imp_subset2 that by blast+
+  moreover have "?lhs \<longleftrightarrow> ?rhs"
+    if contf: "continuous_on S f" and fim: "f ` S \<subseteq> T" and contg: "continuous_on S g" and gim: "g ` S \<subseteq> T"
+  proof
+    assume ?lhs
+    with that show ?rhs
+      by (simp add: homotopic_with_subset_left in_components_subset)
+  next
+    assume R: ?rhs
+    have "\<exists>U. C \<subseteq> U \<and> closedin (top_of_set S) U \<and>
+              openin (top_of_set S) U \<and>
+              homotopic_with_canon (\<lambda>x. True) U T f g" if C: "C \<in> components S" for C
+    proof -
+      have "C \<subseteq> S"
+        by (simp add: in_components_subset that)
+      show ?thesis
+        using S
+      proof
+        assume "locally connected S"
+        show ?thesis
+        proof (intro exI conjI)
+          show "closedin (top_of_set S) C"
+            by (simp add: closedin_component that)
+          show "openin (top_of_set S) C"
+            by (simp add: \<open>locally connected S\<close> openin_components_locally_connected that)
+          show "homotopic_with_canon (\<lambda>x. True) C T f g"
+            by (simp add: R that)
+        qed auto
+      next
+        assume "compact S"
+        have hom: "homotopic_with_canon (\<lambda>x. True) C T f g"
+          using R that by blast
+        obtain U where "C \<subseteq> U" and opeU: "openin (top_of_set S) U"
+                  and hom: "homotopic_with_canon (\<lambda>x. True) U T f g"
+          using homotopic_neighbourhood_extension [OF contf fim contg gim _ \<open>ANR T\<close> hom]
+            \<open>C \<in> components S\<close> closedin_component by blast
+        then obtain V where "open V" and V: "U = S \<inter> V"
+          by (auto simp: openin_open)
+        moreover have "locally compact S"
+          by (simp add: \<open>compact S\<close> closed_imp_locally_compact compact_imp_closed)
+        ultimately obtain K where opeK: "openin (top_of_set S) K" and "compact K" "C \<subseteq> K" "K \<subseteq> V"
+          by (metis C Int_subset_iff Sura_Bura_clopen_subset \<open>C \<subseteq> U\<close> \<open>compact S\<close> compact_components)
+        show ?thesis
+        proof (intro exI conjI)
+          show "closedin (top_of_set S) K"
+            by (meson \<open>compact K\<close> \<open>compact S\<close> closedin_compact_eq opeK openin_imp_subset)
+          show "homotopic_with_canon (\<lambda>x. True) K T f g"
+            using V \<open>K \<subseteq> V\<close> hom homotopic_with_subset_left opeK openin_imp_subset by fastforce
+        qed (use opeK \<open>C \<subseteq> K\<close> in auto)
+      qed
+    qed
+    then obtain \<phi> where \<phi>: "\<And>C. C \<in> components S \<Longrightarrow> C \<subseteq> \<phi> C"
+                  and clo\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> closedin (top_of_set S) (\<phi> C)"
+                  and ope\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> openin (top_of_set S) (\<phi> C)"
+                  and hom\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) (\<phi> C) T f g"
+      by metis
+    have Seq: "S = \<Union> (\<phi> ` components S)"
+    proof
+      show "S \<subseteq> \<Union> (\<phi> ` components S)"
+        by (metis Sup_mono Union_components \<phi> imageI)
+      show "\<Union> (\<phi> ` components S) \<subseteq> S"
+        using ope\<phi> openin_imp_subset by fastforce
+    qed
+    show ?lhs
+      apply (subst Seq)
+      apply (rule homotopic_on_clopen_Union)
+      using Seq clo\<phi> ope\<phi> hom\<phi> by auto
+  qed
+  ultimately show ?thesis by blast
+qed
+
+
+lemma cohomotopically_trivial_on_components:
+  fixes S :: "'a :: euclidean_space set" and T :: "'b :: euclidean_space set"
+  assumes S: "locally connected S \<or> compact S" and "ANR T"
+  shows
+   "(\<forall>f g. continuous_on S f \<longrightarrow> f ` S \<subseteq> T \<longrightarrow> continuous_on S g \<longrightarrow> g ` S \<subseteq> T \<longrightarrow>
+           homotopic_with_canon (\<lambda>x. True) S T f g)
+    \<longleftrightarrow>
+    (\<forall>C\<in>components S.
+        \<forall>f g. continuous_on C f \<longrightarrow> f ` C \<subseteq> T \<longrightarrow> continuous_on C g \<longrightarrow> g ` C \<subseteq> T \<longrightarrow>
+              homotopic_with_canon (\<lambda>x. True) C T f g)"
+     (is "?lhs = ?rhs")
+proof
+  assume L[rule_format]: ?lhs
+  show ?rhs
+  proof clarify
+    fix C f g
+    assume contf: "continuous_on C f" and fim: "f ` C \<subseteq> T"
+       and contg: "continuous_on C g" and gim: "g ` C \<subseteq> T" and C: "C \<in> components S"
+    obtain f' where contf': "continuous_on S f'" and f'im: "f' ` S \<subseteq> T" and f'f: "\<And>x. x \<in> C \<Longrightarrow> f' x = f x"
+      using extension_from_component [OF S \<open>ANR T\<close> C contf fim] by metis
+    obtain g' where contg': "continuous_on S g'" and g'im: "g' ` S \<subseteq> T" and g'g: "\<And>x. x \<in> C \<Longrightarrow> g' x = g x"
+      using extension_from_component [OF S \<open>ANR T\<close> C contg gim] by metis
+    have "homotopic_with_canon (\<lambda>x. True) C T f' g'"
+      using L [OF contf' f'im contg' g'im] homotopic_with_subset_left C in_components_subset by fastforce
+    then show "homotopic_with_canon (\<lambda>x. True) C T f g"
+      using f'f g'g homotopic_with_eq by force
+  qed
+next
+  assume R [rule_format]: ?rhs
+  show ?lhs
+  proof clarify
+    fix f g
+    assume contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
+      and contg: "continuous_on S g" and gim: "g ` S \<subseteq> T"
+    moreover have "homotopic_with_canon (\<lambda>x. True) C T f g" if "C \<in> components S" for C
+      using R [OF that]
+      by (meson contf contg continuous_on_subset fim gim image_mono in_components_subset order.trans that)
+    ultimately show "homotopic_with_canon (\<lambda>x. True) S T f g"
+      by (subst homotopic_on_components_eq [OF S \<open>ANR T\<close>]) auto
+  qed
+qed
+
+subsection\<open>The complement of a set and path-connectedness\<close>
+
+text\<open>Complement in dimension N > 1 of set homeomorphic to any interval in
+ any dimension is (path-)connected. This naively generalizes the argument
+ in Ryuji Maehara's paper "The Jordan curve theorem via the Brouwer fixed point theorem",
+American Mathematical Monthly 1984.\<close>
+
+lemma unbounded_components_complement_absolute_retract:
+  fixes S :: "'a::euclidean_space set"
+  assumes C: "C \<in> components(- S)" and S: "compact S" "AR S"
+    shows "\<not> bounded C"
+proof -
+  obtain y where y: "C = connected_component_set (- S) y" and "y \<notin> S"
+    using C by (auto simp: components_def)
+  have "open(- S)"
+    using S by (simp add: closed_open compact_eq_bounded_closed)
+  have "S retract_of UNIV"
+    using S compact_AR by blast
+  then obtain r where contr: "continuous_on UNIV r" and ontor: "range r \<subseteq> S"
+                  and r: "\<And>x. x \<in> S \<Longrightarrow> r x = x"
+    by (auto simp: retract_of_def retraction_def)
+  show ?thesis
+  proof
+    assume "bounded C"
+    have "connected_component_set (- S) y \<subseteq> S"
+    proof (rule frontier_subset_retraction)
+      show "bounded (connected_component_set (- S) y)"
+        using \<open>bounded C\<close> y by blast
+      show "frontier (connected_component_set (- S) y) \<subseteq> S"
+        using C \<open>compact S\<close> compact_eq_bounded_closed frontier_of_components_closed_complement y by blast
+      show "continuous_on (closure (connected_component_set (- S) y)) r"
+        by (blast intro: continuous_on_subset [OF contr])
+    qed (use ontor r in auto)
+    with \<open>y \<notin> S\<close> show False by force
+  qed
+qed
+
+lemma connected_complement_absolute_retract:
+  fixes S :: "'a::euclidean_space set"
+  assumes S: "compact S" "AR S" and 2: "2 \<le> DIM('a)"
+    shows "connected(- S)"
+proof -
+  have "S retract_of UNIV"
+    using S compact_AR by blast
+  show ?thesis
+    apply (clarsimp simp: connected_iff_connected_component_eq)
+    apply (rule cobounded_unique_unbounded_component [OF _ 2])
+      apply (simp add: \<open>compact S\<close> compact_imp_bounded)
+     apply (meson ComplI S componentsI unbounded_components_complement_absolute_retract)+
+    done
+qed
+
+lemma path_connected_complement_absolute_retract:
+  fixes S :: "'a::euclidean_space set"
+  assumes "compact S" "AR S" "2 \<le> DIM('a)"
+    shows "path_connected(- S)"
+  using connected_complement_absolute_retract [OF assms]
+  using \<open>compact S\<close> compact_eq_bounded_closed connected_open_path_connected by blast
+
+theorem connected_complement_homeomorphic_convex_compact:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes hom: "S homeomorphic T" and T: "convex T" "compact T" and 2: "2 \<le> DIM('a)"
+    shows "connected(- S)"
+proof (cases "S = {}")
+  case True
+  then show ?thesis
+    by (simp add: connected_UNIV)
+next
+  case False
+  show ?thesis
+  proof (rule connected_complement_absolute_retract)
+    show "compact S"
+      using \<open>compact T\<close> hom homeomorphic_compactness by auto
+    show "AR S"
+      by (meson AR_ANR False \<open>convex T\<close> convex_imp_ANR convex_imp_contractible hom homeomorphic_ANR_iff_ANR homeomorphic_contractible_eq)
+  qed (rule 2)
+qed
+
+corollary path_connected_complement_homeomorphic_convex_compact:
+  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
+  assumes hom: "S homeomorphic T" "convex T" "compact T" "2 \<le> DIM('a)"
+    shows "path_connected(- S)"
+  using connected_complement_homeomorphic_convex_compact [OF assms]
+  using \<open>compact T\<close> compact_eq_bounded_closed connected_open_path_connected hom homeomorphic_compactness by blast
+
+lemma path_connected_complement_homeomorphic_interval:
+  fixes S :: "'a::euclidean_space set"
+  assumes "S homeomorphic cbox a b" "2 \<le> DIM('a)"
+  shows "path_connected(-S)"
+  using assms compact_cbox convex_box(1) path_connected_complement_homeomorphic_convex_compact by blast
+
+lemma connected_complement_homeomorphic_interval:
+  fixes S :: "'a::euclidean_space set"
+  assumes "S homeomorphic cbox a b" "2 \<le> DIM('a)"
+  shows "connected(-S)"
+  using assms path_connected_complement_homeomorphic_interval path_connected_imp_connected by blast
+
+end