src/HOL/Analysis/Further_Topology.thy
author wenzelm
Mon Mar 25 17:21:26 2019 +0100 (4 weeks ago)
changeset 69981 3dced198b9ec
parent 69922 4a9167f377b0
child 69986 f2d327275065
permissions -rw-r--r--
more strict AFP properties;
     1 section \<open>Extending Continous Maps, Invariance of Domain, etc\<close> (*FIX rename? *)
     2 
     3 text\<open>Ported from HOL Light (moretop.ml) by L C Paulson\<close>
     4 
     5 theory Further_Topology
     6   imports Equivalence_Lebesgue_Henstock_Integration Weierstrass_Theorems Polytope Complex_Transcendental
     7 begin
     8 
     9 subsection\<open>A map from a sphere to a higher dimensional sphere is nullhomotopic\<close>
    10 
    11 lemma spheremap_lemma1:
    12   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
    13   assumes "subspace S" "subspace T" and dimST: "dim S < dim T"
    14       and "S \<subseteq> T"
    15       and diff_f: "f differentiable_on sphere 0 1 \<inter> S"
    16     shows "f ` (sphere 0 1 \<inter> S) \<noteq> sphere 0 1 \<inter> T"
    17 proof
    18   assume fim: "f ` (sphere 0 1 \<inter> S) = sphere 0 1 \<inter> T"
    19   have inS: "\<And>x. \<lbrakk>x \<in> S; x \<noteq> 0\<rbrakk> \<Longrightarrow> (x /\<^sub>R norm x) \<in> S"
    20     using subspace_mul \<open>subspace S\<close> by blast
    21   have subS01: "(\<lambda>x. x /\<^sub>R norm x) ` (S - {0}) \<subseteq> sphere 0 1 \<inter> S"
    22     using \<open>subspace S\<close> subspace_mul by fastforce
    23   then have diff_f': "f differentiable_on (\<lambda>x. x /\<^sub>R norm x) ` (S - {0})"
    24     by (rule differentiable_on_subset [OF diff_f])
    25   define g where "g \<equiv> \<lambda>x. norm x *\<^sub>R f(inverse(norm x) *\<^sub>R x)"
    26   have gdiff: "g differentiable_on S - {0}"
    27     unfolding g_def
    28     by (rule diff_f' derivative_intros differentiable_on_compose [where f=f] | force)+
    29   have geq: "g ` (S - {0}) = T - {0}"
    30   proof
    31     have "g ` (S - {0}) \<subseteq> T"
    32       apply (auto simp: g_def subspace_mul [OF \<open>subspace T\<close>])
    33       apply (metis (mono_tags, lifting) DiffI subS01 subspace_mul [OF \<open>subspace T\<close>] fim image_subset_iff inf_le2 singletonD)
    34       done
    35     moreover have "g ` (S - {0}) \<subseteq> UNIV - {0}"
    36     proof (clarsimp simp: g_def)
    37       fix y
    38       assume "y \<in> S" and f0: "f (y /\<^sub>R norm y) = 0"
    39       then have "y \<noteq> 0 \<Longrightarrow> y /\<^sub>R norm y \<in> sphere 0 1 \<inter> S"
    40         by (auto simp: subspace_mul [OF \<open>subspace S\<close>])
    41       then show "y = 0"
    42         by (metis fim f0 Int_iff image_iff mem_sphere_0 norm_eq_zero zero_neq_one)
    43     qed
    44     ultimately show "g ` (S - {0}) \<subseteq> T - {0}"
    45       by auto
    46   next
    47     have *: "sphere 0 1 \<inter> T \<subseteq> f ` (sphere 0 1 \<inter> S)"
    48       using fim by (simp add: image_subset_iff)
    49     have "x \<in> (\<lambda>x. norm x *\<^sub>R f (x /\<^sub>R norm x)) ` (S - {0})"
    50           if "x \<in> T" "x \<noteq> 0" for x
    51     proof -
    52       have "x /\<^sub>R norm x \<in> T"
    53         using \<open>subspace T\<close> subspace_mul that by blast
    54       then show ?thesis
    55         using * [THEN subsetD, of "x /\<^sub>R norm x"] that apply clarsimp
    56         apply (rule_tac x="norm x *\<^sub>R xa" in image_eqI, simp)
    57         apply (metis norm_eq_zero right_inverse scaleR_one scaleR_scaleR)
    58         using \<open>subspace S\<close> subspace_mul apply force
    59         done
    60     qed
    61     then have "T - {0} \<subseteq> (\<lambda>x. norm x *\<^sub>R f (x /\<^sub>R norm x)) ` (S - {0})"
    62       by force
    63     then show "T - {0} \<subseteq> g ` (S - {0})"
    64       by (simp add: g_def)
    65   qed
    66   define T' where "T' \<equiv> {y. \<forall>x \<in> T. orthogonal x y}"
    67   have "subspace T'"
    68     by (simp add: subspace_orthogonal_to_vectors T'_def)
    69   have dim_eq: "dim T' + dim T = DIM('a)"
    70     using dim_subspace_orthogonal_to_vectors [of T UNIV] \<open>subspace T\<close>
    71     by (simp add: T'_def)
    72   have "\<exists>v1 v2. v1 \<in> span T \<and> (\<forall>w \<in> span T. orthogonal v2 w) \<and> x = v1 + v2" for x
    73     by (force intro: orthogonal_subspace_decomp_exists [of T x])
    74   then obtain p1 p2 where p1span: "p1 x \<in> span T"
    75                       and "\<And>w. w \<in> span T \<Longrightarrow> orthogonal (p2 x) w"
    76                       and eq: "p1 x + p2 x = x" for x
    77     by metis
    78   then have p1: "\<And>z. p1 z \<in> T" and ortho: "\<And>w. w \<in> T \<Longrightarrow> orthogonal (p2 x) w" for x
    79     using span_eq_iff \<open>subspace T\<close> by blast+
    80   then have p2: "\<And>z. p2 z \<in> T'"
    81     by (simp add: T'_def orthogonal_commute)
    82   have p12_eq: "\<And>x y. \<lbrakk>x \<in> T; y \<in> T'\<rbrakk> \<Longrightarrow> p1(x + y) = x \<and> p2(x + y) = y"
    83   proof (rule orthogonal_subspace_decomp_unique [OF eq p1span, where T=T'])
    84     show "\<And>x y. \<lbrakk>x \<in> T; y \<in> T'\<rbrakk> \<Longrightarrow> p2 (x + y) \<in> span T'"
    85       using span_eq_iff p2 \<open>subspace T'\<close> by blast
    86     show "\<And>a b. \<lbrakk>a \<in> T; b \<in> T'\<rbrakk> \<Longrightarrow> orthogonal a b"
    87       using T'_def by blast
    88   qed (auto simp: span_base)
    89   then have "\<And>c x. p1 (c *\<^sub>R x) = c *\<^sub>R p1 x \<and> p2 (c *\<^sub>R x) = c *\<^sub>R p2 x"
    90   proof -
    91     fix c :: real and x :: 'a
    92     have f1: "c *\<^sub>R x = c *\<^sub>R p1 x + c *\<^sub>R p2 x"
    93       by (metis eq pth_6)
    94     have f2: "c *\<^sub>R p2 x \<in> T'"
    95       by (simp add: \<open>subspace T'\<close> p2 subspace_scale)
    96     have "c *\<^sub>R p1 x \<in> T"
    97       by (metis (full_types) assms(2) p1span span_eq_iff subspace_scale)
    98     then show "p1 (c *\<^sub>R x) = c *\<^sub>R p1 x \<and> p2 (c *\<^sub>R x) = c *\<^sub>R p2 x"
    99       using f2 f1 p12_eq by presburger
   100   qed
   101   moreover have lin_add: "\<And>x y. p1 (x + y) = p1 x + p1 y \<and> p2 (x + y) = p2 x + p2 y"
   102   proof (rule orthogonal_subspace_decomp_unique [OF _ p1span, where T=T'])
   103     show "\<And>x y. p1 (x + y) + p2 (x + y) = p1 x + p1 y + (p2 x + p2 y)"
   104       by (simp add: add.assoc add.left_commute eq)
   105     show  "\<And>a b. \<lbrakk>a \<in> T; b \<in> T'\<rbrakk> \<Longrightarrow> orthogonal a b"
   106       using T'_def by blast
   107   qed (auto simp: p1span p2 span_base span_add)
   108   ultimately have "linear p1" "linear p2"
   109     by unfold_locales auto
   110   have "(\<lambda>z. g (p1 z)) differentiable_on {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
   111     apply (rule differentiable_on_compose [where f=g])
   112     apply (rule linear_imp_differentiable_on [OF \<open>linear p1\<close>])
   113     apply (rule differentiable_on_subset [OF gdiff])
   114     using p12_eq \<open>S \<subseteq> T\<close> apply auto
   115     done
   116   then have diff: "(\<lambda>x. g (p1 x) + p2 x) differentiable_on {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
   117     by (intro derivative_intros linear_imp_differentiable_on [OF \<open>linear p2\<close>])
   118   have "dim {x + y |x y. x \<in> S - {0} \<and> y \<in> T'} \<le> dim {x + y |x y. x \<in> S  \<and> y \<in> T'}"
   119     by (blast intro: dim_subset)
   120   also have "... = dim S + dim T' - dim (S \<inter> T')"
   121     using dim_sums_Int [OF \<open>subspace S\<close> \<open>subspace T'\<close>]
   122     by (simp add: algebra_simps)
   123   also have "... < DIM('a)"
   124     using dimST dim_eq by auto
   125   finally have neg: "negligible {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
   126     by (rule negligible_lowdim)
   127   have "negligible ((\<lambda>x. g (p1 x) + p2 x) ` {x + y |x y. x \<in> S - {0} \<and> y \<in> T'})"
   128     by (rule negligible_differentiable_image_negligible [OF order_refl neg diff])
   129   then have "negligible {x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}"
   130   proof (rule negligible_subset)
   131     have "\<lbrakk>t' \<in> T'; s \<in> S; s \<noteq> 0\<rbrakk>
   132           \<Longrightarrow> g s + t' \<in> (\<lambda>x. g (p1 x) + p2 x) `
   133                          {x + t' |x t'. x \<in> S \<and> x \<noteq> 0 \<and> t' \<in> T'}" for t' s
   134       apply (rule_tac x="s + t'" in image_eqI)
   135       using \<open>S \<subseteq> T\<close> p12_eq by auto
   136     then show "{x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}
   137           \<subseteq> (\<lambda>x. g (p1 x) + p2 x) ` {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
   138       by auto
   139   qed
   140   moreover have "- T' \<subseteq> {x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}"
   141   proof clarsimp
   142     fix z assume "z \<notin> T'"
   143     show "\<exists>x y. z = x + y \<and> x \<in> g ` (S - {0}) \<and> y \<in> T'"
   144       apply (rule_tac x="p1 z" in exI)
   145       apply (rule_tac x="p2 z" in exI)
   146       apply (simp add: p1 eq p2 geq)
   147       by (metis \<open>z \<notin> T'\<close> add.left_neutral eq p2)
   148   qed
   149   ultimately have "negligible (-T')"
   150     using negligible_subset by blast
   151   moreover have "negligible T'"
   152     using negligible_lowdim
   153     by (metis add.commute assms(3) diff_add_inverse2 diff_self_eq_0 dim_eq le_add1 le_antisym linordered_semidom_class.add_diff_inverse not_less0)
   154   ultimately have  "negligible (-T' \<union> T')"
   155     by (metis negligible_Un_eq)
   156   then show False
   157     using negligible_Un_eq non_negligible_UNIV by simp
   158 qed
   159 
   160 
   161 lemma spheremap_lemma2:
   162   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   163   assumes ST: "subspace S" "subspace T" "dim S < dim T"
   164       and "S \<subseteq> T"
   165       and contf: "continuous_on (sphere 0 1 \<inter> S) f"
   166       and fim: "f ` (sphere 0 1 \<inter> S) \<subseteq> sphere 0 1 \<inter> T"
   167     shows "\<exists>c. homotopic_with (\<lambda>x. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) f (\<lambda>x. c)"
   168 proof -
   169   have [simp]: "\<And>x. \<lbrakk>norm x = 1; x \<in> S\<rbrakk> \<Longrightarrow> norm (f x) = 1"
   170     using fim by (simp add: image_subset_iff)
   171   have "compact (sphere 0 1 \<inter> S)"
   172     by (simp add: \<open>subspace S\<close> closed_subspace compact_Int_closed)
   173   then obtain g where pfg: "polynomial_function g" and gim: "g ` (sphere 0 1 \<inter> S) \<subseteq> T"
   174                 and g12: "\<And>x. x \<in> sphere 0 1 \<inter> S \<Longrightarrow> norm(f x - g x) < 1/2"
   175     apply (rule Stone_Weierstrass_polynomial_function_subspace [OF _ contf _ \<open>subspace T\<close>, of "1/2"])
   176     using fim apply auto
   177     done
   178   have gnz: "g x \<noteq> 0" if "x \<in> sphere 0 1 \<inter> S" for x
   179   proof -
   180     have "norm (f x) = 1"
   181       using fim that by (simp add: image_subset_iff)
   182     then show ?thesis
   183       using g12 [OF that] by auto
   184   qed
   185   have diffg: "g differentiable_on sphere 0 1 \<inter> S"
   186     by (metis pfg differentiable_on_polynomial_function)
   187   define h where "h \<equiv> \<lambda>x. inverse(norm(g x)) *\<^sub>R g x"
   188   have h: "x \<in> sphere 0 1 \<inter> S \<Longrightarrow> h x \<in> sphere 0 1 \<inter> T" for x
   189     unfolding h_def
   190     using gnz [of x]
   191     by (auto simp: subspace_mul [OF \<open>subspace T\<close>] subsetD [OF gim])
   192   have diffh: "h differentiable_on sphere 0 1 \<inter> S"
   193     unfolding h_def
   194     apply (intro derivative_intros diffg differentiable_on_compose [OF diffg])
   195     using gnz apply auto
   196     done
   197   have homfg: "homotopic_with (\<lambda>z. True) (sphere 0 1 \<inter> S) (T - {0}) f g"
   198   proof (rule homotopic_with_linear [OF contf])
   199     show "continuous_on (sphere 0 1 \<inter> S) g"
   200       using pfg by (simp add: differentiable_imp_continuous_on diffg)
   201   next
   202     have non0fg: "0 \<notin> closed_segment (f x) (g x)" if "norm x = 1" "x \<in> S" for x
   203     proof -
   204       have "f x \<in> sphere 0 1"
   205         using fim that by (simp add: image_subset_iff)
   206       moreover have "norm(f x - g x) < 1/2"
   207         apply (rule g12)
   208         using that by force
   209       ultimately show ?thesis
   210         by (auto simp: norm_minus_commute dest: segment_bound)
   211     qed
   212     show "\<And>x. x \<in> sphere 0 1 \<inter> S \<Longrightarrow> closed_segment (f x) (g x) \<subseteq> T - {0}"
   213       apply (simp add: subset_Diff_insert non0fg)
   214       apply (simp add: segment_convex_hull)
   215       apply (rule hull_minimal)
   216        using fim image_eqI gim apply force
   217       apply (rule subspace_imp_convex [OF \<open>subspace T\<close>])
   218       done
   219   qed
   220   obtain d where d: "d \<in> (sphere 0 1 \<inter> T) - h ` (sphere 0 1 \<inter> S)"
   221     using h spheremap_lemma1 [OF ST \<open>S \<subseteq> T\<close> diffh] by force
   222   then have non0hd: "0 \<notin> closed_segment (h x) (- d)" if "norm x = 1" "x \<in> S" for x
   223     using midpoint_between [of 0 "h x" "-d"] that h [of x]
   224     by (auto simp: between_mem_segment midpoint_def)
   225   have conth: "continuous_on (sphere 0 1 \<inter> S) h"
   226     using differentiable_imp_continuous_on diffh by blast
   227   have hom_hd: "homotopic_with (\<lambda>z. True) (sphere 0 1 \<inter> S) (T - {0}) h (\<lambda>x. -d)"
   228     apply (rule homotopic_with_linear [OF conth continuous_on_const])
   229     apply (simp add: subset_Diff_insert non0hd)
   230     apply (simp add: segment_convex_hull)
   231     apply (rule hull_minimal)
   232      using h d apply (force simp: subspace_neg [OF \<open>subspace T\<close>])
   233     apply (rule subspace_imp_convex [OF \<open>subspace T\<close>])
   234     done
   235   have conT0: "continuous_on (T - {0}) (\<lambda>y. inverse(norm y) *\<^sub>R y)"
   236     by (intro continuous_intros) auto
   237   have sub0T: "(\<lambda>y. y /\<^sub>R norm y) ` (T - {0}) \<subseteq> sphere 0 1 \<inter> T"
   238     by (fastforce simp: assms(2) subspace_mul)
   239   obtain c where homhc: "homotopic_with (\<lambda>z. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) h (\<lambda>x. c)"
   240     apply (rule_tac c="-d" in that)
   241     apply (rule homotopic_with_eq)
   242        apply (rule homotopic_compose_continuous_left [OF hom_hd conT0 sub0T])
   243     using d apply (auto simp: h_def)
   244     done
   245   show ?thesis
   246     apply (rule_tac x=c in exI)
   247     apply (rule homotopic_with_trans [OF _ homhc])
   248     apply (rule homotopic_with_eq)
   249        apply (rule homotopic_compose_continuous_left [OF homfg conT0 sub0T])
   250       apply (auto simp: h_def)
   251     done
   252 qed
   253 
   254 
   255 lemma spheremap_lemma3:
   256   assumes "bounded S" "convex S" "subspace U" and affSU: "aff_dim S \<le> dim U"
   257   obtains T where "subspace T" "T \<subseteq> U" "S \<noteq> {} \<Longrightarrow> aff_dim T = aff_dim S"
   258                   "(rel_frontier S) homeomorphic (sphere 0 1 \<inter> T)"
   259 proof (cases "S = {}")
   260   case True
   261   with \<open>subspace U\<close> subspace_0 show ?thesis
   262     by (rule_tac T = "{0}" in that) auto
   263 next
   264   case False
   265   then obtain a where "a \<in> S"
   266     by auto
   267   then have affS: "aff_dim S = int (dim ((\<lambda>x. -a+x) ` S))"
   268     by (metis hull_inc aff_dim_eq_dim)
   269   with affSU have "dim ((\<lambda>x. -a+x) ` S) \<le> dim U"
   270     by linarith
   271   with choose_subspace_of_subspace
   272   obtain T where "subspace T" "T \<subseteq> span U" and dimT: "dim T = dim ((\<lambda>x. -a+x) ` S)" .
   273   show ?thesis
   274   proof (rule that [OF \<open>subspace T\<close>])
   275     show "T \<subseteq> U"
   276       using span_eq_iff \<open>subspace U\<close> \<open>T \<subseteq> span U\<close> by blast
   277     show "aff_dim T = aff_dim S"
   278       using dimT \<open>subspace T\<close> affS aff_dim_subspace by fastforce
   279     show "rel_frontier S homeomorphic sphere 0 1 \<inter> T"
   280     proof -
   281       have "aff_dim (ball 0 1 \<inter> T) = aff_dim (T)"
   282         by (metis IntI interior_ball \<open>subspace T\<close> aff_dim_convex_Int_nonempty_interior centre_in_ball empty_iff inf_commute subspace_0 subspace_imp_convex zero_less_one)
   283       then have affS_eq: "aff_dim S = aff_dim (ball 0 1 \<inter> T)"
   284         using \<open>aff_dim T = aff_dim S\<close> by simp
   285       have "rel_frontier S homeomorphic rel_frontier(ball 0 1 \<inter> T)"
   286         apply (rule homeomorphic_rel_frontiers_convex_bounded_sets [OF \<open>convex S\<close> \<open>bounded S\<close>])
   287           apply (simp add: \<open>subspace T\<close> convex_Int subspace_imp_convex)
   288          apply (simp add: bounded_Int)
   289         apply (rule affS_eq)
   290         done
   291       also have "... = frontier (ball 0 1) \<inter> T"
   292         apply (rule convex_affine_rel_frontier_Int [OF convex_ball])
   293          apply (simp add: \<open>subspace T\<close> subspace_imp_affine)
   294         using \<open>subspace T\<close> subspace_0 by force
   295       also have "... = sphere 0 1 \<inter> T"
   296         by auto
   297       finally show ?thesis .
   298     qed
   299   qed
   300 qed
   301 
   302 
   303 proposition inessential_spheremap_lowdim_gen:
   304   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::euclidean_space"
   305   assumes "convex S" "bounded S" "convex T" "bounded T"
   306       and affST: "aff_dim S < aff_dim T"
   307       and contf: "continuous_on (rel_frontier S) f"
   308       and fim: "f ` (rel_frontier S) \<subseteq> rel_frontier T"
   309   obtains c where "homotopic_with (\<lambda>z. True) (rel_frontier S) (rel_frontier T) f (\<lambda>x. c)"
   310 proof (cases "S = {}")
   311   case True
   312   then show ?thesis
   313     by (simp add: that)
   314 next
   315   case False
   316   then show ?thesis
   317   proof (cases "T = {}")
   318     case True
   319     then show ?thesis
   320       using fim that by auto
   321   next
   322     case False
   323     obtain T':: "'a set"
   324       where "subspace T'" and affT': "aff_dim T' = aff_dim T"
   325         and homT: "rel_frontier T homeomorphic sphere 0 1 \<inter> T'"
   326       apply (rule spheremap_lemma3 [OF \<open>bounded T\<close> \<open>convex T\<close> subspace_UNIV, where 'b='a])
   327        apply (simp add: aff_dim_le_DIM)
   328       using \<open>T \<noteq> {}\<close> by blast
   329     with homeomorphic_imp_homotopy_eqv
   330     have relT: "sphere 0 1 \<inter> T'  homotopy_eqv rel_frontier T"
   331       using homotopy_eqv_sym by blast
   332     have "aff_dim S \<le> int (dim T')"
   333       using affT' \<open>subspace T'\<close> affST aff_dim_subspace by force
   334     with spheremap_lemma3 [OF \<open>bounded S\<close> \<open>convex S\<close> \<open>subspace T'\<close>] \<open>S \<noteq> {}\<close>
   335     obtain S':: "'a set" where "subspace S'" "S' \<subseteq> T'"
   336        and affS': "aff_dim S' = aff_dim S"
   337        and homT: "rel_frontier S homeomorphic sphere 0 1 \<inter> S'"
   338         by metis
   339     with homeomorphic_imp_homotopy_eqv
   340     have relS: "sphere 0 1 \<inter> S'  homotopy_eqv rel_frontier S"
   341       using homotopy_eqv_sym by blast
   342     have dimST': "dim S' < dim T'"
   343       by (metis \<open>S' \<subseteq> T'\<close> \<open>subspace S'\<close> \<open>subspace T'\<close> affS' affST affT' less_irrefl not_le subspace_dim_equal)
   344     have "\<exists>c. homotopic_with (\<lambda>z. True) (rel_frontier S) (rel_frontier T) f (\<lambda>x. c)"
   345       apply (rule homotopy_eqv_homotopic_triviality_null_imp [OF relT contf fim])
   346       apply (rule homotopy_eqv_cohomotopic_triviality_null[OF relS, THEN iffD1, rule_format])
   347        apply (metis dimST' \<open>subspace S'\<close>  \<open>subspace T'\<close>  \<open>S' \<subseteq> T'\<close> spheremap_lemma2, blast)
   348       done
   349     with that show ?thesis by blast
   350   qed
   351 qed
   352 
   353 lemma inessential_spheremap_lowdim:
   354   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::euclidean_space"
   355   assumes
   356    "DIM('M) < DIM('a)" and f: "continuous_on (sphere a r) f" "f ` (sphere a r) \<subseteq> (sphere b s)"
   357    obtains c where "homotopic_with (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. c)"
   358 proof (cases "s \<le> 0")
   359   case True then show ?thesis
   360     by (meson nullhomotopic_into_contractible f contractible_sphere that)
   361 next
   362   case False
   363   show ?thesis
   364   proof (cases "r \<le> 0")
   365     case True then show ?thesis
   366       by (meson f nullhomotopic_from_contractible contractible_sphere that)
   367   next
   368     case False
   369     with \<open>\<not> s \<le> 0\<close> have "r > 0" "s > 0" by auto
   370     show ?thesis
   371       apply (rule inessential_spheremap_lowdim_gen [of "cball a r" "cball b s" f])
   372       using  \<open>0 < r\<close> \<open>0 < s\<close> assms(1)
   373              apply (simp_all add: f aff_dim_cball)
   374       using that by blast
   375   qed
   376 qed
   377 
   378 
   379 
   380 subsection\<open> Some technical lemmas about extending maps from cell complexes\<close>
   381 
   382 lemma extending_maps_Union_aux:
   383   assumes fin: "finite \<F>"
   384       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
   385       and "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>; S \<noteq> T\<rbrakk> \<Longrightarrow> S \<inter> T \<subseteq> K"
   386       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>g. continuous_on S g \<and> g ` S \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
   387    shows "\<exists>g. continuous_on (\<Union>\<F>) g \<and> g ` (\<Union>\<F>) \<subseteq> T \<and> (\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x)"
   388 using assms
   389 proof (induction \<F>)
   390   case empty show ?case by simp
   391 next
   392   case (insert S \<F>)
   393   then obtain f where contf: "continuous_on (S) f" and fim: "f ` S \<subseteq> T" and feq: "\<forall>x \<in> S \<inter> K. f x = h x"
   394     by (meson insertI1)
   395   obtain g where contg: "continuous_on (\<Union>\<F>) g" and gim: "g ` \<Union>\<F> \<subseteq> T" and geq: "\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x"
   396     using insert by auto
   397   have fg: "f x = g x" if "x \<in> T" "T \<in> \<F>" "x \<in> S" for x T
   398   proof -
   399     have "T \<inter> S \<subseteq> K \<or> S = T"
   400       using that by (metis (no_types) insert.prems(2) insertCI)
   401     then show ?thesis
   402       using UnionI feq geq \<open>S \<notin> \<F>\<close> subsetD that by fastforce
   403   qed
   404   show ?case
   405     apply (rule_tac x="\<lambda>x. if x \<in> S then f x else g x" in exI, simp)
   406     apply (intro conjI continuous_on_cases)
   407     apply (simp_all add: insert closed_Union contf contg)
   408     using fim gim feq geq
   409     apply (force simp: insert closed_Union contf contg inf_commute intro: fg)+
   410     done
   411 qed
   412 
   413 lemma extending_maps_Union:
   414   assumes fin: "finite \<F>"
   415       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>g. continuous_on S g \<and> g ` S \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
   416       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
   417       and K: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>; \<not> X \<subseteq> Y; \<not> Y \<subseteq> X\<rbrakk> \<Longrightarrow> X \<inter> Y \<subseteq> K"
   418     shows "\<exists>g. continuous_on (\<Union>\<F>) g \<and> g ` (\<Union>\<F>) \<subseteq> T \<and> (\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x)"
   419 apply (simp add: Union_maximal_sets [OF fin, symmetric])
   420 apply (rule extending_maps_Union_aux)
   421 apply (simp_all add: Union_maximal_sets [OF fin] assms)
   422 by (metis K psubsetI)
   423 
   424 
   425 lemma extend_map_lemma:
   426   assumes "finite \<F>" "\<G> \<subseteq> \<F>" "convex T" "bounded T"
   427       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
   428       and aff: "\<And>X. X \<in> \<F> - \<G> \<Longrightarrow> aff_dim X < aff_dim T"
   429       and face: "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>\<rbrakk> \<Longrightarrow> (S \<inter> T) face_of S \<and> (S \<inter> T) face_of T"
   430       and contf: "continuous_on (\<Union>\<G>) f" and fim: "f ` (\<Union>\<G>) \<subseteq> rel_frontier T"
   431   obtains g where "continuous_on (\<Union>\<F>) g" "g ` (\<Union>\<F>) \<subseteq> rel_frontier T" "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> g x = f x"
   432 proof (cases "\<F> - \<G> = {}")
   433   case True
   434   then have "\<Union>\<F> \<subseteq> \<Union>\<G>"
   435     by (simp add: Union_mono)
   436   then show ?thesis
   437     apply (rule_tac g=f in that)
   438       using contf continuous_on_subset apply blast
   439      using fim apply blast
   440     by simp
   441 next
   442   case False
   443   then have "0 \<le> aff_dim T"
   444     by (metis aff aff_dim_empty aff_dim_geq aff_dim_negative_iff all_not_in_conv not_less)
   445   then obtain i::nat where i: "int i = aff_dim T"
   446     by (metis nonneg_eq_int)
   447   have Union_empty_eq: "\<Union>{D. D = {} \<and> P D} = {}" for P :: "'a set \<Rightarrow> bool"
   448     by auto
   449   have extendf: "\<exists>g. continuous_on (\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i})) g \<and>
   450                      g ` (\<Union> (\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i})) \<subseteq> rel_frontier T \<and>
   451                      (\<forall>x \<in> \<Union>\<G>. g x = f x)"
   452        if "i \<le> aff_dim T" for i::nat
   453   using that
   454   proof (induction i)
   455     case 0 then show ?case
   456       apply (simp add: Union_empty_eq)
   457       apply (rule_tac x=f in exI)
   458       apply (intro conjI)
   459       using contf continuous_on_subset apply blast
   460       using fim apply blast
   461       by simp
   462   next
   463     case (Suc p)
   464     with \<open>bounded T\<close> have "rel_frontier T \<noteq> {}"
   465       by (auto simp: rel_frontier_eq_empty affine_bounded_eq_lowdim [of T])
   466     then obtain t where t: "t \<in> rel_frontier T" by auto
   467     have ple: "int p \<le> aff_dim T" using Suc.prems by force
   468     obtain h where conth: "continuous_on (\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p})) h"
   469                and him: "h ` (\<Union> (\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}))
   470                          \<subseteq> rel_frontier T"
   471                and heq: "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> h x = f x"
   472       using Suc.IH [OF ple] by auto
   473     let ?Faces = "{D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D \<le> p}"
   474     have extendh: "\<exists>g. continuous_on D g \<and>
   475                        g ` D \<subseteq> rel_frontier T \<and>
   476                        (\<forall>x \<in> D \<inter> \<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}). g x = h x)"
   477       if D: "D \<in> \<G> \<union> ?Faces" for D
   478     proof (cases "D \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p})")
   479       case True
   480       then show ?thesis
   481         apply (rule_tac x=h in exI)
   482         apply (intro conjI)
   483         apply (blast intro: continuous_on_subset [OF conth])
   484         using him apply blast
   485         by simp
   486     next
   487       case False
   488       note notDsub = False
   489       show ?thesis
   490       proof (cases "\<exists>a. D = {a}")
   491         case True
   492         then obtain a where "D = {a}" by auto
   493         with notDsub t show ?thesis
   494           by (rule_tac x="\<lambda>x. t" in exI) simp
   495       next
   496         case False
   497         have "D \<noteq> {}" using notDsub by auto
   498         have Dnotin: "D \<notin> \<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}"
   499           using notDsub by auto
   500         then have "D \<notin> \<G>" by simp
   501         have "D \<in> ?Faces - {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}"
   502           using Dnotin that by auto
   503         then obtain C where "C \<in> \<F>" "D face_of C" and affD: "aff_dim D = int p"
   504           by auto
   505         then have "bounded D"
   506           using face_of_polytope_polytope poly polytope_imp_bounded by blast
   507         then have [simp]: "\<not> affine D"
   508           using affine_bounded_eq_trivial False \<open>D \<noteq> {}\<close> \<open>bounded D\<close> by blast
   509         have "{F. F facet_of D} \<subseteq> {E. E face_of C \<and> aff_dim E < int p}"
   510           apply clarify
   511           apply (metis \<open>D face_of C\<close> affD eq_iff face_of_trans facet_of_def zle_diff1_eq)
   512           done
   513         moreover have "polyhedron D"
   514           using \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> face_of_polytope_polytope poly polytope_imp_polyhedron by auto
   515         ultimately have relf_sub: "rel_frontier D \<subseteq> \<Union> {E. E face_of C \<and> aff_dim E < p}"
   516           by (simp add: rel_frontier_of_polyhedron Union_mono)
   517         then have him_relf: "h ` rel_frontier D \<subseteq> rel_frontier T"
   518           using \<open>C \<in> \<F>\<close> him by blast
   519         have "convex D"
   520           by (simp add: \<open>polyhedron D\<close> polyhedron_imp_convex)
   521         have affD_lessT: "aff_dim D < aff_dim T"
   522           using Suc.prems affD by linarith
   523         have contDh: "continuous_on (rel_frontier D) h"
   524           using \<open>C \<in> \<F>\<close> relf_sub by (blast intro: continuous_on_subset [OF conth])
   525         then have *: "(\<exists>c. homotopic_with (\<lambda>x. True) (rel_frontier D) (rel_frontier T) h (\<lambda>x. c)) =
   526                       (\<exists>g. continuous_on UNIV g \<and>  range g \<subseteq> rel_frontier T \<and>
   527                            (\<forall>x\<in>rel_frontier D. g x = h x))"
   528           apply (rule nullhomotopic_into_rel_frontier_extension [OF closed_rel_frontier])
   529           apply (simp_all add: assms rel_frontier_eq_empty him_relf)
   530           done
   531         have "(\<exists>c. homotopic_with (\<lambda>x. True) (rel_frontier D)
   532               (rel_frontier T) h (\<lambda>x. c))"
   533           by (metis inessential_spheremap_lowdim_gen
   534                  [OF \<open>convex D\<close> \<open>bounded D\<close> \<open>convex T\<close> \<open>bounded T\<close> affD_lessT contDh him_relf])
   535         then obtain g where contg: "continuous_on UNIV g"
   536                         and gim: "range g \<subseteq> rel_frontier T"
   537                         and gh: "\<And>x. x \<in> rel_frontier D \<Longrightarrow> g x = h x"
   538           by (metis *)
   539         have "D \<inter> E \<subseteq> rel_frontier D"
   540              if "E \<in> \<G> \<union> {D. Bex \<F> ((face_of) D) \<and> aff_dim D < int p}" for E
   541         proof (rule face_of_subset_rel_frontier)
   542           show "D \<inter> E face_of D"
   543             using that \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> face
   544             apply auto
   545             apply (meson face_of_Int_subface \<open>\<G> \<subseteq> \<F>\<close> face_of_refl_eq poly polytope_imp_convex subsetD)
   546             using face_of_Int_subface apply blast
   547             done
   548           show "D \<inter> E \<noteq> D"
   549             using that notDsub by auto
   550         qed
   551         then show ?thesis
   552           apply (rule_tac x=g in exI)
   553           apply (intro conjI ballI)
   554             using continuous_on_subset contg apply blast
   555            using gim apply blast
   556           using gh by fastforce
   557       qed
   558     qed
   559     have intle: "i < 1 + int j \<longleftrightarrow> i \<le> int j" for i j
   560       by auto
   561     have "finite \<G>"
   562       using \<open>finite \<F>\<close> \<open>\<G> \<subseteq> \<F>\<close> rev_finite_subset by blast
   563     then have fin: "finite (\<G> \<union> ?Faces)"
   564       apply simp
   565       apply (rule_tac B = "\<Union>{{D. D face_of C}| C. C \<in> \<F>}" in finite_subset)
   566        by (auto simp: \<open>finite \<F>\<close> finite_polytope_faces poly)
   567     have clo: "closed S" if "S \<in> \<G> \<union> ?Faces" for S
   568       using that \<open>\<G> \<subseteq> \<F>\<close> face_of_polytope_polytope poly polytope_imp_closed by blast
   569     have K: "X \<inter> Y \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < int p})"
   570                 if "X \<in> \<G> \<union> ?Faces" "Y \<in> \<G> \<union> ?Faces" "\<not> Y \<subseteq> X" for X Y
   571     proof -
   572       have ff: "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
   573         if XY: "X face_of D" "Y face_of E" and DE: "D \<in> \<F>" "E \<in> \<F>" for D E
   574         apply (rule face_of_Int_subface [OF _ _ XY])
   575         apply (auto simp: face DE)
   576         done
   577       show ?thesis
   578         using that
   579         apply auto
   580         apply (drule_tac x="X \<inter> Y" in spec, safe)
   581         using ff face_of_imp_convex [of X] face_of_imp_convex [of Y]
   582         apply (fastforce dest: face_of_aff_dim_lt)
   583         by (meson face_of_trans ff)
   584     qed
   585     obtain g where "continuous_on (\<Union>(\<G> \<union> ?Faces)) g"
   586                    "g ` \<Union>(\<G> \<union> ?Faces) \<subseteq> rel_frontier T"
   587                    "(\<forall>x \<in> \<Union>(\<G> \<union> ?Faces) \<inter>
   588                           \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < p}). g x = h x)"
   589       apply (rule exE [OF extending_maps_Union [OF fin extendh clo K]], blast+)
   590       done
   591     then show ?case
   592       apply (simp add: intle local.heq [symmetric], blast)
   593       done
   594   qed
   595   have eq: "\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i}) = \<Union>\<F>"
   596   proof
   597     show "\<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < int i}) \<subseteq> \<Union>\<F>"
   598       apply (rule Union_subsetI)
   599       using \<open>\<G> \<subseteq> \<F>\<close> face_of_imp_subset  apply force
   600       done
   601     show "\<Union>\<F> \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < i})"
   602       apply (rule Union_mono)
   603       using face  apply (fastforce simp: aff i)
   604       done
   605   qed
   606   have "int i \<le> aff_dim T" by (simp add: i)
   607   then show ?thesis
   608     using extendf [of i] unfolding eq by (metis that)
   609 qed
   610 
   611 lemma extend_map_lemma_cofinite0:
   612   assumes "finite \<F>"
   613       and "pairwise (\<lambda>S T. S \<inter> T \<subseteq> K) \<F>"
   614       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (S - {a}) g \<and> g ` (S - {a}) \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
   615       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
   616     shows "\<exists>C g. finite C \<and> disjnt C U \<and> card C \<le> card \<F> \<and>
   617                  continuous_on (\<Union>\<F> - C) g \<and> g ` (\<Union>\<F> - C) \<subseteq> T
   618                   \<and> (\<forall>x \<in> (\<Union>\<F> - C) \<inter> K. g x = h x)"
   619   using assms
   620 proof induction
   621   case empty then show ?case
   622     by force
   623 next
   624   case (insert X \<F>)
   625   then have "closed X" and clo: "\<And>X. X \<in> \<F> \<Longrightarrow> closed X"
   626         and \<F>: "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (S - {a}) g \<and> g ` (S - {a}) \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
   627         and pwX: "\<And>Y. Y \<in> \<F> \<and> Y \<noteq> X \<longrightarrow> X \<inter> Y \<subseteq> K \<and> Y \<inter> X \<subseteq> K"
   628         and pwF: "pairwise (\<lambda> S T. S \<inter> T \<subseteq> K) \<F>"
   629     by (simp_all add: pairwise_insert)
   630   obtain C g where C: "finite C" "disjnt C U" "card C \<le> card \<F>"
   631                and contg: "continuous_on (\<Union>\<F> - C) g"
   632                and gim: "g ` (\<Union>\<F> - C) \<subseteq> T"
   633                and gh:  "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> K \<Longrightarrow> g x = h x"
   634     using insert.IH [OF pwF \<F> clo] by auto
   635   obtain a f where "a \<notin> U"
   636                and contf: "continuous_on (X - {a}) f"
   637                and fim: "f ` (X - {a}) \<subseteq> T"
   638                and fh: "(\<forall>x \<in> X \<inter> K. f x = h x)"
   639     using insert.prems by (meson insertI1)
   640   show ?case
   641   proof (intro exI conjI)
   642     show "finite (insert a C)"
   643       by (simp add: C)
   644     show "disjnt (insert a C) U"
   645       using C \<open>a \<notin> U\<close> by simp
   646     show "card (insert a C) \<le> card (insert X \<F>)"
   647       by (simp add: C card_insert_if insert.hyps le_SucI)
   648     have "closed (\<Union>\<F>)"
   649       using clo insert.hyps by blast
   650     have "continuous_on (X - insert a C \<union> (\<Union>\<F> - insert a C)) (\<lambda>x. if x \<in> X then f x else g x)"
   651        apply (rule continuous_on_cases_local)
   652           apply (simp_all add: closedin_closed)
   653         using \<open>closed X\<close> apply blast
   654         using \<open>closed (\<Union>\<F>)\<close> apply blast
   655         using contf apply (force simp: elim: continuous_on_subset)
   656         using contg apply (force simp: elim: continuous_on_subset)
   657         using fh gh insert.hyps pwX by fastforce
   658     then show "continuous_on (\<Union>(insert X \<F>) - insert a C) (\<lambda>a. if a \<in> X then f a else g a)"
   659       by (blast intro: continuous_on_subset)
   660     show "\<forall>x\<in>(\<Union>(insert X \<F>) - insert a C) \<inter> K. (if x \<in> X then f x else g x) = h x"
   661       using gh by (auto simp: fh)
   662     show "(\<lambda>a. if a \<in> X then f a else g a) ` (\<Union>(insert X \<F>) - insert a C) \<subseteq> T"
   663       using fim gim by auto force
   664   qed
   665 qed
   666 
   667 
   668 lemma extend_map_lemma_cofinite1:
   669 assumes "finite \<F>"
   670     and \<F>: "\<And>X. X \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (X - {a}) g \<and> g ` (X - {a}) \<subseteq> T \<and> (\<forall>x \<in> X \<inter> K. g x = h x)"
   671     and clo: "\<And>X. X \<in> \<F> \<Longrightarrow> closed X"
   672     and K: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>; \<not> X \<subseteq> Y; \<not> Y \<subseteq> X\<rbrakk> \<Longrightarrow> X \<inter> Y \<subseteq> K"
   673   obtains C g where "finite C" "disjnt C U" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
   674                     "g ` (\<Union>\<F> - C) \<subseteq> T"
   675                     "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> K \<Longrightarrow> g x = h x"
   676 proof -
   677   let ?\<F> = "{X \<in> \<F>. \<forall>Y\<in>\<F>. \<not> X \<subset> Y}"
   678   have [simp]: "\<Union>?\<F> = \<Union>\<F>"
   679     by (simp add: Union_maximal_sets assms)
   680   have fin: "finite ?\<F>"
   681     by (force intro: finite_subset [OF _ \<open>finite \<F>\<close>])
   682   have pw: "pairwise (\<lambda> S T. S \<inter> T \<subseteq> K) ?\<F>"
   683     by (simp add: pairwise_def) (metis K psubsetI)
   684   have "card {X \<in> \<F>. \<forall>Y\<in>\<F>. \<not> X \<subset> Y} \<le> card \<F>"
   685     by (simp add: \<open>finite \<F>\<close> card_mono)
   686   moreover
   687   obtain C g where "finite C \<and> disjnt C U \<and> card C \<le> card ?\<F> \<and>
   688                  continuous_on (\<Union>?\<F> - C) g \<and> g ` (\<Union>?\<F> - C) \<subseteq> T
   689                   \<and> (\<forall>x \<in> (\<Union>?\<F> - C) \<inter> K. g x = h x)"
   690     apply (rule exE [OF extend_map_lemma_cofinite0 [OF fin pw, of U T h]])
   691       apply (fastforce intro!:  clo \<F>)+
   692     done
   693   ultimately show ?thesis
   694     by (rule_tac C=C and g=g in that) auto
   695 qed
   696 
   697 
   698 lemma extend_map_lemma_cofinite:
   699   assumes "finite \<F>" "\<G> \<subseteq> \<F>" and T: "convex T" "bounded T"
   700       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
   701       and contf: "continuous_on (\<Union>\<G>) f" and fim: "f ` (\<Union>\<G>) \<subseteq> rel_frontier T"
   702       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X \<and> (X \<inter> Y) face_of Y"
   703       and aff: "\<And>X. X \<in> \<F> - \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T"
   704   obtains C g where
   705      "finite C" "disjnt C (\<Union>\<G>)" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
   706      "g ` (\<Union> \<F> - C) \<subseteq> rel_frontier T" "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> g x = f x"
   707 proof -
   708   define \<H> where "\<H> \<equiv> \<G> \<union> {D. \<exists>C \<in> \<F> - \<G>. D face_of C \<and> aff_dim D < aff_dim T}"
   709   have "finite \<G>"
   710     using assms finite_subset by blast
   711   moreover have "finite (\<Union>{{D. D face_of C} |C. C \<in> \<F>})"
   712     apply (rule finite_Union)
   713      apply (simp add: \<open>finite \<F>\<close>)
   714     using finite_polytope_faces poly by auto
   715   ultimately have "finite \<H>"
   716     apply (simp add: \<H>_def)
   717     apply (rule finite_subset [of _ "\<Union> {{D. D face_of C} | C. C \<in> \<F>}"], auto)
   718     done
   719   have *: "\<And>X Y. \<lbrakk>X \<in> \<H>; Y \<in> \<H>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
   720     unfolding \<H>_def
   721     apply (elim UnE bexE CollectE DiffE)
   722     using subsetD [OF \<open>\<G> \<subseteq> \<F>\<close>] apply (simp_all add: face)
   723       apply (meson subsetD [OF \<open>\<G> \<subseteq> \<F>\<close>] face face_of_Int_subface face_of_imp_subset face_of_refl poly polytope_imp_convex)+
   724     done
   725   obtain h where conth: "continuous_on (\<Union>\<H>) h" and him: "h ` (\<Union>\<H>) \<subseteq> rel_frontier T"
   726              and hf: "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> h x = f x"
   727     using \<open>finite \<H>\<close>
   728     unfolding \<H>_def
   729     apply (rule extend_map_lemma [OF _ Un_upper1 T _ _ _ contf fim])
   730     using \<open>\<G> \<subseteq> \<F>\<close> face_of_polytope_polytope poly apply fastforce
   731     using * apply (auto simp: \<H>_def)
   732     done
   733   have "bounded (\<Union>\<G>)"
   734     using \<open>finite \<G>\<close> \<open>\<G> \<subseteq> \<F>\<close> poly polytope_imp_bounded by blast
   735   then have "\<Union>\<G> \<noteq> UNIV"
   736     by auto
   737   then obtain a where a: "a \<notin> \<Union>\<G>"
   738     by blast
   739   have \<F>: "\<exists>a g. a \<notin> \<Union>\<G> \<and> continuous_on (D - {a}) g \<and>
   740                   g ` (D - {a}) \<subseteq> rel_frontier T \<and> (\<forall>x \<in> D \<inter> \<Union>\<H>. g x = h x)"
   741        if "D \<in> \<F>" for D
   742   proof (cases "D \<subseteq> \<Union>\<H>")
   743     case True
   744     then show ?thesis
   745       apply (rule_tac x=a in exI)
   746       apply (rule_tac x=h in exI)
   747       using him apply (blast intro!: \<open>a \<notin> \<Union>\<G>\<close> continuous_on_subset [OF conth]) +
   748       done
   749   next
   750     case False
   751     note D_not_subset = False
   752     show ?thesis
   753     proof (cases "D \<in> \<G>")
   754       case True
   755       with D_not_subset show ?thesis
   756         by (auto simp: \<H>_def)
   757     next
   758       case False
   759       then have affD: "aff_dim D \<le> aff_dim T"
   760         by (simp add: \<open>D \<in> \<F>\<close> aff)
   761       show ?thesis
   762       proof (cases "rel_interior D = {}")
   763         case True
   764         with \<open>D \<in> \<F>\<close> poly a show ?thesis
   765           by (force simp: rel_interior_eq_empty polytope_imp_convex)
   766       next
   767         case False
   768         then obtain b where brelD: "b \<in> rel_interior D"
   769           by blast
   770         have "polyhedron D"
   771           by (simp add: poly polytope_imp_polyhedron that)
   772         have "rel_frontier D retract_of affine hull D - {b}"
   773           by (simp add: rel_frontier_retract_of_punctured_affine_hull poly polytope_imp_bounded polytope_imp_convex that brelD)
   774         then obtain r where relfD: "rel_frontier D \<subseteq> affine hull D - {b}"
   775                         and contr: "continuous_on (affine hull D - {b}) r"
   776                         and rim: "r ` (affine hull D - {b}) \<subseteq> rel_frontier D"
   777                         and rid: "\<And>x. x \<in> rel_frontier D \<Longrightarrow> r x = x"
   778           by (auto simp: retract_of_def retraction_def)
   779         show ?thesis
   780         proof (intro exI conjI ballI)
   781           show "b \<notin> \<Union>\<G>"
   782           proof clarify
   783             fix E
   784             assume "b \<in> E" "E \<in> \<G>"
   785             then have "E \<inter> D face_of E \<and> E \<inter> D face_of D"
   786               using \<open>\<G> \<subseteq> \<F>\<close> face that by auto
   787             with face_of_subset_rel_frontier \<open>E \<in> \<G>\<close> \<open>b \<in> E\<close> brelD rel_interior_subset [of D]
   788                  D_not_subset rel_frontier_def \<H>_def
   789             show False
   790               by blast
   791           qed
   792           have "r ` (D - {b}) \<subseteq> r ` (affine hull D - {b})"
   793             by (simp add: Diff_mono hull_subset image_mono)
   794           also have "... \<subseteq> rel_frontier D"
   795             by (rule rim)
   796           also have "... \<subseteq> \<Union>{E. E face_of D \<and> aff_dim E < aff_dim T}"
   797             using affD
   798             by (force simp: rel_frontier_of_polyhedron [OF \<open>polyhedron D\<close>] facet_of_def)
   799           also have "... \<subseteq> \<Union>(\<H>)"
   800             using D_not_subset \<H>_def that by fastforce
   801           finally have rsub: "r ` (D - {b}) \<subseteq> \<Union>(\<H>)" .
   802           show "continuous_on (D - {b}) (h \<circ> r)"
   803             apply (intro conjI \<open>b \<notin> \<Union>\<G>\<close> continuous_on_compose)
   804                apply (rule continuous_on_subset [OF contr])
   805             apply (simp add: Diff_mono hull_subset)
   806             apply (rule continuous_on_subset [OF conth rsub])
   807             done
   808           show "(h \<circ> r) ` (D - {b}) \<subseteq> rel_frontier T"
   809             using brelD him rsub by fastforce
   810           show "(h \<circ> r) x = h x" if x: "x \<in> D \<inter> \<Union>\<H>" for x
   811           proof -
   812             consider A where "x \<in> D" "A \<in> \<G>" "x \<in> A"
   813                  | A B where "x \<in> D" "A face_of B" "B \<in> \<F>" "B \<notin> \<G>" "aff_dim A < aff_dim T" "x \<in> A"
   814               using x by (auto simp: \<H>_def)
   815             then have xrel: "x \<in> rel_frontier D"
   816             proof cases
   817               case 1 show ?thesis
   818               proof (rule face_of_subset_rel_frontier [THEN subsetD])
   819                 show "D \<inter> A face_of D"
   820                   using \<open>A \<in> \<G>\<close> \<open>\<G> \<subseteq> \<F>\<close> face \<open>D \<in> \<F>\<close> by blast
   821                 show "D \<inter> A \<noteq> D"
   822                   using \<open>A \<in> \<G>\<close> D_not_subset \<H>_def by blast
   823               qed (auto simp: 1)
   824             next
   825               case 2 show ?thesis
   826               proof (rule face_of_subset_rel_frontier [THEN subsetD])
   827                 show "D \<inter> A face_of D"
   828                   apply (rule face_of_Int_subface [of D B _ A, THEN conjunct1])
   829                      apply (simp_all add: 2 \<open>D \<in> \<F>\<close> face)
   830                    apply (simp add: \<open>polyhedron D\<close> polyhedron_imp_convex face_of_refl)
   831                   done
   832                 show "D \<inter> A \<noteq> D"
   833                   using "2" D_not_subset \<H>_def by blast
   834               qed (auto simp: 2)
   835             qed
   836             show ?thesis
   837               by (simp add: rid xrel)
   838           qed
   839         qed
   840       qed
   841     qed
   842   qed
   843   have clo: "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
   844     by (simp add: poly polytope_imp_closed)
   845   obtain C g where "finite C" "disjnt C (\<Union>\<G>)" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
   846                    "g ` (\<Union>\<F> - C) \<subseteq> rel_frontier T"
   847                and gh: "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> \<Union>\<H> \<Longrightarrow> g x = h x"
   848   proof (rule extend_map_lemma_cofinite1 [OF \<open>finite \<F>\<close> \<F> clo])
   849     show "X \<inter> Y \<subseteq> \<Union>\<H>" if XY: "X \<in> \<F>" "Y \<in> \<F>" and "\<not> X \<subseteq> Y" "\<not> Y \<subseteq> X" for X Y
   850     proof (cases "X \<in> \<G>")
   851       case True
   852       then show ?thesis
   853         by (auto simp: \<H>_def)
   854     next
   855       case False
   856       have "X \<inter> Y \<noteq> X"
   857         using \<open>\<not> X \<subseteq> Y\<close> by blast
   858       with XY
   859       show ?thesis
   860         by (clarsimp simp: \<H>_def)
   861            (metis Diff_iff Int_iff aff antisym_conv face face_of_aff_dim_lt face_of_refl
   862                   not_le poly polytope_imp_convex)
   863     qed
   864   qed (blast)+
   865   with \<open>\<G> \<subseteq> \<F>\<close> show ?thesis
   866     apply (rule_tac C=C and g=g in that)
   867      apply (auto simp: disjnt_def hf [symmetric] \<H>_def intro!: gh)
   868     done
   869 qed
   870 
   871 text\<open>The next two proofs are similar\<close>
   872 theorem extend_map_cell_complex_to_sphere:
   873   assumes "finite \<F>" and S: "S \<subseteq> \<Union>\<F>" "closed S" and T: "convex T" "bounded T"
   874       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
   875       and aff: "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X < aff_dim T"
   876       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X \<and> (X \<inter> Y) face_of Y"
   877       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> rel_frontier T"
   878   obtains g where "continuous_on (\<Union>\<F>) g"
   879      "g ` (\<Union>\<F>) \<subseteq> rel_frontier T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   880 proof -
   881   obtain V g where "S \<subseteq> V" "open V" "continuous_on V g" and gim: "g ` V \<subseteq> rel_frontier T" and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   882     using neighbourhood_extension_into_ANR [OF contf fim _ \<open>closed S\<close>] ANR_rel_frontier_convex T by blast
   883   have "compact S"
   884     by (meson assms compact_Union poly polytope_imp_compact seq_compact_closed_subset seq_compact_eq_compact)
   885   then obtain d where "d > 0" and d: "\<And>x y. \<lbrakk>x \<in> S; y \<in> - V\<rbrakk> \<Longrightarrow> d \<le> dist x y"
   886     using separate_compact_closed [of S "-V"] \<open>open V\<close> \<open>S \<subseteq> V\<close> by force
   887   obtain \<G> where "finite \<G>" "\<Union>\<G> = \<Union>\<F>"
   888              and diaG: "\<And>X. X \<in> \<G> \<Longrightarrow> diameter X < d"
   889              and polyG: "\<And>X. X \<in> \<G> \<Longrightarrow> polytope X"
   890              and affG: "\<And>X. X \<in> \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T - 1"
   891              and faceG: "\<And>X Y. \<lbrakk>X \<in> \<G>; Y \<in> \<G>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
   892   proof (rule cell_complex_subdivision_exists [OF \<open>d>0\<close> \<open>finite \<F>\<close> poly _ face])
   893     show "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> aff_dim T - 1"
   894       by (simp add: aff)
   895   qed auto
   896   obtain h where conth: "continuous_on (\<Union>\<G>) h" and him: "h ` \<Union>\<G> \<subseteq> rel_frontier T" and hg: "\<And>x. x \<in> \<Union>(\<G> \<inter> Pow V) \<Longrightarrow> h x = g x"
   897   proof (rule extend_map_lemma [of \<G> "\<G> \<inter> Pow V" T g])
   898     show "continuous_on (\<Union>(\<G> \<inter> Pow V)) g"
   899       by (metis Union_Int_subset Union_Pow_eq \<open>continuous_on V g\<close> continuous_on_subset le_inf_iff)
   900   qed (use \<open>finite \<G>\<close> T polyG affG faceG gim in fastforce)+
   901   show ?thesis
   902   proof
   903     show "continuous_on (\<Union>\<F>) h"
   904       using \<open>\<Union>\<G> = \<Union>\<F>\<close> conth by auto
   905     show "h ` \<Union>\<F> \<subseteq> rel_frontier T"
   906       using \<open>\<Union>\<G> = \<Union>\<F>\<close> him by auto
   907     show "h x = f x" if "x \<in> S" for x
   908     proof -
   909       have "x \<in> \<Union>\<G>"
   910         using \<open>\<Union>\<G> = \<Union>\<F>\<close> \<open>S \<subseteq> \<Union>\<F>\<close> that by auto
   911       then obtain X where "x \<in> X" "X \<in> \<G>" by blast
   912       then have "diameter X < d" "bounded X"
   913         by (auto simp: diaG \<open>X \<in> \<G>\<close> polyG polytope_imp_bounded)
   914       then have "X \<subseteq> V" using d [OF \<open>x \<in> S\<close>] diameter_bounded_bound [OF \<open>bounded X\<close> \<open>x \<in> X\<close>]
   915         by fastforce
   916       have "h x = g x"
   917         apply (rule hg)
   918         using \<open>X \<in> \<G>\<close> \<open>X \<subseteq> V\<close> \<open>x \<in> X\<close> by blast
   919       also have "... = f x"
   920         by (simp add: gf that)
   921       finally show "h x = f x" .
   922     qed
   923   qed
   924 qed
   925 
   926 
   927 theorem extend_map_cell_complex_to_sphere_cofinite:
   928   assumes "finite \<F>" and S: "S \<subseteq> \<Union>\<F>" "closed S" and T: "convex T" "bounded T"
   929       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
   930       and aff: "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> aff_dim T"
   931       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X \<and> (X \<inter> Y) face_of Y"
   932       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> rel_frontier T"
   933   obtains C g where "finite C" "disjnt C S" "continuous_on (\<Union>\<F> - C) g"
   934      "g ` (\<Union>\<F> - C) \<subseteq> rel_frontier T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   935 proof -
   936   obtain V g where "S \<subseteq> V" "open V" "continuous_on V g" and gim: "g ` V \<subseteq> rel_frontier T" and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   937     using neighbourhood_extension_into_ANR [OF contf fim _ \<open>closed S\<close>] ANR_rel_frontier_convex T by blast
   938   have "compact S"
   939     by (meson assms compact_Union poly polytope_imp_compact seq_compact_closed_subset seq_compact_eq_compact)
   940   then obtain d where "d > 0" and d: "\<And>x y. \<lbrakk>x \<in> S; y \<in> - V\<rbrakk> \<Longrightarrow> d \<le> dist x y"
   941     using separate_compact_closed [of S "-V"] \<open>open V\<close> \<open>S \<subseteq> V\<close> by force
   942   obtain \<G> where "finite \<G>" "\<Union>\<G> = \<Union>\<F>"
   943              and diaG: "\<And>X. X \<in> \<G> \<Longrightarrow> diameter X < d"
   944              and polyG: "\<And>X. X \<in> \<G> \<Longrightarrow> polytope X"
   945              and affG: "\<And>X. X \<in> \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T"
   946              and faceG: "\<And>X Y. \<lbrakk>X \<in> \<G>; Y \<in> \<G>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
   947     by (rule cell_complex_subdivision_exists [OF \<open>d>0\<close> \<open>finite \<F>\<close> poly aff face]) auto
   948   obtain C h where "finite C" and dis: "disjnt C (\<Union>(\<G> \<inter> Pow V))"
   949                and card: "card C \<le> card \<G>" and conth: "continuous_on (\<Union>\<G> - C) h"
   950                and him: "h ` (\<Union>\<G> - C) \<subseteq> rel_frontier T"
   951                and hg: "\<And>x. x \<in> \<Union>(\<G> \<inter> Pow V) \<Longrightarrow> h x = g x"
   952   proof (rule extend_map_lemma_cofinite [of \<G> "\<G> \<inter> Pow V" T g])
   953     show "continuous_on (\<Union>(\<G> \<inter> Pow V)) g"
   954       by (metis Union_Int_subset Union_Pow_eq \<open>continuous_on V g\<close> continuous_on_subset le_inf_iff)
   955     show "g ` \<Union>(\<G> \<inter> Pow V) \<subseteq> rel_frontier T"
   956       using gim by force
   957   qed (auto intro: \<open>finite \<G>\<close> T polyG affG dest: faceG)
   958   have Ssub: "S \<subseteq> \<Union>(\<G> \<inter> Pow V)"
   959   proof
   960     fix x
   961     assume "x \<in> S"
   962     then have "x \<in> \<Union>\<G>"
   963       using \<open>\<Union>\<G> = \<Union>\<F>\<close> \<open>S \<subseteq> \<Union>\<F>\<close> by auto
   964     then obtain X where "x \<in> X" "X \<in> \<G>" by blast
   965     then have "diameter X < d" "bounded X"
   966       by (auto simp: diaG \<open>X \<in> \<G>\<close> polyG polytope_imp_bounded)
   967     then have "X \<subseteq> V" using d [OF \<open>x \<in> S\<close>] diameter_bounded_bound [OF \<open>bounded X\<close> \<open>x \<in> X\<close>]
   968       by fastforce
   969     then show "x \<in> \<Union>(\<G> \<inter> Pow V)"
   970       using \<open>X \<in> \<G>\<close> \<open>x \<in> X\<close> by blast
   971   qed
   972   show ?thesis
   973   proof
   974     show "continuous_on (\<Union>\<F>-C) h"
   975       using \<open>\<Union>\<G> = \<Union>\<F>\<close> conth by auto
   976     show "h ` (\<Union>\<F> - C) \<subseteq> rel_frontier T"
   977       using \<open>\<Union>\<G> = \<Union>\<F>\<close> him by auto
   978     show "h x = f x" if "x \<in> S" for x
   979     proof -
   980       have "h x = g x"
   981         apply (rule hg)
   982         using Ssub that by blast
   983       also have "... = f x"
   984         by (simp add: gf that)
   985       finally show "h x = f x" .
   986     qed
   987     show "disjnt C S"
   988       using dis Ssub  by (meson disjnt_iff subset_eq)
   989   qed (intro \<open>finite C\<close>)
   990 qed
   991 
   992 
   993 
   994 subsection\<open> Special cases and corollaries involving spheres\<close>
   995 
   996 lemma disjnt_Diff1: "X \<subseteq> Y' \<Longrightarrow> disjnt (X - Y) (X' - Y')"
   997   by (auto simp: disjnt_def)
   998 
   999 proposition extend_map_affine_to_sphere_cofinite_simple:
  1000   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1001   assumes "compact S" "convex U" "bounded U"
  1002       and aff: "aff_dim T \<le> aff_dim U"
  1003       and "S \<subseteq> T" and contf: "continuous_on S f"
  1004       and fim: "f ` S \<subseteq> rel_frontier U"
  1005  obtains K g where "finite K" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
  1006                    "g ` (T - K) \<subseteq> rel_frontier U"
  1007                    "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1008 proof -
  1009   have "\<exists>K g. finite K \<and> disjnt K S \<and> continuous_on (T - K) g \<and>
  1010               g ` (T - K) \<subseteq> rel_frontier U \<and> (\<forall>x \<in> S. g x = f x)"
  1011        if "affine T" "S \<subseteq> T" and aff: "aff_dim T \<le> aff_dim U"  for T
  1012   proof (cases "S = {}")
  1013     case True
  1014     show ?thesis
  1015     proof (cases "rel_frontier U = {}")
  1016       case True
  1017       with \<open>bounded U\<close> have "aff_dim U \<le> 0"
  1018         using affine_bounded_eq_lowdim rel_frontier_eq_empty by auto
  1019       with aff have "aff_dim T \<le> 0" by auto
  1020       then obtain a where "T \<subseteq> {a}"
  1021         using \<open>affine T\<close> affine_bounded_eq_lowdim affine_bounded_eq_trivial by auto
  1022       then show ?thesis
  1023         using \<open>S = {}\<close> fim
  1024         by (metis Diff_cancel contf disjnt_empty2 finite.emptyI finite_insert finite_subset)
  1025     next
  1026       case False
  1027       then obtain a where "a \<in> rel_frontier U"
  1028         by auto
  1029       then show ?thesis
  1030         using continuous_on_const [of _ a] \<open>S = {}\<close> by force
  1031     qed
  1032   next
  1033     case False
  1034     have "bounded S"
  1035       by (simp add: \<open>compact S\<close> compact_imp_bounded)
  1036     then obtain b where b: "S \<subseteq> cbox (-b) b"
  1037       using bounded_subset_cbox_symmetric by blast
  1038     define bbox where "bbox \<equiv> cbox (-(b+One)) (b+One)"
  1039     have "cbox (-b) b \<subseteq> bbox"
  1040       by (auto simp: bbox_def algebra_simps intro!: subset_box_imp)
  1041     with b \<open>S \<subseteq> T\<close> have "S \<subseteq> bbox \<inter> T"
  1042       by auto
  1043     then have Ssub: "S \<subseteq> \<Union>{bbox \<inter> T}"
  1044       by auto
  1045     then have "aff_dim (bbox \<inter> T) \<le> aff_dim U"
  1046       by (metis aff aff_dim_subset inf_commute inf_le1 order_trans)
  1047     obtain K g where K: "finite K" "disjnt K S"
  1048                  and contg: "continuous_on (\<Union>{bbox \<inter> T} - K) g"
  1049                  and gim: "g ` (\<Union>{bbox \<inter> T} - K) \<subseteq> rel_frontier U"
  1050                  and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1051     proof (rule extend_map_cell_complex_to_sphere_cofinite
  1052               [OF _ Ssub _ \<open>convex U\<close> \<open>bounded U\<close> _ _ _ contf fim])
  1053       show "closed S"
  1054         using \<open>compact S\<close> compact_eq_bounded_closed by auto
  1055       show poly: "\<And>X. X \<in> {bbox \<inter> T} \<Longrightarrow> polytope X"
  1056         by (simp add: polytope_Int_polyhedron bbox_def polytope_interval affine_imp_polyhedron \<open>affine T\<close>)
  1057       show "\<And>X Y. \<lbrakk>X \<in> {bbox \<inter> T}; Y \<in> {bbox \<inter> T}\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  1058         by (simp add:poly face_of_refl polytope_imp_convex)
  1059       show "\<And>X. X \<in> {bbox \<inter> T} \<Longrightarrow> aff_dim X \<le> aff_dim U"
  1060         by (simp add: \<open>aff_dim (bbox \<inter> T) \<le> aff_dim U\<close>)
  1061     qed auto
  1062     define fro where "fro \<equiv> \<lambda>d. frontier(cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One))"
  1063     obtain d where d12: "1/2 \<le> d" "d \<le> 1" and dd: "disjnt K (fro d)"
  1064     proof (rule disjoint_family_elem_disjnt [OF _ \<open>finite K\<close>])
  1065       show "infinite {1/2..1::real}"
  1066         by (simp add: infinite_Icc)
  1067       have dis1: "disjnt (fro x) (fro y)" if "x<y" for x y
  1068         by (auto simp: algebra_simps that subset_box_imp disjnt_Diff1 frontier_def fro_def)
  1069       then show "disjoint_family_on fro {1/2..1}"
  1070         by (auto simp: disjoint_family_on_def disjnt_def neq_iff)
  1071     qed auto
  1072     define c where "c \<equiv> b + d *\<^sub>R One"
  1073     have cbsub: "cbox (-b) b \<subseteq> box (-c) c"  "cbox (-b) b \<subseteq> cbox (-c) c"  "cbox (-c) c \<subseteq> bbox"
  1074       using d12 by (auto simp: algebra_simps subset_box_imp c_def bbox_def)
  1075     have clo_cbT: "closed (cbox (- c) c \<inter> T)"
  1076       by (simp add: affine_closed closed_Int closed_cbox \<open>affine T\<close>)
  1077     have cpT_ne: "cbox (- c) c \<inter> T \<noteq> {}"
  1078       using \<open>S \<noteq> {}\<close> b cbsub(2) \<open>S \<subseteq> T\<close> by fastforce
  1079     have "closest_point (cbox (- c) c \<inter> T) x \<notin> K" if "x \<in> T" "x \<notin> K" for x
  1080     proof (cases "x \<in> cbox (-c) c")
  1081       case True with that show ?thesis
  1082         by (simp add: closest_point_self)
  1083     next
  1084       case False
  1085       have int_ne: "interior (cbox (-c) c) \<inter> T \<noteq> {}"
  1086         using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b \<open>cbox (- b) b \<subseteq> box (- c) c\<close> by force
  1087       have "convex T"
  1088         by (meson \<open>affine T\<close> affine_imp_convex)
  1089       then have "x \<in> affine hull (cbox (- c) c \<inter> T)"
  1090           by (metis Int_commute Int_iff \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> cbsub(1) \<open>x \<in> T\<close> affine_hull_convex_Int_nonempty_interior all_not_in_conv b hull_inc inf.orderE interior_cbox)
  1091       then have "x \<in> affine hull (cbox (- c) c \<inter> T) - rel_interior (cbox (- c) c \<inter> T)"
  1092         by (meson DiffI False Int_iff rel_interior_subset subsetCE)
  1093       then have "closest_point (cbox (- c) c \<inter> T) x \<in> rel_frontier (cbox (- c) c \<inter> T)"
  1094         by (rule closest_point_in_rel_frontier [OF clo_cbT cpT_ne])
  1095       moreover have "(rel_frontier (cbox (- c) c \<inter> T)) \<subseteq> fro d"
  1096         apply (subst convex_affine_rel_frontier_Int [OF _  \<open>affine T\<close> int_ne])
  1097          apply (auto simp: fro_def c_def)
  1098         done
  1099       ultimately show ?thesis
  1100         using dd  by (force simp: disjnt_def)
  1101     qed
  1102     then have cpt_subset: "closest_point (cbox (- c) c \<inter> T) ` (T - K) \<subseteq> \<Union>{bbox \<inter> T} - K"
  1103       using closest_point_in_set [OF clo_cbT cpT_ne] cbsub(3) by force
  1104     show ?thesis
  1105     proof (intro conjI ballI exI)
  1106       have "continuous_on (T - K) (closest_point (cbox (- c) c \<inter> T))"
  1107         apply (rule continuous_on_closest_point)
  1108         using \<open>S \<noteq> {}\<close> cbsub(2) b that
  1109         by (auto simp: affine_imp_convex convex_Int affine_closed closed_Int closed_cbox \<open>affine T\<close>)
  1110       then show "continuous_on (T - K) (g \<circ> closest_point (cbox (- c) c \<inter> T))"
  1111         by (metis continuous_on_compose continuous_on_subset [OF contg cpt_subset])
  1112       have "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K) \<subseteq> g ` (\<Union>{bbox \<inter> T} - K)"
  1113         by (metis image_comp image_mono cpt_subset)
  1114       also have "... \<subseteq> rel_frontier U"
  1115         by (rule gim)
  1116       finally show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K) \<subseteq> rel_frontier U" .
  1117       show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) x = f x" if "x \<in> S" for x
  1118       proof -
  1119         have "(g \<circ> closest_point (cbox (- c) c \<inter> T)) x = g x"
  1120           unfolding o_def
  1121           by (metis IntI \<open>S \<subseteq> T\<close> b cbsub(2) closest_point_self subset_eq that)
  1122         also have "... = f x"
  1123           by (simp add: that gf)
  1124         finally show ?thesis .
  1125       qed
  1126     qed (auto simp: K)
  1127   qed
  1128   then obtain K g where "finite K" "disjnt K S"
  1129                and contg: "continuous_on (affine hull T - K) g"
  1130                and gim:  "g ` (affine hull T - K) \<subseteq> rel_frontier U"
  1131                and gf:   "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1132     by (metis aff affine_affine_hull aff_dim_affine_hull
  1133               order_trans [OF \<open>S \<subseteq> T\<close> hull_subset [of T affine]])
  1134   then obtain K g where "finite K" "disjnt K S"
  1135                and contg: "continuous_on (T - K) g"
  1136                and gim:  "g ` (T - K) \<subseteq> rel_frontier U"
  1137                and gf:   "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1138     by (rule_tac K=K and g=g in that) (auto simp: hull_inc elim: continuous_on_subset)
  1139   then show ?thesis
  1140     by (rule_tac K="K \<inter> T" and g=g in that) (auto simp: disjnt_iff Diff_Int contg)
  1141 qed
  1142 
  1143 subsection\<open>Extending maps to spheres\<close>
  1144 
  1145 (*Up to extend_map_affine_to_sphere_cofinite_gen*)
  1146 
  1147 lemma extend_map_affine_to_sphere1:
  1148   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::topological_space"
  1149   assumes "finite K" "affine U" and contf: "continuous_on (U - K) f"
  1150       and fim: "f ` (U - K) \<subseteq> T"
  1151       and comps: "\<And>C. \<lbrakk>C \<in> components(U - S); C \<inter> K \<noteq> {}\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  1152       and clo: "closedin (top_of_set U) S" and K: "disjnt K S" "K \<subseteq> U"
  1153   obtains g where "continuous_on (U - L) g" "g ` (U - L) \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1154 proof (cases "K = {}")
  1155   case True
  1156   then show ?thesis
  1157     by (metis Diff_empty Diff_subset contf fim continuous_on_subset image_subsetI rev_image_eqI subset_iff that)
  1158 next
  1159   case False
  1160   have "S \<subseteq> U"
  1161     using clo closedin_limpt by blast
  1162   then have "(U - S) \<inter> K \<noteq> {}"
  1163     by (metis Diff_triv False Int_Diff K disjnt_def inf.absorb_iff2 inf_commute)
  1164   then have "\<Union>(components (U - S)) \<inter> K \<noteq> {}"
  1165     using Union_components by simp
  1166   then obtain C0 where C0: "C0 \<in> components (U - S)" "C0 \<inter> K \<noteq> {}"
  1167     by blast
  1168   have "convex U"
  1169     by (simp add: affine_imp_convex \<open>affine U\<close>)
  1170   then have "locally connected U"
  1171     by (rule convex_imp_locally_connected)
  1172   have "\<exists>a g. a \<in> C \<and> a \<in> L \<and> continuous_on (S \<union> (C - {a})) g \<and>
  1173               g ` (S \<union> (C - {a})) \<subseteq> T \<and> (\<forall>x \<in> S. g x = f x)"
  1174        if C: "C \<in> components (U - S)" and CK: "C \<inter> K \<noteq> {}" for C
  1175   proof -
  1176     have "C \<subseteq> U-S" "C \<inter> L \<noteq> {}"
  1177       by (simp_all add: in_components_subset comps that)
  1178     then obtain a where a: "a \<in> C" "a \<in> L" by auto
  1179     have opeUC: "openin (top_of_set U) C"
  1180     proof (rule openin_trans)
  1181       show "openin (top_of_set (U-S)) C"
  1182         by (simp add: \<open>locally connected U\<close> clo locally_diff_closed openin_components_locally_connected [OF _ C])
  1183       show "openin (top_of_set U) (U - S)"
  1184         by (simp add: clo openin_diff)
  1185     qed
  1186     then obtain d where "C \<subseteq> U" "0 < d" and d: "cball a d \<inter> U \<subseteq> C"
  1187       using openin_contains_cball by (metis \<open>a \<in> C\<close>)
  1188     then have "ball a d \<inter> U \<subseteq> C"
  1189       by auto
  1190     obtain h k where homhk: "homeomorphism (S \<union> C) (S \<union> C) h k"
  1191                  and subC: "{x. (\<not> (h x = x \<and> k x = x))} \<subseteq> C"
  1192                  and bou: "bounded {x. (\<not> (h x = x \<and> k x = x))}"
  1193                  and hin: "\<And>x. x \<in> C \<inter> K \<Longrightarrow> h x \<in> ball a d \<inter> U"
  1194     proof (rule homeomorphism_grouping_points_exists_gen [of C "ball a d \<inter> U" "C \<inter> K" "S \<union> C"])
  1195       show "openin (top_of_set C) (ball a d \<inter> U)"
  1196         by (metis open_ball \<open>C \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> inf.absorb_iff2 inf.orderE inf_assoc open_openin openin_subtopology)
  1197       show "openin (top_of_set (affine hull C)) C"
  1198         by (metis \<open>a \<in> C\<close> \<open>openin (top_of_set U) C\<close> affine_hull_eq affine_hull_openin all_not_in_conv \<open>affine U\<close>)
  1199       show "ball a d \<inter> U \<noteq> {}"
  1200         using \<open>0 < d\<close> \<open>C \<subseteq> U\<close> \<open>a \<in> C\<close> by force
  1201       show "finite (C \<inter> K)"
  1202         by (simp add: \<open>finite K\<close>)
  1203       show "S \<union> C \<subseteq> affine hull C"
  1204         by (metis \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> opeUC affine_hull_eq affine_hull_openin all_not_in_conv assms(2) sup.bounded_iff)
  1205       show "connected C"
  1206         by (metis C in_components_connected)
  1207     qed auto
  1208     have a_BU: "a \<in> ball a d \<inter> U"
  1209       using \<open>0 < d\<close> \<open>C \<subseteq> U\<close> \<open>a \<in> C\<close> by auto
  1210     have "rel_frontier (cball a d \<inter> U) retract_of (affine hull (cball a d \<inter> U) - {a})"
  1211       apply (rule rel_frontier_retract_of_punctured_affine_hull)
  1212         apply (auto simp: \<open>convex U\<close> convex_Int)
  1213       by (metis \<open>affine U\<close> convex_cball empty_iff interior_cball a_BU rel_interior_convex_Int_affine)
  1214     moreover have "rel_frontier (cball a d \<inter> U) = frontier (cball a d) \<inter> U"
  1215       apply (rule convex_affine_rel_frontier_Int)
  1216       using a_BU by (force simp: \<open>affine U\<close>)+
  1217     moreover have "affine hull (cball a d \<inter> U) = U"
  1218       by (metis \<open>convex U\<close> a_BU affine_hull_convex_Int_nonempty_interior affine_hull_eq \<open>affine U\<close> equals0D inf.commute interior_cball)
  1219     ultimately have "frontier (cball a d) \<inter> U retract_of (U - {a})"
  1220       by metis
  1221     then obtain r where contr: "continuous_on (U - {a}) r"
  1222                     and rim: "r ` (U - {a}) \<subseteq> sphere a d"  "r ` (U - {a}) \<subseteq> U"
  1223                     and req: "\<And>x. x \<in> sphere a d \<inter> U \<Longrightarrow> r x = x"
  1224       using \<open>affine U\<close> by (auto simp: retract_of_def retraction_def hull_same)
  1225     define j where "j \<equiv> \<lambda>x. if x \<in> ball a d then r x else x"
  1226     have kj: "\<And>x. x \<in> S \<Longrightarrow> k (j x) = x"
  1227       using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> j_def subC by auto
  1228     have Uaeq: "U - {a} = (cball a d - {a}) \<inter> U \<union> (U - ball a d)"
  1229       using \<open>0 < d\<close> by auto
  1230     have jim: "j ` (S \<union> (C - {a})) \<subseteq> (S \<union> C) - ball a d"
  1231     proof clarify
  1232       fix y  assume "y \<in> S \<union> (C - {a})"
  1233       then have "y \<in> U - {a}"
  1234         using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> by auto
  1235       then have "r y \<in> sphere a d"
  1236         using rim by auto
  1237       then show "j y \<in> S \<union> C - ball a d"
  1238         apply (simp add: j_def)
  1239         using \<open>r y \<in> sphere a d\<close> \<open>y \<in> U - {a}\<close> \<open>y \<in> S \<union> (C - {a})\<close> d rim by fastforce
  1240     qed
  1241     have contj: "continuous_on (U - {a}) j"
  1242       unfolding j_def Uaeq
  1243     proof (intro continuous_on_cases_local continuous_on_id, simp_all add: req closedin_closed Uaeq [symmetric])
  1244       show "\<exists>T. closed T \<and> (cball a d - {a}) \<inter> U = (U - {a}) \<inter> T"
  1245           apply (rule_tac x="(cball a d) \<inter> U" in exI)
  1246         using affine_closed \<open>affine U\<close> by blast
  1247       show "\<exists>T. closed T \<and> U - ball a d = (U - {a}) \<inter> T"
  1248          apply (rule_tac x="U - ball a d" in exI)
  1249         using \<open>0 < d\<close>  by (force simp: affine_closed \<open>affine U\<close> closed_Diff)
  1250       show "continuous_on ((cball a d - {a}) \<inter> U) r"
  1251         by (force intro: continuous_on_subset [OF contr])
  1252     qed
  1253     have fT: "x \<in> U - K \<Longrightarrow> f x \<in> T" for x
  1254       using fim by blast
  1255     show ?thesis
  1256     proof (intro conjI exI)
  1257       show "continuous_on (S \<union> (C - {a})) (f \<circ> k \<circ> j)"
  1258       proof (intro continuous_on_compose)
  1259         show "continuous_on (S \<union> (C - {a})) j"
  1260           apply (rule continuous_on_subset [OF contj])
  1261           using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> by force
  1262         show "continuous_on (j ` (S \<union> (C - {a}))) k"
  1263           apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
  1264           using jim \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> j_def by fastforce
  1265         show "continuous_on (k ` j ` (S \<union> (C - {a}))) f"
  1266         proof (clarify intro!: continuous_on_subset [OF contf])
  1267           fix y  assume "y \<in> S \<union> (C - {a})"
  1268           have ky: "k y \<in> S \<union> C"
  1269             using homeomorphism_image2 [OF homhk] \<open>y \<in> S \<union> (C - {a})\<close> by blast
  1270           have jy: "j y \<in> S \<union> C - ball a d"
  1271             using Un_iff \<open>y \<in> S \<union> (C - {a})\<close> jim by auto
  1272           show "k (j y) \<in> U - K"
  1273             apply safe
  1274             using \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close>  homeomorphism_image2 [OF homhk] jy apply blast
  1275             by (metis DiffD1 DiffD2 Int_iff Un_iff \<open>disjnt K S\<close> disjnt_def empty_iff hin homeomorphism_apply2 homeomorphism_image2 homhk imageI jy)
  1276         qed
  1277       qed
  1278       have ST: "\<And>x. x \<in> S \<Longrightarrow> (f \<circ> k \<circ> j) x \<in> T"
  1279         apply (simp add: kj)
  1280         apply (metis DiffI \<open>S \<subseteq> U\<close> \<open>disjnt K S\<close> subsetD disjnt_iff fim image_subset_iff)
  1281         done
  1282       moreover have "(f \<circ> k \<circ> j) x \<in> T" if "x \<in> C" "x \<noteq> a" "x \<notin> S" for x
  1283       proof -
  1284         have rx: "r x \<in> sphere a d"
  1285           using \<open>C \<subseteq> U\<close> rim that by fastforce
  1286         have jj: "j x \<in> S \<union> C - ball a d"
  1287           using jim that by blast
  1288         have "k (j x) = j x \<longrightarrow> k (j x) \<in> C \<or> j x \<in> C"
  1289           by (metis Diff_iff Int_iff Un_iff \<open>S \<subseteq> U\<close> subsetD d j_def jj rx sphere_cball that(1))
  1290         then have "k (j x) \<in> C"
  1291           using homeomorphism_apply2 [OF homhk, of "j x"]   \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close> a rx
  1292           by (metis (mono_tags, lifting) Diff_iff subsetD jj mem_Collect_eq subC)
  1293         with jj \<open>C \<subseteq> U\<close> show ?thesis
  1294           apply safe
  1295           using ST j_def apply fastforce
  1296           apply (auto simp: not_less intro!: fT)
  1297           by (metis DiffD1 DiffD2 Int_iff hin homeomorphism_apply2 [OF homhk] jj)
  1298       qed
  1299       ultimately show "(f \<circ> k \<circ> j) ` (S \<union> (C - {a})) \<subseteq> T"
  1300         by force
  1301       show "\<forall>x\<in>S. (f \<circ> k \<circ> j) x = f x" using kj by simp
  1302     qed (auto simp: a)
  1303   qed
  1304   then obtain a h where
  1305     ah: "\<And>C. \<lbrakk>C \<in> components (U - S); C \<inter> K \<noteq> {}\<rbrakk>
  1306            \<Longrightarrow> a C \<in> C \<and> a C \<in> L \<and> continuous_on (S \<union> (C - {a C})) (h C) \<and>
  1307                h C ` (S \<union> (C - {a C})) \<subseteq> T \<and> (\<forall>x \<in> S. h C x = f x)"
  1308     using that by metis
  1309   define F where "F \<equiv> {C \<in> components (U - S). C \<inter> K \<noteq> {}}"
  1310   define G where "G \<equiv> {C \<in> components (U - S). C \<inter> K = {}}"
  1311   define UF where "UF \<equiv> (\<Union>C\<in>F. C - {a C})"
  1312   have "C0 \<in> F"
  1313     by (auto simp: F_def C0)
  1314   have "finite F"
  1315   proof (subst finite_image_iff [of "\<lambda>C. C \<inter> K" F, symmetric])
  1316     show "inj_on (\<lambda>C. C \<inter> K) F"
  1317       unfolding F_def inj_on_def
  1318       using components_nonoverlap by blast
  1319     show "finite ((\<lambda>C. C \<inter> K) ` F)"
  1320       unfolding F_def
  1321       by (rule finite_subset [of _ "Pow K"]) (auto simp: \<open>finite K\<close>)
  1322   qed
  1323   obtain g where contg: "continuous_on (S \<union> UF) g"
  1324              and gh: "\<And>x i. \<lbrakk>i \<in> F; x \<in> (S \<union> UF) \<inter> (S \<union> (i - {a i}))\<rbrakk>
  1325                             \<Longrightarrow> g x = h i x"
  1326   proof (rule pasting_lemma_exists_closed [OF \<open>finite F\<close>])
  1327     let ?X = "top_of_set (S \<union> UF)"
  1328     show "topspace ?X \<subseteq> (\<Union>C\<in>F. S \<union> (C - {a C}))"
  1329       using \<open>C0 \<in> F\<close> by (force simp: UF_def)
  1330     show "closedin (top_of_set (S \<union> UF)) (S \<union> (C - {a C}))"
  1331          if "C \<in> F" for C
  1332     proof (rule closedin_closed_subset [of U "S \<union> C"])
  1333       show "closedin (top_of_set U) (S \<union> C)"
  1334         apply (rule closedin_Un_complement_component [OF \<open>locally connected U\<close> clo])
  1335         using F_def that by blast
  1336     next
  1337       have "x = a C'" if "C' \<in> F"  "x \<in> C'" "x \<notin> U" for x C'
  1338       proof -
  1339         have "\<forall>A. x \<in> \<Union>A \<or> C' \<notin> A"
  1340           using \<open>x \<in> C'\<close> by blast
  1341         with that show "x = a C'"
  1342           by (metis (lifting) DiffD1 F_def Union_components mem_Collect_eq)
  1343       qed
  1344       then show "S \<union> UF \<subseteq> U"
  1345         using \<open>S \<subseteq> U\<close> by (force simp: UF_def)
  1346     next
  1347       show "S \<union> (C - {a C}) = (S \<union> C) \<inter> (S \<union> UF)"
  1348         using F_def UF_def components_nonoverlap that by auto
  1349     qed
  1350     show "continuous_map (subtopology ?X (S \<union> (C' - {a C'}))) euclidean (h C')" if "C' \<in> F" for C'
  1351     proof -
  1352       have C': "C' \<in> components (U - S)" "C' \<inter> K \<noteq> {}"
  1353         using F_def that by blast+
  1354       show ?thesis
  1355         using ah [OF C'] by (auto simp: F_def subtopology_subtopology intro: continuous_on_subset)
  1356     qed
  1357     show "\<And>i j x. \<lbrakk>i \<in> F; j \<in> F;
  1358                    x \<in> topspace ?X \<inter> (S \<union> (i - {a i})) \<inter> (S \<union> (j - {a j}))\<rbrakk>
  1359                   \<Longrightarrow> h i x = h j x"
  1360       using components_eq by (fastforce simp: components_eq F_def ah)
  1361   qed auto
  1362   have SU': "S \<union> \<Union>G \<union> (S \<union> UF) \<subseteq> U"
  1363     using \<open>S \<subseteq> U\<close> in_components_subset by (auto simp: F_def G_def UF_def)
  1364   have clo1: "closedin (top_of_set (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> \<Union>G)"
  1365   proof (rule closedin_closed_subset [OF _ SU'])
  1366     have *: "\<And>C. C \<in> F \<Longrightarrow> openin (top_of_set U) C"
  1367       unfolding F_def
  1368       by clarify (metis (no_types, lifting) \<open>locally connected U\<close> clo closedin_def locally_diff_closed openin_components_locally_connected openin_trans topspace_euclidean_subtopology)
  1369     show "closedin (top_of_set U) (U - UF)"
  1370       unfolding UF_def
  1371       by (force intro: openin_delete *)
  1372     show "S \<union> \<Union>G = (U - UF) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
  1373       using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
  1374         apply (metis Diff_iff UnionI Union_components)
  1375        apply (metis DiffD1 UnionI Union_components)
  1376       by (metis (no_types, lifting) IntI components_nonoverlap empty_iff)
  1377   qed
  1378   have clo2: "closedin (top_of_set (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> UF)"
  1379   proof (rule closedin_closed_subset [OF _ SU'])
  1380     show "closedin (top_of_set U) (\<Union>C\<in>F. S \<union> C)"
  1381       apply (rule closedin_Union)
  1382        apply (simp add: \<open>finite F\<close>)
  1383       using F_def \<open>locally connected U\<close> clo closedin_Un_complement_component by blast
  1384     show "S \<union> UF = (\<Union>C\<in>F. S \<union> C) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
  1385       using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
  1386       using C0 apply blast
  1387       by (metis components_nonoverlap disjnt_def disjnt_iff)
  1388   qed
  1389   have SUG: "S \<union> \<Union>G \<subseteq> U - K"
  1390     using \<open>S \<subseteq> U\<close> K apply (auto simp: G_def disjnt_iff)
  1391     by (meson Diff_iff subsetD in_components_subset)
  1392   then have contf': "continuous_on (S \<union> \<Union>G) f"
  1393     by (rule continuous_on_subset [OF contf])
  1394   have contg': "continuous_on (S \<union> UF) g"
  1395     apply (rule continuous_on_subset [OF contg])
  1396     using \<open>S \<subseteq> U\<close> by (auto simp: F_def G_def)
  1397   have  "\<And>x. \<lbrakk>S \<subseteq> U; x \<in> S\<rbrakk> \<Longrightarrow> f x = g x"
  1398     by (subst gh) (auto simp: ah C0 intro: \<open>C0 \<in> F\<close>)
  1399   then have f_eq_g: "\<And>x. x \<in> S \<union> UF \<and> x \<in> S \<union> \<Union>G \<Longrightarrow> f x = g x"
  1400     using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def dest: in_components_subset)
  1401     using components_eq by blast
  1402   have cont: "continuous_on (S \<union> \<Union>G \<union> (S \<union> UF)) (\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x)"
  1403     by (blast intro: continuous_on_cases_local [OF clo1 clo2 contf' contg' f_eq_g, of "\<lambda>x. x \<in> S \<union> \<Union>G"])
  1404   show ?thesis
  1405   proof
  1406     have UF: "\<Union>F - L \<subseteq> UF"
  1407       unfolding F_def UF_def using ah by blast
  1408     have "U - S - L = \<Union>(components (U - S)) - L"
  1409       by simp
  1410     also have "... = \<Union>F \<union> \<Union>G - L"
  1411       unfolding F_def G_def by blast
  1412     also have "... \<subseteq> UF \<union> \<Union>G"
  1413       using UF by blast
  1414     finally have "U - L \<subseteq> S \<union> \<Union>G \<union> (S \<union> UF)"
  1415       by blast
  1416     then show "continuous_on (U - L) (\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x)"
  1417       by (rule continuous_on_subset [OF cont])
  1418     have "((U - L) \<inter> {x. x \<notin> S \<and> (\<forall>xa\<in>G. x \<notin> xa)}) \<subseteq>  ((U - L) \<inter> (-S \<inter> UF))"
  1419       using \<open>U - L \<subseteq> S \<union> \<Union>G \<union> (S \<union> UF)\<close> by auto
  1420     moreover have "g ` ((U - L) \<inter> (-S \<inter> UF)) \<subseteq> T"
  1421     proof -
  1422       have "g x \<in> T" if "x \<in> U" "x \<notin> L" "x \<notin> S" "C \<in> F" "x \<in> C" "x \<noteq> a C" for x C
  1423       proof (subst gh)
  1424         show "x \<in> (S \<union> UF) \<inter> (S \<union> (C - {a C}))"
  1425           using that by (auto simp: UF_def)
  1426         show "h C x \<in> T"
  1427           using ah that by (fastforce simp add: F_def)
  1428       qed (rule that)
  1429       then show ?thesis
  1430         by (force simp: UF_def)
  1431     qed
  1432     ultimately have "g ` ((U - L) \<inter> {x. x \<notin> S \<and> (\<forall>xa\<in>G. x \<notin> xa)}) \<subseteq> T"
  1433       using image_mono order_trans by blast
  1434     moreover have "f ` ((U - L) \<inter> (S \<union> \<Union>G)) \<subseteq> T"
  1435       using fim SUG by blast
  1436     ultimately show "(\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x) ` (U - L) \<subseteq> T"
  1437        by force
  1438     show "\<And>x. x \<in> S \<Longrightarrow> (if x \<in> S \<union> \<Union>G then f x else g x) = f x"
  1439       by (simp add: F_def G_def)
  1440   qed
  1441 qed
  1442 
  1443 
  1444 lemma extend_map_affine_to_sphere2:
  1445   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1446   assumes "compact S" "convex U" "bounded U" "affine T" "S \<subseteq> T"
  1447       and affTU: "aff_dim T \<le> aff_dim U"
  1448       and contf: "continuous_on S f"
  1449       and fim: "f ` S \<subseteq> rel_frontier U"
  1450       and ovlap: "\<And>C. C \<in> components(T - S) \<Longrightarrow> C \<inter> L \<noteq> {}"
  1451     obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S"
  1452                       "continuous_on (T - K) g" "g ` (T - K) \<subseteq> rel_frontier U"
  1453                       "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1454 proof -
  1455   obtain K g where K: "finite K" "K \<subseteq> T" "disjnt K S"
  1456                and contg: "continuous_on (T - K) g"
  1457                and gim: "g ` (T - K) \<subseteq> rel_frontier U"
  1458                and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1459      using assms extend_map_affine_to_sphere_cofinite_simple by metis
  1460   have "(\<exists>y C. C \<in> components (T - S) \<and> x \<in> C \<and> y \<in> C \<and> y \<in> L)" if "x \<in> K" for x
  1461   proof -
  1462     have "x \<in> T-S"
  1463       using \<open>K \<subseteq> T\<close> \<open>disjnt K S\<close> disjnt_def that by fastforce
  1464     then obtain C where "C \<in> components(T - S)" "x \<in> C"
  1465       by (metis UnionE Union_components)
  1466     with ovlap [of C] show ?thesis
  1467       by blast
  1468   qed
  1469   then obtain \<xi> where \<xi>: "\<And>x. x \<in> K \<Longrightarrow> \<exists>C. C \<in> components (T - S) \<and> x \<in> C \<and> \<xi> x \<in> C \<and> \<xi> x \<in> L"
  1470     by metis
  1471   obtain h where conth: "continuous_on (T - \<xi> ` K) h"
  1472              and him: "h ` (T - \<xi> ` K) \<subseteq> rel_frontier U"
  1473              and hg: "\<And>x. x \<in> S \<Longrightarrow> h x = g x"
  1474   proof (rule extend_map_affine_to_sphere1 [OF \<open>finite K\<close> \<open>affine T\<close> contg gim, of S "\<xi> ` K"])
  1475     show cloTS: "closedin (top_of_set T) S"
  1476       by (simp add: \<open>compact S\<close> \<open>S \<subseteq> T\<close> closed_subset compact_imp_closed)
  1477     show "\<And>C. \<lbrakk>C \<in> components (T - S); C \<inter> K \<noteq> {}\<rbrakk> \<Longrightarrow> C \<inter> \<xi> ` K \<noteq> {}"
  1478       using \<xi> components_eq by blast
  1479   qed (use K in auto)
  1480   show ?thesis
  1481   proof
  1482     show *: "\<xi> ` K \<subseteq> L"
  1483       using \<xi> by blast
  1484     show "finite (\<xi> ` K)"
  1485       by (simp add: K)
  1486     show "\<xi> ` K \<subseteq> T"
  1487       by clarify (meson \<xi> Diff_iff contra_subsetD in_components_subset)
  1488     show "continuous_on (T - \<xi> ` K) h"
  1489       by (rule conth)
  1490     show "disjnt (\<xi> ` K) S"
  1491       using K
  1492       apply (auto simp: disjnt_def)
  1493       by (metis \<xi> DiffD2 UnionI Union_components)
  1494   qed (simp_all add: him hg gf)
  1495 qed
  1496 
  1497 
  1498 proposition extend_map_affine_to_sphere_cofinite_gen:
  1499   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1500   assumes SUT: "compact S" "convex U" "bounded U" "affine T" "S \<subseteq> T"
  1501       and aff: "aff_dim T \<le> aff_dim U"
  1502       and contf: "continuous_on S f"
  1503       and fim: "f ` S \<subseteq> rel_frontier U"
  1504       and dis: "\<And>C. \<lbrakk>C \<in> components(T - S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  1505  obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
  1506                    "g ` (T - K) \<subseteq> rel_frontier U"
  1507                    "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1508 proof (cases "S = {}")
  1509   case True
  1510   show ?thesis
  1511   proof (cases "rel_frontier U = {}")
  1512     case True
  1513     with aff have "aff_dim T \<le> 0"
  1514       apply (simp add: rel_frontier_eq_empty)
  1515       using affine_bounded_eq_lowdim \<open>bounded U\<close> order_trans by auto
  1516     with aff_dim_geq [of T] consider "aff_dim T = -1" |  "aff_dim T = 0"
  1517       by linarith
  1518     then show ?thesis
  1519     proof cases
  1520       assume "aff_dim T = -1"
  1521       then have "T = {}"
  1522         by (simp add: aff_dim_empty)
  1523       then show ?thesis
  1524         by (rule_tac K="{}" in that) auto
  1525     next
  1526       assume "aff_dim T = 0"
  1527       then obtain a where "T = {a}"
  1528         using aff_dim_eq_0 by blast
  1529       then have "a \<in> L"
  1530         using dis [of "{a}"] \<open>S = {}\<close> by (auto simp: in_components_self)
  1531       with \<open>S = {}\<close> \<open>T = {a}\<close> show ?thesis
  1532         by (rule_tac K="{a}" and g=f in that) auto
  1533     qed
  1534   next
  1535     case False
  1536     then obtain y where "y \<in> rel_frontier U"
  1537       by auto
  1538     with \<open>S = {}\<close> show ?thesis
  1539       by (rule_tac K="{}" and g="\<lambda>x. y" in that)  (auto simp: continuous_on_const)
  1540   qed
  1541 next
  1542   case False
  1543   have "bounded S"
  1544     by (simp add: assms compact_imp_bounded)
  1545   then obtain b where b: "S \<subseteq> cbox (-b) b"
  1546     using bounded_subset_cbox_symmetric by blast
  1547   define LU where "LU \<equiv> L \<union> (\<Union> {C \<in> components (T - S). \<not>bounded C} - cbox (-(b+One)) (b+One))"
  1548   obtain K g where "finite K" "K \<subseteq> LU" "K \<subseteq> T" "disjnt K S"
  1549                and contg: "continuous_on (T - K) g"
  1550                and gim: "g ` (T - K) \<subseteq> rel_frontier U"
  1551                and gf:  "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1552   proof (rule extend_map_affine_to_sphere2 [OF SUT aff contf fim])
  1553     show "C \<inter> LU \<noteq> {}" if "C \<in> components (T - S)" for C
  1554     proof (cases "bounded C")
  1555       case True
  1556       with dis that show ?thesis
  1557         unfolding LU_def by fastforce
  1558     next
  1559       case False
  1560       then have "\<not> bounded (\<Union>{C \<in> components (T - S). \<not> bounded C})"
  1561         by (metis (no_types, lifting) Sup_upper bounded_subset mem_Collect_eq that)
  1562       then show ?thesis
  1563         apply (clarsimp simp: LU_def Int_Un_distrib Diff_Int_distrib Int_UN_distrib)
  1564         by (metis (no_types, lifting) False Sup_upper bounded_cbox bounded_subset inf.orderE mem_Collect_eq that)
  1565     qed
  1566   qed blast
  1567   have *: False if "x \<in> cbox (- b - m *\<^sub>R One) (b + m *\<^sub>R One)"
  1568                    "x \<notin> box (- b - n *\<^sub>R One) (b + n *\<^sub>R One)"
  1569                    "0 \<le> m" "m < n" "n \<le> 1" for m n x
  1570     using that by (auto simp: mem_box algebra_simps)
  1571   have "disjoint_family_on (\<lambda>d. frontier (cbox (- b - d *\<^sub>R One) (b + d *\<^sub>R One))) {1 / 2..1}"
  1572     by (auto simp: disjoint_family_on_def neq_iff frontier_def dest: *)
  1573   then obtain d where d12: "1/2 \<le> d" "d \<le> 1"
  1574                   and ddis: "disjnt K (frontier (cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One)))"
  1575     using disjoint_family_elem_disjnt [of "{1/2..1::real}" K "\<lambda>d. frontier (cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One))"]
  1576     by (auto simp: \<open>finite K\<close>)
  1577   define c where "c \<equiv> b + d *\<^sub>R One"
  1578   have cbsub: "cbox (-b) b \<subseteq> box (-c) c"
  1579               "cbox (-b) b \<subseteq> cbox (-c) c"
  1580               "cbox (-c) c \<subseteq> cbox (-(b+One)) (b+One)"
  1581     using d12 by (simp_all add: subset_box c_def inner_diff_left inner_left_distrib)
  1582   have clo_cT: "closed (cbox (- c) c \<inter> T)"
  1583     using affine_closed \<open>affine T\<close> by blast
  1584   have cT_ne: "cbox (- c) c \<inter> T \<noteq> {}"
  1585     using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub by fastforce
  1586   have S_sub_cc: "S \<subseteq> cbox (- c) c"
  1587     using \<open>cbox (- b) b \<subseteq> cbox (- c) c\<close> b by auto
  1588   show ?thesis
  1589   proof
  1590     show "finite (K \<inter> cbox (-(b+One)) (b+One))"
  1591       using \<open>finite K\<close> by blast
  1592     show "K \<inter> cbox (- (b + One)) (b + One) \<subseteq> L"
  1593       using \<open>K \<subseteq> LU\<close> by (auto simp: LU_def)
  1594     show "K \<inter> cbox (- (b + One)) (b + One) \<subseteq> T"
  1595       using \<open>K \<subseteq> T\<close> by auto
  1596     show "disjnt (K \<inter> cbox (- (b + One)) (b + One)) S"
  1597       using \<open>disjnt K S\<close>  by (simp add: disjnt_def disjoint_eq_subset_Compl inf.coboundedI1)
  1598     have cloTK: "closest_point (cbox (- c) c \<inter> T) x \<in> T - K"
  1599                 if "x \<in> T" and Knot: "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
  1600     proof (cases "x \<in> cbox (- c) c")
  1601       case True
  1602       with \<open>x \<in> T\<close> show ?thesis
  1603         using cbsub(3) Knot  by (force simp: closest_point_self)
  1604     next
  1605       case False
  1606       have clo_in_rf: "closest_point (cbox (- c) c \<inter> T) x \<in> rel_frontier (cbox (- c) c \<inter> T)"
  1607       proof (intro closest_point_in_rel_frontier [OF clo_cT cT_ne] DiffI notI)
  1608         have "T \<inter> interior (cbox (- c) c) \<noteq> {}"
  1609           using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub(1) by fastforce
  1610         then show "x \<in> affine hull (cbox (- c) c \<inter> T)"
  1611           by (simp add: Int_commute affine_hull_affine_Int_nonempty_interior \<open>affine T\<close> hull_inc that(1))
  1612       next
  1613         show "False" if "x \<in> rel_interior (cbox (- c) c \<inter> T)"
  1614         proof -
  1615           have "interior (cbox (- c) c) \<inter> T \<noteq> {}"
  1616             using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub(1) by fastforce
  1617           then have "affine hull (T \<inter> cbox (- c) c) = T"
  1618             using affine_hull_convex_Int_nonempty_interior [of T "cbox (- c) c"]
  1619             by (simp add: affine_imp_convex \<open>affine T\<close> inf_commute)
  1620           then show ?thesis
  1621             by (meson subsetD le_inf_iff rel_interior_subset that False)
  1622         qed
  1623       qed
  1624       have "closest_point (cbox (- c) c \<inter> T) x \<notin> K"
  1625       proof
  1626         assume inK: "closest_point (cbox (- c) c \<inter> T) x \<in> K"
  1627         have "\<And>x. x \<in> K \<Longrightarrow> x \<notin> frontier (cbox (- (b + d *\<^sub>R One)) (b + d *\<^sub>R One))"
  1628           by (metis ddis disjnt_iff)
  1629         then show False
  1630           by (metis DiffI Int_iff \<open>affine T\<close> cT_ne c_def clo_cT clo_in_rf closest_point_in_set
  1631                     convex_affine_rel_frontier_Int convex_box(1) empty_iff frontier_cbox inK interior_cbox)
  1632       qed
  1633       then show ?thesis
  1634         using cT_ne clo_cT closest_point_in_set by blast
  1635     qed
  1636     show "continuous_on (T - K \<inter> cbox (- (b + One)) (b + One)) (g \<circ> closest_point (cbox (-c) c \<inter> T))"
  1637       apply (intro continuous_on_compose continuous_on_closest_point continuous_on_subset [OF contg])
  1638          apply (simp_all add: clo_cT affine_imp_convex \<open>affine T\<close> convex_Int cT_ne)
  1639       using cloTK by blast
  1640     have "g (closest_point (cbox (- c) c \<inter> T) x) \<in> rel_frontier U"
  1641          if "x \<in> T" "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
  1642       apply (rule gim [THEN subsetD])
  1643       using that cloTK by blast
  1644     then show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K \<inter> cbox (- (b + One)) (b + One))
  1645                \<subseteq> rel_frontier U"
  1646       by force
  1647     show "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> closest_point (cbox (- c) c \<inter> T)) x = f x"
  1648       by simp (metis (mono_tags, lifting) IntI \<open>S \<subseteq> T\<close> cT_ne clo_cT closest_point_refl gf subsetD S_sub_cc)
  1649   qed
  1650 qed
  1651 
  1652 
  1653 corollary extend_map_affine_to_sphere_cofinite:
  1654   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1655   assumes SUT: "compact S" "affine T" "S \<subseteq> T"
  1656       and aff: "aff_dim T \<le> DIM('b)" and "0 \<le> r"
  1657       and contf: "continuous_on S f"
  1658       and fim: "f ` S \<subseteq> sphere a r"
  1659       and dis: "\<And>C. \<lbrakk>C \<in> components(T - S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  1660   obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
  1661                     "g ` (T - K) \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1662 proof (cases "r = 0")
  1663   case True
  1664   with fim show ?thesis
  1665     by (rule_tac K="{}" and g = "\<lambda>x. a" in that) (auto simp: continuous_on_const)
  1666 next
  1667   case False
  1668   with assms have "0 < r" by auto
  1669   then have "aff_dim T \<le> aff_dim (cball a r)"
  1670     by (simp add: aff aff_dim_cball)
  1671   then show ?thesis
  1672     apply (rule extend_map_affine_to_sphere_cofinite_gen
  1673             [OF \<open>compact S\<close> convex_cball bounded_cball \<open>affine T\<close> \<open>S \<subseteq> T\<close> _ contf])
  1674     using fim apply (auto simp: assms False that dest: dis)
  1675     done
  1676 qed
  1677 
  1678 corollary extend_map_UNIV_to_sphere_cofinite:
  1679   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1680   assumes aff: "DIM('a) \<le> DIM('b)" and "0 \<le> r"
  1681       and SUT: "compact S"
  1682       and contf: "continuous_on S f"
  1683       and fim: "f ` S \<subseteq> sphere a r"
  1684       and dis: "\<And>C. \<lbrakk>C \<in> components(- S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  1685   obtains K g where "finite K" "K \<subseteq> L" "disjnt K S" "continuous_on (- K) g"
  1686                     "g ` (- K) \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1687 apply (rule extend_map_affine_to_sphere_cofinite
  1688         [OF \<open>compact S\<close> affine_UNIV subset_UNIV _ \<open>0 \<le> r\<close> contf fim dis])
  1689  apply (auto simp: assms that Compl_eq_Diff_UNIV [symmetric])
  1690 done
  1691 
  1692 corollary extend_map_UNIV_to_sphere_no_bounded_component:
  1693   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1694   assumes aff: "DIM('a) \<le> DIM('b)" and "0 \<le> r"
  1695       and SUT: "compact S"
  1696       and contf: "continuous_on S f"
  1697       and fim: "f ` S \<subseteq> sphere a r"
  1698       and dis: "\<And>C. C \<in> components(- S) \<Longrightarrow> \<not> bounded C"
  1699   obtains g where "continuous_on UNIV g" "g ` UNIV \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1700 apply (rule extend_map_UNIV_to_sphere_cofinite [OF aff \<open>0 \<le> r\<close> \<open>compact S\<close> contf fim, of "{}"])
  1701    apply (auto simp: that dest: dis)
  1702 done
  1703 
  1704 theorem Borsuk_separation_theorem_gen:
  1705   fixes S :: "'a::euclidean_space set"
  1706   assumes "compact S"
  1707     shows "(\<forall>c \<in> components(- S). \<not>bounded c) \<longleftrightarrow>
  1708            (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::'a) 1
  1709                 \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)))"
  1710        (is "?lhs = ?rhs")
  1711 proof
  1712   assume L [rule_format]: ?lhs
  1713   show ?rhs
  1714   proof clarify
  1715     fix f :: "'a \<Rightarrow> 'a"
  1716     assume contf: "continuous_on S f" and fim: "f ` S \<subseteq> sphere 0 1"
  1717     obtain g where contg: "continuous_on UNIV g" and gim: "range g \<subseteq> sphere 0 1"
  1718                and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1719       by (rule extend_map_UNIV_to_sphere_no_bounded_component [OF _ _ \<open>compact S\<close> contf fim L]) auto
  1720     then show "\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)"
  1721       using nullhomotopic_from_contractible [OF contg gim]
  1722       by (metis assms compact_imp_closed contf empty_iff fim homotopic_with_equal nullhomotopic_into_sphere_extension)
  1723   qed
  1724 next
  1725   assume R [rule_format]: ?rhs
  1726   show ?lhs
  1727     unfolding components_def
  1728   proof clarify
  1729     fix a
  1730     assume "a \<notin> S" and a: "bounded (connected_component_set (- S) a)"
  1731     have cont: "continuous_on S (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a))"
  1732       apply (intro continuous_intros)
  1733       using \<open>a \<notin> S\<close> by auto
  1734     have im: "(\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) ` S \<subseteq> sphere 0 1"
  1735       by clarsimp (metis \<open>a \<notin> S\<close> eq_iff_diff_eq_0 left_inverse norm_eq_zero)
  1736     show False
  1737       using R cont im Borsuk_map_essential_bounded_component [OF \<open>compact S\<close> \<open>a \<notin> S\<close>] a by blast
  1738   qed
  1739 qed
  1740 
  1741 
  1742 corollary Borsuk_separation_theorem:
  1743   fixes S :: "'a::euclidean_space set"
  1744   assumes "compact S" and 2: "2 \<le> DIM('a)"
  1745     shows "connected(- S) \<longleftrightarrow>
  1746            (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::'a) 1
  1747                 \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)))"
  1748        (is "?lhs = ?rhs")
  1749 proof
  1750   assume L: ?lhs
  1751   show ?rhs
  1752   proof (cases "S = {}")
  1753     case True
  1754     then show ?thesis by auto
  1755   next
  1756     case False
  1757     then have "(\<forall>c\<in>components (- S). \<not> bounded c)"
  1758       by (metis L assms(1) bounded_empty cobounded_imp_unbounded compact_imp_bounded in_components_maximal order_refl)
  1759     then show ?thesis
  1760       by (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>])
  1761   qed
  1762 next
  1763   assume R: ?rhs
  1764   then show ?lhs
  1765     apply (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>, symmetric])
  1766     apply (auto simp: components_def connected_iff_eq_connected_component_set)
  1767     using connected_component_in apply fastforce
  1768     using cobounded_unique_unbounded_component [OF _ 2, of "-S"] \<open>compact S\<close> compact_eq_bounded_closed by fastforce
  1769 qed
  1770 
  1771 
  1772 lemma homotopy_eqv_separation:
  1773   fixes S :: "'a::euclidean_space set" and T :: "'a set"
  1774   assumes "S homotopy_eqv T" and "compact S" and "compact T"
  1775   shows "connected(- S) \<longleftrightarrow> connected(- T)"
  1776 proof -
  1777   consider "DIM('a) = 1" | "2 \<le> DIM('a)"
  1778     by (metis DIM_ge_Suc0 One_nat_def Suc_1 dual_order.antisym not_less_eq_eq)
  1779   then show ?thesis
  1780   proof cases
  1781     case 1
  1782     then show ?thesis
  1783       using bounded_connected_Compl_1 compact_imp_bounded homotopy_eqv_empty1 homotopy_eqv_empty2 assms by metis
  1784   next
  1785     case 2
  1786     with assms show ?thesis
  1787       by (simp add: Borsuk_separation_theorem homotopy_eqv_cohomotopic_triviality_null)
  1788   qed
  1789 qed
  1790 
  1791 proposition Jordan_Brouwer_separation:
  1792   fixes S :: "'a::euclidean_space set" and a::'a
  1793   assumes hom: "S homeomorphic sphere a r" and "0 < r"
  1794     shows "\<not> connected(- S)"
  1795 proof -
  1796   have "- sphere a r \<inter> ball a r \<noteq> {}"
  1797     using \<open>0 < r\<close> by (simp add: Int_absorb1 subset_eq)
  1798   moreover
  1799   have eq: "- sphere a r - ball a r = - cball a r"
  1800     by auto
  1801   have "- cball a r \<noteq> {}"
  1802   proof -
  1803     have "frontier (cball a r) \<noteq> {}"
  1804       using \<open>0 < r\<close> by auto
  1805     then show ?thesis
  1806       by (metis frontier_complement frontier_empty)
  1807   qed
  1808   with eq have "- sphere a r - ball a r \<noteq> {}"
  1809     by auto
  1810   moreover
  1811   have "connected (- S) = connected (- sphere a r)"
  1812   proof (rule homotopy_eqv_separation)
  1813     show "S homotopy_eqv sphere a r"
  1814       using hom homeomorphic_imp_homotopy_eqv by blast
  1815     show "compact (sphere a r)"
  1816       by simp
  1817     then show " compact S"
  1818       using hom homeomorphic_compactness by blast
  1819   qed
  1820   ultimately show ?thesis
  1821     using connected_Int_frontier [of "- sphere a r" "ball a r"] by (auto simp: \<open>0 < r\<close>)
  1822 qed
  1823 
  1824 
  1825 proposition Jordan_Brouwer_frontier:
  1826   fixes S :: "'a::euclidean_space set" and a::'a
  1827   assumes S: "S homeomorphic sphere a r" and T: "T \<in> components(- S)" and 2: "2 \<le> DIM('a)"
  1828     shows "frontier T = S"
  1829 proof (cases r rule: linorder_cases)
  1830   assume "r < 0"
  1831   with S T show ?thesis by auto
  1832 next
  1833   assume "r = 0"
  1834   with S T card_eq_SucD obtain b where "S = {b}"
  1835     by (auto simp: homeomorphic_finite [of "{a}" S])
  1836   have "components (- {b}) = { -{b}}"
  1837     using T \<open>S = {b}\<close> by (auto simp: components_eq_sing_iff connected_punctured_universe 2)
  1838   with T show ?thesis
  1839     by (metis \<open>S = {b}\<close> cball_trivial frontier_cball frontier_complement singletonD sphere_trivial)
  1840 next
  1841   assume "r > 0"
  1842   have "compact S"
  1843     using homeomorphic_compactness compact_sphere S by blast
  1844   show ?thesis
  1845   proof (rule frontier_minimal_separating_closed)
  1846     show "closed S"
  1847       using \<open>compact S\<close> compact_eq_bounded_closed by blast
  1848     show "\<not> connected (- S)"
  1849       using Jordan_Brouwer_separation S \<open>0 < r\<close> by blast
  1850     obtain f g where hom: "homeomorphism S (sphere a r) f g"
  1851       using S by (auto simp: homeomorphic_def)
  1852     show "connected (- T)" if "closed T" "T \<subset> S" for T
  1853     proof -
  1854       have "f ` T \<subseteq> sphere a r"
  1855         using \<open>T \<subset> S\<close> hom homeomorphism_image1 by blast
  1856       moreover have "f ` T \<noteq> sphere a r"
  1857         using \<open>T \<subset> S\<close> hom
  1858         by (metis homeomorphism_image2 homeomorphism_of_subsets order_refl psubsetE)
  1859       ultimately have "f ` T \<subset> sphere a r" by blast
  1860       then have "connected (- f ` T)"
  1861         by (rule psubset_sphere_Compl_connected [OF _ \<open>0 < r\<close> 2])
  1862       moreover have "compact T"
  1863         using \<open>compact S\<close> bounded_subset compact_eq_bounded_closed that by blast
  1864       moreover then have "compact (f ` T)"
  1865         by (meson compact_continuous_image continuous_on_subset hom homeomorphism_def psubsetE \<open>T \<subset> S\<close>)
  1866       moreover have "T homotopy_eqv f ` T"
  1867         by (meson \<open>f ` T \<subseteq> sphere a r\<close> dual_order.strict_implies_order hom homeomorphic_def homeomorphic_imp_homotopy_eqv homeomorphism_of_subsets \<open>T \<subset> S\<close>)
  1868       ultimately show ?thesis
  1869         using homotopy_eqv_separation [of T "f`T"] by blast
  1870     qed
  1871   qed (rule T)
  1872 qed
  1873 
  1874 proposition Jordan_Brouwer_nonseparation:
  1875   fixes S :: "'a::euclidean_space set" and a::'a
  1876   assumes S: "S homeomorphic sphere a r" and "T \<subset> S" and 2: "2 \<le> DIM('a)"
  1877     shows "connected(- T)"
  1878 proof -
  1879   have *: "connected(C \<union> (S - T))" if "C \<in> components(- S)" for C
  1880   proof (rule connected_intermediate_closure)
  1881     show "connected C"
  1882       using in_components_connected that by auto
  1883     have "S = frontier C"
  1884       using "2" Jordan_Brouwer_frontier S that by blast
  1885     with closure_subset show "C \<union> (S - T) \<subseteq> closure C"
  1886       by (auto simp: frontier_def)
  1887   qed auto
  1888   have "components(- S) \<noteq> {}"
  1889     by (metis S bounded_empty cobounded_imp_unbounded compact_eq_bounded_closed compact_sphere
  1890               components_eq_empty homeomorphic_compactness)
  1891   then have "- T = (\<Union>C \<in> components(- S). C \<union> (S - T))"
  1892     using Union_components [of "-S"] \<open>T \<subset> S\<close> by auto
  1893   then show ?thesis
  1894     apply (rule ssubst)
  1895     apply (rule connected_Union)
  1896     using \<open>T \<subset> S\<close> apply (auto simp: *)
  1897     done
  1898 qed
  1899 
  1900 subsection\<open> Invariance of domain and corollaries\<close>
  1901 
  1902 lemma invariance_of_domain_ball:
  1903   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
  1904   assumes contf: "continuous_on (cball a r) f" and "0 < r"
  1905      and inj: "inj_on f (cball a r)"
  1906    shows "open(f ` ball a r)"
  1907 proof (cases "DIM('a) = 1")
  1908   case True
  1909   obtain h::"'a\<Rightarrow>real" and k
  1910         where "linear h" "linear k" "h ` UNIV = UNIV" "k ` UNIV = UNIV"
  1911               "\<And>x. norm(h x) = norm x" "\<And>x. norm(k x) = norm x"
  1912               "\<And>x. k(h x) = x" "\<And>x. h(k x) = x"
  1913     apply (rule isomorphisms_UNIV_UNIV [where 'M='a and 'N=real])
  1914       using True
  1915        apply force
  1916       by (metis UNIV_I UNIV_eq_I imageI)
  1917     have cont: "continuous_on S h"  "continuous_on T k" for S T
  1918       by (simp_all add: \<open>linear h\<close> \<open>linear k\<close> linear_continuous_on linear_linear)
  1919     have "continuous_on (h ` cball a r) (h \<circ> f \<circ> k)"
  1920       apply (intro continuous_on_compose cont continuous_on_subset [OF contf])
  1921       apply (auto simp: \<open>\<And>x. k (h x) = x\<close>)
  1922       done
  1923     moreover have "is_interval (h ` cball a r)"
  1924       by (simp add: is_interval_connected_1 \<open>linear h\<close> linear_continuous_on linear_linear connected_continuous_image)
  1925     moreover have "inj_on (h \<circ> f \<circ> k) (h ` cball a r)"
  1926       using inj by (simp add: inj_on_def) (metis \<open>\<And>x. k (h x) = x\<close>)
  1927     ultimately have *: "\<And>T. \<lbrakk>open T; T \<subseteq> h ` cball a r\<rbrakk> \<Longrightarrow> open ((h \<circ> f \<circ> k) ` T)"
  1928       using injective_eq_1d_open_map_UNIV by blast
  1929     have "open ((h \<circ> f \<circ> k) ` (h ` ball a r))"
  1930       by (rule *) (auto simp: \<open>linear h\<close> \<open>range h = UNIV\<close> open_surjective_linear_image)
  1931     then have "open ((h \<circ> f) ` ball a r)"
  1932       by (simp add: image_comp \<open>\<And>x. k (h x) = x\<close> cong: image_cong)
  1933     then show ?thesis
  1934       apply (simp only: image_comp [symmetric])
  1935 
  1936       apply (metis open_bijective_linear_image_eq \<open>linear h\<close> \<open>\<And>x. k (h x) = x\<close> \<open>range h = UNIV\<close> bijI inj_on_def)
  1937       done
  1938 next
  1939   case False
  1940   then have 2: "DIM('a) \<ge> 2"
  1941     by (metis DIM_ge_Suc0 One_nat_def Suc_1 antisym not_less_eq_eq)
  1942   have fimsub: "f ` ball a r \<subseteq> - f ` sphere a r"
  1943     using inj  by clarsimp (metis inj_onD less_eq_real_def mem_cball order_less_irrefl)
  1944   have hom: "f ` sphere a r homeomorphic sphere a r"
  1945     by (meson compact_sphere contf continuous_on_subset homeomorphic_compact homeomorphic_sym inj inj_on_subset sphere_cball)
  1946   then have nconn: "\<not> connected (- f ` sphere a r)"
  1947     by (rule Jordan_Brouwer_separation) (auto simp: \<open>0 < r\<close>)
  1948   obtain C where C: "C \<in> components (- f ` sphere a r)" and "bounded C"
  1949     apply (rule cobounded_has_bounded_component [OF _ nconn])
  1950       apply (simp_all add: 2)
  1951     by (meson compact_imp_bounded compact_continuous_image_eq compact_sphere contf inj sphere_cball)
  1952   moreover have "f ` (ball a r) = C"
  1953   proof
  1954     have "C \<noteq> {}"
  1955       by (rule in_components_nonempty [OF C])
  1956     show "C \<subseteq> f ` ball a r"
  1957     proof (rule ccontr)
  1958       assume nonsub: "\<not> C \<subseteq> f ` ball a r"
  1959       have "- f ` cball a r \<subseteq> C"
  1960       proof (rule components_maximal [OF C])
  1961         have "f ` cball a r homeomorphic cball a r"
  1962           using compact_cball contf homeomorphic_compact homeomorphic_sym inj by blast
  1963         then show "connected (- f ` cball a r)"
  1964           by (auto intro: connected_complement_homeomorphic_convex_compact 2)
  1965         show "- f ` cball a r \<subseteq> - f ` sphere a r"
  1966           by auto
  1967         then show "C \<inter> - f ` cball a r \<noteq> {}"
  1968           using \<open>C \<noteq> {}\<close> in_components_subset [OF C] nonsub
  1969           using image_iff by fastforce
  1970       qed
  1971       then have "bounded (- f ` cball a r)"
  1972         using bounded_subset \<open>bounded C\<close> by auto
  1973       then have "\<not> bounded (f ` cball a r)"
  1974         using cobounded_imp_unbounded by blast
  1975       then show "False"
  1976         using compact_continuous_image [OF contf] compact_cball compact_imp_bounded by blast
  1977     qed
  1978     with \<open>C \<noteq> {}\<close> have "C \<inter> f ` ball a r \<noteq> {}"
  1979       by (simp add: inf.absorb_iff1)
  1980     then show "f ` ball a r \<subseteq> C"
  1981       by (metis components_maximal [OF C _ fimsub] connected_continuous_image ball_subset_cball connected_ball contf continuous_on_subset)
  1982   qed
  1983   moreover have "open (- f ` sphere a r)"
  1984     using hom compact_eq_bounded_closed compact_sphere homeomorphic_compactness by blast
  1985   ultimately show ?thesis
  1986     using open_components by blast
  1987 qed
  1988 
  1989 
  1990 text\<open>Proved by L. E. J. Brouwer (1912)\<close>
  1991 theorem invariance_of_domain:
  1992   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
  1993   assumes "continuous_on S f" "open S" "inj_on f S"
  1994     shows "open(f ` S)"
  1995   unfolding open_subopen [of "f`S"]
  1996 proof clarify
  1997   fix a
  1998   assume "a \<in> S"
  1999   obtain \<delta> where "\<delta> > 0" and \<delta>: "cball a \<delta> \<subseteq> S"
  2000     using \<open>open S\<close> \<open>a \<in> S\<close> open_contains_cball_eq by blast
  2001   show "\<exists>T. open T \<and> f a \<in> T \<and> T \<subseteq> f ` S"
  2002   proof (intro exI conjI)
  2003     show "open (f ` (ball a \<delta>))"
  2004       by (meson \<delta> \<open>0 < \<delta>\<close> assms continuous_on_subset inj_on_subset invariance_of_domain_ball)
  2005     show "f a \<in> f ` ball a \<delta>"
  2006       by (simp add: \<open>0 < \<delta>\<close>)
  2007     show "f ` ball a \<delta> \<subseteq> f ` S"
  2008       using \<delta> ball_subset_cball by blast
  2009   qed
  2010 qed
  2011 
  2012 lemma inv_of_domain_ss0:
  2013   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
  2014   assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \<subseteq> S"
  2015       and "subspace S" and dimS: "dim S = DIM('b::euclidean_space)"
  2016       and ope: "openin (top_of_set S) U"
  2017     shows "openin (top_of_set S) (f ` U)"
  2018 proof -
  2019   have "U \<subseteq> S"
  2020     using ope openin_imp_subset by blast
  2021   have "(UNIV::'b set) homeomorphic S"
  2022     by (simp add: \<open>subspace S\<close> dimS homeomorphic_subspaces)
  2023   then obtain h k where homhk: "homeomorphism (UNIV::'b set) S h k"
  2024     using homeomorphic_def by blast
  2025   have homkh: "homeomorphism S (k ` S) k h"
  2026     using homhk homeomorphism_image2 homeomorphism_sym by fastforce
  2027   have "open ((k \<circ> f \<circ> h) ` k ` U)"
  2028   proof (rule invariance_of_domain)
  2029     show "continuous_on (k ` U) (k \<circ> f \<circ> h)"
  2030     proof (intro continuous_intros)
  2031       show "continuous_on (k ` U) h"
  2032         by (meson continuous_on_subset [OF homeomorphism_cont1 [OF homhk]] top_greatest)
  2033       show "continuous_on (h ` k ` U) f"
  2034         apply (rule continuous_on_subset [OF contf], clarify)
  2035         apply (metis homhk homeomorphism_def ope openin_imp_subset rev_subsetD)
  2036         done
  2037       show "continuous_on (f ` h ` k ` U) k"
  2038         apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
  2039         using fim homhk homeomorphism_apply2 ope openin_subset by fastforce
  2040     qed
  2041     have ope_iff: "\<And>T. open T \<longleftrightarrow> openin (top_of_set (k ` S)) T"
  2042       using homhk homeomorphism_image2 open_openin by fastforce
  2043     show "open (k ` U)"
  2044       by (simp add: ope_iff homeomorphism_imp_open_map [OF homkh ope])
  2045     show "inj_on (k \<circ> f \<circ> h) (k ` U)"
  2046       apply (clarsimp simp: inj_on_def)
  2047       by (metis subsetD fim homeomorphism_apply2 [OF homhk] image_subset_iff inj_on_eq_iff injf \<open>U \<subseteq> S\<close>)
  2048   qed
  2049   moreover
  2050   have eq: "f ` U = h ` (k \<circ> f \<circ> h \<circ> k) ` U"
  2051     unfolding image_comp [symmetric] using \<open>U \<subseteq> S\<close> fim
  2052     by (metis homeomorphism_image2 homeomorphism_of_subsets homkh subset_image_iff)
  2053   ultimately show ?thesis
  2054     by (metis (no_types, hide_lams) homeomorphism_imp_open_map homhk image_comp open_openin subtopology_UNIV)
  2055 qed
  2056 
  2057 lemma inv_of_domain_ss1:
  2058   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
  2059   assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \<subseteq> S"
  2060       and "subspace S"
  2061       and ope: "openin (top_of_set S) U"
  2062     shows "openin (top_of_set S) (f ` U)"
  2063 proof -
  2064   define S' where "S' \<equiv> {y. \<forall>x \<in> S. orthogonal x y}"
  2065   have "subspace S'"
  2066     by (simp add: S'_def subspace_orthogonal_to_vectors)
  2067   define g where "g \<equiv> \<lambda>z::'a*'a. ((f \<circ> fst)z, snd z)"
  2068   have "openin (top_of_set (S \<times> S')) (g ` (U \<times> S'))"
  2069   proof (rule inv_of_domain_ss0)
  2070     show "continuous_on (U \<times> S') g"
  2071       apply (simp add: g_def)
  2072       apply (intro continuous_intros continuous_on_compose2 [OF contf continuous_on_fst], auto)
  2073       done
  2074     show "g ` (U \<times> S') \<subseteq> S \<times> S'"
  2075       using fim  by (auto simp: g_def)
  2076     show "inj_on g (U \<times> S')"
  2077       using injf by (auto simp: g_def inj_on_def)
  2078     show "subspace (S \<times> S')"
  2079       by (simp add: \<open>subspace S'\<close> \<open>subspace S\<close> subspace_Times)
  2080     show "openin (top_of_set (S \<times> S')) (U \<times> S')"
  2081       by (simp add: openin_Times [OF ope])
  2082     have "dim (S \<times> S') = dim S + dim S'"
  2083       by (simp add: \<open>subspace S'\<close> \<open>subspace S\<close> dim_Times)
  2084     also have "... = DIM('a)"
  2085       using dim_subspace_orthogonal_to_vectors [OF \<open>subspace S\<close> subspace_UNIV]
  2086       by (simp add: add.commute S'_def)
  2087     finally show "dim (S \<times> S') = DIM('a)" .
  2088   qed
  2089   moreover have "g ` (U \<times> S') = f ` U \<times> S'"
  2090     by (auto simp: g_def image_iff)
  2091   moreover have "0 \<in> S'"
  2092     using \<open>subspace S'\<close> subspace_affine by blast
  2093   ultimately show ?thesis
  2094     by (auto simp: openin_Times_eq)
  2095 qed
  2096 
  2097 
  2098 corollary invariance_of_domain_subspaces:
  2099   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2100   assumes ope: "openin (top_of_set U) S"
  2101       and "subspace U" "subspace V" and VU: "dim V \<le> dim U"
  2102       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
  2103       and injf: "inj_on f S"
  2104     shows "openin (top_of_set V) (f ` S)"
  2105 proof -
  2106   obtain V' where "subspace V'" "V' \<subseteq> U" "dim V' = dim V"
  2107     using choose_subspace_of_subspace [OF VU]
  2108     by (metis span_eq_iff \<open>subspace U\<close>)
  2109   then have "V homeomorphic V'"
  2110     by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
  2111   then obtain h k where homhk: "homeomorphism V V' h k"
  2112     using homeomorphic_def by blast
  2113   have eq: "f ` S = k ` (h \<circ> f) ` S"
  2114   proof -
  2115     have "k ` h ` f ` S = f ` S"
  2116       by (meson fim homeomorphism_def homeomorphism_of_subsets homhk subset_refl)
  2117     then show ?thesis
  2118       by (simp add: image_comp)
  2119   qed
  2120   show ?thesis
  2121     unfolding eq
  2122   proof (rule homeomorphism_imp_open_map)
  2123     show homkh: "homeomorphism V' V k h"
  2124       by (simp add: homeomorphism_symD homhk)
  2125     have hfV': "(h \<circ> f) ` S \<subseteq> V'"
  2126       using fim homeomorphism_image1 homhk by fastforce
  2127     moreover have "openin (top_of_set U) ((h \<circ> f) ` S)"
  2128     proof (rule inv_of_domain_ss1)
  2129       show "continuous_on S (h \<circ> f)"
  2130         by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
  2131       show "inj_on (h \<circ> f) S"
  2132         apply (clarsimp simp: inj_on_def)
  2133         by (metis fim homeomorphism_apply2 [OF homkh] image_subset_iff inj_onD injf)
  2134       show "(h \<circ> f) ` S \<subseteq> U"
  2135         using \<open>V' \<subseteq> U\<close> hfV' by auto
  2136       qed (auto simp: assms)
  2137     ultimately show "openin (top_of_set V') ((h \<circ> f) ` S)"
  2138       using openin_subset_trans \<open>V' \<subseteq> U\<close> by force
  2139   qed
  2140 qed
  2141 
  2142 corollary invariance_of_dimension_subspaces:
  2143   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2144   assumes ope: "openin (top_of_set U) S"
  2145       and "subspace U" "subspace V"
  2146       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
  2147       and injf: "inj_on f S" and "S \<noteq> {}"
  2148     shows "dim U \<le> dim V"
  2149 proof -
  2150   have "False" if "dim V < dim U"
  2151   proof -
  2152     obtain T where "subspace T" "T \<subseteq> U" "dim T = dim V"
  2153       using choose_subspace_of_subspace [of "dim V" U]
  2154       by (metis \<open>dim V < dim U\<close> assms(2) order.strict_implies_order span_eq_iff)
  2155     then have "V homeomorphic T"
  2156       by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
  2157     then obtain h k where homhk: "homeomorphism V T h k"
  2158       using homeomorphic_def  by blast
  2159     have "continuous_on S (h \<circ> f)"
  2160       by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
  2161     moreover have "(h \<circ> f) ` S \<subseteq> U"
  2162       using \<open>T \<subseteq> U\<close> fim homeomorphism_image1 homhk by fastforce
  2163     moreover have "inj_on (h \<circ> f) S"
  2164       apply (clarsimp simp: inj_on_def)
  2165       by (metis fim homeomorphism_apply1 homhk image_subset_iff inj_onD injf)
  2166     ultimately have ope_hf: "openin (top_of_set U) ((h \<circ> f) ` S)"
  2167       using invariance_of_domain_subspaces [OF ope \<open>subspace U\<close> \<open>subspace U\<close>] by blast
  2168     have "(h \<circ> f) ` S \<subseteq> T"
  2169       using fim homeomorphism_image1 homhk by fastforce
  2170     then have "dim ((h \<circ> f) ` S) \<le> dim T"
  2171       by (rule dim_subset)
  2172     also have "dim ((h \<circ> f) ` S) = dim U"
  2173       using \<open>S \<noteq> {}\<close> \<open>subspace U\<close>
  2174       by (blast intro: dim_openin ope_hf)
  2175     finally show False
  2176       using \<open>dim V < dim U\<close> \<open>dim T = dim V\<close> by simp
  2177   qed
  2178   then show ?thesis
  2179     using not_less by blast
  2180 qed
  2181 
  2182 corollary invariance_of_domain_affine_sets:
  2183   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2184   assumes ope: "openin (top_of_set U) S"
  2185       and aff: "affine U" "affine V" "aff_dim V \<le> aff_dim U"
  2186       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
  2187       and injf: "inj_on f S"
  2188     shows "openin (top_of_set V) (f ` S)"
  2189 proof (cases "S = {}")
  2190   case True
  2191   then show ?thesis by auto
  2192 next
  2193   case False
  2194   obtain a b where "a \<in> S" "a \<in> U" "b \<in> V"
  2195     using False fim ope openin_contains_cball by fastforce
  2196   have "openin (top_of_set ((+) (- b) ` V)) (((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S)"
  2197   proof (rule invariance_of_domain_subspaces)
  2198     show "openin (top_of_set ((+) (- a) ` U)) ((+) (- a) ` S)"
  2199       by (metis ope homeomorphism_imp_open_map homeomorphism_translation translation_galois)
  2200     show "subspace ((+) (- a) ` U)"
  2201       by (simp add: \<open>a \<in> U\<close> affine_diffs_subspace_subtract \<open>affine U\<close> cong: image_cong_simp)
  2202     show "subspace ((+) (- b) ` V)"
  2203       by (simp add: \<open>b \<in> V\<close> affine_diffs_subspace_subtract \<open>affine V\<close> cong: image_cong_simp)
  2204     show "dim ((+) (- b) ` V) \<le> dim ((+) (- a) ` U)"
  2205       by (metis \<open>a \<in> U\<close> \<open>b \<in> V\<close> aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff)
  2206     show "continuous_on ((+) (- a) ` S) ((+) (- b) \<circ> f \<circ> (+) a)"
  2207       by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois)
  2208     show "((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S \<subseteq> (+) (- b) ` V"
  2209       using fim by auto
  2210     show "inj_on ((+) (- b) \<circ> f \<circ> (+) a) ((+) (- a) ` S)"
  2211       by (auto simp: inj_on_def) (meson inj_onD injf)
  2212   qed
  2213   then show ?thesis
  2214     by (metis (no_types, lifting) homeomorphism_imp_open_map homeomorphism_translation image_comp translation_galois)
  2215 qed
  2216 
  2217 corollary invariance_of_dimension_affine_sets:
  2218   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2219   assumes ope: "openin (top_of_set U) S"
  2220       and aff: "affine U" "affine V"
  2221       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
  2222       and injf: "inj_on f S" and "S \<noteq> {}"
  2223     shows "aff_dim U \<le> aff_dim V"
  2224 proof -
  2225   obtain a b where "a \<in> S" "a \<in> U" "b \<in> V"
  2226     using \<open>S \<noteq> {}\<close> fim ope openin_contains_cball by fastforce
  2227   have "dim ((+) (- a) ` U) \<le> dim ((+) (- b) ` V)"
  2228   proof (rule invariance_of_dimension_subspaces)
  2229     show "openin (top_of_set ((+) (- a) ` U)) ((+) (- a) ` S)"
  2230       by (metis ope homeomorphism_imp_open_map homeomorphism_translation translation_galois)
  2231     show "subspace ((+) (- a) ` U)"
  2232       by (simp add: \<open>a \<in> U\<close> affine_diffs_subspace_subtract \<open>affine U\<close> cong: image_cong_simp)
  2233     show "subspace ((+) (- b) ` V)"
  2234       by (simp add: \<open>b \<in> V\<close> affine_diffs_subspace_subtract \<open>affine V\<close> cong: image_cong_simp)
  2235     show "continuous_on ((+) (- a) ` S) ((+) (- b) \<circ> f \<circ> (+) a)"
  2236       by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois)
  2237     show "((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S \<subseteq> (+) (- b) ` V"
  2238       using fim by auto
  2239     show "inj_on ((+) (- b) \<circ> f \<circ> (+) a) ((+) (- a) ` S)"
  2240       by (auto simp: inj_on_def) (meson inj_onD injf)
  2241   qed (use \<open>S \<noteq> {}\<close> in auto)
  2242   then show ?thesis
  2243     by (metis \<open>a \<in> U\<close> \<open>b \<in> V\<close> aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff)
  2244 qed
  2245 
  2246 corollary invariance_of_dimension:
  2247   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2248   assumes contf: "continuous_on S f" and "open S"
  2249       and injf: "inj_on f S" and "S \<noteq> {}"
  2250     shows "DIM('a) \<le> DIM('b)"
  2251   using%unimportant invariance_of_dimension_subspaces [of UNIV S UNIV f] assms
  2252   by auto
  2253 
  2254 
  2255 corollary continuous_injective_image_subspace_dim_le:
  2256   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2257   assumes "subspace S" "subspace T"
  2258       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
  2259       and injf: "inj_on f S"
  2260     shows "dim S \<le> dim T"
  2261   apply (rule invariance_of_dimension_subspaces [of S S _ f])
  2262   using%unimportant assms by (auto simp: subspace_affine)
  2263 
  2264 lemma invariance_of_dimension_convex_domain:
  2265   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2266   assumes "convex S"
  2267       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> affine hull T"
  2268       and injf: "inj_on f S"
  2269     shows "aff_dim S \<le> aff_dim T"
  2270 proof (cases "S = {}")
  2271   case True
  2272   then show ?thesis by (simp add: aff_dim_geq)
  2273 next
  2274   case False
  2275   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
  2276   proof (rule invariance_of_dimension_affine_sets)
  2277     show "openin (top_of_set (affine hull S)) (rel_interior S)"
  2278       by (simp add: openin_rel_interior)
  2279     show "continuous_on (rel_interior S) f"
  2280       using contf continuous_on_subset rel_interior_subset by blast
  2281     show "f ` rel_interior S \<subseteq> affine hull T"
  2282       using fim rel_interior_subset by blast
  2283     show "inj_on f (rel_interior S)"
  2284       using inj_on_subset injf rel_interior_subset by blast
  2285     show "rel_interior S \<noteq> {}"
  2286       by (simp add: False \<open>convex S\<close> rel_interior_eq_empty)
  2287   qed auto
  2288   then show ?thesis
  2289     by simp
  2290 qed
  2291 
  2292 
  2293 lemma homeomorphic_convex_sets_le:
  2294   assumes "convex S" "S homeomorphic T"
  2295   shows "aff_dim S \<le> aff_dim T"
  2296 proof -
  2297   obtain h k where homhk: "homeomorphism S T h k"
  2298     using homeomorphic_def assms  by blast
  2299   show ?thesis
  2300   proof (rule invariance_of_dimension_convex_domain [OF \<open>convex S\<close>])
  2301     show "continuous_on S h"
  2302       using homeomorphism_def homhk by blast
  2303     show "h ` S \<subseteq> affine hull T"
  2304       by (metis homeomorphism_def homhk hull_subset)
  2305     show "inj_on h S"
  2306       by (meson homeomorphism_apply1 homhk inj_on_inverseI)
  2307   qed
  2308 qed
  2309 
  2310 lemma homeomorphic_convex_sets:
  2311   assumes "convex S" "convex T" "S homeomorphic T"
  2312   shows "aff_dim S = aff_dim T"
  2313   by (meson assms dual_order.antisym homeomorphic_convex_sets_le homeomorphic_sym)
  2314 
  2315 lemma homeomorphic_convex_compact_sets_eq:
  2316   assumes "convex S" "compact S" "convex T" "compact T"
  2317   shows "S homeomorphic T \<longleftrightarrow> aff_dim S = aff_dim T"
  2318   by (meson assms homeomorphic_convex_compact_sets homeomorphic_convex_sets)
  2319 
  2320 lemma invariance_of_domain_gen:
  2321   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2322   assumes "open S" "continuous_on S f" "inj_on f S" "DIM('b) \<le> DIM('a)"
  2323     shows "open(f ` S)"
  2324   using invariance_of_domain_subspaces [of UNIV S UNIV f] assms by auto
  2325 
  2326 lemma injective_into_1d_imp_open_map_UNIV:
  2327   fixes f :: "'a::euclidean_space \<Rightarrow> real"
  2328   assumes "open T" "continuous_on S f" "inj_on f S" "T \<subseteq> S"
  2329     shows "open (f ` T)"
  2330   apply (rule invariance_of_domain_gen [OF \<open>open T\<close>])
  2331   using assms apply (auto simp: elim: continuous_on_subset subset_inj_on)
  2332   done
  2333 
  2334 lemma continuous_on_inverse_open:
  2335   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2336   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" and gf: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
  2337     shows "continuous_on (f ` S) g"
  2338 proof (clarsimp simp add: continuous_openin_preimage_eq)
  2339   fix T :: "'a set"
  2340   assume "open T"
  2341   have eq: "f ` S \<inter> g -` T = f ` (S \<inter> T)"
  2342     by (auto simp: gf)
  2343   show "openin (top_of_set (f ` S)) (f ` S \<inter> g -` T)"
  2344     apply (subst eq)
  2345     apply (rule open_openin_trans)
  2346       apply (rule invariance_of_domain_gen)
  2347     using assms
  2348          apply auto
  2349     using inj_on_inverseI apply auto[1]
  2350     by (metis \<open>open T\<close> continuous_on_subset inj_onI inj_on_subset invariance_of_domain_gen openin_open openin_open_eq)
  2351 qed
  2352 
  2353 lemma invariance_of_domain_homeomorphism:
  2354   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2355   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" "inj_on f S"
  2356   obtains g where "homeomorphism S (f ` S) f g"
  2357 proof
  2358   show "homeomorphism S (f ` S) f (inv_into S f)"
  2359     by (simp add: assms continuous_on_inverse_open homeomorphism_def)
  2360 qed
  2361 
  2362 corollary invariance_of_domain_homeomorphic:
  2363   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2364   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" "inj_on f S"
  2365   shows "S homeomorphic (f ` S)"
  2366   using%unimportant invariance_of_domain_homeomorphism [OF assms]
  2367   by%unimportant (meson homeomorphic_def)
  2368 
  2369 lemma continuous_image_subset_interior:
  2370   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2371   assumes "continuous_on S f" "inj_on f S" "DIM('b) \<le> DIM('a)"
  2372   shows "f ` (interior S) \<subseteq> interior(f ` S)"
  2373   apply (rule interior_maximal)
  2374    apply (simp add: image_mono interior_subset)
  2375   apply (rule invariance_of_domain_gen)
  2376   using assms
  2377      apply (auto simp: subset_inj_on interior_subset continuous_on_subset)
  2378   done
  2379 
  2380 lemma homeomorphic_interiors_same_dimension:
  2381   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2382   assumes "S homeomorphic T" and dimeq: "DIM('a) = DIM('b)"
  2383   shows "(interior S) homeomorphic (interior T)"
  2384   using assms [unfolded homeomorphic_minimal]
  2385   unfolding homeomorphic_def
  2386 proof (clarify elim!: ex_forward)
  2387   fix f g
  2388   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
  2389      and contf: "continuous_on S f" and contg: "continuous_on T g"
  2390   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
  2391     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
  2392   have fim: "f ` interior S \<subseteq> interior T"
  2393     using continuous_image_subset_interior [OF contf \<open>inj_on f S\<close>] dimeq fST by simp
  2394   have gim: "g ` interior T \<subseteq> interior S"
  2395     using continuous_image_subset_interior [OF contg \<open>inj_on g T\<close>] dimeq gTS by simp
  2396   show "homeomorphism (interior S) (interior T) f g"
  2397     unfolding homeomorphism_def
  2398   proof (intro conjI ballI)
  2399     show "\<And>x. x \<in> interior S \<Longrightarrow> g (f x) = x"
  2400       by (meson \<open>\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x\<close> subsetD interior_subset)
  2401     have "interior T \<subseteq> f ` interior S"
  2402     proof
  2403       fix x assume "x \<in> interior T"
  2404       then have "g x \<in> interior S"
  2405         using gim by blast
  2406       then show "x \<in> f ` interior S"
  2407         by (metis T \<open>x \<in> interior T\<close> image_iff interior_subset subsetCE)
  2408     qed
  2409     then show "f ` interior S = interior T"
  2410       using fim by blast
  2411     show "continuous_on (interior S) f"
  2412       by (metis interior_subset continuous_on_subset contf)
  2413     show "\<And>y. y \<in> interior T \<Longrightarrow> f (g y) = y"
  2414       by (meson T subsetD interior_subset)
  2415     have "interior S \<subseteq> g ` interior T"
  2416     proof
  2417       fix x assume "x \<in> interior S"
  2418       then have "f x \<in> interior T"
  2419         using fim by blast
  2420       then show "x \<in> g ` interior T"
  2421         by (metis S \<open>x \<in> interior S\<close> image_iff interior_subset subsetCE)
  2422     qed
  2423     then show "g ` interior T = interior S"
  2424       using gim by blast
  2425     show "continuous_on (interior T) g"
  2426       by (metis interior_subset continuous_on_subset contg)
  2427   qed
  2428 qed
  2429 
  2430 lemma homeomorphic_open_imp_same_dimension:
  2431   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2432   assumes "S homeomorphic T" "open S" "S \<noteq> {}" "open T" "T \<noteq> {}"
  2433   shows "DIM('a) = DIM('b)"
  2434     using assms
  2435     apply (simp add: homeomorphic_minimal)
  2436     apply (rule order_antisym; metis inj_onI invariance_of_dimension)
  2437     done
  2438 
  2439 proposition homeomorphic_interiors:
  2440   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2441   assumes "S homeomorphic T" "interior S = {} \<longleftrightarrow> interior T = {}"
  2442     shows "(interior S) homeomorphic (interior T)"
  2443 proof (cases "interior T = {}")
  2444   case True
  2445   with assms show ?thesis by auto
  2446 next
  2447   case False
  2448   then have "DIM('a) = DIM('b)"
  2449     using assms
  2450     apply (simp add: homeomorphic_minimal)
  2451     apply (rule order_antisym; metis continuous_on_subset inj_onI inj_on_subset interior_subset invariance_of_dimension open_interior)
  2452     done
  2453   then show ?thesis
  2454     by (rule homeomorphic_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
  2455 qed
  2456 
  2457 lemma homeomorphic_frontiers_same_dimension:
  2458   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2459   assumes "S homeomorphic T" "closed S" "closed T" and dimeq: "DIM('a) = DIM('b)"
  2460   shows "(frontier S) homeomorphic (frontier T)"
  2461   using assms [unfolded homeomorphic_minimal]
  2462   unfolding homeomorphic_def
  2463 proof (clarify elim!: ex_forward)
  2464   fix f g
  2465   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
  2466      and contf: "continuous_on S f" and contg: "continuous_on T g"
  2467   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
  2468     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
  2469   have "g ` interior T \<subseteq> interior S"
  2470     using continuous_image_subset_interior [OF contg \<open>inj_on g T\<close>] dimeq gTS by simp
  2471   then have fim: "f ` frontier S \<subseteq> frontier T"
  2472     apply (simp add: frontier_def)
  2473     using continuous_image_subset_interior assms(2) assms(3) S by auto
  2474   have "f ` interior S \<subseteq> interior T"
  2475     using continuous_image_subset_interior [OF contf \<open>inj_on f S\<close>] dimeq fST by simp
  2476   then have gim: "g ` frontier T \<subseteq> frontier S"
  2477     apply (simp add: frontier_def)
  2478     using continuous_image_subset_interior T assms(2) assms(3) by auto
  2479   show "homeomorphism (frontier S) (frontier T) f g"
  2480     unfolding homeomorphism_def
  2481   proof (intro conjI ballI)
  2482     show gf: "\<And>x. x \<in> frontier S \<Longrightarrow> g (f x) = x"
  2483       by (simp add: S assms(2) frontier_def)
  2484     show fg: "\<And>y. y \<in> frontier T \<Longrightarrow> f (g y) = y"
  2485       by (simp add: T assms(3) frontier_def)
  2486     have "frontier T \<subseteq> f ` frontier S"
  2487     proof
  2488       fix x assume "x \<in> frontier T"
  2489       then have "g x \<in> frontier S"
  2490         using gim by blast
  2491       then show "x \<in> f ` frontier S"
  2492         by (metis fg \<open>x \<in> frontier T\<close> imageI)
  2493     qed
  2494     then show "f ` frontier S = frontier T"
  2495       using fim by blast
  2496     show "continuous_on (frontier S) f"
  2497       by (metis Diff_subset assms(2) closure_eq contf continuous_on_subset frontier_def)
  2498     have "frontier S \<subseteq> g ` frontier T"
  2499     proof
  2500       fix x assume "x \<in> frontier S"
  2501       then have "f x \<in> frontier T"
  2502         using fim by blast
  2503       then show "x \<in> g ` frontier T"
  2504         by (metis gf \<open>x \<in> frontier S\<close> imageI)
  2505     qed
  2506     then show "g ` frontier T = frontier S"
  2507       using gim by blast
  2508     show "continuous_on (frontier T) g"
  2509       by (metis Diff_subset assms(3) closure_closed contg continuous_on_subset frontier_def)
  2510   qed
  2511 qed
  2512 
  2513 lemma homeomorphic_frontiers:
  2514   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2515   assumes "S homeomorphic T" "closed S" "closed T"
  2516           "interior S = {} \<longleftrightarrow> interior T = {}"
  2517     shows "(frontier S) homeomorphic (frontier T)"
  2518 proof (cases "interior T = {}")
  2519   case True
  2520   then show ?thesis
  2521     by (metis Diff_empty assms closure_eq frontier_def)
  2522 next
  2523   case False
  2524   show ?thesis
  2525     apply (rule homeomorphic_frontiers_same_dimension)
  2526        apply (simp_all add: assms)
  2527     using False assms homeomorphic_interiors homeomorphic_open_imp_same_dimension by blast
  2528 qed
  2529 
  2530 lemma continuous_image_subset_rel_interior:
  2531   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2532   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
  2533       and TS: "aff_dim T \<le> aff_dim S"
  2534   shows "f ` (rel_interior S) \<subseteq> rel_interior(f ` S)"
  2535 proof (rule rel_interior_maximal)
  2536   show "f ` rel_interior S \<subseteq> f ` S"
  2537     by(simp add: image_mono rel_interior_subset)
  2538   show "openin (top_of_set (affine hull f ` S)) (f ` rel_interior S)"
  2539   proof (rule invariance_of_domain_affine_sets)
  2540     show "openin (top_of_set (affine hull S)) (rel_interior S)"
  2541       by (simp add: openin_rel_interior)
  2542     show "aff_dim (affine hull f ` S) \<le> aff_dim (affine hull S)"
  2543       by (metis aff_dim_affine_hull aff_dim_subset fim TS order_trans)
  2544     show "f ` rel_interior S \<subseteq> affine hull f ` S"
  2545       by (meson \<open>f ` rel_interior S \<subseteq> f ` S\<close> hull_subset order_trans)
  2546     show "continuous_on (rel_interior S) f"
  2547       using contf continuous_on_subset rel_interior_subset by blast
  2548     show "inj_on f (rel_interior S)"
  2549       using inj_on_subset injf rel_interior_subset by blast
  2550   qed auto
  2551 qed
  2552 
  2553 lemma homeomorphic_rel_interiors_same_dimension:
  2554   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2555   assumes "S homeomorphic T" and aff: "aff_dim S = aff_dim T"
  2556   shows "(rel_interior S) homeomorphic (rel_interior T)"
  2557   using assms [unfolded homeomorphic_minimal]
  2558   unfolding homeomorphic_def
  2559 proof (clarify elim!: ex_forward)
  2560   fix f g
  2561   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
  2562      and contf: "continuous_on S f" and contg: "continuous_on T g"
  2563   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
  2564     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
  2565   have fim: "f ` rel_interior S \<subseteq> rel_interior T"
  2566     by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
  2567   have gim: "g ` rel_interior T \<subseteq> rel_interior S"
  2568     by (metis \<open>inj_on g T\<close> aff contg continuous_image_subset_rel_interior gTS order_refl)
  2569   show "homeomorphism (rel_interior S) (rel_interior T) f g"
  2570     unfolding homeomorphism_def
  2571   proof (intro conjI ballI)
  2572     show gf: "\<And>x. x \<in> rel_interior S \<Longrightarrow> g (f x) = x"
  2573       using S rel_interior_subset by blast
  2574     show fg: "\<And>y. y \<in> rel_interior T \<Longrightarrow> f (g y) = y"
  2575       using T mem_rel_interior_ball by blast
  2576     have "rel_interior T \<subseteq> f ` rel_interior S"
  2577     proof
  2578       fix x assume "x \<in> rel_interior T"
  2579       then have "g x \<in> rel_interior S"
  2580         using gim by blast
  2581       then show "x \<in> f ` rel_interior S"
  2582         by (metis fg \<open>x \<in> rel_interior T\<close> imageI)
  2583     qed
  2584     moreover have "f ` rel_interior S \<subseteq> rel_interior T"
  2585       by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
  2586     ultimately show "f ` rel_interior S = rel_interior T"
  2587       by blast
  2588     show "continuous_on (rel_interior S) f"
  2589       using contf continuous_on_subset rel_interior_subset by blast
  2590     have "rel_interior S \<subseteq> g ` rel_interior T"
  2591     proof
  2592       fix x assume "x \<in> rel_interior S"
  2593       then have "f x \<in> rel_interior T"
  2594         using fim by blast
  2595       then show "x \<in> g ` rel_interior T"
  2596         by (metis gf \<open>x \<in> rel_interior S\<close> imageI)
  2597     qed
  2598     then show "g ` rel_interior T = rel_interior S"
  2599       using gim by blast
  2600     show "continuous_on (rel_interior T) g"
  2601       using contg continuous_on_subset rel_interior_subset by blast
  2602   qed
  2603 qed
  2604 
  2605 lemma homeomorphic_rel_interiors:
  2606   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2607   assumes "S homeomorphic T" "rel_interior S = {} \<longleftrightarrow> rel_interior T = {}"
  2608     shows "(rel_interior S) homeomorphic (rel_interior T)"
  2609 proof (cases "rel_interior T = {}")
  2610   case True
  2611   with assms show ?thesis by auto
  2612 next
  2613   case False
  2614   obtain f g
  2615     where S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
  2616       and contf: "continuous_on S f" and contg: "continuous_on T g"
  2617     using  assms [unfolded homeomorphic_minimal] by auto
  2618   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
  2619     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior S" _ f])
  2620           apply (simp_all add: openin_rel_interior False assms)
  2621     using contf continuous_on_subset rel_interior_subset apply blast
  2622       apply (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
  2623     apply (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
  2624     done
  2625   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
  2626     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior T" _ g])
  2627           apply (simp_all add: openin_rel_interior False assms)
  2628     using contg continuous_on_subset rel_interior_subset apply blast
  2629       apply (meson T hull_subset image_subsetI rel_interior_subset rev_subsetD)
  2630     apply (metis T inj_on_inverseI inj_on_subset rel_interior_subset)
  2631     done
  2632   ultimately have "aff_dim S = aff_dim T" by force
  2633   then show ?thesis
  2634     by (rule homeomorphic_rel_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
  2635 qed
  2636 
  2637 
  2638 lemma homeomorphic_rel_boundaries_same_dimension:
  2639   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2640   assumes "S homeomorphic T" and aff: "aff_dim S = aff_dim T"
  2641   shows "(S - rel_interior S) homeomorphic (T - rel_interior T)"
  2642   using assms [unfolded homeomorphic_minimal]
  2643   unfolding homeomorphic_def
  2644 proof (clarify elim!: ex_forward)
  2645   fix f g
  2646   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
  2647      and contf: "continuous_on S f" and contg: "continuous_on T g"
  2648   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
  2649     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
  2650   have fim: "f ` rel_interior S \<subseteq> rel_interior T"
  2651     by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
  2652   have gim: "g ` rel_interior T \<subseteq> rel_interior S"
  2653     by (metis \<open>inj_on g T\<close> aff contg continuous_image_subset_rel_interior gTS order_refl)
  2654   show "homeomorphism (S - rel_interior S) (T - rel_interior T) f g"
  2655     unfolding homeomorphism_def
  2656   proof (intro conjI ballI)
  2657     show gf: "\<And>x. x \<in> S - rel_interior S \<Longrightarrow> g (f x) = x"
  2658       using S rel_interior_subset by blast
  2659     show fg: "\<And>y. y \<in> T - rel_interior T \<Longrightarrow> f (g y) = y"
  2660       using T mem_rel_interior_ball by blast
  2661     show "f ` (S - rel_interior S) = T - rel_interior T"
  2662       using S fST fim gim by auto
  2663     show "continuous_on (S - rel_interior S) f"
  2664       using contf continuous_on_subset rel_interior_subset by blast
  2665     show "g ` (T - rel_interior T) = S - rel_interior S"
  2666       using T gTS gim fim by auto
  2667     show "continuous_on (T - rel_interior T) g"
  2668       using contg continuous_on_subset rel_interior_subset by blast
  2669   qed
  2670 qed
  2671 
  2672 lemma homeomorphic_rel_boundaries:
  2673   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2674   assumes "S homeomorphic T" "rel_interior S = {} \<longleftrightarrow> rel_interior T = {}"
  2675     shows "(S - rel_interior S) homeomorphic (T - rel_interior T)"
  2676 proof (cases "rel_interior T = {}")
  2677   case True
  2678   with assms show ?thesis by auto
  2679 next
  2680   case False
  2681   obtain f g
  2682     where S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
  2683       and contf: "continuous_on S f" and contg: "continuous_on T g"
  2684     using  assms [unfolded homeomorphic_minimal] by auto
  2685   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
  2686     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior S" _ f])
  2687           apply (simp_all add: openin_rel_interior False assms)
  2688     using contf continuous_on_subset rel_interior_subset apply blast
  2689       apply (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
  2690     apply (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
  2691     done
  2692   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
  2693     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior T" _ g])
  2694           apply (simp_all add: openin_rel_interior False assms)
  2695     using contg continuous_on_subset rel_interior_subset apply blast
  2696       apply (meson T hull_subset image_subsetI rel_interior_subset rev_subsetD)
  2697     apply (metis T inj_on_inverseI inj_on_subset rel_interior_subset)
  2698     done
  2699   ultimately have "aff_dim S = aff_dim T" by force
  2700   then show ?thesis
  2701     by (rule homeomorphic_rel_boundaries_same_dimension [OF \<open>S homeomorphic T\<close>])
  2702 qed
  2703 
  2704 proposition uniformly_continuous_homeomorphism_UNIV_trivial:
  2705   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
  2706   assumes contf: "uniformly_continuous_on S f" and hom: "homeomorphism S UNIV f g"
  2707   shows "S = UNIV"
  2708 proof (cases "S = {}")
  2709   case True
  2710   then show ?thesis
  2711     by (metis UNIV_I hom empty_iff homeomorphism_def image_eqI)
  2712 next
  2713   case False
  2714   have "inj g"
  2715     by (metis UNIV_I hom homeomorphism_apply2 injI)
  2716   then have "open (g ` UNIV)"
  2717     by (blast intro: invariance_of_domain hom homeomorphism_cont2)
  2718   then have "open S"
  2719     using hom homeomorphism_image2 by blast
  2720   moreover have "complete S"
  2721     unfolding complete_def
  2722   proof clarify
  2723     fix \<sigma>
  2724     assume \<sigma>: "\<forall>n. \<sigma> n \<in> S" and "Cauchy \<sigma>"
  2725     have "Cauchy (f o \<sigma>)"
  2726       using uniformly_continuous_imp_Cauchy_continuous \<open>Cauchy \<sigma>\<close> \<sigma> contf by blast
  2727     then obtain l where "(f \<circ> \<sigma>) \<longlonglongrightarrow> l"
  2728       by (auto simp: convergent_eq_Cauchy [symmetric])
  2729     show "\<exists>l\<in>S. \<sigma> \<longlonglongrightarrow> l"
  2730     proof
  2731       show "g l \<in> S"
  2732         using hom homeomorphism_image2 by blast
  2733       have "(g \<circ> (f \<circ> \<sigma>)) \<longlonglongrightarrow> g l"
  2734         by (meson UNIV_I \<open>(f \<circ> \<sigma>) \<longlonglongrightarrow> l\<close> continuous_on_sequentially hom homeomorphism_cont2)
  2735       then show "\<sigma> \<longlonglongrightarrow> g l"
  2736       proof -
  2737         have "\<forall>n. \<sigma> n = (g \<circ> (f \<circ> \<sigma>)) n"
  2738           by (metis (no_types) \<sigma> comp_eq_dest_lhs hom homeomorphism_apply1)
  2739         then show ?thesis
  2740           by (metis (no_types) LIMSEQ_iff \<open>(g \<circ> (f \<circ> \<sigma>)) \<longlonglongrightarrow> g l\<close>)
  2741       qed
  2742     qed
  2743   qed
  2744   then have "closed S"
  2745     by (simp add: complete_eq_closed)
  2746   ultimately show ?thesis
  2747     using clopen [of S] False  by simp
  2748 qed
  2749 
  2750 subsection\<open>Dimension-based conditions for various homeomorphisms\<close>
  2751 
  2752 lemma homeomorphic_subspaces_eq:
  2753   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2754   assumes "subspace S" "subspace T"
  2755   shows "S homeomorphic T \<longleftrightarrow> dim S = dim T"
  2756 proof
  2757   assume "S homeomorphic T"
  2758   then obtain f g where hom: "homeomorphism S T f g"
  2759     using homeomorphic_def by blast
  2760   show "dim S = dim T"
  2761   proof (rule order_antisym)
  2762     show "dim S \<le> dim T"
  2763       by (metis assms dual_order.refl inj_onI homeomorphism_cont1 [OF hom] homeomorphism_apply1 [OF hom] homeomorphism_image1 [OF hom] continuous_injective_image_subspace_dim_le)
  2764     show "dim T \<le> dim S"
  2765       by (metis assms dual_order.refl inj_onI homeomorphism_cont2 [OF hom] homeomorphism_apply2 [OF hom] homeomorphism_image2 [OF hom] continuous_injective_image_subspace_dim_le)
  2766   qed
  2767 next
  2768   assume "dim S = dim T"
  2769   then show "S homeomorphic T"
  2770     by (simp add: assms homeomorphic_subspaces)
  2771 qed
  2772 
  2773 lemma homeomorphic_affine_sets_eq:
  2774   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2775   assumes "affine S" "affine T"
  2776   shows "S homeomorphic T \<longleftrightarrow> aff_dim S = aff_dim T"
  2777 proof (cases "S = {} \<or> T = {}")
  2778   case True
  2779   then show ?thesis
  2780     using assms homeomorphic_affine_sets by force
  2781 next
  2782   case False
  2783   then obtain a b where "a \<in> S" "b \<in> T"
  2784     by blast
  2785   then have "subspace ((+) (- a) ` S)" "subspace ((+) (- b) ` T)"
  2786     using affine_diffs_subspace assms by blast+
  2787   then show ?thesis
  2788     by (metis affine_imp_convex assms homeomorphic_affine_sets homeomorphic_convex_sets)
  2789 qed
  2790 
  2791 lemma homeomorphic_hyperplanes_eq:
  2792   fixes a :: "'a::euclidean_space" and c :: "'b::euclidean_space"
  2793   assumes "a \<noteq> 0" "c \<noteq> 0"
  2794   shows "({x. a \<bullet> x = b} homeomorphic {x. c \<bullet> x = d} \<longleftrightarrow> DIM('a) = DIM('b))"
  2795   apply (auto simp: homeomorphic_affine_sets_eq affine_hyperplane assms)
  2796   by (metis DIM_positive Suc_pred)
  2797 
  2798 lemma homeomorphic_UNIV_UNIV:
  2799   shows "(UNIV::'a set) homeomorphic (UNIV::'b set) \<longleftrightarrow>
  2800     DIM('a::euclidean_space) = DIM('b::euclidean_space)"
  2801   by (simp add: homeomorphic_subspaces_eq)
  2802 
  2803 lemma simply_connected_sphere_gen:
  2804    assumes "convex S" "bounded S" and 3: "3 \<le> aff_dim S"
  2805    shows "simply_connected(rel_frontier S)"
  2806 proof -
  2807   have pa: "path_connected (rel_frontier S)"
  2808     using assms by (simp add: path_connected_sphere_gen)
  2809   show ?thesis
  2810   proof (clarsimp simp add: simply_connected_eq_contractible_circlemap pa)
  2811     fix f
  2812     assume f: "continuous_on (sphere (0::complex) 1) f" "f ` sphere 0 1 \<subseteq> rel_frontier S"
  2813     have eq: "sphere (0::complex) 1 = rel_frontier(cball 0 1)"
  2814       by simp
  2815     have "convex (cball (0::complex) 1)"
  2816       by (rule convex_cball)
  2817     then obtain c where "homotopic_with (\<lambda>z. True) (sphere (0::complex) 1) (rel_frontier S) f (\<lambda>x. c)"
  2818       apply (rule inessential_spheremap_lowdim_gen [OF _ bounded_cball \<open>convex S\<close> \<open>bounded S\<close>, where f=f])
  2819       using f 3
  2820          apply (auto simp: aff_dim_cball)
  2821       done
  2822     then show "\<exists>a. homotopic_with (\<lambda>h. True) (sphere 0 1) (rel_frontier S) f (\<lambda>x. a)"
  2823       by blast
  2824   qed
  2825 qed
  2826 
  2827 subsection\<open>more invariance of domain\<close>(*FIX ME title? *)
  2828 
  2829 proposition invariance_of_domain_sphere_affine_set_gen:
  2830   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2831   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
  2832       and U: "bounded U" "convex U"
  2833       and "affine T" and affTU: "aff_dim T < aff_dim U"
  2834       and ope: "openin (top_of_set (rel_frontier U)) S"
  2835    shows "openin (top_of_set T) (f ` S)"
  2836 proof (cases "rel_frontier U = {}")
  2837   case True
  2838   then show ?thesis
  2839     using ope openin_subset by force
  2840 next
  2841   case False
  2842   obtain b c where b: "b \<in> rel_frontier U" and c: "c \<in> rel_frontier U" and "b \<noteq> c"
  2843     using \<open>bounded U\<close> rel_frontier_not_sing [of U] subset_singletonD False  by fastforce
  2844   obtain V :: "'a set" where "affine V" and affV: "aff_dim V = aff_dim U - 1"
  2845   proof (rule choose_affine_subset [OF affine_UNIV])
  2846     show "- 1 \<le> aff_dim U - 1"
  2847       by (metis aff_dim_empty aff_dim_geq aff_dim_negative_iff affTU diff_0 diff_right_mono not_le)
  2848     show "aff_dim U - 1 \<le> aff_dim (UNIV::'a set)"
  2849       by (metis aff_dim_UNIV aff_dim_le_DIM le_cases not_le zle_diff1_eq)
  2850   qed auto
  2851   have SU: "S \<subseteq> rel_frontier U"
  2852     using ope openin_imp_subset by auto
  2853   have homb: "rel_frontier U - {b} homeomorphic V"
  2854    and homc: "rel_frontier U - {c} homeomorphic V"
  2855     using homeomorphic_punctured_sphere_affine_gen [of U _ V]
  2856     by (simp_all add: \<open>affine V\<close> affV U b c)
  2857   then obtain g h j k
  2858            where gh: "homeomorphism (rel_frontier U - {b}) V g h"
  2859              and jk: "homeomorphism (rel_frontier U - {c}) V j k"
  2860     by (auto simp: homeomorphic_def)
  2861   with SU have hgsub: "(h ` g ` (S - {b})) \<subseteq> S" and kjsub: "(k ` j ` (S - {c})) \<subseteq> S"
  2862     by (simp_all add: homeomorphism_def subset_eq)
  2863   have [simp]: "aff_dim T \<le> aff_dim V"
  2864     by (simp add: affTU affV)
  2865   have "openin (top_of_set T) ((f \<circ> h) ` g ` (S - {b}))"
  2866   proof (rule invariance_of_domain_affine_sets [OF _ \<open>affine V\<close>])
  2867     show "openin (top_of_set V) (g ` (S - {b}))"
  2868       apply (rule homeomorphism_imp_open_map [OF gh])
  2869       by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
  2870     show "continuous_on (g ` (S - {b})) (f \<circ> h)"
  2871        apply (rule continuous_on_compose)
  2872         apply (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets gh set_eq_subset)
  2873       using contf continuous_on_subset hgsub by blast
  2874     show "inj_on (f \<circ> h) (g ` (S - {b}))"
  2875       using kjsub
  2876       apply (clarsimp simp add: inj_on_def)
  2877       by (metis SU b homeomorphism_def inj_onD injf insert_Diff insert_iff gh rev_subsetD)
  2878     show "(f \<circ> h) ` g ` (S - {b}) \<subseteq> T"
  2879       by (metis fim image_comp image_mono hgsub subset_trans)
  2880   qed (auto simp: assms)
  2881   moreover
  2882   have "openin (top_of_set T) ((f \<circ> k) ` j ` (S - {c}))"
  2883   proof (rule invariance_of_domain_affine_sets [OF _ \<open>affine V\<close>])
  2884     show "openin (top_of_set V) (j ` (S - {c}))"
  2885       apply (rule homeomorphism_imp_open_map [OF jk])
  2886       by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
  2887     show "continuous_on (j ` (S - {c})) (f \<circ> k)"
  2888        apply (rule continuous_on_compose)
  2889         apply (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets jk set_eq_subset)
  2890       using contf continuous_on_subset kjsub by blast
  2891     show "inj_on (f \<circ> k) (j ` (S - {c}))"
  2892       using kjsub
  2893       apply (clarsimp simp add: inj_on_def)
  2894       by (metis SU c homeomorphism_def inj_onD injf insert_Diff insert_iff jk rev_subsetD)
  2895     show "(f \<circ> k) ` j ` (S - {c}) \<subseteq> T"
  2896       by (metis fim image_comp image_mono kjsub subset_trans)
  2897   qed (auto simp: assms)
  2898   ultimately have "openin (top_of_set T) ((f \<circ> h) ` g ` (S - {b}) \<union> ((f \<circ> k) ` j ` (S - {c})))"
  2899     by (rule openin_Un)
  2900   moreover have "(f \<circ> h) ` g ` (S - {b}) = f ` (S - {b})"
  2901   proof -
  2902     have "h ` g ` (S - {b}) = (S - {b})"
  2903     proof
  2904       show "h ` g ` (S - {b}) \<subseteq> S - {b}"
  2905         using homeomorphism_apply1 [OF gh] SU
  2906         by (fastforce simp add: image_iff image_subset_iff)
  2907       show "S - {b} \<subseteq> h ` g ` (S - {b})"
  2908         apply clarify
  2909         by  (metis SU subsetD homeomorphism_apply1 [OF gh] image_iff member_remove remove_def)
  2910     qed
  2911     then show ?thesis
  2912       by (metis image_comp)
  2913   qed
  2914   moreover have "(f \<circ> k) ` j ` (S - {c}) = f ` (S - {c})"
  2915   proof -
  2916     have "k ` j ` (S - {c}) = (S - {c})"
  2917     proof
  2918       show "k ` j ` (S - {c}) \<subseteq> S - {c}"
  2919         using homeomorphism_apply1 [OF jk] SU
  2920         by (fastforce simp add: image_iff image_subset_iff)
  2921       show "S - {c} \<subseteq> k ` j ` (S - {c})"
  2922         apply clarify
  2923         by  (metis SU subsetD homeomorphism_apply1 [OF jk] image_iff member_remove remove_def)
  2924     qed
  2925     then show ?thesis
  2926       by (metis image_comp)
  2927   qed
  2928   moreover have "f ` (S - {b}) \<union> f ` (S - {c}) = f ` (S)"
  2929     using \<open>b \<noteq> c\<close> by blast
  2930   ultimately show ?thesis
  2931     by simp
  2932 qed
  2933 
  2934 
  2935 lemma invariance_of_domain_sphere_affine_set:
  2936   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2937   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
  2938       and "r \<noteq> 0" "affine T" and affTU: "aff_dim T < DIM('a)"
  2939       and ope: "openin (top_of_set (sphere a r)) S"
  2940    shows "openin (top_of_set T) (f ` S)"
  2941 proof (cases "sphere a r = {}")
  2942   case True
  2943   then show ?thesis
  2944     using ope openin_subset by force
  2945 next
  2946   case False
  2947   show ?thesis
  2948   proof (rule invariance_of_domain_sphere_affine_set_gen [OF contf injf fim bounded_cball convex_cball \<open>affine T\<close>])
  2949     show "aff_dim T < aff_dim (cball a r)"
  2950       by (metis False affTU aff_dim_cball assms(4) linorder_cases sphere_empty)
  2951     show "openin (top_of_set (rel_frontier (cball a r))) S"
  2952       by (simp add: \<open>r \<noteq> 0\<close> ope)
  2953   qed
  2954 qed
  2955 
  2956 lemma no_embedding_sphere_lowdim:
  2957   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2958   assumes contf: "continuous_on (sphere a r) f" and injf: "inj_on f (sphere a r)" and "r > 0"
  2959    shows "DIM('a) \<le> DIM('b)"
  2960 proof -
  2961   have "False" if "DIM('a) > DIM('b)"
  2962   proof -
  2963     have "compact (f ` sphere a r)"
  2964       using compact_continuous_image
  2965       by (simp add: compact_continuous_image contf)
  2966     then have "\<not> open (f ` sphere a r)"
  2967       using compact_open
  2968       by (metis assms(3) image_is_empty not_less_iff_gr_or_eq sphere_eq_empty)
  2969     then show False
  2970       using invariance_of_domain_sphere_affine_set [OF contf injf subset_UNIV] \<open>r > 0\<close>
  2971       by (metis aff_dim_UNIV affine_UNIV less_irrefl of_nat_less_iff open_openin openin_subtopology_self subtopology_UNIV that)
  2972   qed
  2973   then show ?thesis
  2974     using not_less by blast
  2975 qed
  2976 
  2977 lemma simply_connected_sphere:
  2978   fixes a :: "'a::euclidean_space"
  2979   assumes "3 \<le> DIM('a)"
  2980     shows "simply_connected(sphere a r)"
  2981 proof (cases rule: linorder_cases [of r 0])
  2982   case less
  2983   then show ?thesis by simp
  2984 next
  2985   case equal
  2986   then show ?thesis  by (auto simp: convex_imp_simply_connected)
  2987 next
  2988   case greater
  2989   then show ?thesis
  2990     using simply_connected_sphere_gen [of "cball a r"] assms
  2991     by (simp add: aff_dim_cball)
  2992 qed
  2993 
  2994 lemma simply_connected_sphere_eq:
  2995   fixes a :: "'a::euclidean_space"
  2996   shows "simply_connected(sphere a r) \<longleftrightarrow> 3 \<le> DIM('a) \<or> r \<le> 0"  (is "?lhs = ?rhs")
  2997 proof (cases "r \<le> 0")
  2998   case True
  2999   have "simply_connected (sphere a r)"
  3000     apply (rule convex_imp_simply_connected)
  3001     using True less_eq_real_def by auto
  3002   with True show ?thesis by auto
  3003 next
  3004   case False
  3005   show ?thesis
  3006   proof
  3007     assume L: ?lhs
  3008     have "False" if "DIM('a) = 1 \<or> DIM('a) = 2"
  3009       using that
  3010     proof
  3011       assume "DIM('a) = 1"
  3012       with L show False
  3013         using connected_sphere_eq simply_connected_imp_connected
  3014         by (metis False Suc_1 not_less_eq_eq order_refl)
  3015     next
  3016       assume "DIM('a) = 2"
  3017       then have "sphere a r homeomorphic sphere (0::complex) 1"
  3018         by (metis DIM_complex False homeomorphic_spheres_gen not_less zero_less_one)
  3019       then have "simply_connected(sphere (0::complex) 1)"
  3020         using L homeomorphic_simply_connected_eq by blast
  3021       then obtain a::complex where "homotopic_with (\<lambda>h. True) (sphere 0 1) (sphere 0 1) id (\<lambda>x. a)"
  3022         apply (simp add: simply_connected_eq_contractible_circlemap)
  3023         by (metis continuous_on_id' id_apply image_id subset_refl)
  3024       then show False
  3025         using contractible_sphere contractible_def not_one_le_zero by blast
  3026     qed
  3027     with False show ?rhs
  3028       apply simp
  3029       by (metis DIM_ge_Suc0 le_antisym not_less_eq_eq numeral_2_eq_2 numeral_3_eq_3)
  3030   next
  3031     assume ?rhs
  3032     with False show ?lhs by (simp add: simply_connected_sphere)
  3033   qed
  3034 qed
  3035 
  3036 
  3037 lemma simply_connected_punctured_universe_eq:
  3038   fixes a :: "'a::euclidean_space"
  3039   shows "simply_connected(- {a}) \<longleftrightarrow> 3 \<le> DIM('a)"
  3040 proof -
  3041   have [simp]: "a \<in> rel_interior (cball a 1)"
  3042     by (simp add: rel_interior_nonempty_interior)
  3043   have [simp]: "affine hull cball a 1 - {a} = -{a}"
  3044     by (metis Compl_eq_Diff_UNIV aff_dim_cball aff_dim_lt_full not_less_iff_gr_or_eq zero_less_one)
  3045   have "simply_connected(- {a}) \<longleftrightarrow> simply_connected(sphere a 1)"
  3046     apply (rule sym)
  3047     apply (rule homotopy_eqv_simple_connectedness)
  3048     using homotopy_eqv_rel_frontier_punctured_affine_hull [of "cball a 1" a] apply auto
  3049     done
  3050   also have "...  \<longleftrightarrow> 3 \<le> DIM('a)"
  3051     by (simp add: simply_connected_sphere_eq)
  3052   finally show ?thesis .
  3053 qed
  3054 
  3055 lemma not_simply_connected_circle:
  3056   fixes a :: complex
  3057   shows "0 < r \<Longrightarrow> \<not> simply_connected(sphere a r)"
  3058 by (simp add: simply_connected_sphere_eq)
  3059 
  3060 
  3061 proposition simply_connected_punctured_convex:
  3062   fixes a :: "'a::euclidean_space"
  3063   assumes "convex S" and 3: "3 \<le> aff_dim S"
  3064     shows "simply_connected(S - {a})"
  3065 proof (cases "a \<in> rel_interior S")
  3066   case True
  3067   then obtain e where "a \<in> S" "0 < e" and e: "cball a e \<inter> affine hull S \<subseteq> S"
  3068     by (auto simp: rel_interior_cball)
  3069   have con: "convex (cball a e \<inter> affine hull S)"
  3070     by (simp add: convex_Int)
  3071   have bo: "bounded (cball a e \<inter> affine hull S)"
  3072     by (simp add: bounded_Int)
  3073   have "affine hull S \<inter> interior (cball a e) \<noteq> {}"
  3074     using \<open>0 < e\<close> \<open>a \<in> S\<close> hull_subset by fastforce
  3075   then have "3 \<le> aff_dim (affine hull S \<inter> cball a e)"
  3076     by (simp add: 3 aff_dim_convex_Int_nonempty_interior [OF convex_affine_hull])
  3077   also have "... = aff_dim (cball a e \<inter> affine hull S)"
  3078     by (simp add: Int_commute)
  3079   finally have "3 \<le> aff_dim (cball a e \<inter> affine hull S)" .
  3080   moreover have "rel_frontier (cball a e \<inter> affine hull S) homotopy_eqv S - {a}"
  3081   proof (rule homotopy_eqv_rel_frontier_punctured_convex)
  3082     show "a \<in> rel_interior (cball a e \<inter> affine hull S)"
  3083       by (meson IntI Int_mono \<open>a \<in> S\<close> \<open>0 < e\<close> e \<open>cball a e \<inter> affine hull S \<subseteq> S\<close> ball_subset_cball centre_in_cball dual_order.strict_implies_order hull_inc hull_mono mem_rel_interior_ball)
  3084     have "closed (cball a e \<inter> affine hull S)"
  3085       by blast
  3086     then show "rel_frontier (cball a e \<inter> affine hull S) \<subseteq> S"
  3087       apply (simp add: rel_frontier_def)
  3088       using e by blast
  3089     show "S \<subseteq> affine hull (cball a e \<inter> affine hull S)"
  3090       by (metis (no_types, lifting) IntI \<open>a \<in> S\<close> \<open>0 < e\<close> affine_hull_convex_Int_nonempty_interior centre_in_ball convex_affine_hull empty_iff hull_subset inf_commute interior_cball subsetCE subsetI)
  3091     qed (auto simp: assms con bo)
  3092   ultimately show ?thesis
  3093     using homotopy_eqv_simple_connectedness simply_connected_sphere_gen [OF con bo]
  3094     by blast
  3095 next
  3096   case False
  3097   show ?thesis
  3098     apply (rule contractible_imp_simply_connected)
  3099     apply (rule contractible_convex_tweak_boundary_points [OF \<open>convex S\<close>])
  3100      apply (simp add: False rel_interior_subset subset_Diff_insert)
  3101     by (meson Diff_subset closure_subset subset_trans)
  3102 qed
  3103 
  3104 corollary simply_connected_punctured_universe:
  3105   fixes a :: "'a::euclidean_space"
  3106   assumes "3 \<le> DIM('a)"
  3107   shows "simply_connected(- {a})"
  3108 proof -
  3109   have [simp]: "affine hull cball a 1 = UNIV"
  3110     apply auto
  3111     by (metis UNIV_I aff_dim_cball aff_dim_lt_full zero_less_one not_less_iff_gr_or_eq)
  3112   have "simply_connected (rel_frontier (cball a 1)) = simply_connected (affine hull cball a 1 - {a})"
  3113     apply (rule homotopy_eqv_simple_connectedness)
  3114     apply (rule homotopy_eqv_rel_frontier_punctured_affine_hull)
  3115       apply (force simp: rel_interior_cball intro: homotopy_eqv_simple_connectedness homotopy_eqv_rel_frontier_punctured_affine_hull)+
  3116     done
  3117   then show ?thesis
  3118     using simply_connected_sphere [of a 1, OF assms] by (auto simp: Compl_eq_Diff_UNIV)
  3119 qed
  3120 
  3121 
  3122 subsection\<open>The power, squaring and exponential functions as covering maps\<close>
  3123 
  3124 proposition covering_space_power_punctured_plane:
  3125   assumes "0 < n"
  3126     shows "covering_space (- {0}) (\<lambda>z::complex. z^n) (- {0})"
  3127 proof -
  3128   consider "n = 1" | "2 \<le> n" using assms by linarith
  3129   then obtain e where "0 < e"
  3130                 and e: "\<And>w z. cmod(w - z) < e * cmod z \<Longrightarrow> (w^n = z^n \<longleftrightarrow> w = z)"
  3131   proof cases
  3132     assume "n = 1" then show ?thesis
  3133       by (rule_tac e=1 in that) auto
  3134   next
  3135     assume "2 \<le> n"
  3136     have eq_if_pow_eq:
  3137          "w = z" if lt: "cmod (w - z) < 2 * sin (pi / real n) * cmod z"
  3138                  and eq: "w^n = z^n" for w z
  3139     proof (cases "z = 0")
  3140       case True with eq assms show ?thesis by (auto simp: power_0_left)
  3141     next
  3142       case False
  3143       then have "z \<noteq> 0" by auto
  3144       have "(w/z)^n = 1"
  3145         by (metis False divide_self_if eq power_divide power_one)
  3146       then obtain j where j: "w / z = exp (2 * of_real pi * \<i> * j / n)" and "j < n"
  3147         using Suc_leI assms \<open>2 \<le> n\<close> complex_roots_unity [THEN eqset_imp_iff, of n "w/z"]
  3148         by force
  3149       have "cmod (w/z - 1) < 2 * sin (pi / real n)"
  3150         using lt assms \<open>z \<noteq> 0\<close> by (simp add: divide_simps norm_divide)
  3151       then have "cmod (exp (\<i> * of_real (2 * pi * j / n)) - 1) < 2 * sin (pi / real n)"
  3152         by (simp add: j field_simps)
  3153       then have "2 * \<bar>sin((2 * pi * j / n) / 2)\<bar> < 2 * sin (pi / real n)"
  3154         by (simp only: dist_exp_i_1)
  3155       then have sin_less: "sin((pi * j / n)) < sin (pi / real n)"
  3156         by (simp add: field_simps)
  3157       then have "w / z = 1"
  3158       proof (cases "j = 0")
  3159         case True then show ?thesis by (auto simp: j)
  3160       next
  3161         case False
  3162         then have "sin (pi / real n) \<le> sin((pi * j / n))"
  3163         proof (cases "j / n \<le> 1/2")
  3164           case True
  3165           show ?thesis
  3166             apply (rule sin_monotone_2pi_le)
  3167             using \<open>j \<noteq> 0 \<close> \<open>j < n\<close> True
  3168             apply (auto simp: field_simps intro: order_trans [of _ 0])
  3169             done
  3170         next
  3171           case False
  3172           then have seq: "sin(pi * j / n) = sin(pi * (n - j) / n)"
  3173             using \<open>j < n\<close> by (simp add: algebra_simps diff_divide_distrib of_nat_diff)
  3174           show ?thesis
  3175             apply (simp only: seq)
  3176             apply (rule sin_monotone_2pi_le)
  3177             using \<open>j < n\<close> False
  3178             apply (auto simp: field_simps intro: order_trans [of _ 0])
  3179             done
  3180         qed
  3181         with sin_less show ?thesis by force
  3182       qed
  3183       then show ?thesis by simp
  3184     qed
  3185     show ?thesis
  3186       apply (rule_tac e = "2 * sin(pi / n)" in that)
  3187        apply (force simp: \<open>2 \<le> n\<close> sin_pi_divide_n_gt_0)
  3188       apply (meson eq_if_pow_eq)
  3189       done
  3190   qed
  3191   have zn1: "continuous_on (- {0}) (\<lambda>z::complex. z^n)"
  3192     by (rule continuous_intros)+
  3193   have zn2: "(\<lambda>z::complex. z^n) ` (- {0}) = - {0}"
  3194     using assms by (auto simp: image_def elim: exists_complex_root_nonzero [where n = n])
  3195   have zn3: "\<exists>T. z^n \<in> T \<and> open T \<and> 0 \<notin> T \<and>
  3196                (\<exists>v. \<Union>v = -{0} \<inter> (\<lambda>z. z ^ n) -` T \<and>
  3197                     (\<forall>u\<in>v. open u \<and> 0 \<notin> u) \<and>
  3198                     pairwise disjnt v \<and>
  3199                     (\<forall>u\<in>v. Ex (homeomorphism u T (\<lambda>z. z^n))))"
  3200            if "z \<noteq> 0" for z::complex
  3201   proof -
  3202     define d where "d \<equiv> min (1/2) (e/4) * norm z"
  3203     have "0 < d"
  3204       by (simp add: d_def \<open>0 < e\<close> \<open>z \<noteq> 0\<close>)
  3205     have iff_x_eq_y: "x^n = y^n \<longleftrightarrow> x = y"
  3206          if eq: "w^n = z^n" and x: "x \<in> ball w d" and y: "y \<in> ball w d" for w x y
  3207     proof -
  3208       have [simp]: "norm z = norm w" using that
  3209         by (simp add: assms power_eq_imp_eq_norm)
  3210       show ?thesis
  3211       proof (cases "w = 0")
  3212         case True with \<open>z \<noteq> 0\<close> assms eq
  3213         show ?thesis by (auto simp: power_0_left)
  3214       next
  3215         case False
  3216         have "cmod (x - y) < 2*d"
  3217           using x y
  3218           by (simp add: dist_norm [symmetric]) (metis dist_commute mult_2 dist_triangle_less_add)
  3219         also have "... \<le> 2 * e / 4 * norm w"
  3220           using \<open>e > 0\<close> by (simp add: d_def min_mult_distrib_right)
  3221         also have "... = e * (cmod w / 2)"
  3222           by simp
  3223         also have "... \<le> e * cmod y"
  3224           apply (rule mult_left_mono)
  3225           using \<open>e > 0\<close> y
  3226            apply (simp_all add: dist_norm d_def min_mult_distrib_right del: divide_const_simps)
  3227           apply (metis dist_0_norm dist_complex_def dist_triangle_half_l linorder_not_less order_less_irrefl)
  3228           done
  3229         finally have "cmod (x - y) < e * cmod y" .
  3230         then show ?thesis by (rule e)
  3231       qed
  3232     qed
  3233     then have inj: "inj_on (\<lambda>w. w^n) (ball z d)"
  3234       by (simp add: inj_on_def)
  3235     have cont: "continuous_on (ball z d) (\<lambda>w. w ^ n)"
  3236       by (intro continuous_intros)
  3237     have noncon: "\<not> (\<lambda>w::complex. w^n) constant_on UNIV"
  3238       by (metis UNIV_I assms constant_on_def power_one zero_neq_one zero_power)
  3239     have im_eq: "(\<lambda>w. w^n) ` ball z' d = (\<lambda>w. w^n) ` ball z d"
  3240                 if z': "z'^n = z^n" for z'
  3241     proof -
  3242       have nz': "norm z' = norm z" using that assms power_eq_imp_eq_norm by blast
  3243       have "(w \<in> (\<lambda>w. w^n) ` ball z' d) = (w \<in> (\<lambda>w. w^n) ` ball z d)" for w
  3244       proof (cases "w=0")
  3245         case True with assms show ?thesis
  3246           by (simp add: image_def ball_def nz')
  3247       next
  3248         case False
  3249         have "z' \<noteq> 0" using \<open>z \<noteq> 0\<close> nz' by force
  3250         have [simp]: "(z*x / z')^n = x^n" if "x \<noteq> 0" for x
  3251           using z' that by (simp add: field_simps \<open>z \<noteq> 0\<close>)
  3252         have [simp]: "cmod (z - z * x / z') = cmod (z' - x)" if "x \<noteq> 0" for x
  3253         proof -
  3254           have "cmod (z - z * x / z') = cmod z * cmod (1 - x / z')"
  3255             by (metis (no_types) ab_semigroup_mult_class.mult_ac(1) divide_complex_def mult.right_neutral norm_mult right_diff_distrib')
  3256           also have "... = cmod z' * cmod (1 - x / z')"
  3257             by (simp add: nz')
  3258           also have "... = cmod (z' - x)"
  3259             by (simp add: \<open>z' \<noteq> 0\<close> diff_divide_eq_iff norm_divide)
  3260           finally show ?thesis .
  3261         qed
  3262         have [simp]: "(z'*x / z)^n = x^n" if "x \<noteq> 0" for x
  3263           using z' that by (simp add: field_simps \<open>z \<noteq> 0\<close>)
  3264         have [simp]: "cmod (z' - z' * x / z) = cmod (z - x)" if "x \<noteq> 0" for x
  3265         proof -
  3266           have "cmod (z * (1 - x * inverse z)) = cmod (z - x)"
  3267             by (metis \<open>z \<noteq> 0\<close> diff_divide_distrib divide_complex_def divide_self_if nonzero_eq_divide_eq semiring_normalization_rules(7))
  3268           then show ?thesis
  3269             by (metis (no_types) mult.assoc divide_complex_def mult.right_neutral norm_mult nz' right_diff_distrib')
  3270         qed
  3271         show ?thesis
  3272           unfolding image_def ball_def
  3273           apply safe
  3274           apply simp_all
  3275           apply (rule_tac x="z/z' * x" in exI)
  3276           using assms False apply (simp add: dist_norm)
  3277           apply (rule_tac x="z'/z * x" in exI)
  3278           using assms False apply (simp add: dist_norm)
  3279           done
  3280       qed
  3281       then show ?thesis by blast
  3282     qed
  3283 
  3284     have ex_ball: "\<exists>B. (\<exists>z'. B = ball z' d \<and> z'^n = z^n) \<and> x \<in> B"
  3285                   if "x \<noteq> 0" and eq: "x^n = w^n" and dzw: "dist z w < d" for x w
  3286     proof -
  3287       have "w \<noteq> 0" by (metis assms power_eq_0_iff that(1) that(2))
  3288       have [simp]: "cmod x = cmod w"
  3289         using assms power_eq_imp_eq_norm eq by blast
  3290       have [simp]: "cmod (x * z / w - x) = cmod (z - w)"
  3291       proof -
  3292         have "cmod (x * z / w - x) = cmod x * cmod (z / w - 1)"
  3293           by (metis (no_types) mult.right_neutral norm_mult right_diff_distrib' times_divide_eq_right)
  3294         also have "... = cmod w * cmod (z / w - 1)"
  3295           by simp
  3296         also have "... = cmod (z - w)"
  3297           by (simp add: \<open>w \<noteq> 0\<close> divide_diff_eq_iff nonzero_norm_divide)
  3298         finally show ?thesis .
  3299       qed
  3300       show ?thesis
  3301         apply (rule_tac x="ball (z / w * x) d" in exI)
  3302         using \<open>d > 0\<close> that
  3303         apply (simp add: ball_eq_ball_iff)
  3304         apply (simp add: \<open>z \<noteq> 0\<close> \<open>w \<noteq> 0\<close> field_simps)
  3305         apply (simp add: dist_norm)
  3306         done
  3307     qed
  3308 
  3309     show ?thesis
  3310     proof (rule exI, intro conjI)
  3311       show "z ^ n \<in> (\<lambda>w. w ^ n) ` ball z d"
  3312         using \<open>d > 0\<close> by simp
  3313       show "open ((\<lambda>w. w ^ n) ` ball z d)"
  3314         by (rule invariance_of_domain [OF cont open_ball inj])
  3315       show "0 \<notin> (\<lambda>w. w ^ n) ` ball z d"
  3316         using \<open>z \<noteq> 0\<close> assms by (force simp: d_def)
  3317       show "\<exists>v. \<Union>v = - {0} \<inter> (\<lambda>z. z ^ n) -` (\<lambda>w. w ^ n) ` ball z d \<and>
  3318                 (\<forall>u\<in>v. open u \<and> 0 \<notin> u) \<and>
  3319                 disjoint v \<and>
  3320                 (\<forall>u\<in>v. Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n)))"
  3321       proof (rule exI, intro ballI conjI)
  3322         show "\<Union>{ball z' d |z'. z'^n = z^n} = - {0} \<inter> (\<lambda>z. z ^ n) -` (\<lambda>w. w ^ n) ` ball z d" (is "?l = ?r")
  3323         proof 
  3324           show "?l \<subseteq> ?r"
  3325             apply auto
  3326              apply (simp add: assms d_def power_eq_imp_eq_norm that)
  3327             by (metis im_eq image_eqI mem_ball)
  3328           show "?r \<subseteq> ?l"
  3329             by auto (meson ex_ball)
  3330         qed
  3331         show "\<And>u. u \<in> {ball z' d |z'. z' ^ n = z ^ n} \<Longrightarrow> 0 \<notin> u"
  3332           by (force simp add: assms d_def power_eq_imp_eq_norm that)
  3333 
  3334         show "disjoint {ball z' d |z'. z' ^ n = z ^ n}"
  3335         proof (clarsimp simp add: pairwise_def disjnt_iff)
  3336           fix \<xi> \<zeta> x
  3337           assume "\<xi>^n = z^n" "\<zeta>^n = z^n" "ball \<xi> d \<noteq> ball \<zeta> d"
  3338             and "dist \<xi> x < d" "dist \<zeta> x < d"
  3339           then have "dist \<xi> \<zeta> < d+d"
  3340             using dist_triangle_less_add by blast
  3341           then have "cmod (\<xi> - \<zeta>) < 2*d"
  3342             by (simp add: dist_norm)
  3343           also have "... \<le> e * cmod z"
  3344             using mult_right_mono \<open>0 < e\<close> that by (auto simp: d_def)
  3345           finally have "cmod (\<xi> - \<zeta>) < e * cmod z" .
  3346           with e have "\<xi> = \<zeta>"
  3347             by (metis \<open>\<xi>^n = z^n\<close> \<open>\<zeta>^n = z^n\<close> assms power_eq_imp_eq_norm)
  3348           then show "False"
  3349             using \<open>ball \<xi> d \<noteq> ball \<zeta> d\<close> by blast
  3350         qed
  3351         show "Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n))"
  3352           if "u \<in> {ball z' d |z'. z' ^ n = z ^ n}" for u
  3353         proof (rule invariance_of_domain_homeomorphism [of "u" "\<lambda>z. z^n"])
  3354           show "open u"
  3355             using that by auto
  3356           show "continuous_on u (\<lambda>z. z ^ n)"
  3357             by (intro continuous_intros)
  3358           show "inj_on (\<lambda>z. z ^ n) u"
  3359             using that by (auto simp: iff_x_eq_y inj_on_def)
  3360           show "\<And>g. homeomorphism u ((\<lambda>z. z ^ n) ` u) (\<lambda>z. z ^ n) g \<Longrightarrow> Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n))"
  3361             using im_eq that by clarify metis
  3362         qed auto
  3363       qed auto
  3364     qed
  3365   qed
  3366   show ?thesis
  3367     using assms
  3368     apply (simp add: covering_space_def zn1 zn2)
  3369     apply (subst zn2 [symmetric])
  3370     apply (simp add: openin_open_eq open_Compl)
  3371     apply (blast intro: zn3)
  3372     done
  3373 qed
  3374 
  3375 corollary covering_space_square_punctured_plane:
  3376   "covering_space (- {0}) (\<lambda>z::complex. z^2) (- {0})"
  3377   by%unimportant (simp add: covering_space_power_punctured_plane)
  3378 
  3379 
  3380 proposition covering_space_exp_punctured_plane:
  3381   "covering_space UNIV (\<lambda>z::complex. exp z) (- {0})"
  3382 proof (simp add: covering_space_def, intro conjI ballI)
  3383   show "continuous_on UNIV (\<lambda>z::complex. exp z)"
  3384     by (rule continuous_on_exp [OF continuous_on_id])
  3385   show "range exp = - {0::complex}"
  3386     by auto (metis exp_Ln range_eqI)
  3387   show "\<exists>T. z \<in> T \<and> openin (top_of_set (- {0})) T \<and>
  3388              (\<exists>v. \<Union>v = exp -` T \<and> (\<forall>u\<in>v. open u) \<and> disjoint v \<and>
  3389                   (\<forall>u\<in>v. \<exists>q. homeomorphism u T exp q))"
  3390         if "z \<in> - {0::complex}" for z
  3391   proof -
  3392     have "z \<noteq> 0"
  3393       using that by auto
  3394     have inj_exp: "inj_on exp (ball (Ln z) 1)"
  3395       apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
  3396       using pi_ge_two by (simp add: ball_subset_ball_iff)
  3397     define \<V> where "\<V> \<equiv> range (\<lambda>n. (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1))"
  3398     show ?thesis
  3399     proof (intro exI conjI)
  3400       show "z \<in> exp ` (ball(Ln z) 1)"
  3401         by (metis \<open>z \<noteq> 0\<close> centre_in_ball exp_Ln rev_image_eqI zero_less_one)
  3402       have "open (- {0::complex})"
  3403         by blast
  3404       moreover have "inj_on exp (ball (Ln z) 1)"
  3405         apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
  3406         using pi_ge_two by (simp add: ball_subset_ball_iff)
  3407       ultimately show "openin (top_of_set (- {0})) (exp ` ball (Ln z) 1)"
  3408         by (auto simp: openin_open_eq invariance_of_domain continuous_on_exp [OF continuous_on_id])
  3409       show "\<Union>\<V> = exp -` exp ` ball (Ln z) 1"
  3410         by (force simp: \<V>_def Complex_Transcendental.exp_eq image_iff)
  3411       show "\<forall>V\<in>\<V>. open V"
  3412         by (auto simp: \<V>_def inj_on_def continuous_intros invariance_of_domain)
  3413       have xy: "2 \<le> cmod (2 * of_int x * of_real pi * \<i> - 2 * of_int y * of_real pi * \<i>)"
  3414                if "x < y" for x y
  3415       proof -
  3416         have "1 \<le> abs (x - y)"
  3417           using that by linarith
  3418         then have "1 \<le> cmod (of_int x - of_int y) * 1"
  3419           by (metis mult.right_neutral norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
  3420         also have "... \<le> cmod (of_int x - of_int y) * of_real pi"
  3421           apply (rule mult_left_mono)
  3422           using pi_ge_two by auto
  3423         also have "... \<le> cmod ((of_int x - of_int y) * of_real pi * \<i>)"
  3424           by (simp add: norm_mult)
  3425         also have "... \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)"
  3426           by (simp add: algebra_simps)
  3427         finally have "1 \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)" .
  3428         then have "2 * 1 \<le> cmod (2 * (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>))"
  3429           by (metis mult_le_cancel_left_pos norm_mult_numeral1 zero_less_numeral)
  3430         then show ?thesis
  3431           by (simp add: algebra_simps)
  3432       qed
  3433       show "disjoint \<V>"
  3434         apply (clarsimp simp add: \<V>_def pairwise_def disjnt_def add.commute [of _ "x*y" for x y]
  3435                         image_add_ball ball_eq_ball_iff)
  3436         apply (rule disjoint_ballI)
  3437         apply (auto simp: dist_norm neq_iff)
  3438         by (metis norm_minus_commute xy)+
  3439       show "\<forall>u\<in>\<V>. \<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
  3440       proof
  3441         fix u
  3442         assume "u \<in> \<V>"
  3443         then obtain n where n: "u = (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1)"
  3444           by (auto simp: \<V>_def)
  3445         have "compact (cball (Ln z) 1)"
  3446           by simp
  3447         moreover have "continuous_on (cball (Ln z) 1) exp"
  3448           by (rule continuous_on_exp [OF continuous_on_id])
  3449         moreover have "inj_on exp (cball (Ln z) 1)"
  3450           apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
  3451           using pi_ge_two by (simp add: cball_subset_ball_iff)
  3452         ultimately obtain \<gamma> where hom: "homeomorphism (cball (Ln z) 1) (exp ` cball (Ln z) 1) exp \<gamma>"
  3453           using homeomorphism_compact  by blast
  3454         have eq1: "exp ` u = exp ` ball (Ln z) 1"
  3455           unfolding n
  3456           apply (auto simp: algebra_simps)
  3457           apply (rename_tac w)
  3458           apply (rule_tac x = "w + \<i> * (of_int n * (of_real pi * 2))" in image_eqI)
  3459           apply (auto simp: image_iff)
  3460           done
  3461         have \<gamma>exp: "\<gamma> (exp x) + 2 * of_int n * of_real pi * \<i> = x" if "x \<in> u" for x
  3462         proof -
  3463           have "exp x = exp (x - 2 * of_int n * of_real pi * \<i>)"
  3464             by (simp add: exp_eq)
  3465           then have "\<gamma> (exp x) = \<gamma> (exp (x - 2 * of_int n * of_real pi * \<i>))"
  3466             by simp
  3467           also have "... = x - 2 * of_int n * of_real pi * \<i>"
  3468             apply (rule homeomorphism_apply1 [OF hom])
  3469             using \<open>x \<in> u\<close> by (auto simp: n)
  3470           finally show ?thesis
  3471             by simp
  3472         qed
  3473         have exp2n: "exp (\<gamma> (exp x) + 2 * of_int n * complex_of_real pi * \<i>) = exp x"
  3474                 if "dist (Ln z) x < 1" for x
  3475           using that by (auto simp: exp_eq homeomorphism_apply1 [OF hom])
  3476         have cont: "continuous_on (exp ` ball (Ln z) 1) (\<lambda>x. \<gamma> x + 2 * of_int n * complex_of_real pi * \<i>)"
  3477           apply (intro continuous_intros)
  3478           apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF hom]])
  3479           apply (force simp:)
  3480           done
  3481         show "\<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
  3482           apply (rule_tac x="(\<lambda>x. x + of_real(2 * n * pi) * \<i>) \<circ> \<gamma>" in exI)
  3483           unfolding homeomorphism_def
  3484           apply (intro conjI ballI eq1 continuous_on_exp [OF continuous_on_id])
  3485              apply (auto simp: \<gamma>exp exp2n cont n)
  3486            apply (simp add:  homeomorphism_apply1 [OF hom])
  3487           using hom homeomorphism_apply1  apply (force simp: image_iff)
  3488           done
  3489       qed
  3490     qed
  3491   qed
  3492 qed
  3493 
  3494 
  3495 subsection\<open>Hence the Borsukian results about mappings into circles\<close>(*FIX ME title *)
  3496 
  3497 lemma inessential_eq_continuous_logarithm:
  3498   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3499   shows "(\<exists>a. homotopic_with (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)) \<longleftrightarrow>
  3500          (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x)))"
  3501   (is "?lhs \<longleftrightarrow> ?rhs")
  3502 proof
  3503   assume ?lhs thus ?rhs
  3504     by (metis covering_space_lift_inessential_function covering_space_exp_punctured_plane)
  3505 next
  3506   assume ?rhs
  3507   then obtain g where contg: "continuous_on S g" and f: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3508     by metis
  3509   obtain a where "homotopic_with (\<lambda>h. True) S (- {of_real 0}) (exp \<circ> g) (\<lambda>x. a)"
  3510   proof (rule nullhomotopic_through_contractible [OF contg subset_UNIV _ _ contractible_UNIV])
  3511     show "continuous_on (UNIV::complex set) exp"
  3512       by (intro continuous_intros)
  3513     show "range exp \<subseteq> - {0}"
  3514       by auto
  3515   qed force
  3516   thus ?lhs
  3517     apply (rule_tac x=a in exI)
  3518     by (simp add: f homotopic_with_eq)
  3519 qed
  3520 
  3521 corollary inessential_imp_continuous_logarithm_circle:
  3522   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3523   assumes "homotopic_with (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)"
  3524   obtains g where "continuous_on S g" and "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3525 proof -
  3526   have "homotopic_with (\<lambda>h. True) S (- {0}) f (\<lambda>t. a)"
  3527     using assms homotopic_with_subset_right by fastforce
  3528   then show ?thesis
  3529     by (metis inessential_eq_continuous_logarithm that)
  3530 qed
  3531 
  3532 
  3533 lemma inessential_eq_continuous_logarithm_circle:
  3534   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3535   shows "(\<exists>a. homotopic_with (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)) \<longleftrightarrow>
  3536          (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(\<i> * of_real(g x))))"
  3537   (is "?lhs \<longleftrightarrow> ?rhs")
  3538 proof
  3539   assume L: ?lhs
  3540   then obtain g where contg: "continuous_on S g" and g: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3541     using inessential_imp_continuous_logarithm_circle by blast
  3542   have "f ` S \<subseteq> sphere 0 1"
  3543     by (metis L homotopic_with_imp_subset1)
  3544   then have "\<And>x. x \<in> S \<Longrightarrow> Re (g x) = 0"
  3545     using g by auto
  3546   then show ?rhs
  3547     apply (rule_tac x="Im \<circ> g" in exI)
  3548      apply (intro conjI contg continuous_intros)
  3549     apply (auto simp: Euler g)
  3550     done
  3551 next
  3552   assume ?rhs
  3553   then obtain g where contg: "continuous_on S g" and g: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(\<i>* of_real(g x))"
  3554     by metis
  3555   obtain a where "homotopic_with (\<lambda>h. True) S (sphere 0 1) ((exp \<circ> (\<lambda>z. \<i>*z)) \<circ> (of_real \<circ> g)) (\<lambda>x. a)"
  3556   proof (rule nullhomotopic_through_contractible)
  3557     show "continuous_on S (complex_of_real \<circ> g)"
  3558       by (intro conjI contg continuous_intros)
  3559     show "(complex_of_real \<circ> g) ` S \<subseteq> \<real>"
  3560       by auto
  3561     show "continuous_on \<real> (exp \<circ> (*)\<i>)"
  3562       by (intro continuous_intros)
  3563     show "(exp \<circ> (*)\<i>) ` \<real> \<subseteq> sphere 0 1"
  3564       by (auto simp: complex_is_Real_iff)
  3565   qed (auto simp: convex_Reals convex_imp_contractible)
  3566   moreover have "\<And>x. x \<in> S \<Longrightarrow> (exp \<circ> (*)\<i> \<circ> (complex_of_real \<circ> g)) x = f x"
  3567     by (simp add: g)
  3568   ultimately show ?lhs
  3569     apply (rule_tac x=a in exI)
  3570     by (simp add: homotopic_with_eq)
  3571 qed
  3572 
  3573 proposition homotopic_with_sphere_times:
  3574   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3575   assumes hom: "homotopic_with (\<lambda>x. True) S (sphere 0 1) f g" and conth: "continuous_on S h"
  3576       and hin: "\<And>x. x \<in> S \<Longrightarrow> h x \<in> sphere 0 1"
  3577     shows "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x * h x) (\<lambda>x. g x * h x)"
  3578 proof -
  3579   obtain k where contk: "continuous_on ({0..1::real} \<times> S) k"
  3580              and kim: "k ` ({0..1} \<times> S) \<subseteq> sphere 0 1"
  3581              and k0:  "\<And>x. k(0, x) = f x"
  3582              and k1: "\<And>x. k(1, x) = g x"
  3583     using hom by (auto simp: homotopic_with_def)
  3584   show ?thesis
  3585     apply (simp add: homotopic_with)
  3586     apply (rule_tac x="\<lambda>z. k z*(h \<circ> snd)z" in exI)
  3587     apply (intro conjI contk continuous_intros)
  3588        apply (simp add: conth)
  3589     using kim hin apply (force simp: norm_mult k0 k1)+
  3590     done
  3591 qed
  3592 
  3593 proposition homotopic_circlemaps_divide:
  3594   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3595     shows "homotopic_with (\<lambda>x. True) S (sphere 0 1) f g \<longleftrightarrow>
  3596            continuous_on S f \<and> f ` S \<subseteq> sphere 0 1 \<and>
  3597            continuous_on S g \<and> g ` S \<subseteq> sphere 0 1 \<and>
  3598            (\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c))"
  3599 proof -
  3600   have "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
  3601        if "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c)" for c
  3602   proof -
  3603     have "S = {} \<or> path_component (sphere 0 1) 1 c"
  3604       using homotopic_with_imp_subset2 [OF that] path_connected_sphere [of "0::complex" 1]
  3605       by (auto simp: path_connected_component)
  3606     then have "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. 1) (\<lambda>x. c)"
  3607       by (metis homotopic_constant_maps)
  3608     then show ?thesis
  3609       using homotopic_with_symD homotopic_with_trans that by blast
  3610   qed
  3611   then have *: "(\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c)) \<longleftrightarrow>
  3612                 homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
  3613     by auto
  3614   have "homotopic_with (\<lambda>x. True) S (sphere 0 1) f g \<longleftrightarrow>
  3615            continuous_on S f \<and> f ` S \<subseteq> sphere 0 1 \<and>
  3616            continuous_on S g \<and> g ` S \<subseteq> sphere 0 1 \<and>
  3617            homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
  3618         (is "?lhs \<longleftrightarrow> ?rhs")
  3619   proof
  3620     assume L: ?lhs
  3621     have geq1 [simp]: "\<And>x. x \<in> S \<Longrightarrow> cmod (g x) = 1"
  3622       using homotopic_with_imp_subset2 [OF L]
  3623       by (simp add: image_subset_iff)
  3624     have cont: "continuous_on S (inverse \<circ> g)"
  3625       apply (rule continuous_intros)
  3626       using homotopic_with_imp_continuous [OF L] apply blast
  3627       apply (rule continuous_on_subset [of "sphere 0 1", OF continuous_on_inverse])
  3628         apply (auto simp: continuous_on_id)
  3629       done
  3630     have "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
  3631       using homotopic_with_sphere_times [OF L cont]
  3632       apply (rule homotopic_with_eq)
  3633          apply (auto simp: division_ring_class.divide_inverse norm_inverse)
  3634       by (metis geq1 norm_zero right_inverse zero_neq_one)
  3635     with L show ?rhs
  3636       by (auto simp: homotopic_with_imp_continuous dest: homotopic_with_imp_subset1 homotopic_with_imp_subset2)
  3637   next
  3638     assume ?rhs then show ?lhs
  3639       by (force simp: elim: homotopic_with_eq dest: homotopic_with_sphere_times [where h=g])+
  3640   qed
  3641   then show ?thesis
  3642     by (simp add: *)
  3643 qed
  3644 
  3645 subsection\<open>Upper and lower hemicontinuous functions\<close>
  3646 
  3647 text\<open>And relation in the case of preimage map to open and closed maps, and fact that upper and lower
  3648 hemicontinuity together imply continuity in the sense of the Hausdorff metric (at points where the
  3649 function gives a bounded and nonempty set).\<close>
  3650 
  3651 
  3652 text\<open>Many similar proofs below.\<close>
  3653 lemma upper_hemicontinuous:
  3654   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
  3655     shows "((\<forall>U. openin (top_of_set T) U
  3656                  \<longrightarrow> openin (top_of_set S) {x \<in> S. f x \<subseteq> U}) \<longleftrightarrow>
  3657             (\<forall>U. closedin (top_of_set T) U
  3658                  \<longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}))"
  3659           (is "?lhs = ?rhs")
  3660 proof (intro iffI allI impI)
  3661   fix U
  3662   assume * [rule_format]: ?lhs and "closedin (top_of_set T) U"
  3663   then have "openin (top_of_set T) (T - U)"
  3664     by (simp add: openin_diff)
  3665   then have "openin (top_of_set S) {x \<in> S. f x \<subseteq> T - U}"
  3666     using * [of "T-U"] by blast
  3667   moreover have "S - {x \<in> S. f x \<subseteq> T - U} = {x \<in> S. f x \<inter> U \<noteq> {}}"
  3668     using assms by blast
  3669   ultimately show "closedin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
  3670     by (simp add: openin_closedin_eq)
  3671 next
  3672   fix U
  3673   assume * [rule_format]: ?rhs and "openin (top_of_set T) U"
  3674   then have "closedin (top_of_set T) (T - U)"
  3675     by (simp add: closedin_diff)
  3676   then have "closedin (top_of_set S) {x \<in> S. f x \<inter> (T - U) \<noteq> {}}"
  3677     using * [of "T-U"] by blast
  3678   moreover have "{x \<in> S. f x \<inter> (T - U) \<noteq> {}} = S - {x \<in> S. f x \<subseteq> U}"
  3679     using assms by auto
  3680   ultimately show "openin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
  3681     by (simp add: openin_closedin_eq)
  3682 qed
  3683 
  3684 lemma lower_hemicontinuous:
  3685   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
  3686     shows "((\<forall>U. closedin (top_of_set T) U
  3687                  \<longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}) \<longleftrightarrow>
  3688             (\<forall>U. openin (top_of_set T) U
  3689                  \<longrightarrow> openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}))"
  3690           (is "?lhs = ?rhs")
  3691 proof (intro iffI allI impI)
  3692   fix U
  3693   assume * [rule_format]: ?lhs and "openin (top_of_set T) U"
  3694   then have "closedin (top_of_set T) (T - U)"
  3695     by (simp add: closedin_diff)
  3696   then have "closedin (top_of_set S) {x \<in> S. f x \<subseteq> T-U}"
  3697     using * [of "T-U"] by blast
  3698   moreover have "{x \<in> S. f x \<subseteq> T-U} = S - {x \<in> S. f x \<inter> U \<noteq> {}}"
  3699     using assms by auto
  3700   ultimately show "openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
  3701     by (simp add: openin_closedin_eq)
  3702 next
  3703   fix U
  3704   assume * [rule_format]: ?rhs and "closedin (top_of_set T) U"
  3705   then have "openin (top_of_set T) (T - U)"
  3706     by (simp add: openin_diff)
  3707   then have "openin (top_of_set S) {x \<in> S. f x \<inter> (T - U) \<noteq> {}}"
  3708     using * [of "T-U"] by blast
  3709   moreover have "S - {x \<in> S. f x \<inter> (T - U) \<noteq> {}} = {x \<in> S. f x \<subseteq> U}"
  3710     using assms by blast
  3711   ultimately show "closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
  3712     by (simp add: openin_closedin_eq)
  3713 qed
  3714 
  3715 lemma open_map_iff_lower_hemicontinuous_preimage:
  3716   assumes "f ` S \<subseteq> T"
  3717     shows "((\<forall>U. openin (top_of_set S) U
  3718                  \<longrightarrow> openin (top_of_set T) (f ` U)) \<longleftrightarrow>
  3719             (\<forall>U. closedin (top_of_set S) U
  3720                  \<longrightarrow> closedin (top_of_set T) {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}))"
  3721           (is "?lhs = ?rhs")
  3722 proof (intro iffI allI impI)
  3723   fix U
  3724   assume * [rule_format]: ?lhs and "closedin (top_of_set S) U"
  3725   then have "openin (top_of_set S) (S - U)"
  3726     by (simp add: openin_diff)
  3727   then have "openin (top_of_set T) (f ` (S - U))"
  3728     using * [of "S-U"] by blast
  3729   moreover have "T - (f ` (S - U)) = {y \<in> T. {x \<in> S. f x = y} \<subseteq> U}"
  3730     using assms by blast
  3731   ultimately show "closedin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> U}"
  3732     by (simp add: openin_closedin_eq)
  3733 next
  3734   fix U
  3735   assume * [rule_format]: ?rhs and opeSU: "openin (top_of_set S) U"
  3736   then have "closedin (top_of_set S) (S - U)"
  3737     by (simp add: closedin_diff)
  3738   then have "closedin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
  3739     using * [of "S-U"] by blast
  3740   moreover have "{y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U} = T - (f ` U)"
  3741     using assms openin_imp_subset [OF opeSU] by auto
  3742   ultimately show "openin (top_of_set T) (f ` U)"
  3743     using assms openin_imp_subset [OF opeSU] by (force simp: openin_closedin_eq)
  3744 qed
  3745 
  3746 lemma closed_map_iff_upper_hemicontinuous_preimage:
  3747   assumes "f ` S \<subseteq> T"
  3748     shows "((\<forall>U. closedin (top_of_set S) U
  3749                  \<longrightarrow> closedin (top_of_set T) (f ` U)) \<longleftrightarrow>
  3750             (\<forall>U. openin (top_of_set S) U
  3751                  \<longrightarrow> openin (top_of_set T) {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}))"
  3752           (is "?lhs = ?rhs")
  3753 proof (intro iffI allI impI)
  3754   fix U
  3755   assume * [rule_format]: ?lhs and opeSU: "openin (top_of_set S) U"
  3756   then have "closedin (top_of_set S) (S - U)"
  3757     by (simp add: closedin_diff)
  3758   then have "closedin (top_of_set T) (f ` (S - U))"
  3759     using * [of "S-U"] by blast
  3760   moreover have "f ` (S - U) = T -  {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}"
  3761     using assms openin_imp_subset [OF opeSU] by auto
  3762   ultimately show "openin (top_of_set T)  {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}"
  3763     using assms openin_imp_subset [OF opeSU] by (force simp: openin_closedin_eq)
  3764 next
  3765   fix U
  3766   assume * [rule_format]: ?rhs and cloSU: "closedin (top_of_set S) U"
  3767   then have "openin (top_of_set S) (S - U)"
  3768     by (simp add: openin_diff)
  3769   then have "openin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
  3770     using * [of "S-U"] by blast
  3771   moreover have "(f ` U) = T - {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
  3772     using assms closedin_imp_subset [OF cloSU]  by auto
  3773   ultimately show "closedin (top_of_set T) (f ` U)"
  3774     by (simp add: openin_closedin_eq)
  3775 qed
  3776 
  3777 proposition upper_lower_hemicontinuous_explicit:
  3778   fixes T :: "('b::{real_normed_vector,heine_borel}) set"
  3779   assumes fST: "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
  3780       and ope: "\<And>U. openin (top_of_set T) U
  3781                      \<Longrightarrow> openin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
  3782       and clo: "\<And>U. closedin (top_of_set T) U
  3783                      \<Longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
  3784       and "x \<in> S" "0 < e" and bofx: "bounded(f x)" and fx_ne: "f x \<noteq> {}"
  3785   obtains d where "0 < d"
  3786              "\<And>x'. \<lbrakk>x' \<in> S; dist x x' < d\<rbrakk>
  3787                            \<Longrightarrow> (\<forall>y \<in> f x. \<exists>y'. y' \<in> f x' \<and> dist y y' < e) \<and>
  3788                                (\<forall>y' \<in> f x'. \<exists>y. y \<in> f x \<and> dist y' y < e)"
  3789 proof -
  3790   have "openin (top_of_set T) (T \<inter> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b}))"
  3791     by (auto simp: open_sums openin_open_Int)
  3792   with ope have "openin (top_of_set S)
  3793                     {u \<in> S. f u \<subseteq> T \<inter> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b})}" by blast
  3794   with \<open>0 < e\<close> \<open>x \<in> S\<close> obtain d1 where "d1 > 0" and
  3795          d1: "\<And>x'. \<lbrakk>x' \<in> S; dist x' x < d1\<rbrakk> \<Longrightarrow> f x' \<subseteq> T \<and> f x' \<subseteq> (\<Union>a \<in> f x. \<Union>b \<in> ball 0 e. {a + b})"
  3796     by (force simp: openin_euclidean_subtopology_iff dest: fST)
  3797   have oo: "\<And>U. openin (top_of_set T) U \<Longrightarrow>
  3798                  openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
  3799     apply (rule lower_hemicontinuous [THEN iffD1, rule_format])
  3800     using fST clo by auto
  3801   have "compact (closure(f x))"
  3802     by (simp add: bofx)
  3803   moreover have "closure(f x) \<subseteq> (\<Union>a \<in> f x. ball a (e/2))"
  3804     using \<open>0 < e\<close> by (force simp: closure_approachable simp del: divide_const_simps)
  3805   ultimately obtain C where "C \<subseteq> f x" "finite C" "closure(f x) \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
  3806     apply (rule compactE, force)
  3807     by (metis finite_subset_image)
  3808   then have fx_cover: "f x \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
  3809     by (meson closure_subset order_trans)
  3810   with fx_ne have "C \<noteq> {}"
  3811     by blast
  3812   have xin: "x \<in> (\<Inter>a \<in> C. {x \<in> S. f x \<inter> T \<inter> ball a (e/2) \<noteq> {}})"
  3813     using \<open>x \<in> S\<close> \<open>0 < e\<close> fST \<open>C \<subseteq> f x\<close> by force
  3814   have "openin (top_of_set S) {x \<in> S. f x \<inter> (T \<inter> ball a (e/2)) \<noteq> {}}" for a
  3815     by (simp add: openin_open_Int oo)
  3816   then have "openin (top_of_set S) (\<Inter>a \<in> C. {x \<in> S. f x \<inter> T \<inter> ball a (e/2) \<noteq> {}})"
  3817     by (simp add: Int_assoc openin_INT2 [OF \<open>finite C\<close> \<open>C \<noteq> {}\<close>])
  3818   with xin obtain d2 where "d2>0"
  3819               and d2: "\<And>u v. \<lbrakk>u \<in> S; dist u x < d2; v \<in> C\<rbrakk> \<Longrightarrow> f u \<inter> T \<inter> ball v (e/2) \<noteq> {}"
  3820     unfolding openin_euclidean_subtopology_iff using xin by fastforce
  3821   show ?thesis
  3822   proof (intro that conjI ballI)
  3823     show "0 < min d1 d2"
  3824       using \<open>0 < d1\<close> \<open>0 < d2\<close> by linarith
  3825   next
  3826     fix x' y
  3827     assume "x' \<in> S" "dist x x' < min d1 d2" "y \<in> f x"
  3828     then have dd2: "dist x' x < d2"
  3829       by (auto simp: dist_commute)
  3830     obtain a where "a \<in> C" "y \<in> ball a (e/2)"
  3831       using fx_cover \<open>y \<in> f x\<close> by auto
  3832     then show "\<exists>y'. y' \<in> f x' \<and> dist y y' < e"
  3833       using d2 [OF \<open>x' \<in> S\<close> dd2] dist_triangle_half_r by fastforce
  3834   next
  3835     fix x' y'
  3836     assume "x' \<in> S" "dist x x' < min d1 d2" "y' \<in> f x'"
  3837     then have "dist x' x < d1"
  3838       by (auto simp: dist_commute)
  3839     then have "y' \<in> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b})"
  3840       using d1 [OF \<open>x' \<in> S\<close>] \<open>y' \<in> f x'\<close> by force
  3841     then show "\<exists>y. y \<in> f x \<and> dist y' y < e"
  3842       apply auto
  3843       by (metis add_diff_cancel_left' dist_norm)
  3844   qed
  3845 qed
  3846 
  3847 
  3848 subsection\<open>Complex logs exist on various "well-behaved" sets\<close>
  3849 
  3850 lemma continuous_logarithm_on_contractible:
  3851   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3852   assumes "continuous_on S f" "contractible S" "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3853   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3854 proof -
  3855   obtain c where hom: "homotopic_with (\<lambda>h. True) S (-{0}) f (\<lambda>x. c)"
  3856     using nullhomotopic_from_contractible assms
  3857     by (metis imageE subset_Compl_singleton)
  3858   then show ?thesis
  3859     by (metis inessential_eq_continuous_logarithm that)
  3860 qed
  3861 
  3862 lemma continuous_logarithm_on_simply_connected:
  3863   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3864   assumes contf: "continuous_on S f" and S: "simply_connected S" "locally path_connected S"
  3865       and f: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3866   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3867   using covering_space_lift [OF covering_space_exp_punctured_plane S contf]
  3868   by (metis (full_types) f imageE subset_Compl_singleton)
  3869 
  3870 lemma continuous_logarithm_on_cball:
  3871   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3872   assumes "continuous_on (cball a r) f" and "\<And>z. z \<in> cball a r \<Longrightarrow> f z \<noteq> 0"
  3873     obtains h where "continuous_on (cball a r) h" "\<And>z. z \<in> cball a r \<Longrightarrow> f z = exp(h z)"
  3874   using assms continuous_logarithm_on_contractible convex_imp_contractible by blast
  3875 
  3876 lemma continuous_logarithm_on_ball:
  3877   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3878   assumes "continuous_on (ball a r) f" and "\<And>z. z \<in> ball a r \<Longrightarrow> f z \<noteq> 0"
  3879   obtains h where "continuous_on (ball a r) h" "\<And>z. z \<in> ball a r \<Longrightarrow> f z = exp(h z)"
  3880   using assms continuous_logarithm_on_contractible convex_imp_contractible by blast
  3881 
  3882 lemma continuous_sqrt_on_contractible:
  3883   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3884   assumes "continuous_on S f" "contractible S"
  3885       and "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3886   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = (g x) ^ 2"
  3887 proof -
  3888   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3889     using continuous_logarithm_on_contractible [OF assms] by blast
  3890   show ?thesis
  3891   proof
  3892     show "continuous_on S (\<lambda>z. exp (g z / 2))"
  3893       by (rule continuous_on_compose2 [of UNIV exp]; intro continuous_intros contg subset_UNIV) auto
  3894     show "\<And>x. x \<in> S \<Longrightarrow> f x = (exp (g x / 2))\<^sup>2"
  3895       by (metis exp_double feq nonzero_mult_div_cancel_left times_divide_eq_right zero_neq_numeral)
  3896   qed
  3897 qed
  3898 
  3899 lemma continuous_sqrt_on_simply_connected:
  3900   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3901   assumes contf: "continuous_on S f" and S: "simply_connected S" "locally path_connected S"
  3902       and f: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3903   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = (g x) ^ 2"
  3904 proof -
  3905   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3906     using continuous_logarithm_on_simply_connected [OF assms] by blast
  3907   show ?thesis
  3908   proof
  3909     show "continuous_on S (\<lambda>z. exp (g z / 2))"
  3910       by (rule continuous_on_compose2 [of UNIV exp]; intro continuous_intros contg subset_UNIV) auto
  3911     show "\<And>x. x \<in> S \<Longrightarrow> f x = (exp (g x / 2))\<^sup>2"
  3912       by (metis exp_double feq nonzero_mult_div_cancel_left times_divide_eq_right zero_neq_numeral)
  3913   qed
  3914 qed
  3915 
  3916 
  3917 subsection\<open>Another simple case where sphere maps are nullhomotopic\<close>
  3918 
  3919 lemma inessential_spheremap_2_aux:
  3920   fixes f :: "'a::euclidean_space \<Rightarrow> complex"
  3921   assumes 2: "2 < DIM('a)" and contf: "continuous_on (sphere a r) f" 
  3922       and fim: "f `(sphere a r) \<subseteq> (sphere 0 1)" 
  3923   obtains c where "homotopic_with (\<lambda>z. True) (sphere a r) (sphere 0 1) f (\<lambda>x. c)"
  3924 proof -
  3925   obtain g where contg: "continuous_on (sphere a r) g" 
  3926              and feq: "\<And>x. x \<in> sphere a r \<Longrightarrow> f x = exp(g x)"
  3927   proof (rule continuous_logarithm_on_simply_connected [OF contf])
  3928     show "simply_connected (sphere a r)"
  3929       using 2 by (simp add: simply_connected_sphere_eq)
  3930     show "locally path_connected (sphere a r)"
  3931       by (simp add: locally_path_connected_sphere)
  3932     show "\<And>z.  z \<in> sphere a r \<Longrightarrow> f z \<noteq> 0"
  3933       using fim by force
  3934   qed auto
  3935   have "\<exists>g. continuous_on (sphere a r) g \<and> (\<forall>x\<in>sphere a r. f x = exp (\<i> * complex_of_real (g x)))"
  3936   proof (intro exI conjI)
  3937     show "continuous_on (sphere a r) (Im \<circ> g)"
  3938       by (intro contg continuous_intros continuous_on_compose)
  3939     show "\<forall>x\<in>sphere a r. f x = exp (\<i> * complex_of_real ((Im \<circ> g) x))"
  3940       using exp_eq_polar feq fim norm_exp_eq_Re by auto
  3941   qed
  3942   with inessential_eq_continuous_logarithm_circle that show ?thesis 
  3943     by metis
  3944 qed
  3945 
  3946 lemma inessential_spheremap_2:
  3947   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3948   assumes a2: "2 < DIM('a)" and b2: "DIM('b) = 2" 
  3949       and contf: "continuous_on (sphere a r) f" and fim: "f `(sphere a r) \<subseteq> (sphere b s)"
  3950   obtains c where "homotopic_with (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. c)"
  3951 proof (cases "s \<le> 0")
  3952   case True
  3953   then show ?thesis
  3954     using contf contractible_sphere fim nullhomotopic_into_contractible that by blast
  3955 next
  3956   case False
  3957   then have "sphere b s homeomorphic sphere (0::complex) 1"
  3958     using assms by (simp add: homeomorphic_spheres_gen)
  3959   then obtain h k where hk: "homeomorphism (sphere b s) (sphere (0::complex) 1) h k"
  3960     by (auto simp: homeomorphic_def)
  3961   then have conth: "continuous_on (sphere b s) h"
  3962        and  contk: "continuous_on (sphere 0 1) k"
  3963        and  him: "h ` sphere b s \<subseteq> sphere 0 1"
  3964        and  kim: "k ` sphere 0 1 \<subseteq> sphere b s"
  3965     by (simp_all add: homeomorphism_def)
  3966   obtain c where "homotopic_with (\<lambda>z. True) (sphere a r) (sphere 0 1) (h \<circ> f) (\<lambda>x. c)"
  3967   proof (rule inessential_spheremap_2_aux [OF a2])
  3968     show "continuous_on (sphere a r) (h \<circ> f)"
  3969       by (meson continuous_on_compose [OF contf] conth continuous_on_subset fim)
  3970     show "(h \<circ> f) ` sphere a r \<subseteq> sphere 0 1"
  3971       using fim him by force
  3972   qed auto
  3973   then have "homotopic_with (\<lambda>f. True) (sphere a r) (sphere b s) (k \<circ> (h \<circ> f)) (k \<circ> (\<lambda>x. c))"
  3974     by (rule homotopic_compose_continuous_left [OF _ contk kim])
  3975   then have "homotopic_with (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. k c)"
  3976     apply (rule homotopic_with_eq, auto)
  3977     by (metis fim hk homeomorphism_def image_subset_iff mem_sphere)
  3978   then show ?thesis
  3979     by (metis that)
  3980 qed
  3981 
  3982 
  3983 subsection\<open>Holomorphic logarithms and square roots\<close>
  3984 
  3985 lemma contractible_imp_holomorphic_log:
  3986   assumes holf: "f holomorphic_on S"
  3987       and S: "contractible S"
  3988       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3989   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
  3990 proof -
  3991   have contf: "continuous_on S f"
  3992     by (simp add: holf holomorphic_on_imp_continuous_on)
  3993   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
  3994     by (metis continuous_logarithm_on_contractible [OF contf S fnz])
  3995   have "g field_differentiable at z within S" if "f field_differentiable at z within S" "z \<in> S" for z
  3996   proof -
  3997     obtain f' where f': "((\<lambda>y. (f y - f z) / (y - z)) \<longlongrightarrow> f') (at z within S)"
  3998       using \<open>f field_differentiable at z within S\<close> by (auto simp: field_differentiable_def has_field_derivative_iff)
  3999     then have ee: "((\<lambda>x. (exp(g x) - exp(g z)) / (x - z)) \<longlongrightarrow> f') (at z within S)"
  4000       by (simp add: feq \<open>z \<in> S\<close> Lim_transform_within [OF _ zero_less_one])
  4001     have "(((\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<circ> g) \<longlongrightarrow> exp (g z))
  4002           (at z within S)"
  4003     proof (rule tendsto_compose_at)
  4004       show "(g \<longlongrightarrow> g z) (at z within S)"
  4005         using contg continuous_on \<open>z \<in> S\<close> by blast
  4006       show "(\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<midarrow>g z\<rightarrow> exp (g z)"
  4007         apply (subst Lim_at_zero)
  4008         apply (simp add: DERIV_D cong: if_cong Lim_cong_within)
  4009         done
  4010       qed auto
  4011     then have dd: "((\<lambda>x. if g x = g z then exp(g z) else (exp(g x) - exp(g z)) / (g x - g z)) \<longlongrightarrow> exp(g z)) (at z within S)"
  4012       by (simp add: o_def)
  4013     have "continuous (at z within S) g"
  4014       using contg continuous_on_eq_continuous_within \<open>z \<in> S\<close> by blast
  4015     then have "(\<forall>\<^sub>F x in at z within S. dist (g x) (g z) < 2*pi)"
  4016       by (simp add: continuous_within tendsto_iff)
  4017     then have "\<forall>\<^sub>F x in at z within S. exp (g x) = exp (g z) \<longrightarrow> g x \<noteq> g z \<longrightarrow> x = z"
  4018       apply (rule eventually_mono)
  4019       apply (auto simp: exp_eq dist_norm norm_mult)
  4020       done
  4021     then have "((\<lambda>y. (g y - g z) / (y - z)) \<longlongrightarrow> f' / exp (g z)) (at z within S)"
  4022       by (auto intro!: Lim_transform_eventually [OF _ tendsto_divide [OF ee dd]])
  4023     then show ?thesis
  4024       by (auto simp: field_differentiable_def has_field_derivative_iff)
  4025   qed
  4026   then have "g holomorphic_on S"
  4027     using holf holomorphic_on_def by auto
  4028   then show ?thesis
  4029     using feq that by auto
  4030 qed
  4031 
  4032 (*Identical proofs*)
  4033 lemma simply_connected_imp_holomorphic_log:
  4034   assumes holf: "f holomorphic_on S"
  4035       and S: "simply_connected S" "locally path_connected S"
  4036       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  4037   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
  4038 proof -
  4039   have contf: "continuous_on S f"
  4040     by (simp add: holf holomorphic_on_imp_continuous_on)
  4041   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
  4042     by (metis continuous_logarithm_on_simply_connected [OF contf S fnz])
  4043   have "g field_differentiable at z within S" if "f field_differentiable at z within S" "z \<in> S" for z
  4044   proof -
  4045     obtain f' where f': "((\<lambda>y. (f y - f z) / (y - z)) \<longlongrightarrow> f') (at z within S)"
  4046       using \<open>f field_differentiable at z within S\<close> by (auto simp: field_differentiable_def has_field_derivative_iff)
  4047     then have ee: "((\<lambda>x. (exp(g x) - exp(g z)) / (x - z)) \<longlongrightarrow> f') (at z within S)"
  4048       by (simp add: feq \<open>z \<in> S\<close> Lim_transform_within [OF _ zero_less_one])
  4049     have "(((\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<circ> g) \<longlongrightarrow> exp (g z))
  4050           (at z within S)"
  4051     proof (rule tendsto_compose_at)
  4052       show "(g \<longlongrightarrow> g z) (at z within S)"
  4053         using contg continuous_on \<open>z \<in> S\<close> by blast
  4054       show "(\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<midarrow>g z\<rightarrow> exp (g z)"
  4055         apply (subst Lim_at_zero)
  4056         apply (simp add: DERIV_D cong: if_cong Lim_cong_within)
  4057         done
  4058       qed auto
  4059     then have dd: "((\<lambda>x. if g x = g z then exp(g z) else (exp(g x) - exp(g z)) / (g x - g z)) \<longlongrightarrow> exp(g z)) (at z within S)"
  4060       by (simp add: o_def)
  4061     have "continuous (at z within S) g"
  4062       using contg continuous_on_eq_continuous_within \<open>z \<in> S\<close> by blast
  4063     then have "(\<forall>\<^sub>F x in at z within S. dist (g x) (g z) < 2*pi)"
  4064       by (simp add: continuous_within tendsto_iff)
  4065     then have "\<forall>\<^sub>F x in at z within S. exp (g x) = exp (g z) \<longrightarrow> g x \<noteq> g z \<longrightarrow> x = z"
  4066       apply (rule eventually_mono)
  4067       apply (auto simp: exp_eq dist_norm norm_mult)
  4068       done
  4069     then have "((\<lambda>y. (g y - g z) / (y - z)) \<longlongrightarrow> f' / exp (g z)) (at z within S)"
  4070       by (auto intro!: Lim_transform_eventually [OF _ tendsto_divide [OF ee dd]])
  4071     then show ?thesis
  4072       by (auto simp: field_differentiable_def has_field_derivative_iff)
  4073   qed
  4074   then have "g holomorphic_on S"
  4075     using holf holomorphic_on_def by auto
  4076   then show ?thesis
  4077     using feq that by auto
  4078 qed
  4079 
  4080 
  4081 lemma contractible_imp_holomorphic_sqrt:
  4082   assumes holf: "f holomorphic_on S"
  4083       and S: "contractible S"
  4084       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  4085   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = g z ^ 2"
  4086 proof -
  4087   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
  4088     using contractible_imp_holomorphic_log [OF assms] by blast
  4089   show ?thesis
  4090   proof
  4091     show "exp \<circ> (\<lambda>z. z / 2) \<circ> g holomorphic_on S"
  4092       by (intro holomorphic_on_compose holg holomorphic_intros) auto
  4093     show "\<And>z. z \<in> S \<Longrightarrow> f z = ((exp \<circ> (\<lambda>z. z / 2) \<circ> g) z)\<^sup>2"
  4094       apply (auto simp: feq)
  4095       by (metis eq_divide_eq_numeral1(1) exp_double mult.commute zero_neq_numeral)
  4096   qed
  4097 qed
  4098 
  4099 lemma simply_connected_imp_holomorphic_sqrt:
  4100   assumes holf: "f holomorphic_on S"
  4101       and S: "simply_connected S" "locally path_connected S"
  4102       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  4103   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = g z ^ 2"
  4104 proof -
  4105   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
  4106     using simply_connected_imp_holomorphic_log [OF assms] by blast
  4107   show ?thesis
  4108   proof
  4109     show "exp \<circ> (\<lambda>z. z / 2) \<circ> g holomorphic_on S"
  4110       by (intro holomorphic_on_compose holg holomorphic_intros) auto
  4111     show "\<And>z. z \<in> S \<Longrightarrow> f z = ((exp \<circ> (\<lambda>z. z / 2) \<circ> g) z)\<^sup>2"
  4112       apply (auto simp: feq)
  4113       by (metis eq_divide_eq_numeral1(1) exp_double mult.commute zero_neq_numeral)
  4114   qed
  4115 qed
  4116 
  4117 text\<open> Related theorems about holomorphic inverse cosines.\<close>
  4118 
  4119 lemma contractible_imp_holomorphic_arccos:
  4120   assumes holf: "f holomorphic_on S" and S: "contractible S"
  4121       and non1: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 1 \<and> f z \<noteq> -1"
  4122   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = cos(g z)"
  4123 proof -
  4124   have hol1f: "(\<lambda>z. 1 - f z ^ 2) holomorphic_on S"
  4125     by (intro holomorphic_intros holf)
  4126   obtain g where holg: "g holomorphic_on S" and eq: "\<And>z. z \<in> S \<Longrightarrow> 1 - (f z)\<^sup>2 = (g z)\<^sup>2"
  4127     using contractible_imp_holomorphic_sqrt [OF hol1f S]
  4128     by (metis eq_iff_diff_eq_0 non1 power2_eq_1_iff)
  4129   have holfg: "(\<lambda>z. f z + \<i>*g z) holomorphic_on S"
  4130     by (intro holf holg holomorphic_intros)
  4131   have "\<And>z. z \<in> S \<Longrightarrow> f z + \<i>*g z \<noteq> 0"
  4132     by (metis Arccos_body_lemma eq add.commute add.inverse_unique complex_i_mult_minus power2_csqrt power2_eq_iff)
  4133   then obtain h where holh: "h holomorphic_on S" and fgeq: "\<And>z. z \<in> S \<Longrightarrow> f z + \<i>*g z = exp (h z)"
  4134     using contractible_imp_holomorphic_log [OF holfg S] by metis
  4135   show ?thesis
  4136   proof
  4137     show "(\<lambda>z. -\<i>*h z) holomorphic_on S"
  4138       by (intro holh holomorphic_intros)
  4139     show "f z = cos (- \<i>*h z)" if "z \<in> S" for z
  4140     proof -
  4141       have "(f z + \<i>*g z)*(f z - \<i>*g z) = 1"
  4142         using that eq by (auto simp: algebra_simps power2_eq_square)
  4143       then have "f z - \<i>*g z = inverse (f z + \<i>*g z)"
  4144         using inverse_unique by force
  4145       also have "... = exp (- h z)"
  4146         by (simp add: exp_minus fgeq that)
  4147       finally have "f z = exp (- h z) + \<i>*g z"
  4148         by (simp add: diff_eq_eq)
  4149       then show ?thesis
  4150         apply (simp add: cos_exp_eq)
  4151         by (metis fgeq add.assoc mult_2_right that)
  4152     qed
  4153   qed
  4154 qed
  4155 
  4156 
  4157 lemma contractible_imp_holomorphic_arccos_bounded:
  4158   assumes holf: "f holomorphic_on S" and S: "contractible S" and "a \<in> S"
  4159       and non1: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 1 \<and> f z \<noteq> -1"
  4160   obtains g where "g holomorphic_on S" "norm(g a) \<le> pi + norm(f a)" "\<And>z. z \<in> S \<Longrightarrow> f z = cos(g z)"
  4161 proof -
  4162   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = cos (g z)"
  4163     using contractible_imp_holomorphic_arccos [OF holf S non1] by blast
  4164   obtain b where "cos b = f a" "norm b \<le> pi + norm (f a)"
  4165     using cos_Arccos norm_Arccos_bounded by blast
  4166   then have "cos b = cos (g a)"
  4167     by (simp add: \<open>a \<in> S\<close> feq)
  4168   then consider n where "n \<in> \<int>" "b = g a + of_real(2*n*pi)" | n where "n \<in> \<int>" "b = -g a + of_real(2*n*pi)"
  4169     by (auto simp: complex_cos_eq)
  4170   then show ?thesis
  4171   proof cases
  4172     case 1
  4173     show ?thesis
  4174     proof
  4175       show "(\<lambda>z. g z + of_real(2*n*pi)) holomorphic_on S"
  4176         by (intro holomorphic_intros holg)
  4177       show "cmod (g a + of_real(2*n*pi)) \<le> pi + cmod (f a)"
  4178         using "1" \<open>cmod b \<le> pi + cmod (f a)\<close> by blast
  4179       show "\<And>z. z \<in> S \<Longrightarrow> f z = cos (g z + complex_of_real (2*n*pi))"
  4180         by (metis \<open>n \<in> \<int>\<close> complex_cos_eq feq)
  4181     qed
  4182   next
  4183     case 2
  4184     show ?thesis
  4185     proof
  4186       show "(\<lambda>z. -g z + of_real(2*n*pi)) holomorphic_on S"
  4187         by (intro holomorphic_intros holg)
  4188       show "cmod (-g a + of_real(2*n*pi)) \<le> pi + cmod (f a)"
  4189         using "2" \<open>cmod b \<le> pi + cmod (f a)\<close> by blast
  4190       show "\<And>z. z \<in> S \<Longrightarrow> f z = cos (-g z + complex_of_real (2*n*pi))"
  4191         by (metis \<open>n \<in> \<int>\<close> complex_cos_eq feq)
  4192     qed
  4193   qed
  4194 qed
  4195 
  4196 
  4197 subsection\<open>The "Borsukian" property of sets\<close>
  4198 
  4199 text\<open>This doesn't have a standard name. Kuratowski uses ``contractible with respect to \<open>[S\<^sup>1]\<close>''
  4200  while Whyburn uses ``property b''. It's closely related to unicoherence.\<close>
  4201 
  4202 definition%important Borsukian where
  4203     "Borsukian S \<equiv>
  4204         \<forall>f. continuous_on S f \<and> f ` S \<subseteq> (- {0::complex})
  4205             \<longrightarrow> (\<exists>a. homotopic_with (\<lambda>h. True) S (- {0}) f (\<lambda>x. a))"
  4206 
  4207 lemma Borsukian_retraction_gen:
  4208   assumes "Borsukian S" "continuous_on S h" "h ` S = T"
  4209           "continuous_on T k"  "k ` T \<subseteq> S"  "\<And>y. y \<in> T \<Longrightarrow> h(k y) = y"
  4210     shows "Borsukian T"
  4211 proof -
  4212   interpret R: Retracts S h T k
  4213     using assms by (simp add: Retracts.intro)
  4214   show ?thesis
  4215     using assms
  4216     apply (simp add: Borsukian_def, clarify)
  4217     apply (rule R.cohomotopically_trivial_retraction_null_gen [OF TrueI TrueI refl, of "-{0}"], auto)
  4218     done
  4219 qed
  4220 
  4221 lemma retract_of_Borsukian: "\<lbrakk>Borsukian T; S retract_of T\<rbrakk> \<Longrightarrow> Borsukian S"
  4222   apply (auto simp: retract_of_def retraction_def)
  4223   apply (erule (1) Borsukian_retraction_gen)
  4224   apply (meson retraction retraction_def)
  4225     apply (auto simp: continuous_on_id)
  4226     done
  4227 
  4228 lemma homeomorphic_Borsukian: "\<lbrakk>Borsukian S; S homeomorphic T\<rbrakk> \<Longrightarrow> Borsukian T"
  4229   using Borsukian_retraction_gen order_refl
  4230   by (fastforce simp add: homeomorphism_def homeomorphic_def)
  4231 
  4232 lemma homeomorphic_Borsukian_eq:
  4233    "S homeomorphic T \<Longrightarrow> Borsukian S \<longleftrightarrow> Borsukian T"
  4234   by (meson homeomorphic_Borsukian homeomorphic_sym)
  4235 
  4236 lemma Borsukian_translation:
  4237   fixes S :: "'a::real_normed_vector set"
  4238   shows "Borsukian (image (\<lambda>x. a + x) S) \<longleftrightarrow> Borsukian S"
  4239   apply (rule homeomorphic_Borsukian_eq)
  4240     using homeomorphic_translation homeomorphic_sym by blast
  4241 
  4242 lemma Borsukian_injective_linear_image:
  4243   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4244   assumes "linear f" "inj f"
  4245     shows "Borsukian(f ` S) \<longleftrightarrow> Borsukian S"
  4246   apply (rule homeomorphic_Borsukian_eq)
  4247   using assms homeomorphic_sym linear_homeomorphic_image by blast
  4248 
  4249 lemma homotopy_eqv_Borsukianness:
  4250   fixes S :: "'a::real_normed_vector set"
  4251     and T :: "'b::real_normed_vector set"
  4252    assumes "S homotopy_eqv T"
  4253      shows "(Borsukian S \<longleftrightarrow> Borsukian T)"
  4254   by (meson Borsukian_def assms homotopy_eqv_cohomotopic_triviality_null)
  4255 
  4256 lemma Borsukian_alt:
  4257   fixes S :: "'a::real_normed_vector set"
  4258   shows
  4259    "Borsukian S \<longleftrightarrow>
  4260         (\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> -{0} \<and>
  4261                continuous_on S g \<and> g ` S \<subseteq> -{0}
  4262                \<longrightarrow> homotopic_with (\<lambda>h. True) S (- {0::complex}) f g)"
  4263   unfolding Borsukian_def homotopic_triviality
  4264   by (simp add: path_connected_punctured_universe)
  4265 
  4266 lemma Borsukian_continuous_logarithm:
  4267   fixes S :: "'a::real_normed_vector set"
  4268   shows "Borsukian S \<longleftrightarrow>
  4269             (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> (- {0::complex})
  4270                  \<longrightarrow> (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))))"
  4271   by (simp add: Borsukian_def inessential_eq_continuous_logarithm)
  4272 
  4273 lemma Borsukian_continuous_logarithm_circle:
  4274   fixes S :: "'a::real_normed_vector set"
  4275   shows "Borsukian S \<longleftrightarrow>
  4276              (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
  4277                   \<longrightarrow> (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))))"
  4278    (is "?lhs = ?rhs")
  4279 proof
  4280   assume ?lhs then show ?rhs
  4281     by (force simp: Borsukian_continuous_logarithm)
  4282 next
  4283   assume RHS [rule_format]: ?rhs
  4284   show ?lhs
  4285   proof (clarsimp simp: Borsukian_continuous_logarithm)
  4286     fix f :: "'a \<Rightarrow> complex"
  4287     assume contf: "continuous_on S f" and 0: "0 \<notin> f ` S"
  4288     then have "continuous_on S (\<lambda>x. f x / complex_of_real (cmod (f x)))"
  4289       by (intro continuous_intros) auto
  4290     moreover have "(\<lambda>x. f x / complex_of_real (cmod (f x))) ` S \<subseteq> sphere 0 1"
  4291       using 0 by (auto simp: norm_divide)
  4292     ultimately obtain g where contg: "continuous_on S g"
  4293                   and fg: "\<forall>x \<in> S. f x / complex_of_real (cmod (f x)) = exp(g x)"
  4294       using RHS [of "\<lambda>x. f x / of_real(norm(f x))"] by auto
  4295     show "\<exists>g. continuous_on S g \<and> (\<forall>x\<in>S. f x = exp (g x))"
  4296     proof (intro exI ballI conjI)
  4297       show "continuous_on S (\<lambda>x. (Ln \<circ> of_real \<circ> norm \<circ> f)x + g x)"
  4298         by (intro continuous_intros contf contg conjI) (use "0" in auto)
  4299       show "f x = exp ((Ln \<circ> complex_of_real \<circ> cmod \<circ> f) x + g x)" if "x \<in> S" for x
  4300         using 0 that
  4301         apply (clarsimp simp: exp_add)
  4302         apply (subst exp_Ln, force)
  4303         by (metis eq_divide_eq exp_not_eq_zero fg mult.commute)
  4304     qed
  4305   qed
  4306 qed
  4307 
  4308 
  4309 lemma Borsukian_continuous_logarithm_circle_real:
  4310   fixes S :: "'a::real_normed_vector set"
  4311   shows "Borsukian S \<longleftrightarrow>
  4312          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
  4313               \<longrightarrow> (\<exists>g. continuous_on S (complex_of_real \<circ> g) \<and> (\<forall>x \<in> S. f x = exp(\<i> * of_real(g x)))))"
  4314    (is "?lhs = ?rhs")
  4315 proof
  4316   assume LHS: ?lhs
  4317   show ?rhs
  4318   proof (clarify)
  4319     fix f :: "'a \<Rightarrow> complex"
  4320     assume "continuous_on S f" and f01: "f ` S \<subseteq> sphere 0 1"
  4321     then obtain g where contg: "continuous_on S g" and "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  4322       using LHS by (auto simp: Borsukian_continuous_logarithm_circle)
  4323     then have "\<forall>x\<in>S. f x = exp (\<i> * complex_of_real ((Im \<circ> g) x))"
  4324       using f01 apply (simp add: image_iff subset_iff)
  4325         by (metis cis_conv_exp exp_eq_polar mult.left_neutral norm_exp_eq_Re of_real_1)
  4326     then show "\<exists>g. continuous_on S (complex_of_real \<circ> g) \<and> (\<forall>x\<in>S. f x = exp (\<i> * complex_of_real (g x)))"
  4327       by (rule_tac x="Im \<circ> g" in exI) (force intro: continuous_intros contg)
  4328   qed
  4329 next
  4330   assume RHS [rule_format]: ?rhs
  4331   show ?lhs
  4332   proof (clarsimp simp: Borsukian_continuous_logarithm_circle)
  4333     fix f :: "'a \<Rightarrow> complex"
  4334     assume "continuous_on S f" and f01: "f ` S \<subseteq> sphere 0 1"
  4335     then obtain g where contg: "continuous_on S (complex_of_real \<circ> g)" and "\<And>x. x \<in> S \<Longrightarrow> f x =  exp(\<i> * of_real(g x))"
  4336       by (metis RHS)
  4337     then show "\<exists>g. continuous_on S g \<and> (\<forall>x\<in>S. f x = exp (g x))"
  4338       by (rule_tac x="\<lambda>x. \<i>* of_real(g x)" in exI) (auto simp: continuous_intros contg)
  4339   qed
  4340 qed
  4341 
  4342 lemma Borsukian_circle:
  4343   fixes S :: "'a::real_normed_vector set"
  4344   shows "Borsukian S \<longleftrightarrow>
  4345          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
  4346               \<longrightarrow> (\<exists>a. homotopic_with (\<lambda>h. True) S (sphere (0::complex) 1) f (\<lambda>x. a)))"
  4347 by (simp add: inessential_eq_continuous_logarithm_circle Borsukian_continuous_logarithm_circle_real)
  4348 
  4349 lemma contractible_imp_Borsukian: "contractible S \<Longrightarrow> Borsukian S"
  4350   by (meson Borsukian_def nullhomotopic_from_contractible)
  4351 
  4352 lemma simply_connected_imp_Borsukian:
  4353   fixes S :: "'a::real_normed_vector set"
  4354   shows  "\<lbrakk>simply_connected S; locally path_connected S\<rbrakk> \<Longrightarrow> Borsukian S"
  4355   apply (simp add: Borsukian_continuous_logarithm)
  4356   by (metis (no_types, lifting) continuous_logarithm_on_simply_connected image_iff)
  4357 
  4358 lemma starlike_imp_Borsukian:
  4359   fixes S :: "'a::real_normed_vector set"
  4360   shows "starlike S \<Longrightarrow> Borsukian S"
  4361   by (simp add: contractible_imp_Borsukian starlike_imp_contractible)
  4362 
  4363 lemma Borsukian_empty: "Borsukian {}"
  4364   by (auto simp: contractible_imp_Borsukian)
  4365 
  4366 lemma Borsukian_UNIV: "Borsukian (UNIV :: 'a::real_normed_vector set)"
  4367   by (auto simp: contractible_imp_Borsukian)
  4368 
  4369 lemma convex_imp_Borsukian:
  4370   fixes S :: "'a::real_normed_vector set"
  4371   shows "convex S \<Longrightarrow> Borsukian S"
  4372   by (meson Borsukian_def convex_imp_contractible nullhomotopic_from_contractible)
  4373 
  4374 proposition Borsukian_sphere:
  4375   fixes a :: "'a::euclidean_space"
  4376   shows "3 \<le> DIM('a) \<Longrightarrow> Borsukian (sphere a r)"
  4377   apply (rule simply_connected_imp_Borsukian)
  4378   using simply_connected_sphere apply blast
  4379   using ENR_imp_locally_path_connected ENR_sphere by blast
  4380 
  4381 proposition Borsukian_open_Un:
  4382   fixes S :: "'a::real_normed_vector set"
  4383   assumes opeS: "openin (top_of_set (S \<union> T)) S"
  4384       and opeT: "openin (top_of_set (S \<union> T)) T"
  4385       and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
  4386     shows "Borsukian(S \<union> T)"
  4387 proof (clarsimp simp add: Borsukian_continuous_logarithm)
  4388   fix f :: "'a \<Rightarrow> complex"
  4389   assume contf: "continuous_on (S \<union> T) f" and 0: "0 \<notin> f ` (S \<union> T)"
  4390   then have contfS: "continuous_on S f" and contfT: "continuous_on T f"
  4391     using continuous_on_subset by auto
  4392   have "\<lbrakk>continuous_on S f; f ` S \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))"
  4393     using BS by (auto simp: Borsukian_continuous_logarithm)
  4394   then obtain g where contg: "continuous_on S g" and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  4395     using "0" contfS by blast
  4396   have "\<lbrakk>continuous_on T f; f ` T \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on T g \<and> (\<forall>x \<in> T. f x = exp(g x))"
  4397     using BT by (auto simp: Borsukian_continuous_logarithm)
  4398   then obtain h where conth: "continuous_on T h" and fh: "\<And>x. x \<in> T \<Longrightarrow> f x = exp(h x)"
  4399     using "0" contfT by blast
  4400   show "\<exists>g. continuous_on (S \<union> T) g \<and> (\<forall>x\<in>S \<union> T. f x = exp (g x))"
  4401   proof (cases "S \<inter> T = {}")
  4402     case True
  4403     show ?thesis
  4404     proof (intro exI conjI)
  4405       show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
  4406         apply (rule continuous_on_cases_local_open [OF opeS opeT contg conth])
  4407         using True by blast
  4408       show "\<forall>x\<in>S \<union> T. f x = exp (if x \<in> S then g x else h x)"
  4409         using fg fh by auto
  4410     qed
  4411   next
  4412     case False
  4413     have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
  4414     proof (rule continuous_discrete_range_constant [OF ST])
  4415       show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
  4416         apply (intro continuous_intros)
  4417         apply (meson contg continuous_on_subset inf_le1)
  4418         by (meson conth continuous_on_subset inf_sup_ord(2))
  4419       show "\<exists>e>0. \<forall>y. y \<in> S \<inter> T \<and> g y - h y \<noteq> g x - h x \<longrightarrow> e \<le> cmod (g y - h y - (g x - h x))"
  4420            if "x \<in> S \<inter> T" for x
  4421       proof -
  4422         have "g y - g x = h y - h x"
  4423               if "y \<in> S" "y \<in> T" "cmod (g y - g x - (h y - h x)) < 2 * pi" for y
  4424         proof (rule exp_complex_eqI)
  4425           have "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> \<le> cmod (g y - g x - (h y - h x))"
  4426             by (metis abs_Im_le_cmod minus_complex.simps(2))
  4427           then show "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> < 2 * pi"
  4428             using that by linarith
  4429           have "exp (g x) = exp (h x)" "exp (g y) = exp (h y)"
  4430             using fg fh that \<open>x \<in> S \<inter> T\<close> by fastforce+
  4431           then show "exp (g y - g x) = exp (h y - h x)"
  4432             by (simp add: exp_diff)
  4433         qed
  4434         then show ?thesis
  4435           by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
  4436       qed
  4437     qed 
  4438     then obtain a where a: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = a"
  4439       by (auto simp: constant_on_def)
  4440     with False have "exp a = 1"
  4441       by (metis IntI disjoint_iff_not_equal divide_self_if exp_diff exp_not_eq_zero fg fh)
  4442     with a show ?thesis
  4443       apply (rule_tac x="\<lambda>x. if x \<in> S then g x else a + h x" in exI)
  4444       apply (intro continuous_on_cases_local_open opeS opeT contg conth continuous_intros conjI)
  4445        apply (auto simp: algebra_simps fg fh exp_add)
  4446       done
  4447   qed
  4448 qed
  4449 
  4450 text\<open>The proof is a duplicate of that of \<open>Borsukian_open_Un\<close>.\<close>
  4451 lemma Borsukian_closed_Un:
  4452   fixes S :: "'a::real_normed_vector set"
  4453   assumes cloS: "closedin (top_of_set (S \<union> T)) S"
  4454       and cloT: "closedin (top_of_set (S \<union> T)) T"
  4455       and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
  4456     shows "Borsukian(S \<union> T)"
  4457 proof (clarsimp simp add: Borsukian_continuous_logarithm)
  4458   fix f :: "'a \<Rightarrow> complex"
  4459   assume contf: "continuous_on (S \<union> T) f" and 0: "0 \<notin> f ` (S \<union> T)"
  4460   then have contfS: "continuous_on S f" and contfT: "continuous_on T f"
  4461     using continuous_on_subset by auto
  4462   have "\<lbrakk>continuous_on S f; f ` S \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))"
  4463     using BS by (auto simp: Borsukian_continuous_logarithm)
  4464   then obtain g where contg: "continuous_on S g" and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  4465     using "0" contfS by blast
  4466   have "\<lbrakk>continuous_on T f; f ` T \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on T g \<and> (\<forall>x \<in> T. f x = exp(g x))"
  4467     using BT by (auto simp: Borsukian_continuous_logarithm)
  4468   then obtain h where conth: "continuous_on T h" and fh: "\<And>x. x \<in> T \<Longrightarrow> f x = exp(h x)"
  4469     using "0" contfT by blast
  4470   show "\<exists>g. continuous_on (S \<union> T) g \<and> (\<forall>x\<in>S \<union> T. f x = exp (g x))"
  4471   proof (cases "S \<inter> T = {}")
  4472     case True
  4473     show ?thesis
  4474     proof (intro exI conjI)
  4475       show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
  4476         apply (rule continuous_on_cases_local [OF cloS cloT contg conth])
  4477         using True by blast
  4478       show "\<forall>x\<in>S \<union> T. f x = exp (if x \<in> S then g x else h x)"
  4479         using fg fh by auto
  4480     qed
  4481   next
  4482     case False
  4483     have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
  4484     proof (rule continuous_discrete_range_constant [OF ST])
  4485       show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
  4486         apply (intro continuous_intros)
  4487         apply (meson contg continuous_on_subset inf_le1)
  4488         by (meson conth continuous_on_subset inf_sup_ord(2))
  4489       show "\<exists>e>0. \<forall>y. y \<in> S \<inter> T \<and> g y - h y \<noteq> g x - h x \<longrightarrow> e \<le> cmod (g y - h y - (g x - h x))"
  4490            if "x \<in> S \<inter> T" for x
  4491       proof -
  4492         have "g y - g x = h y - h x"
  4493               if "y \<in> S" "y \<in> T" "cmod (g y - g x - (h y - h x)) < 2 * pi" for y
  4494         proof (rule exp_complex_eqI)
  4495           have "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> \<le> cmod (g y - g x - (h y - h x))"
  4496             by (metis abs_Im_le_cmod minus_complex.simps(2))
  4497           then show "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> < 2 * pi"
  4498             using that by linarith
  4499           have "exp (g x) = exp (h x)" "exp (g y) = exp (h y)"
  4500             using fg fh that \<open>x \<in> S \<inter> T\<close> by fastforce+
  4501           then show "exp (g y - g x) = exp (h y - h x)"
  4502             by (simp add: exp_diff)
  4503         qed
  4504         then show ?thesis
  4505           by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
  4506       qed
  4507     qed
  4508     then obtain a where a: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = a"
  4509       by (auto simp: constant_on_def)
  4510     with False have "exp a = 1"
  4511       by (metis IntI disjoint_iff_not_equal divide_self_if exp_diff exp_not_eq_zero fg fh)
  4512     with a show ?thesis
  4513       apply (rule_tac x="\<lambda>x. if x \<in> S then g x else a + h x" in exI)
  4514       apply (intro continuous_on_cases_local cloS cloT contg conth continuous_intros conjI)
  4515        apply (auto simp: algebra_simps fg fh exp_add)
  4516       done
  4517   qed
  4518 qed
  4519 
  4520 lemma Borsukian_separation_compact:
  4521   fixes S :: "complex set"
  4522   assumes "compact S"
  4523     shows "Borsukian S \<longleftrightarrow> connected(- S)"
  4524   by (simp add: Borsuk_separation_theorem Borsukian_circle assms)
  4525 
  4526 lemma Borsukian_monotone_image_compact:
  4527   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4528   assumes "Borsukian S" and contf: "continuous_on S f" and fim: "f ` S = T"
  4529       and "compact S" and conn: "\<And>y. y \<in> T \<Longrightarrow> connected {x. x \<in> S \<and> f x = y}"
  4530     shows "Borsukian T"
  4531 proof (clarsimp simp add: Borsukian_continuous_logarithm)
  4532   fix g :: "'b \<Rightarrow> complex"
  4533   assume contg: "continuous_on T g" and 0: "0 \<notin> g ` T"
  4534   have "continuous_on S (g \<circ> f)"
  4535     using contf contg continuous_on_compose fim by blast
  4536   moreover have "(g \<circ> f) ` S \<subseteq> -{0}"
  4537     using fim 0 by auto
  4538   ultimately obtain h where conth: "continuous_on S h" and gfh: "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> f) x = exp(h x)"
  4539     using \<open>Borsukian S\<close> by (auto simp: Borsukian_continuous_logarithm)
  4540   have "\<And>y. \<exists>x. y \<in> T \<longrightarrow> x \<in> S \<and> f x = y"
  4541     using fim by auto
  4542   then obtain f' where f': "\<And>y. y \<in> T \<longrightarrow> f' y \<in> S \<and> f (f' y) = y"
  4543     by metis
  4544   have *: "(\<lambda>x. h x - h(f' y)) constant_on {x. x \<in> S \<and> f x = y}" if "y \<in> T" for y
  4545   proof (rule continuous_discrete_range_constant [OF conn [OF that], of "\<lambda>x. h x - h (f' y)"], simp_all add: algebra_simps)
  4546     show "continuous_on {x \<in> S. f x = y} (\<lambda>x. h x - h (f' y))"
  4547       by (intro continuous_intros continuous_on_subset [OF conth]) auto
  4548     show "\<exists>e>0. \<forall>u. u \<in> S \<and> f u = y \<and> h u \<noteq> h x \<longrightarrow> e \<le> cmod (h u - h x)"
  4549       if x: "x \<in> S \<and> f x = y" for x
  4550     proof -
  4551       have "h u = h x" if "u \<in> S" "f u = y" "cmod (h u - h x) < 2 * pi" for u
  4552       proof (rule exp_complex_eqI)
  4553         have "\<bar>Im (h u) - Im (h x)\<bar> \<le> cmod (h u - h x)"
  4554           by (metis abs_Im_le_cmod minus_complex.simps(2))
  4555         then show "\<bar>Im (h u) - Im (h x)\<bar> < 2 * pi"
  4556           using that by linarith
  4557         show "exp (h u) = exp (h x)"
  4558           by (simp add: gfh [symmetric] x that)
  4559       qed
  4560       then show ?thesis
  4561         by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
  4562     qed
  4563   qed 
  4564   have "h x = h (f' (f x))" if "x \<in> S" for x
  4565     using * [of "f x"] fim that unfolding constant_on_def by clarsimp (metis f' imageI right_minus_eq)
  4566   moreover have "\<And>x. x \<in> T \<Longrightarrow> \<exists>u. u \<in> S \<and> x = f u \<and> h (f' x) = h u"
  4567     using f' by fastforce
  4568   ultimately
  4569   have eq: "((\<lambda>x. (x, (h \<circ> f') x)) ` T) =
  4570             {p. \<exists>x. x \<in> S \<and> (x, p) \<in> (S \<times> UNIV) \<inter> ((\<lambda>z. snd z - ((f \<circ> fst) z, (h \<circ> fst) z)) -` {0})}"
  4571     using fim by (auto simp: image_iff)
  4572   show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (h x))"
  4573   proof (intro exI conjI)
  4574     show "continuous_on T (h \<circ> f')"
  4575     proof (rule continuous_from_closed_graph [of "h ` S"])
  4576       show "compact (h ` S)"
  4577         by (simp add: \<open>compact S\<close> compact_continuous_image conth)
  4578       show "(h \<circ> f') ` T \<subseteq> h ` S"
  4579         by (auto simp: f')
  4580       show "closed ((\<lambda>x. (x, (h \<circ> f') x)) ` T)"
  4581         apply (subst eq)
  4582         apply (intro closed_compact_projection [OF \<open>compact S\<close>] continuous_closed_preimage
  4583                      continuous_intros continuous_on_subset [OF contf] continuous_on_subset [OF conth])
  4584            apply (auto simp: \<open>compact S\<close> closed_Times compact_imp_closed)
  4585         done
  4586     qed
  4587   qed (use f' gfh in fastforce)
  4588 qed
  4589 
  4590 
  4591 lemma Borsukian_open_map_image_compact:
  4592   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4593   assumes "Borsukian S" and contf: "continuous_on S f" and fim: "f ` S = T" and "compact S"
  4594       and ope: "\<And>U. openin (top_of_set S) U
  4595                      \<Longrightarrow> openin (top_of_set T) (f ` U)"
  4596     shows "Borsukian T"
  4597 proof (clarsimp simp add: Borsukian_continuous_logarithm_circle_real)
  4598   fix g :: "'b \<Rightarrow> complex"
  4599   assume contg: "continuous_on T g" and gim: "g ` T \<subseteq> sphere 0 1"
  4600   have "continuous_on S (g \<circ> f)"
  4601     using contf contg continuous_on_compose fim by blast
  4602   moreover have "(g \<circ> f) ` S \<subseteq> sphere 0 1"
  4603     using fim gim by auto
  4604   ultimately obtain h where cont_cxh: "continuous_on S (complex_of_real \<circ> h)"
  4605                        and gfh: "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> f) x = exp(\<i> * of_real(h x))"
  4606     using \<open>Borsukian S\<close> Borsukian_continuous_logarithm_circle_real  by metis
  4607   then have conth: "continuous_on S h"
  4608     by simp
  4609   have "\<exists>x. x \<in> S \<and> f x = y \<and> (\<forall>x' \<in> S. f x' = y \<longrightarrow> h x \<le> h x')" if "y \<in> T" for y
  4610   proof -
  4611     have 1: "compact (h ` {x \<in> S. f x = y})"
  4612     proof (rule compact_continuous_image)
  4613       show "continuous_on {x \<in> S. f x = y} h"
  4614         by (rule continuous_on_subset [OF conth]) auto
  4615       have "compact (S \<inter> f -` {y})"
  4616         by (rule proper_map_from_compact [OF contf _ \<open>compact S\<close>, of T]) (simp_all add: fim that)
  4617       then show "compact {x \<in> S. f x = y}" 
  4618         by (auto simp: vimage_def Int_def)
  4619     qed
  4620     have 2: "h ` {x \<in> S. f x = y} \<noteq> {}"
  4621       using fim that by auto
  4622     have "\<exists>s \<in> h ` {x \<in> S. f x = y}. \<forall>t \<in> h ` {x \<in> S. f x = y}. s \<le> t"
  4623       using compact_attains_inf [OF 1 2] by blast
  4624     then show ?thesis by auto
  4625   qed
  4626   then obtain k where kTS: "\<And>y. y \<in> T \<Longrightarrow> k y \<in> S"
  4627                   and fk:  "\<And>y. y \<in> T \<Longrightarrow> f (k y) = y "
  4628                   and hle: "\<And>x' y. \<lbrakk>y \<in> T; x' \<in> S; f x' = y\<rbrakk> \<Longrightarrow> h (k y) \<le> h x'"
  4629     by metis
  4630   have "continuous_on T (h \<circ> k)"
  4631   proof (clarsimp simp add: continuous_on_iff)
  4632     fix y and e::real
  4633     assume "y \<in> T" "0 < e"
  4634     moreover have "uniformly_continuous_on S (complex_of_real \<circ> h)"
  4635       using \<open>compact S\<close> cont_cxh compact_uniformly_continuous by blast
  4636     ultimately obtain d where "0 < d"
  4637                   and d: "\<And>x x'. \<lbrakk>x\<in>S; x'\<in>S; dist x' x < d\<rbrakk> \<Longrightarrow> dist (h x') (h x) < e"
  4638       by (force simp: uniformly_continuous_on_def)
  4639     obtain \<delta> where "0 < \<delta>" and \<delta>:
  4640       "\<And>x'. \<lbrakk>x' \<in> T; dist y x' < \<delta>\<rbrakk>
  4641                \<Longrightarrow> (\<forall>v \<in> {z \<in> S. f z = y}. \<exists>v'. v' \<in> {z \<in> S. f z = x'} \<and> dist v v' < d) \<and>
  4642                    (\<forall>v' \<in> {z \<in> S. f z = x'}. \<exists>v. v \<in> {z \<in> S. f z = y} \<and> dist v' v < d)"
  4643     proof (rule upper_lower_hemicontinuous_explicit [of T "\<lambda>y. {z \<in> S. f z = y}" S])
  4644       show "\<And>U. openin (top_of_set S) U
  4645                  \<Longrightarrow> openin (top_of_set T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
  4646         using continuous_imp_closed_map closed_map_iff_upper_hemicontinuous_preimage [OF fim [THEN equalityD1]]
  4647         by (simp add: continuous_imp_closed_map \<open>compact S\<close> contf fim)
  4648       show "\<And>U. closedin (top_of_set S) U \<Longrightarrow>
  4649                  closedin (top_of_set T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
  4650         using  ope open_map_iff_lower_hemicontinuous_preimage [OF fim [THEN equalityD1]]
  4651         by meson
  4652       show "bounded {z \<in> S. f z = y}"
  4653         by (metis (no_types, lifting) compact_imp_bounded [OF \<open>compact S\<close>] bounded_subset mem_Collect_eq subsetI)
  4654     qed (use \<open>y \<in> T\<close> \<open>0 < d\<close> fk kTS in \<open>force+\<close>)
  4655     have "dist (h (k y')) (h (k y)) < e" if "y' \<in> T" "dist y y' < \<delta>" for y'
  4656     proof -
  4657       have k1: "k y \<in> S" "f (k y) = y" and k2: "k y' \<in> S" "f (k y') = y'"
  4658         by (auto simp: \<open>y \<in> T\<close> \<open>y' \<in> T\<close> kTS fk)
  4659       have 1: "\<And>v. \<lbrakk>v \<in> S; f v = y\<rbrakk> \<Longrightarrow> \<exists>v'. v' \<in> {z \<in> S. f z = y'} \<and> dist v v' < d"
  4660        and 2: "\<And>v'. \<lbrakk>v' \<in> S; f v' = y'\<rbrakk> \<Longrightarrow> \<exists>v. v \<in> {z \<in> S. f z = y} \<and> dist v' v < d"
  4661         using \<delta> [OF that] by auto
  4662       then obtain w' w where "w' \<in> S" "f w' = y'" "dist (k y) w' < d"
  4663         and "w \<in> S" "f w = y" "dist (k y') w < d"
  4664         using 1 [OF k1] 2 [OF k2] by auto
  4665       then show ?thesis
  4666         using d [of w "k y'"] d [of w' "k y"] k1 k2 \<open>y' \<in> T\<close>  \<open>y \<in> T\<close> hle
  4667         by (fastforce simp: dist_norm abs_diff_less_iff algebra_simps)
  4668     qed
  4669     then show "\<exists>d>0. \<forall>x'\<in>T. dist x' y < d \<longrightarrow> dist (h (k x')) (h (k y)) < e"
  4670       using  \<open>0 < \<delta>\<close> by (auto simp: dist_commute)
  4671   qed
  4672   then show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (\<i> * complex_of_real (h x)))"
  4673     using fk gfh kTS by force
  4674 qed
  4675 
  4676 
  4677 text\<open>If two points are separated by a closed set, there's a minimal one.\<close>
  4678 proposition closed_irreducible_separator:
  4679   fixes a :: "'a::real_normed_vector"
  4680   assumes "closed S" and ab: "\<not> connected_component (- S) a b"
  4681   obtains T where "T \<subseteq> S" "closed T" "T \<noteq> {}" "\<not> connected_component (- T) a b"
  4682                   "\<And>U. U \<subset> T \<Longrightarrow> connected_component (- U) a b"
  4683 proof (cases "a \<in> S \<or> b \<in> S")
  4684   case True
  4685   then show ?thesis
  4686   proof
  4687     assume *: "a \<in> S"
  4688     show ?thesis
  4689     proof
  4690       show "{a} \<subseteq> S"
  4691         using * by blast
  4692       show "\<not> connected_component (- {a}) a b"
  4693         using connected_component_in by auto
  4694       show "\<And>U. U \<subset> {a} \<Longrightarrow> connected_component (- U) a b"
  4695         by (metis connected_component_UNIV UNIV_I compl_bot_eq connected_component_eq_eq less_le_not_le subset_singletonD)
  4696     qed auto
  4697   next
  4698     assume *: "b \<in> S"
  4699     show ?thesis
  4700     proof
  4701       show "{b} \<subseteq> S"
  4702         using * by blast
  4703       show "\<not> connected_component (- {b}) a b"
  4704         using connected_component_in by auto
  4705       show "\<And>U. U \<subset> {b} \<Longrightarrow> connected_component (- U) a b"
  4706         by (metis connected_component_UNIV UNIV_I compl_bot_eq connected_component_eq_eq less_le_not_le subset_singletonD)
  4707     qed auto
  4708   qed
  4709 next
  4710   case False
  4711   define A where "A \<equiv> connected_component_set (- S) a"
  4712   define B where "B \<equiv> connected_component_set (- (closure A)) b"
  4713   have "a \<in> A"
  4714     using False A_def by auto
  4715   have "b \<in> B"
  4716     unfolding A_def B_def closure_Un_frontier
  4717     using ab False \<open>closed S\<close> frontier_complement frontier_of_connected_component_subset frontier_subset_closed by force
  4718   have "frontier B \<subseteq> frontier (connected_component_set (- closure A) b)"
  4719     using B_def by blast
  4720   also have frsub: "... \<subseteq> frontier A"
  4721   proof -
  4722     have "\<And>A. closure (- closure (- A)) \<subseteq> closure A"
  4723       by (metis (no_types) closure_mono closure_subset compl_le_compl_iff double_compl)
  4724     then show ?thesis
  4725       by (metis (no_types) closure_closure double_compl frontier_closures frontier_of_connected_component_subset le_inf_iff subset_trans)
  4726   qed
  4727   finally have frBA: "frontier B \<subseteq> frontier A" .
  4728   show ?thesis
  4729   proof
  4730     show "frontier B \<subseteq> S"
  4731     proof -
  4732       have "frontier S \<subseteq> S"
  4733         by (simp add: \<open>closed S\<close> frontier_subset_closed)
  4734       then show ?thesis
  4735         using frsub frontier_complement frontier_of_connected_component_subset
  4736         unfolding A_def B_def by blast
  4737     qed
  4738     show "closed (frontier B)"
  4739       by simp
  4740     show "\<not> connected_component (- frontier B) a b"
  4741       unfolding connected_component_def
  4742     proof clarify
  4743       fix T
  4744       assume "connected T" and TB: "T \<subseteq> - frontier B" and "a \<in> T" and "b \<in> T"
  4745       have "a \<notin> B"
  4746         by (metis A_def B_def ComplD \<open>a \<in> A\<close> assms(1) closed_open connected_component_subset in_closure_connected_component subsetD)
  4747       have "T \<inter> B \<noteq> {}"
  4748         using \<open>b \<in> B\<close> \<open>b \<in> T\<close> by blast
  4749       moreover have "T - B \<noteq> {}"
  4750         using \<open>a \<notin> B\<close> \<open>a \<in> T\<close> by blast
  4751       ultimately show "False"
  4752         using connected_Int_frontier [of T B] TB \<open>connected T\<close> by blast
  4753     qed
  4754     moreover have "connected_component (- frontier B) a b" if "frontier B = {}"
  4755       apply (simp add: that)
  4756       using connected_component_eq_UNIV by blast
  4757     ultimately show "frontier B \<noteq> {}"
  4758       by blast
  4759     show "connected_component (- U) a b" if "U \<subset> frontier B" for U
  4760     proof -
  4761       obtain p where Usub: "U \<subseteq> frontier B" and p: "p \<in> frontier B" "p \<notin> U"
  4762         using \<open>U \<subset> frontier B\<close> by blast
  4763       show ?thesis
  4764         unfolding connected_component_def
  4765       proof (intro exI conjI)
  4766         have "connected ((insert p A) \<union> (insert p B))"
  4767         proof (rule connected_Un)
  4768           show "connected (insert p A)"
  4769             by (metis A_def IntD1 frBA \<open>p \<in> frontier B\<close> closure_insert closure_subset connected_connected_component connected_intermediate_closure frontier_closures insert_absorb subsetCE subset_insertI)
  4770           show "connected (insert p B)"
  4771             by (metis B_def IntD1 \<open>p \<in> frontier B\<close> closure_insert closure_subset connected_connected_component connected_intermediate_closure frontier_closures insert_absorb subset_insertI)
  4772         qed blast
  4773         then show "connected (insert p (B \<union> A))"
  4774           by (simp add: sup.commute)
  4775         have "A \<subseteq> - U"
  4776           using A_def Usub \<open>frontier B \<subseteq> S\<close> connected_component_subset by fastforce
  4777         moreover have "B \<subseteq> - U"
  4778           using B_def Usub connected_component_subset frBA frontier_closures by fastforce
  4779         ultimately show "insert p (B \<union> A) \<subseteq> - U"
  4780           using p by auto
  4781       qed (auto simp: \<open>a \<in> A\<close> \<open>b \<in> B\<close>)
  4782     qed
  4783   qed
  4784 qed
  4785 
  4786 lemma frontier_minimal_separating_closed_pointwise:
  4787   fixes S :: "'a::real_normed_vector set"
  4788   assumes S: "closed S" "a \<notin> S" and nconn: "\<not> connected_component (- S) a b"
  4789       and conn: "\<And>T. \<lbrakk>closed T; T \<subset> S\<rbrakk> \<Longrightarrow> connected_component (- T) a b"
  4790     shows "frontier(connected_component_set (- S) a) = S" (is "?F = S")
  4791 proof -
  4792   have "?F \<subseteq> S"
  4793     by (simp add: S componentsI frontier_of_components_closed_complement)
  4794   moreover have False if "?F \<subset> S"
  4795   proof -
  4796     have "connected_component (- ?F) a b"
  4797       by (simp add: conn that)
  4798     then obtain T where "connected T" "T \<subseteq> -?F" "a \<in> T" "b \<in> T"
  4799       by (auto simp: connected_component_def)
  4800     moreover have "T \<inter> ?F \<noteq> {}"
  4801     proof (rule connected_Int_frontier [OF \<open>connected T\<close>])
  4802       show "T \<inter> connected_component_set (- S) a \<noteq> {}"
  4803         using \<open>a \<notin> S\<close> \<open>a \<in> T\<close> by fastforce
  4804       show "T - connected_component_set (- S) a \<noteq> {}"
  4805         using \<open>b \<in> T\<close> nconn by blast
  4806     qed
  4807     ultimately show ?thesis
  4808       by blast
  4809   qed
  4810   ultimately show ?thesis
  4811     by blast
  4812 qed
  4813 
  4814 
  4815 subsection\<open>Unicoherence (closed)\<close>
  4816 
  4817 definition%important unicoherent where
  4818   "unicoherent U \<equiv>
  4819   \<forall>S T. connected S \<and> connected T \<and> S \<union> T = U \<and>
  4820         closedin (top_of_set U) S \<and> closedin (top_of_set U) T
  4821         \<longrightarrow> connected (S \<inter> T)"
  4822 
  4823 lemma unicoherentI [intro?]:
  4824   assumes "\<And>S T. \<lbrakk>connected S; connected T; U = S \<union> T; closedin (top_of_set U) S; closedin (top_of_set U) T\<rbrakk>
  4825           \<Longrightarrow> connected (S \<inter> T)"
  4826   shows "unicoherent U"
  4827   using assms unfolding unicoherent_def by blast
  4828 
  4829 lemma unicoherentD:
  4830   assumes "unicoherent U" "connected S" "connected T" "U = S \<union> T" "closedin (top_of_set U) S" "closedin (top_of_set U) T"
  4831   shows "connected (S \<inter> T)"
  4832   using assms unfolding unicoherent_def by blast
  4833 
  4834 proposition homeomorphic_unicoherent:
  4835   assumes ST: "S homeomorphic T" and S: "unicoherent S"
  4836   shows "unicoherent T"
  4837 proof -
  4838   obtain f g where gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x" and fim: "T = f ` S" and gfim: "g ` f ` S = S"
  4839     and contf: "continuous_on S f" and contg: "continuous_on (f ` S) g"
  4840     using ST by (auto simp: homeomorphic_def homeomorphism_def)
  4841   show ?thesis
  4842   proof
  4843     fix U V
  4844     assume "connected U" "connected V" and T: "T = U \<union> V"
  4845       and cloU: "closedin (top_of_set T) U"
  4846       and cloV: "closedin (top_of_set T) V"
  4847     have "f ` (g ` U \<inter> g ` V) \<subseteq> U" "f ` (g ` U \<inter> g ` V) \<subseteq> V"
  4848       using gf fim T by auto (metis UnCI image_iff)+
  4849     moreover have "U \<inter> V \<subseteq> f ` (g ` U \<inter> g ` V)"
  4850       using gf fim by (force simp: image_iff T)
  4851     ultimately have "U \<inter> V = f ` (g ` U \<inter> g ` V)" by blast
  4852     moreover have "connected (f ` (g ` U \<inter> g ` V))"
  4853     proof (rule connected_continuous_image)
  4854       show "continuous_on (g ` U \<inter> g ` V) f"
  4855         apply (rule continuous_on_subset [OF contf])
  4856         using T fim gfim by blast
  4857       show "connected (g ` U \<inter> g ` V)"
  4858       proof (intro conjI unicoherentD [OF S])
  4859         show "connected (g ` U)" "connected (g ` V)"
  4860           using \<open>connected U\<close> cloU \<open>connected V\<close> cloV
  4861           by (metis Topological_Spaces.connected_continuous_image closedin_imp_subset contg continuous_on_subset fim)+
  4862         show "S = g ` U \<union> g ` V"
  4863           using T fim gfim by auto
  4864         have hom: "homeomorphism T S g f"
  4865           by (simp add: contf contg fim gf gfim homeomorphism_def)
  4866         have "closedin (top_of_set T) U" "closedin (top_of_set T) V"
  4867           by (simp_all add: cloU cloV)
  4868         then show "closedin (top_of_set S) (g ` U)"
  4869                   "closedin (top_of_set S) (g ` V)"
  4870           by (blast intro: homeomorphism_imp_closed_map [OF hom])+
  4871       qed
  4872     qed
  4873     ultimately show "connected (U \<inter> V)" by metis
  4874   qed
  4875 qed
  4876 
  4877 
  4878 lemma homeomorphic_unicoherent_eq:
  4879    "S homeomorphic T \<Longrightarrow> (unicoherent S \<longleftrightarrow> unicoherent T)"
  4880   by (meson homeomorphic_sym homeomorphic_unicoherent)
  4881 
  4882 lemma unicoherent_translation:
  4883   fixes S :: "'a::real_normed_vector set"
  4884   shows
  4885    "unicoherent (image (\<lambda>x. a + x) S) \<longleftrightarrow> unicoherent S"
  4886   using homeomorphic_translation homeomorphic_unicoherent_eq by blast
  4887 
  4888 lemma unicoherent_injective_linear_image:
  4889   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4890   assumes "linear f" "inj f"
  4891   shows "(unicoherent(f ` S) \<longleftrightarrow> unicoherent S)"
  4892   using assms homeomorphic_unicoherent_eq linear_homeomorphic_image by blast
  4893 
  4894 
  4895 lemma Borsukian_imp_unicoherent:
  4896   fixes U :: "'a::euclidean_space set"
  4897   assumes "Borsukian U"  shows "unicoherent U"
  4898   unfolding unicoherent_def
  4899 proof clarify
  4900   fix S T
  4901   assume "connected S" "connected T" "U = S \<union> T"
  4902      and cloS: "closedin (top_of_set (S \<union> T)) S"
  4903      and cloT: "closedin (top_of_set (S \<union> T)) T"
  4904   show "connected (S \<inter> T)"
  4905     unfolding connected_closedin_eq
  4906   proof clarify
  4907     fix V W
  4908     assume "closedin (top_of_set (S \<inter> T)) V"
  4909        and "closedin (top_of_set (S \<inter> T)) W"
  4910        and VW: "V \<union> W = S \<inter> T" "V \<inter> W = {}" and "V \<noteq> {}" "W \<noteq> {}"
  4911     then have cloV: "closedin (top_of_set U) V" and cloW: "closedin (top_of_set U) W"
  4912       using \<open>U = S \<union> T\<close> cloS cloT closedin_trans by blast+
  4913     obtain q where contq: "continuous_on U q"
  4914          and q01: "\<And>x. x \<in> U \<Longrightarrow> q x \<in> {0..1::real}"
  4915          and qV: "\<And>x. x \<in> V \<Longrightarrow> q x = 0" and qW: "\<And>x. x \<in> W \<Longrightarrow> q x = 1"
  4916       by (rule Urysohn_local [OF cloV cloW \<open>V \<inter> W = {}\<close>, of 0 1])
  4917          (fastforce simp: closed_segment_eq_real_ivl)
  4918     let ?h = "\<lambda>x. if x \<in> S then exp(pi * \<i> * q x) else 1 / exp(pi * \<i> * q x)"
  4919     have eqST: "exp(pi * \<i> * q x) = 1 / exp(pi * \<i> * q x)" if "x \<in> S \<inter> T" for x
  4920     proof -
  4921       have "x \<in> V \<union> W"
  4922         using that \<open>V \<union> W = S \<inter> T\<close> by blast
  4923       with qV qW show ?thesis by force
  4924     qed
  4925     obtain g where contg: "continuous_on U g"
  4926       and circle: "g ` U \<subseteq> sphere 0 1"
  4927       and S: "\<And>x. x \<in> S \<Longrightarrow> g x = exp(pi * \<i> * q x)"
  4928       and T: "\<And>x. x \<in> T \<Longrightarrow> g x = 1 / exp(pi * \<i> * q x)"
  4929     proof
  4930       show "continuous_on U ?h"
  4931         unfolding \<open>U = S \<union> T\<close>
  4932       proof (rule continuous_on_cases_local [OF cloS cloT])
  4933         show "continuous_on S (\<lambda>x. exp (pi * \<i> * q x))"
  4934           apply (intro continuous_intros)
  4935           using \<open>U = S \<union> T\<close> continuous_on_subset contq by blast
  4936         show "continuous_on T (\<lambda>x. 1 / exp (pi * \<i> * q x))"
  4937           apply (intro continuous_intros)
  4938           using \<open>U = S \<union> T\<close> continuous_on_subset contq by auto
  4939       qed (use eqST in auto)
  4940     qed (use eqST in \<open>auto simp: norm_divide\<close>)
  4941     then obtain h where conth: "continuous_on U h" and heq: "\<And>x. x \<in> U \<Longrightarrow> g x = exp (h x)"
  4942       by (metis Borsukian_continuous_logarithm_circle assms)
  4943     obtain v w where "v \<in> V" "w \<in> W"
  4944       using \<open>V \<noteq> {}\<close> \<open>W \<noteq> {}\<close> by blast
  4945     then have vw: "v \<in> S \<inter> T" "w \<in> S \<inter> T"
  4946       using VW by auto
  4947     have iff: "2 * pi \<le> cmod (2 * of_int m * of_real pi * \<i> - 2 * of_int n * of_real pi * \<i>)
  4948           \<longleftrightarrow> 1 \<le> abs (m - n)" for m n
  4949     proof -
  4950       have "2 * pi \<le> cmod (2 * of_int m * of_real pi * \<i> - 2 * of_int n * of_real pi * \<i>)
  4951             \<longleftrightarrow> 2 * pi \<le> cmod ((2 * pi * \<i>) * (of_int m - of_int n))"
  4952         by (simp add: algebra_simps)
  4953       also have "... \<longleftrightarrow> 2 * pi \<le> 2 * pi * cmod (of_int m - of_int n)"
  4954         by (simp add: norm_mult)
  4955       also have "... \<longleftrightarrow> 1 \<le> abs (m - n)"
  4956         by simp (metis norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
  4957       finally show ?thesis .
  4958     qed
  4959     have *: "\<exists>n::int. h x - (pi * \<i> * q x) = (of_int(2*n) * pi) * \<i>" if "x \<in> S" for x
  4960       using that S \<open>U = S \<union> T\<close> heq exp_eq [symmetric] by (simp add: algebra_simps)
  4961     moreover have "(\<lambda>x. h x - (pi * \<i> * q x)) constant_on S"
  4962     proof (rule continuous_discrete_range_constant [OF \<open>connected S\<close>])
  4963       have "continuous_on S h" "continuous_on S q"
  4964         using \<open>U = S \<union> T\<close> continuous_on_subset conth contq by blast+
  4965       then show "continuous_on S (\<lambda>x. h x - (pi * \<i> * q x))"
  4966         by (intro continuous_intros)
  4967       have "2*pi \<le> cmod (h y - (pi * \<i> * q y) - (h x - (pi * \<i> * q x)))"
  4968         if "x \<in> S" "y \<in> S" and ne: "h y - (pi * \<i> * q y) \<noteq> h x - (pi * \<i> * q x)" for x y
  4969         using * [OF \<open>x \<in> S\<close>] * [OF \<open>y \<in> S\<close>] ne by (auto simp: iff)
  4970       then show "\<And>x. x \<in> S \<Longrightarrow>
  4971          \<exists>e>0. \<forall>y. y \<in> S \<and> h y - (pi * \<i> * q y) \<noteq> h x - (pi * \<i> * q x) \<longrightarrow>
  4972                    e \<le> cmod (h y - (pi * \<i> * q y) - (h x - (pi * \<i> * q x)))"
  4973         by (rule_tac x="2*pi" in exI) auto
  4974     qed
  4975     ultimately
  4976     obtain m where m: "\<And>x. x \<in> S \<Longrightarrow> h x - (pi * \<i> * q x) = (of_int(2*m) * pi) * \<i>"
  4977       using vw by (force simp: constant_on_def)
  4978     have *: "\<exists>n::int. h x = - (pi * \<i> * q x) + (of_int(2*n) * pi) * \<i>" if "x \<in> T" for x
  4979       unfolding exp_eq [symmetric]
  4980       using that T \<open>U = S \<union> T\<close> by (simp add: exp_minus field_simps  heq [symmetric])
  4981     moreover have "(\<lambda>x. h x + (pi * \<i> * q x)) constant_on T"
  4982     proof (rule continuous_discrete_range_constant [OF \<open>connected T\<close>])
  4983       have "continuous_on T h" "continuous_on T q"
  4984         using \<open>U = S \<union> T\<close> continuous_on_subset conth contq by blast+
  4985       then show "continuous_on T (\<lambda>x. h x + (pi * \<i> * q x))"
  4986         by (intro continuous_intros)
  4987       have "2*pi \<le> cmod (h y + (pi * \<i> * q y) - (h x + (pi * \<i> * q x)))"
  4988         if "x \<in> T" "y \<in> T" and ne: "h y + (pi * \<i> * q y) \<noteq> h x + (pi * \<i> * q x)" for x y
  4989         using * [OF \<open>x \<in> T\<close>] * [OF \<open>y \<in> T\<close>] ne by (auto simp: iff)
  4990       then show "\<And>x. x \<in> T \<Longrightarrow>
  4991          \<exists>e>0. \<forall>y. y \<in> T \<and> h y + (pi * \<i> * q y) \<noteq> h x + (pi * \<i> * q x) \<longrightarrow>
  4992                    e \<le> cmod (h y + (pi * \<i> * q y) - (h x + (pi * \<i> * q x)))"
  4993         by (rule_tac x="2*pi" in exI) auto
  4994     qed
  4995     ultimately
  4996     obtain n where n: "\<And>x. x \<in> T \<Longrightarrow> h x + (pi * \<i> * q x) = (of_int(2*n) * pi) * \<i>"
  4997       using vw by (force simp: constant_on_def)
  4998     show "False"
  4999       using m [of v] m [of w] n [of v] n [of w] vw
  5000       by (auto simp: algebra_simps \<open>v \<in> V\<close> \<open>w \<in> W\<close> qV qW)
  5001   qed
  5002 qed
  5003 
  5004 
  5005 corollary contractible_imp_unicoherent:
  5006   fixes U :: "'a::euclidean_space set"
  5007   assumes "contractible U"  shows "unicoherent U"
  5008   by%unimportant (simp add: Borsukian_imp_unicoherent assms contractible_imp_Borsukian)
  5009 
  5010 corollary convex_imp_unicoherent:
  5011   fixes U :: "'a::euclidean_space set"
  5012   assumes "convex U"  shows "unicoherent U"
  5013   by%unimportant (simp add: Borsukian_imp_unicoherent assms convex_imp_Borsukian)
  5014 
  5015 text\<open>If the type class constraint can be relaxed, I don't know how!\<close>
  5016 corollary unicoherent_UNIV: "unicoherent (UNIV :: 'a :: euclidean_space set)"
  5017   by%unimportant (simp add: convex_imp_unicoherent)
  5018 
  5019 
  5020 lemma unicoherent_monotone_image_compact:
  5021   fixes T :: "'b :: t2_space set"
  5022   assumes S: "unicoherent S" "compact S" and contf: "continuous_on S f" and fim: "f ` S = T"
  5023   and conn: "\<And>y. y \<in> T \<Longrightarrow> connected (S \<inter> f -` {y})"
  5024   shows "unicoherent T"
  5025 proof
  5026   fix U V
  5027   assume UV: "connected U" "connected V" "T = U \<union> V"
  5028      and cloU: "closedin (top_of_set T) U"
  5029      and cloV: "closedin (top_of_set T) V"
  5030   moreover have "compact T"
  5031     using \<open>compact S\<close> compact_continuous_image contf fim by blast
  5032   ultimately have "closed U" "closed V"
  5033     by (auto simp: closedin_closed_eq compact_imp_closed)
  5034   let ?SUV = "(S \<inter> f -` U) \<inter> (S \<inter> f -` V)"
  5035   have UV_eq: "f ` ?SUV = U \<inter> V"
  5036     using \<open>T = U \<union> V\<close> fim by force+
  5037   have "connected (f ` ?SUV)"
  5038   proof (rule connected_continuous_image)
  5039     show "continuous_on ?SUV f"
  5040       by (meson contf continuous_on_subset inf_le1)
  5041     show "connected ?SUV"
  5042     proof (rule unicoherentD [OF \<open>unicoherent S\<close>, of "S \<inter> f -` U" "S \<inter> f -` V"])
  5043       have "\<And>C. closedin (top_of_set S) C \<Longrightarrow> closedin (top_of_set T) (f ` C)"
  5044         by (metis \<open>compact S\<close> closed_subset closedin_compact closedin_imp_subset compact_continuous_image compact_imp_closed contf continuous_on_subset fim image_mono)
  5045       then show "connected (S \<inter> f -` U)" "connected (S \<inter> f -` V)"
  5046         using UV by (auto simp: conn intro: connected_closed_monotone_preimage [OF contf fim])
  5047       show "S = (S \<inter> f -` U) \<union> (S \<inter> f -` V)"
  5048         using UV fim by blast
  5049       show "closedin (top_of_set S) (S \<inter> f -` U)"
  5050             "closedin (top_of_set S) (S \<inter> f -` V)"
  5051         by (auto simp: continuous_on_imp_closedin cloU cloV contf fim)
  5052     qed
  5053   qed
  5054   with UV_eq show "connected (U \<inter> V)"
  5055     by simp
  5056 qed
  5057 
  5058 
  5059 subsection\<open>Several common variants of unicoherence\<close>
  5060 
  5061 lemma connected_frontier_simple:
  5062   fixes S :: "'a :: euclidean_space set"
  5063   assumes "connected S" "connected(- S)" shows "connected(frontier S)"
  5064   unfolding frontier_closures
  5065   apply (rule unicoherentD [OF unicoherent_UNIV])
  5066       apply (simp_all add: assms connected_imp_connected_closure)
  5067   by (simp add: closure_def)
  5068 
  5069 lemma connected_frontier_component_complement:
  5070   fixes S :: "'a :: euclidean_space set"
  5071   assumes "connected S" and C: "C \<in> components(- S)" shows "connected(frontier C)"
  5072   apply (rule connected_frontier_simple)
  5073   using C in_components_connected apply blast
  5074   by (metis Compl_eq_Diff_UNIV connected_UNIV assms top_greatest component_complement_connected)
  5075 
  5076 lemma connected_frontier_disjoint:
  5077   fixes S :: "'a :: euclidean_space set"
  5078   assumes "connected S" "connected T" "disjnt S T" and ST: "frontier S \<subseteq> frontier T"
  5079   shows "connected(frontier S)"
  5080 proof (cases "S = UNIV")
  5081   case True then show ?thesis
  5082     by simp
  5083 next
  5084   case False
  5085   then have "-S \<noteq> {}"
  5086     by blast
  5087   then obtain C where C: "C \<in> components(- S)" and "T \<subseteq> C"
  5088     by (metis ComplI disjnt_iff subsetI exists_component_superset \<open>disjnt S T\<close> \<open>connected T\<close>)
  5089   moreover have "frontier S = frontier C"
  5090   proof -
  5091     have "frontier C \<subseteq> frontier S"
  5092       using C frontier_complement frontier_of_components_subset by blast
  5093     moreover have "x \<in> frontier C" if "x \<in> frontier S" for x
  5094     proof -
  5095       have "x \<in> closure C"
  5096         using that unfolding frontier_def
  5097         by (metis (no_types) Diff_eq ST \<open>T \<subseteq> C\<close> closure_mono contra_subsetD frontier_def le_inf_iff that)
  5098       moreover have "x \<notin> interior C"
  5099         using that unfolding frontier_def
  5100         by (metis C Compl_eq_Diff_UNIV Diff_iff subsetD in_components_subset interior_diff interior_mono)
  5101       ultimately show ?thesis
  5102         by (auto simp: frontier_def)
  5103     qed
  5104     ultimately show ?thesis
  5105       by blast
  5106   qed
  5107   ultimately show ?thesis
  5108     using \<open>connected S\<close> connected_frontier_component_complement by auto
  5109 qed
  5110 
  5111 
  5112 subsection\<open>Some separation results\<close>
  5113 
  5114 lemma separation_by_component_closed_pointwise:
  5115   fixes S :: "'a :: euclidean_space set"
  5116   assumes "closed S" "\<not> connected_component (- S) a b"
  5117   obtains C where "C \<in> components S" "\<not> connected_component(- C) a b"
  5118 proof (cases "a \<in> S \<or> b \<in> S")
  5119   case True
  5120   then show ?thesis
  5121     using connected_component_in componentsI that by fastforce
  5122 next
  5123   case False
  5124   obtain T where "T \<subseteq> S" "closed T" "T \<noteq> {}"
  5125              and nab: "\<not> connected_component (- T) a b"
  5126              and conn: "\<And>U. U \<subset> T \<Longrightarrow> connected_component (- U) a b"
  5127     using closed_irreducible_separator [OF assms] by metis
  5128   moreover have "connected T"
  5129   proof -
  5130     have ab: "frontier(connected_component_set (- T) a) = T" "frontier(connected_component_set (- T) b) = T"
  5131       using frontier_minimal_separating_closed_pointwise
  5132       by (metis False \<open>T \<subseteq> S\<close> \<open>closed T\<close> connected_component_sym conn connected_component_eq_empty connected_component_intermediate_subset empty_subsetI nab)+
  5133     have "connected (frontier (connected_component_set (- T) a))"
  5134     proof (rule connected_frontier_disjoint)
  5135       show "disjnt (connected_component_set (- T) a) (connected_component_set (- T) b)"
  5136         unfolding disjnt_iff
  5137         by (metis connected_component_eq connected_component_eq_empty connected_component_idemp mem_Collect_eq nab)
  5138       show "frontier (connected_component_set (- T) a) \<subseteq> frontier (connected_component_set (- T) b)"
  5139         by (simp add: ab)
  5140     qed auto
  5141     with ab \<open>closed T\<close> show ?thesis
  5142       by simp
  5143   qed
  5144   ultimately obtain C where "C \<in> components S" "T \<subseteq> C"
  5145     using exists_component_superset [of T S] by blast
  5146   then show ?thesis
  5147     by (meson Compl_anti_mono connected_component_of_subset nab that)
  5148 qed
  5149 
  5150 
  5151 lemma separation_by_component_closed:
  5152   fixes S :: "'a :: euclidean_space set"
  5153   assumes "closed S" "\<not> connected(- S)"
  5154   obtains C where "C \<in> components S" "\<not> connected(- C)"
  5155 proof -
  5156   obtain x y where "closed S" "x \<notin> S" "y \<notin> S" and "\<not> connected_component (- S) x y"
  5157     using assms by (auto simp: connected_iff_connected_component)
  5158   then obtain C where "C \<in> components S" "\<not> connected_component(- C) x y"
  5159     using separation_by_component_closed_pointwise by metis
  5160   then show "thesis"
  5161     apply (clarify elim!: componentsE)
  5162     by (metis Compl_iff \<open>C \<in> components S\<close> \<open>x \<notin> S\<close> \<open>y \<notin> S\<close> connected_component_eq connected_component_eq_eq connected_iff_connected_component that)
  5163 qed
  5164 
  5165 lemma separation_by_Un_closed_pointwise:
  5166   fixes S :: "'a :: euclidean_space set"
  5167   assumes ST: "closed S" "closed T" "S \<inter> T = {}"
  5168       and conS: "connected_component (- S) a b" and conT: "connected_component (- T) a b"
  5169     shows "connected_component (- (S \<union> T)) a b"
  5170 proof (rule ccontr)
  5171   have "a \<notin> S" "b \<notin> S" "a \<notin> T" "b \<notin> T"
  5172     using conS conT connected_component_in by auto
  5173   assume "\<not> connected_component (- (S \<union> T)) a b"
  5174   then obtain C where "C \<in> components (S \<union> T)" and C: "\<not> connected_component(- C) a b"
  5175     using separation_by_component_closed_pointwise assms by blast
  5176   then have "C \<subseteq> S \<or> C \<subseteq> T"
  5177   proof -
  5178     have "connected C" "C \<subseteq> S \<union> T"
  5179       using \<open>C \<in> components (S \<union> T)\<close> in_components_subset by (blast elim: componentsE)+
  5180     moreover then have "C \<inter> T = {} \<or> C \<inter> S = {}"
  5181       by (metis Int_empty_right ST inf.commute connected_closed)
  5182     ultimately show ?thesis
  5183       by blast
  5184   qed
  5185   then show False
  5186     by (meson Compl_anti_mono C conS conT connected_component_of_subset)
  5187 qed
  5188 
  5189 lemma separation_by_Un_closed:
  5190   fixes S :: "'a :: euclidean_space set"
  5191   assumes ST: "closed S" "closed T" "S \<inter> T = {}" and conS: "connected(- S)" and conT: "connected(- T)"
  5192   shows "connected(- (S \<union> T))"
  5193   using assms separation_by_Un_closed_pointwise
  5194   by (fastforce simp add: connected_iff_connected_component)
  5195 
  5196 lemma open_unicoherent_UNIV:
  5197   fixes S :: "'a :: euclidean_space set"
  5198   assumes "open S" "open T" "connected S" "connected T" "S \<union> T = UNIV"
  5199   shows "connected(S \<inter> T)"
  5200 proof -
  5201   have "connected(- (-S \<union> -T))"
  5202     by (metis closed_Compl compl_sup compl_top_eq double_compl separation_by_Un_closed assms)
  5203   then show ?thesis
  5204     by simp
  5205 qed
  5206 
  5207 lemma separation_by_component_open_aux:
  5208   fixes S :: "'a :: euclidean_space set"
  5209   assumes ST: "closed S" "closed T" "S \<inter> T = {}"
  5210       and "S \<noteq> {}" "T \<noteq> {}"
  5211   obtains C where "C \<in> components(-(S \<union> T))" "C \<noteq> {}" "frontier C \<inter> S \<noteq> {}" "frontier C \<inter> T \<noteq> {}"
  5212 proof (rule ccontr)
  5213   let ?S = "S \<union> \<Union>{C \<in> components(- (S \<union> T)). frontier C \<subseteq> S}"
  5214   let ?T = "T \<union> \<Union>{C \<in> components(- (S \<union> T)). frontier C \<subseteq> T}"
  5215   assume "\<not> thesis"
  5216   with that have *: "frontier C \<inter> S = {} \<or> frontier C \<inter> T = {}"
  5217             if C: "C \<in> components (- (S \<union> T))" "C \<noteq> {}" for C
  5218     using C by blast
  5219   have "\<exists>A B::'a set. closed A \<and> closed B \<and> UNIV \<subseteq> A \<union> B \<and> A \<inter> B = {} \<and> A \<noteq> {} \<and> B \<noteq> {}"
  5220   proof (intro exI conjI)
  5221     have "frontier (\<Union>{C \<in> components (- S \<inter> - T). frontier C \<subseteq> S}) \<subseteq> S"
  5222       apply (rule subset_trans [OF frontier_Union_subset_closure])
  5223       by (metis (no_types, lifting) SUP_least \<open>closed S\<close> closure_minimal mem_Collect_eq)
  5224     then have "frontier ?S \<subseteq> S"
  5225       by (simp add: frontier_subset_eq assms  subset_trans [OF frontier_Un_subset])
  5226     then show "closed ?S"
  5227       using frontier_subset_eq by fastforce
  5228     have "frontier (\<Union>{C \<in> components (- S \<inter> - T). frontier C \<subseteq> T}) \<subseteq> T"
  5229       apply (rule subset_trans [OF frontier_Union_subset_closure])
  5230       by (metis (no_types, lifting) SUP_least \<open>closed T\<close> closure_minimal mem_Collect_eq)
  5231     then have "frontier ?T \<subseteq> T"
  5232       by (simp add: frontier_subset_eq assms  subset_trans [OF frontier_Un_subset])
  5233     then show "closed ?T"
  5234       using frontier_subset_eq by fastforce
  5235     have "UNIV \<subseteq> (S \<union> T) \<union> \<Union>(components(- (S \<union> T)))"
  5236       using Union_components by blast
  5237     also have "...  \<subseteq> ?S \<union> ?T"
  5238     proof -
  5239       have "C \<in> components (-(S \<union> T)) \<and> frontier C \<subseteq> S \<or>
  5240             C \<in> components (-(S \<union> T)) \<and> frontier C \<subseteq> T"
  5241         if "C \<in> components (- (S \<union> T))" "C \<noteq> {}" for C
  5242         using * [OF that] that
  5243         by clarify (metis (no_types, lifting) UnE \<open>closed S\<close> \<open>closed T\<close> closed_Un disjoint_iff_not_equal frontier_of_components_closed_complement subsetCE)
  5244       then show ?thesis
  5245         by blast
  5246     qed
  5247     finally show "UNIV \<subseteq> ?S \<union> ?T" .
  5248     have "\<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> S} \<union>
  5249           \<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> T} \<subseteq> - (S \<union> T)"
  5250       using in_components_subset by fastforce
  5251     moreover have "\<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> S} \<inter>
  5252                    \<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> T} = {}"
  5253     proof -
  5254       have "C \<inter> C' = {}" if "C \<in> components (- (S \<union> T))" "frontier C \<subseteq> S"
  5255                             "C' \<in> components (- (S \<union> T))" "frontier C' \<subseteq> T" for C C'
  5256       proof -
  5257         have NUN: "- S \<inter> - T \<noteq> UNIV"
  5258           using \<open>T \<noteq> {}\<close> by blast
  5259         have "C \<noteq> C'"
  5260         proof
  5261           assume "C = C'"
  5262           with that have "frontier C' \<subseteq> S \<inter> T"
  5263             by simp
  5264           also have "... = {}"
  5265             using \<open>S \<inter> T = {}\<close> by blast
  5266           finally have "C' = {} \<or> C' = UNIV"
  5267             using frontier_eq_empty by auto
  5268           then show False
  5269             using \<open>C = C'\<close> NUN that by (force simp: dest: in_components_nonempty in_components_subset)
  5270         qed
  5271         with that show ?thesis
  5272           by (simp add: components_nonoverlap [of _ "-(S \<union> T)"])
  5273       qed
  5274       then show ?thesis
  5275         by blast
  5276     qed
  5277     ultimately show "?S \<inter> ?T = {}"
  5278       using ST by blast
  5279     show "?S \<noteq> {}" "?T \<noteq> {}"
  5280       using \<open>S \<noteq> {}\<close> \<open>T \<noteq> {}\<close> by blast+
  5281   qed
  5282     then show False
  5283       by (metis Compl_disjoint connected_UNIV compl_bot_eq compl_unique connected_closedD inf_sup_absorb sup_compl_top_left1 top.extremum_uniqueI)
  5284 qed
  5285 
  5286 
  5287 proposition separation_by_component_open:
  5288   fixes S :: "'a :: euclidean_space set"
  5289   assumes "open S" and non: "\<not> connected(- S)"
  5290   obtains C where "C \<in> components S" "\<not> connected(- C)"
  5291 proof -
  5292   obtain T U
  5293     where "closed T" "closed U" and TU: "T \<union> U = - S" "T \<inter> U = {}" "T \<noteq> {}" "U \<noteq> {}"
  5294     using assms by (auto simp: connected_closed_set closed_def)
  5295   then obtain C where C: "C \<in> components(-(T \<union> U))" "C \<noteq> {}"
  5296           and "frontier C \<inter> T \<noteq> {}" "frontier C \<inter> U \<noteq> {}"
  5297     using separation_by_component_open_aux [OF \<open>closed T\<close> \<open>closed U\<close> \<open>T \<inter> U = {}\<close>] by force
  5298   show "thesis"
  5299   proof
  5300     show "C \<in> components S"
  5301       using C(1) TU(1) by auto
  5302     show "\<not> connected (- C)"
  5303     proof
  5304       assume "connected (- C)"
  5305       then have "connected (frontier C)"
  5306         using connected_frontier_simple [of C] \<open>C \<in> components S\<close> in_components_connected by blast
  5307       then show False
  5308         unfolding connected_closed
  5309         by (metis C(1) TU(2) \<open>closed T\<close> \<open>closed U\<close> \<open>frontier C \<inter> T \<noteq> {}\<close> \<open>frontier C \<inter> U \<noteq> {}\<close> closed_Un frontier_of_components_closed_complement inf_bot_right inf_commute)
  5310     qed
  5311   qed
  5312 qed
  5313 
  5314 lemma separation_by_Un_open:
  5315   fixes S :: "'a :: euclidean_space set"
  5316   assumes "open S" "open T" "S \<inter> T = {}" and cS: "connected(-S)" and cT: "connected(-T)"
  5317     shows "connected(- (S \<union> T))"
  5318   using assms unicoherent_UNIV unfolding unicoherent_def by force
  5319 
  5320 
  5321 lemma nonseparation_by_component_eq:
  5322   fixes S :: "'a :: euclidean_space set"
  5323   assumes "open S \<or> closed S"
  5324   shows "((\<forall>C \<in> components S. connected(-C)) \<longleftrightarrow> connected(- S))" (is "?lhs = ?rhs")
  5325 proof
  5326   assume ?lhs with assms show ?rhs
  5327     by (meson separation_by_component_closed separation_by_component_open)
  5328 next
  5329   assume ?rhs with assms show ?lhs
  5330     using component_complement_connected by force
  5331 qed
  5332 
  5333 
  5334 text\<open>Another interesting equivalent of an inessential mapping into C-{0}\<close>
  5335 proposition inessential_eq_extensible:
  5336   fixes f :: "'a::euclidean_space \<Rightarrow> complex"
  5337   assumes "closed S"
  5338   shows "(\<exists>a. homotopic_with (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)) \<longleftrightarrow>
  5339          (\<exists>g. continuous_on UNIV g \<and> (\<forall>x \<in> S. g x = f x) \<and> (\<forall>x. g x \<noteq> 0))"
  5340      (is "?lhs = ?rhs")
  5341 proof
  5342   assume ?lhs
  5343   then obtain a where a: "homotopic_with (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)" ..
  5344   show ?rhs
  5345   proof (cases "S = {}")
  5346     case True
  5347     with a show ?thesis
  5348       using continuous_on_const by force
  5349   next
  5350     case False
  5351     have anr: "ANR (-{0::complex})"
  5352       by (simp add: ANR_delete open_Compl open_imp_ANR)
  5353     obtain g where contg: "continuous_on UNIV g" and gim: "g ` UNIV \<subseteq> -{0}"
  5354                    and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  5355     proof (rule Borsuk_homotopy_extension_homotopic [OF _ _ continuous_on_const _ homotopic_with_symD [OF a]])
  5356       show "closedin (top_of_set UNIV) S"
  5357         using assms by auto
  5358       show "range (\<lambda>t. a) \<subseteq> - {0}"
  5359         using a homotopic_with_imp_subset2 False by blast
  5360     qed (use anr that in \<open>force+\<close>)
  5361     then show ?thesis
  5362       by force
  5363   qed
  5364 next
  5365   assume ?rhs
  5366   then obtain g where contg: "continuous_on UNIV g"
  5367           and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x" and non0: "\<And>x. g x \<noteq> 0"
  5368     by metis
  5369   obtain h k::"'a\<Rightarrow>'a" where hk: "homeomorphism (ball 0 1) UNIV h k"
  5370     using homeomorphic_ball01_UNIV homeomorphic_def by blast
  5371   then have "continuous_on (ball 0 1) (g \<circ> h)"
  5372     by (meson contg continuous_on_compose continuous_on_subset homeomorphism_cont1 top_greatest)
  5373   then obtain j where contj: "continuous_on (ball 0 1) j"
  5374                   and j: "\<And>z. z \<in> ball 0 1 \<Longrightarrow> exp(j z) = (g \<circ> h) z"
  5375     by (metis (mono_tags, hide_lams) continuous_logarithm_on_ball comp_apply non0)
  5376   have [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (k x) = x"
  5377     using hk homeomorphism_apply2 by blast
  5378   have "\<exists>\<zeta>. continuous_on S \<zeta>\<and> (\<forall>x\<in>S. f x = exp (\<zeta> x))"
  5379   proof (intro exI conjI ballI)
  5380     show "continuous_on S (j \<circ> k)"
  5381     proof (rule continuous_on_compose)
  5382       show "continuous_on S k"
  5383         by (meson continuous_on_subset hk homeomorphism_cont2 top_greatest)
  5384       show "continuous_on (k ` S) j"
  5385         apply (rule continuous_on_subset [OF contj])
  5386         using homeomorphism_image2 [OF hk] continuous_on_subset [OF contj] by blast
  5387     qed
  5388     show "f x = exp ((j \<circ> k) x)" if "x \<in> S" for x
  5389     proof -
  5390       have "f x = (g \<circ> h) (k x)"
  5391         by (simp add: gf that)
  5392       also have "... = exp (j (k x))"
  5393         by (metis rangeI homeomorphism_image2 [OF hk] j)
  5394       finally show ?thesis by simp
  5395     qed
  5396   qed
  5397   then show ?lhs
  5398     by (simp add: inessential_eq_continuous_logarithm)
  5399 qed
  5400 
  5401 lemma inessential_on_clopen_Union:
  5402   fixes \<F> :: "'a::euclidean_space set set"
  5403   assumes T: "path_connected T"
  5404       and "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (top_of_set (\<Union>\<F>)) S"
  5405       and "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set (\<Union>\<F>)) S"
  5406       and hom: "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a. homotopic_with (\<lambda>x. True) S T f (\<lambda>x. a)"
  5407   obtains a where "homotopic_with (\<lambda>x. True) (\<Union>\<F>) T f (\<lambda>x. a)"
  5408 proof (cases "\<Union>\<F> = {}")
  5409   case True
  5410   with that show ?thesis
  5411     by force
  5412 next
  5413   case False
  5414   then obtain C where "C \<in> \<F>" "C \<noteq> {}"
  5415     by blast
  5416   then obtain a where clo: "closedin (top_of_set (\<Union>\<F>)) C"
  5417     and ope: "openin (top_of_set (\<Union>\<F>)) C"
  5418     and "homotopic_with (\<lambda>x. True) C T f (\<lambda>x. a)"
  5419     using assms by blast
  5420   with \<open>C \<noteq> {}\<close> have "f ` C \<subseteq> T" "a \<in> T"
  5421     using homotopic_with_imp_subset1 homotopic_with_imp_subset2 by blast+
  5422   have "homotopic_with (\<lambda>x. True) (\<Union>\<F>) T f (\<lambda>x. a)"
  5423   proof (rule homotopic_on_clopen_Union)
  5424     show "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (top_of_set (\<Union>\<F>)) S"
  5425          "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set (\<Union>\<F>)) S"
  5426       by (simp_all add: assms)
  5427     show "homotopic_with (\<lambda>x. True) S T f (\<lambda>x. a)" if "S \<in> \<F>" for S
  5428     proof (cases "S = {}")
  5429       case True
  5430       then show ?thesis
  5431         by auto
  5432     next
  5433       case False
  5434       then obtain b where "b \<in> S"
  5435         by blast
  5436       obtain c where c: "homotopic_with (\<lambda>x. True) S T f (\<lambda>x. c)"
  5437         using \<open>S \<in> \<F>\<close> hom by blast
  5438       then have "c \<in> T"
  5439         using \<open>b \<in> S\<close> homotopic_with_imp_subset2 by blast
  5440       then have "homotopic_with (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. c)"
  5441         using T \<open>a \<in> T\<close> homotopic_constant_maps path_connected_component by blast
  5442       then show ?thesis
  5443         using c homotopic_with_symD homotopic_with_trans by blast
  5444     qed
  5445   qed
  5446   then show ?thesis ..
  5447 qed
  5448 
  5449 proposition Janiszewski_dual:
  5450   fixes S :: "complex set"
  5451   assumes
  5452    "compact S" "compact T" "connected S" "connected T" "connected(- (S \<union> T))"
  5453  shows "connected(S \<inter> T)"
  5454 proof -
  5455   have ST: "compact (S \<union> T)"
  5456     by (simp add: assms compact_Un)
  5457   with Borsukian_imp_unicoherent [of "S \<union> T"] ST assms
  5458   show ?thesis
  5459     by (auto simp: closed_subset compact_imp_closed Borsukian_separation_compact unicoherent_def)
  5460 qed
  5461 
  5462 end