src/HOL/Analysis/Further_Topology.thy
author Angeliki KoutsoukouArgyraki <ak2110@cam.ac.uk>
Tue Aug 28 13:28:39 2018 +0100 (12 months ago)
changeset 68833 fde093888c16
parent 68634 db0980691ef4
child 69064 5840724b1d71
permissions -rw-r--r--
tagged 21 theories in the Analysis library for the manual
     1 section%important \<open>Extending Continous Maps, Invariance of Domain, etc\<close>
     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%important\<open>A map from a sphere to a higher dimensional sphere is nullhomotopic\<close>
    10 
    11 lemma%important 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%unimportant
    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%important 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%unimportant -
   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%important 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%unimportant (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%important 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%unimportant (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%unimportant 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>~ 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%important\<open> Some technical lemmas about extending maps from cell complexes\<close>
   381 
   382 lemma%unimportant 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%unimportant 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>; ~ X \<subseteq> Y; ~ 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%important 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%unimportant (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" "~ 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%unimportant 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%unimportant 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>; ~(X \<subseteq> Y); ~(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%important 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%unimportant -
   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%important 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%unimportant -
   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%important 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%unimportant -
   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%important\<open> Special cases and corollaries involving spheres\<close>
   995 
   996 lemma%unimportant disjnt_Diff1: "X \<subseteq> Y' \<Longrightarrow> disjnt (X - Y) (X' - Y')"
   997   by (auto simp: disjnt_def)
   998 
   999 proposition%important 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%unimportant -
  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%important\<open>Extending maps to spheres\<close>
  1144 
  1145 (*Up to extend_map_affine_to_sphere_cofinite_gen*)
  1146 
  1147 lemma%important 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 (subtopology euclidean 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%unimportant (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 (subtopology euclidean U) C"
  1180     proof (rule openin_trans)
  1181       show "openin (subtopology euclidean (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 (subtopology euclidean 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. (~ (h x = x \<and> k x = x))} \<subseteq> C"
  1192                  and bou: "bounded {x. (~ (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 (subtopology euclidean 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 (subtopology euclidean (affine hull C)) C"
  1198         by (metis \<open>a \<in> C\<close> \<open>openin (subtopology euclidean 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>, of "S \<union> UF" "\<lambda>C. S \<union> (C - {a C})" h])
  1327     show "S \<union> UF \<subseteq> (\<Union>C\<in>F. S \<union> (C - {a C}))"
  1328       using \<open>C0 \<in> F\<close> by (force simp: UF_def)
  1329     show "closedin (subtopology euclidean (S \<union> UF)) (S \<union> (C - {a C}))"
  1330          if "C \<in> F" for C
  1331     proof (rule closedin_closed_subset [of U "S \<union> C"])
  1332       show "closedin (subtopology euclidean U) (S \<union> C)"
  1333         apply (rule closedin_Un_complement_component [OF \<open>locally connected U\<close> clo])
  1334         using F_def that by blast
  1335     next
  1336       have "x = a C'" if "C' \<in> F"  "x \<in> C'" "x \<notin> U" for x C'
  1337       proof -
  1338         have "\<forall>A. x \<in> \<Union>A \<or> C' \<notin> A"
  1339           using \<open>x \<in> C'\<close> by blast
  1340         with that show "x = a C'"
  1341           by (metis (lifting) DiffD1 F_def Union_components mem_Collect_eq)
  1342       qed
  1343       then show "S \<union> UF \<subseteq> U"
  1344         using \<open>S \<subseteq> U\<close> by (force simp: UF_def)
  1345     next
  1346       show "S \<union> (C - {a C}) = (S \<union> C) \<inter> (S \<union> UF)"
  1347         using F_def UF_def components_nonoverlap that by auto
  1348     qed
  1349   next
  1350     show "continuous_on (S \<union> (C' - {a C'})) (h C')" if "C' \<in> F" for C'
  1351       using ah F_def that by blast
  1352     show "\<And>i j x. \<lbrakk>i \<in> F; j \<in> F;
  1353                    x \<in> (S \<union> UF) \<inter> (S \<union> (i - {a i})) \<inter> (S \<union> (j - {a j}))\<rbrakk>
  1354                   \<Longrightarrow> h i x = h j x"
  1355       using components_eq by (fastforce simp: components_eq F_def ah)
  1356   qed blast
  1357   have SU': "S \<union> \<Union>G \<union> (S \<union> UF) \<subseteq> U"
  1358     using \<open>S \<subseteq> U\<close> in_components_subset by (auto simp: F_def G_def UF_def)
  1359   have clo1: "closedin (subtopology euclidean (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> \<Union>G)"
  1360   proof (rule closedin_closed_subset [OF _ SU'])
  1361     have *: "\<And>C. C \<in> F \<Longrightarrow> openin (subtopology euclidean U) C"
  1362       unfolding F_def
  1363       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)
  1364     show "closedin (subtopology euclidean U) (U - UF)"
  1365       unfolding UF_def
  1366       by (force intro: openin_delete *)
  1367     show "S \<union> \<Union>G = (U - UF) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
  1368       using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
  1369         apply (metis Diff_iff UnionI Union_components)
  1370        apply (metis DiffD1 UnionI Union_components)
  1371       by (metis (no_types, lifting) IntI components_nonoverlap empty_iff)
  1372   qed
  1373   have clo2: "closedin (subtopology euclidean (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> UF)"
  1374   proof (rule closedin_closed_subset [OF _ SU'])
  1375     show "closedin (subtopology euclidean U) (\<Union>C\<in>F. S \<union> C)"
  1376       apply (rule closedin_Union)
  1377        apply (simp add: \<open>finite F\<close>)
  1378       using F_def \<open>locally connected U\<close> clo closedin_Un_complement_component by blast
  1379     show "S \<union> UF = (\<Union>C\<in>F. S \<union> C) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
  1380       using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
  1381       using C0 apply blast
  1382       by (metis components_nonoverlap disjnt_def disjnt_iff)
  1383   qed
  1384   have SUG: "S \<union> \<Union>G \<subseteq> U - K"
  1385     using \<open>S \<subseteq> U\<close> K apply (auto simp: G_def disjnt_iff)
  1386     by (meson Diff_iff subsetD in_components_subset)
  1387   then have contf': "continuous_on (S \<union> \<Union>G) f"
  1388     by (rule continuous_on_subset [OF contf])
  1389   have contg': "continuous_on (S \<union> UF) g"
  1390     apply (rule continuous_on_subset [OF contg])
  1391     using \<open>S \<subseteq> U\<close> by (auto simp: F_def G_def)
  1392   have  "\<And>x. \<lbrakk>S \<subseteq> U; x \<in> S\<rbrakk> \<Longrightarrow> f x = g x"
  1393     by (subst gh) (auto simp: ah C0 intro: \<open>C0 \<in> F\<close>)
  1394   then have f_eq_g: "\<And>x. x \<in> S \<union> UF \<and> x \<in> S \<union> \<Union>G \<Longrightarrow> f x = g x"
  1395     using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def dest: in_components_subset)
  1396     using components_eq by blast
  1397   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)"
  1398     by (blast intro: continuous_on_cases_local [OF clo1 clo2 contf' contg' f_eq_g, of "\<lambda>x. x \<in> S \<union> \<Union>G"])
  1399   show ?thesis
  1400   proof
  1401     have UF: "\<Union>F - L \<subseteq> UF"
  1402       unfolding F_def UF_def using ah by blast
  1403     have "U - S - L = \<Union>(components (U - S)) - L"
  1404       by simp
  1405     also have "... = \<Union>F \<union> \<Union>G - L"
  1406       unfolding F_def G_def by blast
  1407     also have "... \<subseteq> UF \<union> \<Union>G"
  1408       using UF by blast
  1409     finally have "U - L \<subseteq> S \<union> \<Union>G \<union> (S \<union> UF)"
  1410       by blast
  1411     then show "continuous_on (U - L) (\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x)"
  1412       by (rule continuous_on_subset [OF cont])
  1413     have "((U - L) \<inter> {x. x \<notin> S \<and> (\<forall>xa\<in>G. x \<notin> xa)}) \<subseteq>  ((U - L) \<inter> (-S \<inter> UF))"
  1414       using \<open>U - L \<subseteq> S \<union> \<Union>G \<union> (S \<union> UF)\<close> by auto
  1415     moreover have "g ` ((U - L) \<inter> (-S \<inter> UF)) \<subseteq> T"
  1416     proof -
  1417       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
  1418       proof (subst gh)
  1419         show "x \<in> (S \<union> UF) \<inter> (S \<union> (C - {a C}))"
  1420           using that by (auto simp: UF_def)
  1421         show "h C x \<in> T"
  1422           using ah that by (fastforce simp add: F_def)
  1423       qed (rule that)
  1424       then show ?thesis
  1425         by (force simp: UF_def)
  1426     qed
  1427     ultimately have "g ` ((U - L) \<inter> {x. x \<notin> S \<and> (\<forall>xa\<in>G. x \<notin> xa)}) \<subseteq> T"
  1428       using image_mono order_trans by blast
  1429     moreover have "f ` ((U - L) \<inter> (S \<union> \<Union>G)) \<subseteq> T"
  1430       using fim SUG by blast
  1431     ultimately show "(\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x) ` (U - L) \<subseteq> T"
  1432        by force
  1433     show "\<And>x. x \<in> S \<Longrightarrow> (if x \<in> S \<union> \<Union>G then f x else g x) = f x"
  1434       by (simp add: F_def G_def)
  1435   qed
  1436 qed
  1437 
  1438 
  1439 lemma%important extend_map_affine_to_sphere2:
  1440   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1441   assumes "compact S" "convex U" "bounded U" "affine T" "S \<subseteq> T"
  1442       and affTU: "aff_dim T \<le> aff_dim U"
  1443       and contf: "continuous_on S f"
  1444       and fim: "f ` S \<subseteq> rel_frontier U"
  1445       and ovlap: "\<And>C. C \<in> components(T - S) \<Longrightarrow> C \<inter> L \<noteq> {}"
  1446     obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S"
  1447                       "continuous_on (T - K) g" "g ` (T - K) \<subseteq> rel_frontier U"
  1448                       "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1449 proof%unimportant -
  1450   obtain K g where K: "finite K" "K \<subseteq> T" "disjnt K S"
  1451                and contg: "continuous_on (T - K) g"
  1452                and gim: "g ` (T - K) \<subseteq> rel_frontier U"
  1453                and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1454      using assms extend_map_affine_to_sphere_cofinite_simple by metis
  1455   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
  1456   proof -
  1457     have "x \<in> T-S"
  1458       using \<open>K \<subseteq> T\<close> \<open>disjnt K S\<close> disjnt_def that by fastforce
  1459     then obtain C where "C \<in> components(T - S)" "x \<in> C"
  1460       by (metis UnionE Union_components)
  1461     with ovlap [of C] show ?thesis
  1462       by blast
  1463   qed
  1464   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"
  1465     by metis
  1466   obtain h where conth: "continuous_on (T - \<xi> ` K) h"
  1467              and him: "h ` (T - \<xi> ` K) \<subseteq> rel_frontier U"
  1468              and hg: "\<And>x. x \<in> S \<Longrightarrow> h x = g x"
  1469   proof (rule extend_map_affine_to_sphere1 [OF \<open>finite K\<close> \<open>affine T\<close> contg gim, of S "\<xi> ` K"])
  1470     show cloTS: "closedin (subtopology euclidean T) S"
  1471       by (simp add: \<open>compact S\<close> \<open>S \<subseteq> T\<close> closed_subset compact_imp_closed)
  1472     show "\<And>C. \<lbrakk>C \<in> components (T - S); C \<inter> K \<noteq> {}\<rbrakk> \<Longrightarrow> C \<inter> \<xi> ` K \<noteq> {}"
  1473       using \<xi> components_eq by blast
  1474   qed (use K in auto)
  1475   show ?thesis
  1476   proof
  1477     show *: "\<xi> ` K \<subseteq> L"
  1478       using \<xi> by blast
  1479     show "finite (\<xi> ` K)"
  1480       by (simp add: K)
  1481     show "\<xi> ` K \<subseteq> T"
  1482       by clarify (meson \<xi> Diff_iff contra_subsetD in_components_subset)
  1483     show "continuous_on (T - \<xi> ` K) h"
  1484       by (rule conth)
  1485     show "disjnt (\<xi> ` K) S"
  1486       using K
  1487       apply (auto simp: disjnt_def)
  1488       by (metis \<xi> DiffD2 UnionI Union_components)
  1489   qed (simp_all add: him hg gf)
  1490 qed
  1491 
  1492 
  1493 proposition%important extend_map_affine_to_sphere_cofinite_gen:
  1494   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1495   assumes SUT: "compact S" "convex U" "bounded U" "affine T" "S \<subseteq> T"
  1496       and aff: "aff_dim T \<le> aff_dim U"
  1497       and contf: "continuous_on S f"
  1498       and fim: "f ` S \<subseteq> rel_frontier U"
  1499       and dis: "\<And>C. \<lbrakk>C \<in> components(T - S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  1500  obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
  1501                    "g ` (T - K) \<subseteq> rel_frontier U"
  1502                    "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1503 proof%unimportant (cases "S = {}")
  1504   case True
  1505   show ?thesis
  1506   proof (cases "rel_frontier U = {}")
  1507     case True
  1508     with aff have "aff_dim T \<le> 0"
  1509       apply (simp add: rel_frontier_eq_empty)
  1510       using affine_bounded_eq_lowdim \<open>bounded U\<close> order_trans by auto
  1511     with aff_dim_geq [of T] consider "aff_dim T = -1" |  "aff_dim T = 0"
  1512       by linarith
  1513     then show ?thesis
  1514     proof cases
  1515       assume "aff_dim T = -1"
  1516       then have "T = {}"
  1517         by (simp add: aff_dim_empty)
  1518       then show ?thesis
  1519         by (rule_tac K="{}" in that) auto
  1520     next
  1521       assume "aff_dim T = 0"
  1522       then obtain a where "T = {a}"
  1523         using aff_dim_eq_0 by blast
  1524       then have "a \<in> L"
  1525         using dis [of "{a}"] \<open>S = {}\<close> by (auto simp: in_components_self)
  1526       with \<open>S = {}\<close> \<open>T = {a}\<close> show ?thesis
  1527         by (rule_tac K="{a}" and g=f in that) auto
  1528     qed
  1529   next
  1530     case False
  1531     then obtain y where "y \<in> rel_frontier U"
  1532       by auto
  1533     with \<open>S = {}\<close> show ?thesis
  1534       by (rule_tac K="{}" and g="\<lambda>x. y" in that)  (auto simp: continuous_on_const)
  1535   qed
  1536 next
  1537   case False
  1538   have "bounded S"
  1539     by (simp add: assms compact_imp_bounded)
  1540   then obtain b where b: "S \<subseteq> cbox (-b) b"
  1541     using bounded_subset_cbox_symmetric by blast
  1542   define LU where "LU \<equiv> L \<union> (\<Union> {C \<in> components (T - S). ~bounded C} - cbox (-(b+One)) (b+One))"
  1543   obtain K g where "finite K" "K \<subseteq> LU" "K \<subseteq> T" "disjnt K S"
  1544                and contg: "continuous_on (T - K) g"
  1545                and gim: "g ` (T - K) \<subseteq> rel_frontier U"
  1546                and gf:  "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1547   proof (rule extend_map_affine_to_sphere2 [OF SUT aff contf fim])
  1548     show "C \<inter> LU \<noteq> {}" if "C \<in> components (T - S)" for C
  1549     proof (cases "bounded C")
  1550       case True
  1551       with dis that show ?thesis
  1552         unfolding LU_def by fastforce
  1553     next
  1554       case False
  1555       then have "\<not> bounded (\<Union>{C \<in> components (T - S). \<not> bounded C})"
  1556         by (metis (no_types, lifting) Sup_upper bounded_subset mem_Collect_eq that)
  1557       then show ?thesis
  1558         apply (clarsimp simp: LU_def Int_Un_distrib Diff_Int_distrib Int_UN_distrib)
  1559         by (metis (no_types, lifting) False Sup_upper bounded_cbox bounded_subset inf.orderE mem_Collect_eq that)
  1560     qed
  1561   qed blast
  1562   have *: False if "x \<in> cbox (- b - m *\<^sub>R One) (b + m *\<^sub>R One)"
  1563                    "x \<notin> box (- b - n *\<^sub>R One) (b + n *\<^sub>R One)"
  1564                    "0 \<le> m" "m < n" "n \<le> 1" for m n x
  1565     using that by (auto simp: mem_box algebra_simps)
  1566   have "disjoint_family_on (\<lambda>d. frontier (cbox (- b - d *\<^sub>R One) (b + d *\<^sub>R One))) {1 / 2..1}"
  1567     by (auto simp: disjoint_family_on_def neq_iff frontier_def dest: *)
  1568   then obtain d where d12: "1/2 \<le> d" "d \<le> 1"
  1569                   and ddis: "disjnt K (frontier (cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One)))"
  1570     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))"]
  1571     by (auto simp: \<open>finite K\<close>)
  1572   define c where "c \<equiv> b + d *\<^sub>R One"
  1573   have cbsub: "cbox (-b) b \<subseteq> box (-c) c"
  1574               "cbox (-b) b \<subseteq> cbox (-c) c"
  1575               "cbox (-c) c \<subseteq> cbox (-(b+One)) (b+One)"
  1576     using d12 by (simp_all add: subset_box c_def inner_diff_left inner_left_distrib)
  1577   have clo_cT: "closed (cbox (- c) c \<inter> T)"
  1578     using affine_closed \<open>affine T\<close> by blast
  1579   have cT_ne: "cbox (- c) c \<inter> T \<noteq> {}"
  1580     using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub by fastforce
  1581   have S_sub_cc: "S \<subseteq> cbox (- c) c"
  1582     using \<open>cbox (- b) b \<subseteq> cbox (- c) c\<close> b by auto
  1583   show ?thesis
  1584   proof
  1585     show "finite (K \<inter> cbox (-(b+One)) (b+One))"
  1586       using \<open>finite K\<close> by blast
  1587     show "K \<inter> cbox (- (b + One)) (b + One) \<subseteq> L"
  1588       using \<open>K \<subseteq> LU\<close> by (auto simp: LU_def)
  1589     show "K \<inter> cbox (- (b + One)) (b + One) \<subseteq> T"
  1590       using \<open>K \<subseteq> T\<close> by auto
  1591     show "disjnt (K \<inter> cbox (- (b + One)) (b + One)) S"
  1592       using \<open>disjnt K S\<close>  by (simp add: disjnt_def disjoint_eq_subset_Compl inf.coboundedI1)
  1593     have cloTK: "closest_point (cbox (- c) c \<inter> T) x \<in> T - K"
  1594                 if "x \<in> T" and Knot: "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
  1595     proof (cases "x \<in> cbox (- c) c")
  1596       case True
  1597       with \<open>x \<in> T\<close> show ?thesis
  1598         using cbsub(3) Knot  by (force simp: closest_point_self)
  1599     next
  1600       case False
  1601       have clo_in_rf: "closest_point (cbox (- c) c \<inter> T) x \<in> rel_frontier (cbox (- c) c \<inter> T)"
  1602       proof (intro closest_point_in_rel_frontier [OF clo_cT cT_ne] DiffI notI)
  1603         have "T \<inter> interior (cbox (- c) c) \<noteq> {}"
  1604           using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub(1) by fastforce
  1605         then show "x \<in> affine hull (cbox (- c) c \<inter> T)"
  1606           by (simp add: Int_commute affine_hull_affine_Int_nonempty_interior \<open>affine T\<close> hull_inc that(1))
  1607       next
  1608         show "False" if "x \<in> rel_interior (cbox (- c) c \<inter> T)"
  1609         proof -
  1610           have "interior (cbox (- c) c) \<inter> T \<noteq> {}"
  1611             using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub(1) by fastforce
  1612           then have "affine hull (T \<inter> cbox (- c) c) = T"
  1613             using affine_hull_convex_Int_nonempty_interior [of T "cbox (- c) c"]
  1614             by (simp add: affine_imp_convex \<open>affine T\<close> inf_commute)
  1615           then show ?thesis
  1616             by (meson subsetD le_inf_iff rel_interior_subset that False)
  1617         qed
  1618       qed
  1619       have "closest_point (cbox (- c) c \<inter> T) x \<notin> K"
  1620       proof
  1621         assume inK: "closest_point (cbox (- c) c \<inter> T) x \<in> K"
  1622         have "\<And>x. x \<in> K \<Longrightarrow> x \<notin> frontier (cbox (- (b + d *\<^sub>R One)) (b + d *\<^sub>R One))"
  1623           by (metis ddis disjnt_iff)
  1624         then show False
  1625           by (metis DiffI Int_iff \<open>affine T\<close> cT_ne c_def clo_cT clo_in_rf closest_point_in_set
  1626                     convex_affine_rel_frontier_Int convex_box(1) empty_iff frontier_cbox inK interior_cbox)
  1627       qed
  1628       then show ?thesis
  1629         using cT_ne clo_cT closest_point_in_set by blast
  1630     qed
  1631     show "continuous_on (T - K \<inter> cbox (- (b + One)) (b + One)) (g \<circ> closest_point (cbox (-c) c \<inter> T))"
  1632       apply (intro continuous_on_compose continuous_on_closest_point continuous_on_subset [OF contg])
  1633          apply (simp_all add: clo_cT affine_imp_convex \<open>affine T\<close> convex_Int cT_ne)
  1634       using cloTK by blast
  1635     have "g (closest_point (cbox (- c) c \<inter> T) x) \<in> rel_frontier U"
  1636          if "x \<in> T" "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
  1637       apply (rule gim [THEN subsetD])
  1638       using that cloTK by blast
  1639     then show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K \<inter> cbox (- (b + One)) (b + One))
  1640                \<subseteq> rel_frontier U"
  1641       by force
  1642     show "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> closest_point (cbox (- c) c \<inter> T)) x = f x"
  1643       by simp (metis (mono_tags, lifting) IntI \<open>S \<subseteq> T\<close> cT_ne clo_cT closest_point_refl gf subsetD S_sub_cc)
  1644   qed
  1645 qed
  1646 
  1647 
  1648 corollary%important extend_map_affine_to_sphere_cofinite:
  1649   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1650   assumes SUT: "compact S" "affine T" "S \<subseteq> T"
  1651       and aff: "aff_dim T \<le> DIM('b)" and "0 \<le> r"
  1652       and contf: "continuous_on S f"
  1653       and fim: "f ` S \<subseteq> sphere a r"
  1654       and dis: "\<And>C. \<lbrakk>C \<in> components(T - S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  1655   obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
  1656                     "g ` (T - K) \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1657 proof%unimportant (cases "r = 0")
  1658   case True
  1659   with fim show ?thesis
  1660     by (rule_tac K="{}" and g = "\<lambda>x. a" in that) (auto simp: continuous_on_const)
  1661 next
  1662   case False
  1663   with assms have "0 < r" by auto
  1664   then have "aff_dim T \<le> aff_dim (cball a r)"
  1665     by (simp add: aff aff_dim_cball)
  1666   then show ?thesis
  1667     apply (rule extend_map_affine_to_sphere_cofinite_gen
  1668             [OF \<open>compact S\<close> convex_cball bounded_cball \<open>affine T\<close> \<open>S \<subseteq> T\<close> _ contf])
  1669     using fim apply (auto simp: assms False that dest: dis)
  1670     done
  1671 qed
  1672 
  1673 corollary%important extend_map_UNIV_to_sphere_cofinite:
  1674   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1675   assumes aff: "DIM('a) \<le> DIM('b)" and "0 \<le> r"
  1676       and SUT: "compact S"
  1677       and contf: "continuous_on S f"
  1678       and fim: "f ` S \<subseteq> sphere a r"
  1679       and dis: "\<And>C. \<lbrakk>C \<in> components(- S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  1680   obtains K g where "finite K" "K \<subseteq> L" "disjnt K S" "continuous_on (- K) g"
  1681                     "g ` (- K) \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1682 apply (rule extend_map_affine_to_sphere_cofinite
  1683         [OF \<open>compact S\<close> affine_UNIV subset_UNIV _ \<open>0 \<le> r\<close> contf fim dis])
  1684  apply (auto simp: assms that Compl_eq_Diff_UNIV [symmetric])
  1685 done
  1686 
  1687 corollary%important extend_map_UNIV_to_sphere_no_bounded_component:
  1688   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1689   assumes aff: "DIM('a) \<le> DIM('b)" and "0 \<le> r"
  1690       and SUT: "compact S"
  1691       and contf: "continuous_on S f"
  1692       and fim: "f ` S \<subseteq> sphere a r"
  1693       and dis: "\<And>C. C \<in> components(- S) \<Longrightarrow> \<not> bounded C"
  1694   obtains g where "continuous_on UNIV g" "g ` UNIV \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1695 apply (rule extend_map_UNIV_to_sphere_cofinite [OF aff \<open>0 \<le> r\<close> \<open>compact S\<close> contf fim, of "{}"])
  1696    apply (auto simp: that dest: dis)
  1697 done
  1698 
  1699 theorem%important Borsuk_separation_theorem_gen:
  1700   fixes S :: "'a::euclidean_space set"
  1701   assumes "compact S"
  1702     shows "(\<forall>c \<in> components(- S). ~bounded c) \<longleftrightarrow>
  1703            (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::'a) 1
  1704                 \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)))"
  1705        (is "?lhs = ?rhs")
  1706 proof%unimportant
  1707   assume L [rule_format]: ?lhs
  1708   show ?rhs
  1709   proof clarify
  1710     fix f :: "'a \<Rightarrow> 'a"
  1711     assume contf: "continuous_on S f" and fim: "f ` S \<subseteq> sphere 0 1"
  1712     obtain g where contg: "continuous_on UNIV g" and gim: "range g \<subseteq> sphere 0 1"
  1713                and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  1714       by (rule extend_map_UNIV_to_sphere_no_bounded_component [OF _ _ \<open>compact S\<close> contf fim L]) auto
  1715     then show "\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)"
  1716       using nullhomotopic_from_contractible [OF contg gim]
  1717       by (metis assms compact_imp_closed contf empty_iff fim homotopic_with_equal nullhomotopic_into_sphere_extension)
  1718   qed
  1719 next
  1720   assume R [rule_format]: ?rhs
  1721   show ?lhs
  1722     unfolding components_def
  1723   proof clarify
  1724     fix a
  1725     assume "a \<notin> S" and a: "bounded (connected_component_set (- S) a)"
  1726     have cont: "continuous_on S (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a))"
  1727       apply (intro continuous_intros)
  1728       using \<open>a \<notin> S\<close> by auto
  1729     have im: "(\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) ` S \<subseteq> sphere 0 1"
  1730       by clarsimp (metis \<open>a \<notin> S\<close> eq_iff_diff_eq_0 left_inverse norm_eq_zero)
  1731     show False
  1732       using R cont im Borsuk_map_essential_bounded_component [OF \<open>compact S\<close> \<open>a \<notin> S\<close>] a by blast
  1733   qed
  1734 qed
  1735 
  1736 
  1737 corollary%important Borsuk_separation_theorem:
  1738   fixes S :: "'a::euclidean_space set"
  1739   assumes "compact S" and 2: "2 \<le> DIM('a)"
  1740     shows "connected(- S) \<longleftrightarrow>
  1741            (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::'a) 1
  1742                 \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)))"
  1743        (is "?lhs = ?rhs")
  1744 proof%unimportant
  1745   assume L: ?lhs
  1746   show ?rhs
  1747   proof (cases "S = {}")
  1748     case True
  1749     then show ?thesis by auto
  1750   next
  1751     case False
  1752     then have "(\<forall>c\<in>components (- S). \<not> bounded c)"
  1753       by (metis L assms(1) bounded_empty cobounded_imp_unbounded compact_imp_bounded in_components_maximal order_refl)
  1754     then show ?thesis
  1755       by (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>])
  1756   qed
  1757 next
  1758   assume R: ?rhs
  1759   then show ?lhs
  1760     apply (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>, symmetric])
  1761     apply (auto simp: components_def connected_iff_eq_connected_component_set)
  1762     using connected_component_in apply fastforce
  1763     using cobounded_unique_unbounded_component [OF _ 2, of "-S"] \<open>compact S\<close> compact_eq_bounded_closed by fastforce
  1764 qed
  1765 
  1766 
  1767 lemma%unimportant homotopy_eqv_separation:
  1768   fixes S :: "'a::euclidean_space set" and T :: "'a set"
  1769   assumes "S homotopy_eqv T" and "compact S" and "compact T"
  1770   shows "connected(- S) \<longleftrightarrow> connected(- T)"
  1771 proof -
  1772   consider "DIM('a) = 1" | "2 \<le> DIM('a)"
  1773     by (metis DIM_ge_Suc0 One_nat_def Suc_1 dual_order.antisym not_less_eq_eq)
  1774   then show ?thesis
  1775   proof cases
  1776     case 1
  1777     then show ?thesis
  1778       using bounded_connected_Compl_1 compact_imp_bounded homotopy_eqv_empty1 homotopy_eqv_empty2 assms by metis
  1779   next
  1780     case 2
  1781     with assms show ?thesis
  1782       by (simp add: Borsuk_separation_theorem homotopy_eqv_cohomotopic_triviality_null)
  1783   qed
  1784 qed
  1785 
  1786 lemma%important Jordan_Brouwer_separation:
  1787   fixes S :: "'a::euclidean_space set" and a::'a
  1788   assumes hom: "S homeomorphic sphere a r" and "0 < r"
  1789     shows "\<not> connected(- S)"
  1790 proof%unimportant -
  1791   have "- sphere a r \<inter> ball a r \<noteq> {}"
  1792     using \<open>0 < r\<close> by (simp add: Int_absorb1 subset_eq)
  1793   moreover
  1794   have eq: "- sphere a r - ball a r = - cball a r"
  1795     by auto
  1796   have "- cball a r \<noteq> {}"
  1797   proof -
  1798     have "frontier (cball a r) \<noteq> {}"
  1799       using \<open>0 < r\<close> by auto
  1800     then show ?thesis
  1801       by (metis frontier_complement frontier_empty)
  1802   qed
  1803   with eq have "- sphere a r - ball a r \<noteq> {}"
  1804     by auto
  1805   moreover
  1806   have "connected (- S) = connected (- sphere a r)"
  1807   proof (rule homotopy_eqv_separation)
  1808     show "S homotopy_eqv sphere a r"
  1809       using hom homeomorphic_imp_homotopy_eqv by blast
  1810     show "compact (sphere a r)"
  1811       by simp
  1812     then show " compact S"
  1813       using hom homeomorphic_compactness by blast
  1814   qed
  1815   ultimately show ?thesis
  1816     using connected_Int_frontier [of "- sphere a r" "ball a r"] by (auto simp: \<open>0 < r\<close>)
  1817 qed
  1818 
  1819 
  1820 lemma%important Jordan_Brouwer_frontier:
  1821   fixes S :: "'a::euclidean_space set" and a::'a
  1822   assumes S: "S homeomorphic sphere a r" and T: "T \<in> components(- S)" and 2: "2 \<le> DIM('a)"
  1823     shows "frontier T = S"
  1824 proof%unimportant (cases r rule: linorder_cases)
  1825   assume "r < 0"
  1826   with S T show ?thesis by auto
  1827 next
  1828   assume "r = 0"
  1829   with S T card_eq_SucD obtain b where "S = {b}"
  1830     by (auto simp: homeomorphic_finite [of "{a}" S])
  1831   have "components (- {b}) = { -{b}}"
  1832     using T \<open>S = {b}\<close> by (auto simp: components_eq_sing_iff connected_punctured_universe 2)
  1833   with T show ?thesis
  1834     by (metis \<open>S = {b}\<close> cball_trivial frontier_cball frontier_complement singletonD sphere_trivial)
  1835 next
  1836   assume "r > 0"
  1837   have "compact S"
  1838     using homeomorphic_compactness compact_sphere S by blast
  1839   show ?thesis
  1840   proof (rule frontier_minimal_separating_closed)
  1841     show "closed S"
  1842       using \<open>compact S\<close> compact_eq_bounded_closed by blast
  1843     show "\<not> connected (- S)"
  1844       using Jordan_Brouwer_separation S \<open>0 < r\<close> by blast
  1845     obtain f g where hom: "homeomorphism S (sphere a r) f g"
  1846       using S by (auto simp: homeomorphic_def)
  1847     show "connected (- T)" if "closed T" "T \<subset> S" for T
  1848     proof -
  1849       have "f ` T \<subseteq> sphere a r"
  1850         using \<open>T \<subset> S\<close> hom homeomorphism_image1 by blast
  1851       moreover have "f ` T \<noteq> sphere a r"
  1852         using \<open>T \<subset> S\<close> hom
  1853         by (metis homeomorphism_image2 homeomorphism_of_subsets order_refl psubsetE)
  1854       ultimately have "f ` T \<subset> sphere a r" by blast
  1855       then have "connected (- f ` T)"
  1856         by (rule psubset_sphere_Compl_connected [OF _ \<open>0 < r\<close> 2])
  1857       moreover have "compact T"
  1858         using \<open>compact S\<close> bounded_subset compact_eq_bounded_closed that by blast
  1859       moreover then have "compact (f ` T)"
  1860         by (meson compact_continuous_image continuous_on_subset hom homeomorphism_def psubsetE \<open>T \<subset> S\<close>)
  1861       moreover have "T homotopy_eqv f ` T"
  1862         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>)
  1863       ultimately show ?thesis
  1864         using homotopy_eqv_separation [of T "f`T"] by blast
  1865     qed
  1866   qed (rule T)
  1867 qed
  1868 
  1869 lemma%important Jordan_Brouwer_nonseparation:
  1870   fixes S :: "'a::euclidean_space set" and a::'a
  1871   assumes S: "S homeomorphic sphere a r" and "T \<subset> S" and 2: "2 \<le> DIM('a)"
  1872     shows "connected(- T)"
  1873 proof%unimportant -
  1874   have *: "connected(C \<union> (S - T))" if "C \<in> components(- S)" for C
  1875   proof (rule connected_intermediate_closure)
  1876     show "connected C"
  1877       using in_components_connected that by auto
  1878     have "S = frontier C"
  1879       using "2" Jordan_Brouwer_frontier S that by blast
  1880     with closure_subset show "C \<union> (S - T) \<subseteq> closure C"
  1881       by (auto simp: frontier_def)
  1882   qed auto
  1883   have "components(- S) \<noteq> {}"
  1884     by (metis S bounded_empty cobounded_imp_unbounded compact_eq_bounded_closed compact_sphere
  1885               components_eq_empty homeomorphic_compactness)
  1886   then have "- T = (\<Union>C \<in> components(- S). C \<union> (S - T))"
  1887     using Union_components [of "-S"] \<open>T \<subset> S\<close> by auto
  1888   then show ?thesis
  1889     apply (rule ssubst)
  1890     apply (rule connected_Union)
  1891     using \<open>T \<subset> S\<close> apply (auto simp: *)
  1892     done
  1893 qed
  1894 
  1895 subsection%important\<open> Invariance of domain and corollaries\<close>
  1896 
  1897 lemma%unimportant invariance_of_domain_ball:
  1898   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
  1899   assumes contf: "continuous_on (cball a r) f" and "0 < r"
  1900      and inj: "inj_on f (cball a r)"
  1901    shows "open(f ` ball a r)"
  1902 proof (cases "DIM('a) = 1")
  1903   case True
  1904   obtain h::"'a\<Rightarrow>real" and k
  1905         where "linear h" "linear k" "h ` UNIV = UNIV" "k ` UNIV = UNIV"
  1906               "\<And>x. norm(h x) = norm x" "\<And>x. norm(k x) = norm x"
  1907               "\<And>x. k(h x) = x" "\<And>x. h(k x) = x"
  1908     apply (rule isomorphisms_UNIV_UNIV [where 'M='a and 'N=real])
  1909       using True
  1910        apply force
  1911       by (metis UNIV_I UNIV_eq_I imageI)
  1912     have cont: "continuous_on S h"  "continuous_on T k" for S T
  1913       by (simp_all add: \<open>linear h\<close> \<open>linear k\<close> linear_continuous_on linear_linear)
  1914     have "continuous_on (h ` cball a r) (h \<circ> f \<circ> k)"
  1915       apply (intro continuous_on_compose cont continuous_on_subset [OF contf])
  1916       apply (auto simp: \<open>\<And>x. k (h x) = x\<close>)
  1917       done
  1918     moreover have "is_interval (h ` cball a r)"
  1919       by (simp add: is_interval_connected_1 \<open>linear h\<close> linear_continuous_on linear_linear connected_continuous_image)
  1920     moreover have "inj_on (h \<circ> f \<circ> k) (h ` cball a r)"
  1921       using inj by (simp add: inj_on_def) (metis \<open>\<And>x. k (h x) = x\<close>)
  1922     ultimately have *: "\<And>T. \<lbrakk>open T; T \<subseteq> h ` cball a r\<rbrakk> \<Longrightarrow> open ((h \<circ> f \<circ> k) ` T)"
  1923       using injective_eq_1d_open_map_UNIV by blast
  1924     have "open ((h \<circ> f \<circ> k) ` (h ` ball a r))"
  1925       by (rule *) (auto simp: \<open>linear h\<close> \<open>range h = UNIV\<close> open_surjective_linear_image)
  1926     then have "open ((h \<circ> f) ` ball a r)"
  1927       by (simp add: image_comp \<open>\<And>x. k (h x) = x\<close> cong: image_cong)
  1928     then show ?thesis
  1929       apply (simp add: image_comp [symmetric])
  1930       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)
  1931       done
  1932 next
  1933   case False
  1934   then have 2: "DIM('a) \<ge> 2"
  1935     by (metis DIM_ge_Suc0 One_nat_def Suc_1 antisym not_less_eq_eq)
  1936   have fimsub: "f ` ball a r \<subseteq> - f ` sphere a r"
  1937     using inj  by clarsimp (metis inj_onD less_eq_real_def mem_cball order_less_irrefl)
  1938   have hom: "f ` sphere a r homeomorphic sphere a r"
  1939     by (meson compact_sphere contf continuous_on_subset homeomorphic_compact homeomorphic_sym inj inj_on_subset sphere_cball)
  1940   then have nconn: "\<not> connected (- f ` sphere a r)"
  1941     by (rule Jordan_Brouwer_separation) (auto simp: \<open>0 < r\<close>)
  1942   obtain C where C: "C \<in> components (- f ` sphere a r)" and "bounded C"
  1943     apply (rule cobounded_has_bounded_component [OF _ nconn])
  1944       apply (simp_all add: 2)
  1945     by (meson compact_imp_bounded compact_continuous_image_eq compact_sphere contf inj sphere_cball)
  1946   moreover have "f ` (ball a r) = C"
  1947   proof
  1948     have "C \<noteq> {}"
  1949       by (rule in_components_nonempty [OF C])
  1950     show "C \<subseteq> f ` ball a r"
  1951     proof (rule ccontr)
  1952       assume nonsub: "\<not> C \<subseteq> f ` ball a r"
  1953       have "- f ` cball a r \<subseteq> C"
  1954       proof (rule components_maximal [OF C])
  1955         have "f ` cball a r homeomorphic cball a r"
  1956           using compact_cball contf homeomorphic_compact homeomorphic_sym inj by blast
  1957         then show "connected (- f ` cball a r)"
  1958           by (auto intro: connected_complement_homeomorphic_convex_compact 2)
  1959         show "- f ` cball a r \<subseteq> - f ` sphere a r"
  1960           by auto
  1961         then show "C \<inter> - f ` cball a r \<noteq> {}"
  1962           using \<open>C \<noteq> {}\<close> in_components_subset [OF C] nonsub
  1963           using image_iff by fastforce
  1964       qed
  1965       then have "bounded (- f ` cball a r)"
  1966         using bounded_subset \<open>bounded C\<close> by auto
  1967       then have "\<not> bounded (f ` cball a r)"
  1968         using cobounded_imp_unbounded by blast
  1969       then show "False"
  1970         using compact_continuous_image [OF contf] compact_cball compact_imp_bounded by blast
  1971     qed
  1972     with \<open>C \<noteq> {}\<close> have "C \<inter> f ` ball a r \<noteq> {}"
  1973       by (simp add: inf.absorb_iff1)
  1974     then show "f ` ball a r \<subseteq> C"
  1975       by (metis components_maximal [OF C _ fimsub] connected_continuous_image ball_subset_cball connected_ball contf continuous_on_subset)
  1976   qed
  1977   moreover have "open (- f ` sphere a r)"
  1978     using hom compact_eq_bounded_closed compact_sphere homeomorphic_compactness by blast
  1979   ultimately show ?thesis
  1980     using open_components by blast
  1981 qed
  1982 
  1983 
  1984 text\<open>Proved by L. E. J. Brouwer (1912)\<close>
  1985 theorem%important invariance_of_domain:
  1986   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
  1987   assumes "continuous_on S f" "open S" "inj_on f S"
  1988     shows "open(f ` S)"
  1989   unfolding open_subopen [of "f`S"]
  1990 proof%unimportant clarify
  1991   fix a
  1992   assume "a \<in> S"
  1993   obtain \<delta> where "\<delta> > 0" and \<delta>: "cball a \<delta> \<subseteq> S"
  1994     using \<open>open S\<close> \<open>a \<in> S\<close> open_contains_cball_eq by blast
  1995   show "\<exists>T. open T \<and> f a \<in> T \<and> T \<subseteq> f ` S"
  1996   proof (intro exI conjI)
  1997     show "open (f ` (ball a \<delta>))"
  1998       by (meson \<delta> \<open>0 < \<delta>\<close> assms continuous_on_subset inj_on_subset invariance_of_domain_ball)
  1999     show "f a \<in> f ` ball a \<delta>"
  2000       by (simp add: \<open>0 < \<delta>\<close>)
  2001     show "f ` ball a \<delta> \<subseteq> f ` S"
  2002       using \<delta> ball_subset_cball by blast
  2003   qed
  2004 qed
  2005 
  2006 lemma%unimportant inv_of_domain_ss0:
  2007   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
  2008   assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \<subseteq> S"
  2009       and "subspace S" and dimS: "dim S = DIM('b::euclidean_space)"
  2010       and ope: "openin (subtopology euclidean S) U"
  2011     shows "openin (subtopology euclidean S) (f ` U)"
  2012 proof -
  2013   have "U \<subseteq> S"
  2014     using ope openin_imp_subset by blast
  2015   have "(UNIV::'b set) homeomorphic S"
  2016     by (simp add: \<open>subspace S\<close> dimS homeomorphic_subspaces)
  2017   then obtain h k where homhk: "homeomorphism (UNIV::'b set) S h k"
  2018     using homeomorphic_def by blast
  2019   have homkh: "homeomorphism S (k ` S) k h"
  2020     using homhk homeomorphism_image2 homeomorphism_sym by fastforce
  2021   have "open ((k \<circ> f \<circ> h) ` k ` U)"
  2022   proof (rule invariance_of_domain)
  2023     show "continuous_on (k ` U) (k \<circ> f \<circ> h)"
  2024     proof (intro continuous_intros)
  2025       show "continuous_on (k ` U) h"
  2026         by (meson continuous_on_subset [OF homeomorphism_cont1 [OF homhk]] top_greatest)
  2027       show "continuous_on (h ` k ` U) f"
  2028         apply (rule continuous_on_subset [OF contf], clarify)
  2029         apply (metis homhk homeomorphism_def ope openin_imp_subset rev_subsetD)
  2030         done
  2031       show "continuous_on (f ` h ` k ` U) k"
  2032         apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
  2033         using fim homhk homeomorphism_apply2 ope openin_subset by fastforce
  2034     qed
  2035     have ope_iff: "\<And>T. open T \<longleftrightarrow> openin (subtopology euclidean (k ` S)) T"
  2036       using homhk homeomorphism_image2 open_openin by fastforce
  2037     show "open (k ` U)"
  2038       by (simp add: ope_iff homeomorphism_imp_open_map [OF homkh ope])
  2039     show "inj_on (k \<circ> f \<circ> h) (k ` U)"
  2040       apply (clarsimp simp: inj_on_def)
  2041       by (metis subsetD fim homeomorphism_apply2 [OF homhk] image_subset_iff inj_on_eq_iff injf \<open>U \<subseteq> S\<close>)
  2042   qed
  2043   moreover
  2044   have eq: "f ` U = h ` (k \<circ> f \<circ> h \<circ> k) ` U"
  2045     apply (auto simp: image_comp [symmetric])
  2046     apply (metis homkh \<open>U \<subseteq> S\<close> fim homeomorphism_image2 homeomorphism_of_subsets homhk imageI subset_UNIV)
  2047     by (metis \<open>U \<subseteq> S\<close> subsetD fim homeomorphism_def homhk image_eqI)
  2048   ultimately show ?thesis
  2049     by (metis (no_types, hide_lams) homeomorphism_imp_open_map homhk image_comp open_openin subtopology_UNIV)
  2050 qed
  2051 
  2052 lemma%unimportant inv_of_domain_ss1:
  2053   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
  2054   assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \<subseteq> S"
  2055       and "subspace S"
  2056       and ope: "openin (subtopology euclidean S) U"
  2057     shows "openin (subtopology euclidean S) (f ` U)"
  2058 proof -
  2059   define S' where "S' \<equiv> {y. \<forall>x \<in> S. orthogonal x y}"
  2060   have "subspace S'"
  2061     by (simp add: S'_def subspace_orthogonal_to_vectors)
  2062   define g where "g \<equiv> \<lambda>z::'a*'a. ((f \<circ> fst)z, snd z)"
  2063   have "openin (subtopology euclidean (S \<times> S')) (g ` (U \<times> S'))"
  2064   proof (rule inv_of_domain_ss0)
  2065     show "continuous_on (U \<times> S') g"
  2066       apply (simp add: g_def)
  2067       apply (intro continuous_intros continuous_on_compose2 [OF contf continuous_on_fst], auto)
  2068       done
  2069     show "g ` (U \<times> S') \<subseteq> S \<times> S'"
  2070       using fim  by (auto simp: g_def)
  2071     show "inj_on g (U \<times> S')"
  2072       using injf by (auto simp: g_def inj_on_def)
  2073     show "subspace (S \<times> S')"
  2074       by (simp add: \<open>subspace S'\<close> \<open>subspace S\<close> subspace_Times)
  2075     show "openin (subtopology euclidean (S \<times> S')) (U \<times> S')"
  2076       by (simp add: openin_Times [OF ope])
  2077     have "dim (S \<times> S') = dim S + dim S'"
  2078       by (simp add: \<open>subspace S'\<close> \<open>subspace S\<close> dim_Times)
  2079     also have "... = DIM('a)"
  2080       using dim_subspace_orthogonal_to_vectors [OF \<open>subspace S\<close> subspace_UNIV]
  2081       by (simp add: add.commute S'_def)
  2082     finally show "dim (S \<times> S') = DIM('a)" .
  2083   qed
  2084   moreover have "g ` (U \<times> S') = f ` U \<times> S'"
  2085     by (auto simp: g_def image_iff)
  2086   moreover have "0 \<in> S'"
  2087     using \<open>subspace S'\<close> subspace_affine by blast
  2088   ultimately show ?thesis
  2089     by (auto simp: openin_Times_eq)
  2090 qed
  2091 
  2092 
  2093 corollary%important invariance_of_domain_subspaces:
  2094   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2095   assumes ope: "openin (subtopology euclidean U) S"
  2096       and "subspace U" "subspace V" and VU: "dim V \<le> dim U"
  2097       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
  2098       and injf: "inj_on f S"
  2099     shows "openin (subtopology euclidean V) (f ` S)"
  2100 proof%unimportant -
  2101   obtain V' where "subspace V'" "V' \<subseteq> U" "dim V' = dim V"
  2102     using choose_subspace_of_subspace [OF VU]
  2103     by (metis span_eq_iff \<open>subspace U\<close>)
  2104   then have "V homeomorphic V'"
  2105     by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
  2106   then obtain h k where homhk: "homeomorphism V V' h k"
  2107     using homeomorphic_def by blast
  2108   have eq: "f ` S = k ` (h \<circ> f) ` S"
  2109   proof -
  2110     have "k ` h ` f ` S = f ` S"
  2111       by (meson fim homeomorphism_def homeomorphism_of_subsets homhk subset_refl)
  2112     then show ?thesis
  2113       by (simp add: image_comp)
  2114   qed
  2115   show ?thesis
  2116     unfolding eq
  2117   proof (rule homeomorphism_imp_open_map)
  2118     show homkh: "homeomorphism V' V k h"
  2119       by (simp add: homeomorphism_symD homhk)
  2120     have hfV': "(h \<circ> f) ` S \<subseteq> V'"
  2121       using fim homeomorphism_image1 homhk by fastforce
  2122     moreover have "openin (subtopology euclidean U) ((h \<circ> f) ` S)"
  2123     proof (rule inv_of_domain_ss1)
  2124       show "continuous_on S (h \<circ> f)"
  2125         by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
  2126       show "inj_on (h \<circ> f) S"
  2127         apply (clarsimp simp: inj_on_def)
  2128         by (metis fim homeomorphism_apply2 [OF homkh] image_subset_iff inj_onD injf)
  2129       show "(h \<circ> f) ` S \<subseteq> U"
  2130         using \<open>V' \<subseteq> U\<close> hfV' by auto
  2131       qed (auto simp: assms)
  2132     ultimately show "openin (subtopology euclidean V') ((h \<circ> f) ` S)"
  2133       using openin_subset_trans \<open>V' \<subseteq> U\<close> by force
  2134   qed
  2135 qed
  2136 
  2137 corollary%important invariance_of_dimension_subspaces:
  2138   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2139   assumes ope: "openin (subtopology euclidean U) S"
  2140       and "subspace U" "subspace V"
  2141       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
  2142       and injf: "inj_on f S" and "S \<noteq> {}"
  2143     shows "dim U \<le> dim V"
  2144 proof%unimportant -
  2145   have "False" if "dim V < dim U"
  2146   proof -
  2147     obtain T where "subspace T" "T \<subseteq> U" "dim T = dim V"
  2148       using choose_subspace_of_subspace [of "dim V" U]
  2149       by (metis \<open>dim V < dim U\<close> assms(2) order.strict_implies_order span_eq_iff)
  2150     then have "V homeomorphic T"
  2151       by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
  2152     then obtain h k where homhk: "homeomorphism V T h k"
  2153       using homeomorphic_def  by blast
  2154     have "continuous_on S (h \<circ> f)"
  2155       by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
  2156     moreover have "(h \<circ> f) ` S \<subseteq> U"
  2157       using \<open>T \<subseteq> U\<close> fim homeomorphism_image1 homhk by fastforce
  2158     moreover have "inj_on (h \<circ> f) S"
  2159       apply (clarsimp simp: inj_on_def)
  2160       by (metis fim homeomorphism_apply1 homhk image_subset_iff inj_onD injf)
  2161     ultimately have ope_hf: "openin (subtopology euclidean U) ((h \<circ> f) ` S)"
  2162       using invariance_of_domain_subspaces [OF ope \<open>subspace U\<close> \<open>subspace U\<close>] by auto
  2163     have "(h \<circ> f) ` S \<subseteq> T"
  2164       using fim homeomorphism_image1 homhk by fastforce
  2165     then show ?thesis
  2166       by (metis dim_openin \<open>dim T = dim V\<close> ope_hf \<open>subspace U\<close> \<open>S \<noteq> {}\<close> dim_subset image_is_empty not_le that)
  2167   qed
  2168   then show ?thesis
  2169     using not_less by blast
  2170 qed
  2171 
  2172 corollary%important invariance_of_domain_affine_sets:
  2173   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2174   assumes ope: "openin (subtopology euclidean U) S"
  2175       and aff: "affine U" "affine V" "aff_dim V \<le> aff_dim U"
  2176       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
  2177       and injf: "inj_on f S"
  2178     shows "openin (subtopology euclidean V) (f ` S)"
  2179 proof%unimportant (cases "S = {}")
  2180   case True
  2181   then show ?thesis by auto
  2182 next
  2183   case False
  2184   obtain a b where "a \<in> S" "a \<in> U" "b \<in> V"
  2185     using False fim ope openin_contains_cball by fastforce
  2186   have "openin (subtopology euclidean ((+) (- b) ` V)) (((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S)"
  2187   proof (rule invariance_of_domain_subspaces)
  2188     show "openin (subtopology euclidean ((+) (- a) ` U)) ((+) (- a) ` S)"
  2189       by (metis ope homeomorphism_imp_open_map homeomorphism_translation translation_galois)
  2190     show "subspace ((+) (- a) ` U)"
  2191       by (simp add: \<open>a \<in> U\<close> affine_diffs_subspace \<open>affine U\<close>)
  2192     show "subspace ((+) (- b) ` V)"
  2193       by (simp add: \<open>b \<in> V\<close> affine_diffs_subspace \<open>affine V\<close>)
  2194     show "dim ((+) (- b) ` V) \<le> dim ((+) (- a) ` U)"
  2195       by (metis \<open>a \<in> U\<close> \<open>b \<in> V\<close> aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff)
  2196     show "continuous_on ((+) (- a) ` S) ((+) (- b) \<circ> f \<circ> (+) a)"
  2197       by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois)
  2198     show "((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S \<subseteq> (+) (- b) ` V"
  2199       using fim by auto
  2200     show "inj_on ((+) (- b) \<circ> f \<circ> (+) a) ((+) (- a) ` S)"
  2201       by (auto simp: inj_on_def) (meson inj_onD injf)
  2202   qed
  2203   then show ?thesis
  2204     by (metis (no_types, lifting) homeomorphism_imp_open_map homeomorphism_translation image_comp translation_galois)
  2205 qed
  2206 
  2207 corollary%important invariance_of_dimension_affine_sets:
  2208   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2209   assumes ope: "openin (subtopology euclidean U) S"
  2210       and aff: "affine U" "affine V"
  2211       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
  2212       and injf: "inj_on f S" and "S \<noteq> {}"
  2213     shows "aff_dim U \<le> aff_dim V"
  2214 proof%unimportant -
  2215   obtain a b where "a \<in> S" "a \<in> U" "b \<in> V"
  2216     using \<open>S \<noteq> {}\<close> fim ope openin_contains_cball by fastforce
  2217   have "dim ((+) (- a) ` U) \<le> dim ((+) (- b) ` V)"
  2218   proof (rule invariance_of_dimension_subspaces)
  2219     show "openin (subtopology euclidean ((+) (- a) ` U)) ((+) (- a) ` S)"
  2220       by (metis ope homeomorphism_imp_open_map homeomorphism_translation translation_galois)
  2221     show "subspace ((+) (- a) ` U)"
  2222       by (simp add: \<open>a \<in> U\<close> affine_diffs_subspace \<open>affine U\<close>)
  2223     show "subspace ((+) (- b) ` V)"
  2224       by (simp add: \<open>b \<in> V\<close> affine_diffs_subspace \<open>affine V\<close>)
  2225     show "continuous_on ((+) (- a) ` S) ((+) (- b) \<circ> f \<circ> (+) a)"
  2226       by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois)
  2227     show "((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S \<subseteq> (+) (- b) ` V"
  2228       using fim by auto
  2229     show "inj_on ((+) (- b) \<circ> f \<circ> (+) a) ((+) (- a) ` S)"
  2230       by (auto simp: inj_on_def) (meson inj_onD injf)
  2231   qed (use \<open>S \<noteq> {}\<close> in auto)
  2232   then show ?thesis
  2233     by (metis \<open>a \<in> U\<close> \<open>b \<in> V\<close> aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff)
  2234 qed
  2235 
  2236 corollary%important invariance_of_dimension:
  2237   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2238   assumes contf: "continuous_on S f" and "open S"
  2239       and injf: "inj_on f S" and "S \<noteq> {}"
  2240     shows "DIM('a) \<le> DIM('b)"
  2241   using%unimportant invariance_of_dimension_subspaces [of UNIV S UNIV f] assms
  2242   by auto
  2243 
  2244 
  2245 corollary%important continuous_injective_image_subspace_dim_le:
  2246   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2247   assumes "subspace S" "subspace T"
  2248       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
  2249       and injf: "inj_on f S"
  2250     shows "dim S \<le> dim T"
  2251   apply (rule invariance_of_dimension_subspaces [of S S _ f])
  2252   using%unimportant assms by (auto simp: subspace_affine)
  2253 
  2254 lemma%unimportant invariance_of_dimension_convex_domain:
  2255   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2256   assumes "convex S"
  2257       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> affine hull T"
  2258       and injf: "inj_on f S"
  2259     shows "aff_dim S \<le> aff_dim T"
  2260 proof (cases "S = {}")
  2261   case True
  2262   then show ?thesis by (simp add: aff_dim_geq)
  2263 next
  2264   case False
  2265   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
  2266   proof (rule invariance_of_dimension_affine_sets)
  2267     show "openin (subtopology euclidean (affine hull S)) (rel_interior S)"
  2268       by (simp add: openin_rel_interior)
  2269     show "continuous_on (rel_interior S) f"
  2270       using contf continuous_on_subset rel_interior_subset by blast
  2271     show "f ` rel_interior S \<subseteq> affine hull T"
  2272       using fim rel_interior_subset by blast
  2273     show "inj_on f (rel_interior S)"
  2274       using inj_on_subset injf rel_interior_subset by blast
  2275     show "rel_interior S \<noteq> {}"
  2276       by (simp add: False \<open>convex S\<close> rel_interior_eq_empty)
  2277   qed auto
  2278   then show ?thesis
  2279     by simp
  2280 qed
  2281 
  2282 
  2283 lemma%unimportant homeomorphic_convex_sets_le:
  2284   assumes "convex S" "S homeomorphic T"
  2285   shows "aff_dim S \<le> aff_dim T"
  2286 proof -
  2287   obtain h k where homhk: "homeomorphism S T h k"
  2288     using homeomorphic_def assms  by blast
  2289   show ?thesis
  2290   proof (rule invariance_of_dimension_convex_domain [OF \<open>convex S\<close>])
  2291     show "continuous_on S h"
  2292       using homeomorphism_def homhk by blast
  2293     show "h ` S \<subseteq> affine hull T"
  2294       by (metis homeomorphism_def homhk hull_subset)
  2295     show "inj_on h S"
  2296       by (meson homeomorphism_apply1 homhk inj_on_inverseI)
  2297   qed
  2298 qed
  2299 
  2300 lemma%unimportant homeomorphic_convex_sets:
  2301   assumes "convex S" "convex T" "S homeomorphic T"
  2302   shows "aff_dim S = aff_dim T"
  2303   by (meson assms dual_order.antisym homeomorphic_convex_sets_le homeomorphic_sym)
  2304 
  2305 lemma%unimportant homeomorphic_convex_compact_sets_eq:
  2306   assumes "convex S" "compact S" "convex T" "compact T"
  2307   shows "S homeomorphic T \<longleftrightarrow> aff_dim S = aff_dim T"
  2308   by (meson assms homeomorphic_convex_compact_sets homeomorphic_convex_sets)
  2309 
  2310 lemma%unimportant invariance_of_domain_gen:
  2311   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2312   assumes "open S" "continuous_on S f" "inj_on f S" "DIM('b) \<le> DIM('a)"
  2313     shows "open(f ` S)"
  2314   using invariance_of_domain_subspaces [of UNIV S UNIV f] assms by auto
  2315 
  2316 lemma%unimportant injective_into_1d_imp_open_map_UNIV:
  2317   fixes f :: "'a::euclidean_space \<Rightarrow> real"
  2318   assumes "open T" "continuous_on S f" "inj_on f S" "T \<subseteq> S"
  2319     shows "open (f ` T)"
  2320   apply (rule invariance_of_domain_gen [OF \<open>open T\<close>])
  2321   using assms apply (auto simp: elim: continuous_on_subset subset_inj_on)
  2322   done
  2323 
  2324 lemma%unimportant continuous_on_inverse_open:
  2325   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2326   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" and gf: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
  2327     shows "continuous_on (f ` S) g"
  2328 proof (clarsimp simp add: continuous_openin_preimage_eq)
  2329   fix T :: "'a set"
  2330   assume "open T"
  2331   have eq: "f ` S \<inter> g -` T = f ` (S \<inter> T)"
  2332     by (auto simp: gf)
  2333   show "openin (subtopology euclidean (f ` S)) (f ` S \<inter> g -` T)"
  2334     apply (subst eq)
  2335     apply (rule open_openin_trans)
  2336       apply (rule invariance_of_domain_gen)
  2337     using assms
  2338          apply auto
  2339     using inj_on_inverseI apply auto[1]
  2340     by (metis \<open>open T\<close> continuous_on_subset inj_onI inj_on_subset invariance_of_domain_gen openin_open openin_open_eq)
  2341 qed
  2342 
  2343 lemma%unimportant invariance_of_domain_homeomorphism:
  2344   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2345   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" "inj_on f S"
  2346   obtains g where "homeomorphism S (f ` S) f g"
  2347 proof
  2348   show "homeomorphism S (f ` S) f (inv_into S f)"
  2349     by (simp add: assms continuous_on_inverse_open homeomorphism_def)
  2350 qed
  2351 
  2352 corollary%important invariance_of_domain_homeomorphic:
  2353   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2354   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" "inj_on f S"
  2355   shows "S homeomorphic (f ` S)"
  2356   using%unimportant invariance_of_domain_homeomorphism [OF assms]
  2357   by%unimportant (meson homeomorphic_def)
  2358 
  2359 lemma%unimportant continuous_image_subset_interior:
  2360   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2361   assumes "continuous_on S f" "inj_on f S" "DIM('b) \<le> DIM('a)"
  2362   shows "f ` (interior S) \<subseteq> interior(f ` S)"
  2363   apply (rule interior_maximal)
  2364    apply (simp add: image_mono interior_subset)
  2365   apply (rule invariance_of_domain_gen)
  2366   using assms
  2367      apply (auto simp: subset_inj_on interior_subset continuous_on_subset)
  2368   done
  2369 
  2370 lemma%important homeomorphic_interiors_same_dimension:
  2371   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2372   assumes "S homeomorphic T" and dimeq: "DIM('a) = DIM('b)"
  2373   shows "(interior S) homeomorphic (interior T)"
  2374   using assms [unfolded homeomorphic_minimal]
  2375   unfolding homeomorphic_def
  2376 proof%unimportant (clarify elim!: ex_forward)
  2377   fix f g
  2378   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"
  2379      and contf: "continuous_on S f" and contg: "continuous_on T g"
  2380   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
  2381     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
  2382   have fim: "f ` interior S \<subseteq> interior T"
  2383     using continuous_image_subset_interior [OF contf \<open>inj_on f S\<close>] dimeq fST by simp
  2384   have gim: "g ` interior T \<subseteq> interior S"
  2385     using continuous_image_subset_interior [OF contg \<open>inj_on g T\<close>] dimeq gTS by simp
  2386   show "homeomorphism (interior S) (interior T) f g"
  2387     unfolding homeomorphism_def
  2388   proof (intro conjI ballI)
  2389     show "\<And>x. x \<in> interior S \<Longrightarrow> g (f x) = x"
  2390       by (meson \<open>\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x\<close> subsetD interior_subset)
  2391     have "interior T \<subseteq> f ` interior S"
  2392     proof
  2393       fix x assume "x \<in> interior T"
  2394       then have "g x \<in> interior S"
  2395         using gim by blast
  2396       then show "x \<in> f ` interior S"
  2397         by (metis T \<open>x \<in> interior T\<close> image_iff interior_subset subsetCE)
  2398     qed
  2399     then show "f ` interior S = interior T"
  2400       using fim by blast
  2401     show "continuous_on (interior S) f"
  2402       by (metis interior_subset continuous_on_subset contf)
  2403     show "\<And>y. y \<in> interior T \<Longrightarrow> f (g y) = y"
  2404       by (meson T subsetD interior_subset)
  2405     have "interior S \<subseteq> g ` interior T"
  2406     proof
  2407       fix x assume "x \<in> interior S"
  2408       then have "f x \<in> interior T"
  2409         using fim by blast
  2410       then show "x \<in> g ` interior T"
  2411         by (metis S \<open>x \<in> interior S\<close> image_iff interior_subset subsetCE)
  2412     qed
  2413     then show "g ` interior T = interior S"
  2414       using gim by blast
  2415     show "continuous_on (interior T) g"
  2416       by (metis interior_subset continuous_on_subset contg)
  2417   qed
  2418 qed
  2419 
  2420 lemma%unimportant homeomorphic_open_imp_same_dimension:
  2421   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2422   assumes "S homeomorphic T" "open S" "S \<noteq> {}" "open T" "T \<noteq> {}"
  2423   shows "DIM('a) = DIM('b)"
  2424     using assms
  2425     apply (simp add: homeomorphic_minimal)
  2426     apply (rule order_antisym; metis inj_onI invariance_of_dimension)
  2427     done
  2428 
  2429 lemma%unimportant homeomorphic_interiors:
  2430   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2431   assumes "S homeomorphic T" "interior S = {} \<longleftrightarrow> interior T = {}"
  2432     shows "(interior S) homeomorphic (interior T)"
  2433 proof (cases "interior T = {}")
  2434   case True
  2435   with assms show ?thesis by auto
  2436 next
  2437   case False
  2438   then have "DIM('a) = DIM('b)"
  2439     using assms
  2440     apply (simp add: homeomorphic_minimal)
  2441     apply (rule order_antisym; metis continuous_on_subset inj_onI inj_on_subset interior_subset invariance_of_dimension open_interior)
  2442     done
  2443   then show ?thesis
  2444     by (rule homeomorphic_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
  2445 qed
  2446 
  2447 lemma%unimportant homeomorphic_frontiers_same_dimension:
  2448   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2449   assumes "S homeomorphic T" "closed S" "closed T" and dimeq: "DIM('a) = DIM('b)"
  2450   shows "(frontier S) homeomorphic (frontier T)"
  2451   using assms [unfolded homeomorphic_minimal]
  2452   unfolding homeomorphic_def
  2453 proof (clarify elim!: ex_forward)
  2454   fix f g
  2455   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"
  2456      and contf: "continuous_on S f" and contg: "continuous_on T g"
  2457   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
  2458     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
  2459   have "g ` interior T \<subseteq> interior S"
  2460     using continuous_image_subset_interior [OF contg \<open>inj_on g T\<close>] dimeq gTS by simp
  2461   then have fim: "f ` frontier S \<subseteq> frontier T"
  2462     apply (simp add: frontier_def)
  2463     using continuous_image_subset_interior assms(2) assms(3) S by auto
  2464   have "f ` interior S \<subseteq> interior T"
  2465     using continuous_image_subset_interior [OF contf \<open>inj_on f S\<close>] dimeq fST by simp
  2466   then have gim: "g ` frontier T \<subseteq> frontier S"
  2467     apply (simp add: frontier_def)
  2468     using continuous_image_subset_interior T assms(2) assms(3) by auto
  2469   show "homeomorphism (frontier S) (frontier T) f g"
  2470     unfolding homeomorphism_def
  2471   proof (intro conjI ballI)
  2472     show gf: "\<And>x. x \<in> frontier S \<Longrightarrow> g (f x) = x"
  2473       by (simp add: S assms(2) frontier_def)
  2474     show fg: "\<And>y. y \<in> frontier T \<Longrightarrow> f (g y) = y"
  2475       by (simp add: T assms(3) frontier_def)
  2476     have "frontier T \<subseteq> f ` frontier S"
  2477     proof
  2478       fix x assume "x \<in> frontier T"
  2479       then have "g x \<in> frontier S"
  2480         using gim by blast
  2481       then show "x \<in> f ` frontier S"
  2482         by (metis fg \<open>x \<in> frontier T\<close> imageI)
  2483     qed
  2484     then show "f ` frontier S = frontier T"
  2485       using fim by blast
  2486     show "continuous_on (frontier S) f"
  2487       by (metis Diff_subset assms(2) closure_eq contf continuous_on_subset frontier_def)
  2488     have "frontier S \<subseteq> g ` frontier T"
  2489     proof
  2490       fix x assume "x \<in> frontier S"
  2491       then have "f x \<in> frontier T"
  2492         using fim by blast
  2493       then show "x \<in> g ` frontier T"
  2494         by (metis gf \<open>x \<in> frontier S\<close> imageI)
  2495     qed
  2496     then show "g ` frontier T = frontier S"
  2497       using gim by blast
  2498     show "continuous_on (frontier T) g"
  2499       by (metis Diff_subset assms(3) closure_closed contg continuous_on_subset frontier_def)
  2500   qed
  2501 qed
  2502 
  2503 lemma%unimportant homeomorphic_frontiers:
  2504   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2505   assumes "S homeomorphic T" "closed S" "closed T"
  2506           "interior S = {} \<longleftrightarrow> interior T = {}"
  2507     shows "(frontier S) homeomorphic (frontier T)"
  2508 proof (cases "interior T = {}")
  2509   case True
  2510   then show ?thesis
  2511     by (metis Diff_empty assms closure_eq frontier_def)
  2512 next
  2513   case False
  2514   show ?thesis
  2515     apply (rule homeomorphic_frontiers_same_dimension)
  2516        apply (simp_all add: assms)
  2517     using False assms homeomorphic_interiors homeomorphic_open_imp_same_dimension by blast
  2518 qed
  2519 
  2520 lemma%unimportant continuous_image_subset_rel_interior:
  2521   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2522   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
  2523       and TS: "aff_dim T \<le> aff_dim S"
  2524   shows "f ` (rel_interior S) \<subseteq> rel_interior(f ` S)"
  2525 proof (rule rel_interior_maximal)
  2526   show "f ` rel_interior S \<subseteq> f ` S"
  2527     by(simp add: image_mono rel_interior_subset)
  2528   show "openin (subtopology euclidean (affine hull f ` S)) (f ` rel_interior S)"
  2529   proof (rule invariance_of_domain_affine_sets)
  2530     show "openin (subtopology euclidean (affine hull S)) (rel_interior S)"
  2531       by (simp add: openin_rel_interior)
  2532     show "aff_dim (affine hull f ` S) \<le> aff_dim (affine hull S)"
  2533       by (metis aff_dim_affine_hull aff_dim_subset fim TS order_trans)
  2534     show "f ` rel_interior S \<subseteq> affine hull f ` S"
  2535       by (meson \<open>f ` rel_interior S \<subseteq> f ` S\<close> hull_subset order_trans)
  2536     show "continuous_on (rel_interior S) f"
  2537       using contf continuous_on_subset rel_interior_subset by blast
  2538     show "inj_on f (rel_interior S)"
  2539       using inj_on_subset injf rel_interior_subset by blast
  2540   qed auto
  2541 qed
  2542 
  2543 lemma%unimportant homeomorphic_rel_interiors_same_dimension:
  2544   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2545   assumes "S homeomorphic T" and aff: "aff_dim S = aff_dim T"
  2546   shows "(rel_interior S) homeomorphic (rel_interior T)"
  2547   using assms [unfolded homeomorphic_minimal]
  2548   unfolding homeomorphic_def
  2549 proof (clarify elim!: ex_forward)
  2550   fix f g
  2551   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"
  2552      and contf: "continuous_on S f" and contg: "continuous_on T g"
  2553   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
  2554     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
  2555   have fim: "f ` rel_interior S \<subseteq> rel_interior T"
  2556     by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
  2557   have gim: "g ` rel_interior T \<subseteq> rel_interior S"
  2558     by (metis \<open>inj_on g T\<close> aff contg continuous_image_subset_rel_interior gTS order_refl)
  2559   show "homeomorphism (rel_interior S) (rel_interior T) f g"
  2560     unfolding homeomorphism_def
  2561   proof (intro conjI ballI)
  2562     show gf: "\<And>x. x \<in> rel_interior S \<Longrightarrow> g (f x) = x"
  2563       using S rel_interior_subset by blast
  2564     show fg: "\<And>y. y \<in> rel_interior T \<Longrightarrow> f (g y) = y"
  2565       using T mem_rel_interior_ball by blast
  2566     have "rel_interior T \<subseteq> f ` rel_interior S"
  2567     proof
  2568       fix x assume "x \<in> rel_interior T"
  2569       then have "g x \<in> rel_interior S"
  2570         using gim by blast
  2571       then show "x \<in> f ` rel_interior S"
  2572         by (metis fg \<open>x \<in> rel_interior T\<close> imageI)
  2573     qed
  2574     moreover have "f ` rel_interior S \<subseteq> rel_interior T"
  2575       by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
  2576     ultimately show "f ` rel_interior S = rel_interior T"
  2577       by blast
  2578     show "continuous_on (rel_interior S) f"
  2579       using contf continuous_on_subset rel_interior_subset by blast
  2580     have "rel_interior S \<subseteq> g ` rel_interior T"
  2581     proof
  2582       fix x assume "x \<in> rel_interior S"
  2583       then have "f x \<in> rel_interior T"
  2584         using fim by blast
  2585       then show "x \<in> g ` rel_interior T"
  2586         by (metis gf \<open>x \<in> rel_interior S\<close> imageI)
  2587     qed
  2588     then show "g ` rel_interior T = rel_interior S"
  2589       using gim by blast
  2590     show "continuous_on (rel_interior T) g"
  2591       using contg continuous_on_subset rel_interior_subset by blast
  2592   qed
  2593 qed
  2594 
  2595 lemma%important homeomorphic_rel_interiors:
  2596   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2597   assumes "S homeomorphic T" "rel_interior S = {} \<longleftrightarrow> rel_interior T = {}"
  2598     shows "(rel_interior S) homeomorphic (rel_interior T)"
  2599 proof%unimportant (cases "rel_interior T = {}")
  2600   case True
  2601   with assms show ?thesis by auto
  2602 next
  2603   case False
  2604   obtain f g
  2605     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"
  2606       and contf: "continuous_on S f" and contg: "continuous_on T g"
  2607     using  assms [unfolded homeomorphic_minimal] by auto
  2608   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
  2609     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior S" _ f])
  2610           apply (simp_all add: openin_rel_interior False assms)
  2611     using contf continuous_on_subset rel_interior_subset apply blast
  2612       apply (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
  2613     apply (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
  2614     done
  2615   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
  2616     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior T" _ g])
  2617           apply (simp_all add: openin_rel_interior False assms)
  2618     using contg continuous_on_subset rel_interior_subset apply blast
  2619       apply (meson T hull_subset image_subsetI rel_interior_subset rev_subsetD)
  2620     apply (metis T inj_on_inverseI inj_on_subset rel_interior_subset)
  2621     done
  2622   ultimately have "aff_dim S = aff_dim T" by force
  2623   then show ?thesis
  2624     by (rule homeomorphic_rel_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
  2625 qed
  2626 
  2627 
  2628 lemma%unimportant homeomorphic_rel_boundaries_same_dimension:
  2629   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2630   assumes "S homeomorphic T" and aff: "aff_dim S = aff_dim T"
  2631   shows "(S - rel_interior S) homeomorphic (T - rel_interior T)"
  2632   using assms [unfolded homeomorphic_minimal]
  2633   unfolding homeomorphic_def
  2634 proof (clarify elim!: ex_forward)
  2635   fix f g
  2636   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"
  2637      and contf: "continuous_on S f" and contg: "continuous_on T g"
  2638   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
  2639     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
  2640   have fim: "f ` rel_interior S \<subseteq> rel_interior T"
  2641     by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
  2642   have gim: "g ` rel_interior T \<subseteq> rel_interior S"
  2643     by (metis \<open>inj_on g T\<close> aff contg continuous_image_subset_rel_interior gTS order_refl)
  2644   show "homeomorphism (S - rel_interior S) (T - rel_interior T) f g"
  2645     unfolding homeomorphism_def
  2646   proof (intro conjI ballI)
  2647     show gf: "\<And>x. x \<in> S - rel_interior S \<Longrightarrow> g (f x) = x"
  2648       using S rel_interior_subset by blast
  2649     show fg: "\<And>y. y \<in> T - rel_interior T \<Longrightarrow> f (g y) = y"
  2650       using T mem_rel_interior_ball by blast
  2651     show "f ` (S - rel_interior S) = T - rel_interior T"
  2652       using S fST fim gim by auto
  2653     show "continuous_on (S - rel_interior S) f"
  2654       using contf continuous_on_subset rel_interior_subset by blast
  2655     show "g ` (T - rel_interior T) = S - rel_interior S"
  2656       using T gTS gim fim by auto
  2657     show "continuous_on (T - rel_interior T) g"
  2658       using contg continuous_on_subset rel_interior_subset by blast
  2659   qed
  2660 qed
  2661 
  2662 lemma%unimportant homeomorphic_rel_boundaries:
  2663   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2664   assumes "S homeomorphic T" "rel_interior S = {} \<longleftrightarrow> rel_interior T = {}"
  2665     shows "(S - rel_interior S) homeomorphic (T - rel_interior T)"
  2666 proof (cases "rel_interior T = {}")
  2667   case True
  2668   with assms show ?thesis by auto
  2669 next
  2670   case False
  2671   obtain f g
  2672     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"
  2673       and contf: "continuous_on S f" and contg: "continuous_on T g"
  2674     using  assms [unfolded homeomorphic_minimal] by auto
  2675   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
  2676     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior S" _ f])
  2677           apply (simp_all add: openin_rel_interior False assms)
  2678     using contf continuous_on_subset rel_interior_subset apply blast
  2679       apply (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
  2680     apply (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
  2681     done
  2682   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
  2683     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior T" _ g])
  2684           apply (simp_all add: openin_rel_interior False assms)
  2685     using contg continuous_on_subset rel_interior_subset apply blast
  2686       apply (meson T hull_subset image_subsetI rel_interior_subset rev_subsetD)
  2687     apply (metis T inj_on_inverseI inj_on_subset rel_interior_subset)
  2688     done
  2689   ultimately have "aff_dim S = aff_dim T" by force
  2690   then show ?thesis
  2691     by (rule homeomorphic_rel_boundaries_same_dimension [OF \<open>S homeomorphic T\<close>])
  2692 qed
  2693 
  2694 proposition%important uniformly_continuous_homeomorphism_UNIV_trivial:
  2695   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
  2696   assumes contf: "uniformly_continuous_on S f" and hom: "homeomorphism S UNIV f g"
  2697   shows "S = UNIV"
  2698 proof%unimportant (cases "S = {}")
  2699   case True
  2700   then show ?thesis
  2701     by (metis UNIV_I hom empty_iff homeomorphism_def image_eqI)
  2702 next
  2703   case False
  2704   have "inj g"
  2705     by (metis UNIV_I hom homeomorphism_apply2 injI)
  2706   then have "open (g ` UNIV)"
  2707     by (blast intro: invariance_of_domain hom homeomorphism_cont2)
  2708   then have "open S"
  2709     using hom homeomorphism_image2 by blast
  2710   moreover have "complete S"
  2711     unfolding complete_def
  2712   proof clarify
  2713     fix \<sigma>
  2714     assume \<sigma>: "\<forall>n. \<sigma> n \<in> S" and "Cauchy \<sigma>"
  2715     have "Cauchy (f o \<sigma>)"
  2716       using uniformly_continuous_imp_Cauchy_continuous \<open>Cauchy \<sigma>\<close> \<sigma> contf by blast
  2717     then obtain l where "(f \<circ> \<sigma>) \<longlonglongrightarrow> l"
  2718       by (auto simp: convergent_eq_Cauchy [symmetric])
  2719     show "\<exists>l\<in>S. \<sigma> \<longlonglongrightarrow> l"
  2720     proof
  2721       show "g l \<in> S"
  2722         using hom homeomorphism_image2 by blast
  2723       have "(g \<circ> (f \<circ> \<sigma>)) \<longlonglongrightarrow> g l"
  2724         by (meson UNIV_I \<open>(f \<circ> \<sigma>) \<longlonglongrightarrow> l\<close> continuous_on_sequentially hom homeomorphism_cont2)
  2725       then show "\<sigma> \<longlonglongrightarrow> g l"
  2726       proof -
  2727         have "\<forall>n. \<sigma> n = (g \<circ> (f \<circ> \<sigma>)) n"
  2728           by (metis (no_types) \<sigma> comp_eq_dest_lhs hom homeomorphism_apply1)
  2729         then show ?thesis
  2730           by (metis (no_types) LIMSEQ_iff \<open>(g \<circ> (f \<circ> \<sigma>)) \<longlonglongrightarrow> g l\<close>)
  2731       qed
  2732     qed
  2733   qed
  2734   then have "closed S"
  2735     by (simp add: complete_eq_closed)
  2736   ultimately show ?thesis
  2737     using clopen [of S] False  by simp
  2738 qed
  2739 
  2740 subsection%important\<open>Dimension-based conditions for various homeomorphisms\<close>
  2741 
  2742 lemma%unimportant homeomorphic_subspaces_eq:
  2743   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2744   assumes "subspace S" "subspace T"
  2745   shows "S homeomorphic T \<longleftrightarrow> dim S = dim T"
  2746 proof
  2747   assume "S homeomorphic T"
  2748   then obtain f g where hom: "homeomorphism S T f g"
  2749     using homeomorphic_def by blast
  2750   show "dim S = dim T"
  2751   proof (rule order_antisym)
  2752     show "dim S \<le> dim T"
  2753       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)
  2754     show "dim T \<le> dim S"
  2755       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)
  2756   qed
  2757 next
  2758   assume "dim S = dim T"
  2759   then show "S homeomorphic T"
  2760     by (simp add: assms homeomorphic_subspaces)
  2761 qed
  2762 
  2763 lemma%unimportant homeomorphic_affine_sets_eq:
  2764   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  2765   assumes "affine S" "affine T"
  2766   shows "S homeomorphic T \<longleftrightarrow> aff_dim S = aff_dim T"
  2767 proof (cases "S = {} \<or> T = {}")
  2768   case True
  2769   then show ?thesis
  2770     using assms homeomorphic_affine_sets by force
  2771 next
  2772   case False
  2773   then obtain a b where "a \<in> S" "b \<in> T"
  2774     by blast
  2775   then have "subspace ((+) (- a) ` S)" "subspace ((+) (- b) ` T)"
  2776     using affine_diffs_subspace assms by blast+
  2777   then show ?thesis
  2778     by (metis affine_imp_convex assms homeomorphic_affine_sets homeomorphic_convex_sets)
  2779 qed
  2780 
  2781 lemma%unimportant homeomorphic_hyperplanes_eq:
  2782   fixes a :: "'a::euclidean_space" and c :: "'b::euclidean_space"
  2783   assumes "a \<noteq> 0" "c \<noteq> 0"
  2784   shows "({x. a \<bullet> x = b} homeomorphic {x. c \<bullet> x = d} \<longleftrightarrow> DIM('a) = DIM('b))"
  2785   apply (auto simp: homeomorphic_affine_sets_eq affine_hyperplane assms)
  2786   by (metis DIM_positive Suc_pred)
  2787 
  2788 lemma%unimportant homeomorphic_UNIV_UNIV:
  2789   shows "(UNIV::'a set) homeomorphic (UNIV::'b set) \<longleftrightarrow>
  2790     DIM('a::euclidean_space) = DIM('b::euclidean_space)"
  2791   by (simp add: homeomorphic_subspaces_eq)
  2792 
  2793 lemma%unimportant simply_connected_sphere_gen:
  2794    assumes "convex S" "bounded S" and 3: "3 \<le> aff_dim S"
  2795    shows "simply_connected(rel_frontier S)"
  2796 proof -
  2797   have pa: "path_connected (rel_frontier S)"
  2798     using assms by (simp add: path_connected_sphere_gen)
  2799   show ?thesis
  2800   proof (clarsimp simp add: simply_connected_eq_contractible_circlemap pa)
  2801     fix f
  2802     assume f: "continuous_on (sphere (0::complex) 1) f" "f ` sphere 0 1 \<subseteq> rel_frontier S"
  2803     have eq: "sphere (0::complex) 1 = rel_frontier(cball 0 1)"
  2804       by simp
  2805     have "convex (cball (0::complex) 1)"
  2806       by (rule convex_cball)
  2807     then obtain c where "homotopic_with (\<lambda>z. True) (sphere (0::complex) 1) (rel_frontier S) f (\<lambda>x. c)"
  2808       apply (rule inessential_spheremap_lowdim_gen [OF _ bounded_cball \<open>convex S\<close> \<open>bounded S\<close>, where f=f])
  2809       using f 3
  2810          apply (auto simp: aff_dim_cball)
  2811       done
  2812     then show "\<exists>a. homotopic_with (\<lambda>h. True) (sphere 0 1) (rel_frontier S) f (\<lambda>x. a)"
  2813       by blast
  2814   qed
  2815 qed
  2816 
  2817 subsection%important\<open>more invariance of domain\<close>
  2818 
  2819 proposition%important invariance_of_domain_sphere_affine_set_gen:
  2820   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2821   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
  2822       and U: "bounded U" "convex U"
  2823       and "affine T" and affTU: "aff_dim T < aff_dim U"
  2824       and ope: "openin (subtopology euclidean (rel_frontier U)) S"
  2825    shows "openin (subtopology euclidean T) (f ` S)"
  2826 proof%unimportant (cases "rel_frontier U = {}")
  2827   case True
  2828   then show ?thesis
  2829     using ope openin_subset by force
  2830 next
  2831   case False
  2832   obtain b c where b: "b \<in> rel_frontier U" and c: "c \<in> rel_frontier U" and "b \<noteq> c"
  2833     using \<open>bounded U\<close> rel_frontier_not_sing [of U] subset_singletonD False  by fastforce
  2834   obtain V :: "'a set" where "affine V" and affV: "aff_dim V = aff_dim U - 1"
  2835   proof (rule choose_affine_subset [OF affine_UNIV])
  2836     show "- 1 \<le> aff_dim U - 1"
  2837       by (metis aff_dim_empty aff_dim_geq aff_dim_negative_iff affTU diff_0 diff_right_mono not_le)
  2838     show "aff_dim U - 1 \<le> aff_dim (UNIV::'a set)"
  2839       by (metis aff_dim_UNIV aff_dim_le_DIM le_cases not_le zle_diff1_eq)
  2840   qed auto
  2841   have SU: "S \<subseteq> rel_frontier U"
  2842     using ope openin_imp_subset by auto
  2843   have homb: "rel_frontier U - {b} homeomorphic V"
  2844    and homc: "rel_frontier U - {c} homeomorphic V"
  2845     using homeomorphic_punctured_sphere_affine_gen [of U _ V]
  2846     by (simp_all add: \<open>affine V\<close> affV U b c)
  2847   then obtain g h j k
  2848            where gh: "homeomorphism (rel_frontier U - {b}) V g h"
  2849              and jk: "homeomorphism (rel_frontier U - {c}) V j k"
  2850     by (auto simp: homeomorphic_def)
  2851   with SU have hgsub: "(h ` g ` (S - {b})) \<subseteq> S" and kjsub: "(k ` j ` (S - {c})) \<subseteq> S"
  2852     by (simp_all add: homeomorphism_def subset_eq)
  2853   have [simp]: "aff_dim T \<le> aff_dim V"
  2854     by (simp add: affTU affV)
  2855   have "openin (subtopology euclidean T) ((f \<circ> h) ` g ` (S - {b}))"
  2856   proof (rule invariance_of_domain_affine_sets [OF _ \<open>affine V\<close>])
  2857     show "openin (subtopology euclidean V) (g ` (S - {b}))"
  2858       apply (rule homeomorphism_imp_open_map [OF gh])
  2859       by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
  2860     show "continuous_on (g ` (S - {b})) (f \<circ> h)"
  2861        apply (rule continuous_on_compose)
  2862         apply (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets gh set_eq_subset)
  2863       using contf continuous_on_subset hgsub by blast
  2864     show "inj_on (f \<circ> h) (g ` (S - {b}))"
  2865       using kjsub
  2866       apply (clarsimp simp add: inj_on_def)
  2867       by (metis SU b homeomorphism_def inj_onD injf insert_Diff insert_iff gh rev_subsetD)
  2868     show "(f \<circ> h) ` g ` (S - {b}) \<subseteq> T"
  2869       by (metis fim image_comp image_mono hgsub subset_trans)
  2870   qed (auto simp: assms)
  2871   moreover
  2872   have "openin (subtopology euclidean T) ((f \<circ> k) ` j ` (S - {c}))"
  2873   proof (rule invariance_of_domain_affine_sets [OF _ \<open>affine V\<close>])
  2874     show "openin (subtopology euclidean V) (j ` (S - {c}))"
  2875       apply (rule homeomorphism_imp_open_map [OF jk])
  2876       by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
  2877     show "continuous_on (j ` (S - {c})) (f \<circ> k)"
  2878        apply (rule continuous_on_compose)
  2879         apply (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets jk set_eq_subset)
  2880       using contf continuous_on_subset kjsub by blast
  2881     show "inj_on (f \<circ> k) (j ` (S - {c}))"
  2882       using kjsub
  2883       apply (clarsimp simp add: inj_on_def)
  2884       by (metis SU c homeomorphism_def inj_onD injf insert_Diff insert_iff jk rev_subsetD)
  2885     show "(f \<circ> k) ` j ` (S - {c}) \<subseteq> T"
  2886       by (metis fim image_comp image_mono kjsub subset_trans)
  2887   qed (auto simp: assms)
  2888   ultimately have "openin (subtopology euclidean T) ((f \<circ> h) ` g ` (S - {b}) \<union> ((f \<circ> k) ` j ` (S - {c})))"
  2889     by (rule openin_Un)
  2890   moreover have "(f \<circ> h) ` g ` (S - {b}) = f ` (S - {b})"
  2891   proof -
  2892     have "h ` g ` (S - {b}) = (S - {b})"
  2893     proof
  2894       show "h ` g ` (S - {b}) \<subseteq> S - {b}"
  2895         using homeomorphism_apply1 [OF gh] SU
  2896         by (fastforce simp add: image_iff image_subset_iff)
  2897       show "S - {b} \<subseteq> h ` g ` (S - {b})"
  2898         apply clarify
  2899         by  (metis SU subsetD homeomorphism_apply1 [OF gh] image_iff member_remove remove_def)
  2900     qed
  2901     then show ?thesis
  2902       by (metis image_comp)
  2903   qed
  2904   moreover have "(f \<circ> k) ` j ` (S - {c}) = f ` (S - {c})"
  2905   proof -
  2906     have "k ` j ` (S - {c}) = (S - {c})"
  2907     proof
  2908       show "k ` j ` (S - {c}) \<subseteq> S - {c}"
  2909         using homeomorphism_apply1 [OF jk] SU
  2910         by (fastforce simp add: image_iff image_subset_iff)
  2911       show "S - {c} \<subseteq> k ` j ` (S - {c})"
  2912         apply clarify
  2913         by  (metis SU subsetD homeomorphism_apply1 [OF jk] image_iff member_remove remove_def)
  2914     qed
  2915     then show ?thesis
  2916       by (metis image_comp)
  2917   qed
  2918   moreover have "f ` (S - {b}) \<union> f ` (S - {c}) = f ` (S)"
  2919     using \<open>b \<noteq> c\<close> by blast
  2920   ultimately show ?thesis
  2921     by simp
  2922 qed
  2923 
  2924 
  2925 lemma%unimportant invariance_of_domain_sphere_affine_set:
  2926   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2927   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
  2928       and "r \<noteq> 0" "affine T" and affTU: "aff_dim T < DIM('a)"
  2929       and ope: "openin (subtopology euclidean (sphere a r)) S"
  2930    shows "openin (subtopology euclidean T) (f ` S)"
  2931 proof (cases "sphere a r = {}")
  2932   case True
  2933   then show ?thesis
  2934     using ope openin_subset by force
  2935 next
  2936   case False
  2937   show ?thesis
  2938   proof (rule invariance_of_domain_sphere_affine_set_gen [OF contf injf fim bounded_cball convex_cball \<open>affine T\<close>])
  2939     show "aff_dim T < aff_dim (cball a r)"
  2940       by (metis False affTU aff_dim_cball assms(4) linorder_cases sphere_empty)
  2941     show "openin (subtopology euclidean (rel_frontier (cball a r))) S"
  2942       by (simp add: \<open>r \<noteq> 0\<close> ope)
  2943   qed
  2944 qed
  2945 
  2946 lemma%unimportant no_embedding_sphere_lowdim:
  2947   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2948   assumes contf: "continuous_on (sphere a r) f" and injf: "inj_on f (sphere a r)" and "r > 0"
  2949    shows "DIM('a) \<le> DIM('b)"
  2950 proof -
  2951   have "False" if "DIM('a) > DIM('b)"
  2952   proof -
  2953     have "compact (f ` sphere a r)"
  2954       using compact_continuous_image
  2955       by (simp add: compact_continuous_image contf)
  2956     then have "\<not> open (f ` sphere a r)"
  2957       using compact_open
  2958       by (metis assms(3) image_is_empty not_less_iff_gr_or_eq sphere_eq_empty)
  2959     then show False
  2960       using invariance_of_domain_sphere_affine_set [OF contf injf subset_UNIV] \<open>r > 0\<close>
  2961       by (metis aff_dim_UNIV affine_UNIV less_irrefl of_nat_less_iff open_openin openin_subtopology_self subtopology_UNIV that)
  2962   qed
  2963   then show ?thesis
  2964     using not_less by blast
  2965 qed
  2966 
  2967 lemma%unimportant simply_connected_sphere:
  2968   fixes a :: "'a::euclidean_space"
  2969   assumes "3 \<le> DIM('a)"
  2970     shows "simply_connected(sphere a r)"
  2971 proof (cases rule: linorder_cases [of r 0])
  2972   case less
  2973   then show ?thesis by simp
  2974 next
  2975   case equal
  2976   then show ?thesis  by (auto simp: convex_imp_simply_connected)
  2977 next
  2978   case greater
  2979   then show ?thesis
  2980     using simply_connected_sphere_gen [of "cball a r"] assms
  2981     by (simp add: aff_dim_cball)
  2982 qed
  2983 
  2984 lemma%unimportant simply_connected_sphere_eq:
  2985   fixes a :: "'a::euclidean_space"
  2986   shows "simply_connected(sphere a r) \<longleftrightarrow> 3 \<le> DIM('a) \<or> r \<le> 0"  (is "?lhs = ?rhs")
  2987 proof (cases "r \<le> 0")
  2988   case True
  2989   have "simply_connected (sphere a r)"
  2990     apply (rule convex_imp_simply_connected)
  2991     using True less_eq_real_def by auto
  2992   with True show ?thesis by auto
  2993 next
  2994   case False
  2995   show ?thesis
  2996   proof
  2997     assume L: ?lhs
  2998     have "False" if "DIM('a) = 1 \<or> DIM('a) = 2"
  2999       using that
  3000     proof
  3001       assume "DIM('a) = 1"
  3002       with L show False
  3003         using connected_sphere_eq simply_connected_imp_connected
  3004         by (metis False Suc_1 not_less_eq_eq order_refl)
  3005     next
  3006       assume "DIM('a) = 2"
  3007       then have "sphere a r homeomorphic sphere (0::complex) 1"
  3008         by (metis DIM_complex False homeomorphic_spheres_gen not_less zero_less_one)
  3009       then have "simply_connected(sphere (0::complex) 1)"
  3010         using L homeomorphic_simply_connected_eq by blast
  3011       then obtain a::complex where "homotopic_with (\<lambda>h. True) (sphere 0 1) (sphere 0 1) id (\<lambda>x. a)"
  3012         apply (simp add: simply_connected_eq_contractible_circlemap)
  3013         by (metis continuous_on_id' id_apply image_id subset_refl)
  3014       then show False
  3015         using contractible_sphere contractible_def not_one_le_zero by blast
  3016     qed
  3017     with False show ?rhs
  3018       apply simp
  3019       by (metis DIM_ge_Suc0 le_antisym not_less_eq_eq numeral_2_eq_2 numeral_3_eq_3)
  3020   next
  3021     assume ?rhs
  3022     with False show ?lhs by (simp add: simply_connected_sphere)
  3023   qed
  3024 qed
  3025 
  3026 
  3027 lemma%unimportant simply_connected_punctured_universe_eq:
  3028   fixes a :: "'a::euclidean_space"
  3029   shows "simply_connected(- {a}) \<longleftrightarrow> 3 \<le> DIM('a)"
  3030 proof -
  3031   have [simp]: "a \<in> rel_interior (cball a 1)"
  3032     by (simp add: rel_interior_nonempty_interior)
  3033   have [simp]: "affine hull cball a 1 - {a} = -{a}"
  3034     by (metis Compl_eq_Diff_UNIV aff_dim_cball aff_dim_lt_full not_less_iff_gr_or_eq zero_less_one)
  3035   have "simply_connected(- {a}) \<longleftrightarrow> simply_connected(sphere a 1)"
  3036     apply (rule sym)
  3037     apply (rule homotopy_eqv_simple_connectedness)
  3038     using homotopy_eqv_rel_frontier_punctured_affine_hull [of "cball a 1" a] apply auto
  3039     done
  3040   also have "...  \<longleftrightarrow> 3 \<le> DIM('a)"
  3041     by (simp add: simply_connected_sphere_eq)
  3042   finally show ?thesis .
  3043 qed
  3044 
  3045 lemma%unimportant not_simply_connected_circle:
  3046   fixes a :: complex
  3047   shows "0 < r \<Longrightarrow> \<not> simply_connected(sphere a r)"
  3048 by (simp add: simply_connected_sphere_eq)
  3049 
  3050 
  3051 proposition%important simply_connected_punctured_convex:
  3052   fixes a :: "'a::euclidean_space"
  3053   assumes "convex S" and 3: "3 \<le> aff_dim S"
  3054     shows "simply_connected(S - {a})"
  3055 proof%unimportant (cases "a \<in> rel_interior S")
  3056   case True
  3057   then obtain e where "a \<in> S" "0 < e" and e: "cball a e \<inter> affine hull S \<subseteq> S"
  3058     by (auto simp: rel_interior_cball)
  3059   have con: "convex (cball a e \<inter> affine hull S)"
  3060     by (simp add: convex_Int)
  3061   have bo: "bounded (cball a e \<inter> affine hull S)"
  3062     by (simp add: bounded_Int)
  3063   have "affine hull S \<inter> interior (cball a e) \<noteq> {}"
  3064     using \<open>0 < e\<close> \<open>a \<in> S\<close> hull_subset by fastforce
  3065   then have "3 \<le> aff_dim (affine hull S \<inter> cball a e)"
  3066     by (simp add: 3 aff_dim_convex_Int_nonempty_interior [OF convex_affine_hull])
  3067   also have "... = aff_dim (cball a e \<inter> affine hull S)"
  3068     by (simp add: Int_commute)
  3069   finally have "3 \<le> aff_dim (cball a e \<inter> affine hull S)" .
  3070   moreover have "rel_frontier (cball a e \<inter> affine hull S) homotopy_eqv S - {a}"
  3071   proof (rule homotopy_eqv_rel_frontier_punctured_convex)
  3072     show "a \<in> rel_interior (cball a e \<inter> affine hull S)"
  3073       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)
  3074     have "closed (cball a e \<inter> affine hull S)"
  3075       by blast
  3076     then show "rel_frontier (cball a e \<inter> affine hull S) \<subseteq> S"
  3077       apply (simp add: rel_frontier_def)
  3078       using e by blast
  3079     show "S \<subseteq> affine hull (cball a e \<inter> affine hull S)"
  3080       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)
  3081     qed (auto simp: assms con bo)
  3082   ultimately show ?thesis
  3083     using homotopy_eqv_simple_connectedness simply_connected_sphere_gen [OF con bo]
  3084     by blast
  3085 next
  3086   case False
  3087   show ?thesis
  3088     apply (rule contractible_imp_simply_connected)
  3089     apply (rule contractible_convex_tweak_boundary_points [OF \<open>convex S\<close>])
  3090      apply (simp add: False rel_interior_subset subset_Diff_insert)
  3091     by (meson Diff_subset closure_subset subset_trans)
  3092 qed
  3093 
  3094 corollary%important simply_connected_punctured_universe:
  3095   fixes a :: "'a::euclidean_space"
  3096   assumes "3 \<le> DIM('a)"
  3097   shows "simply_connected(- {a})"
  3098 proof%unimportant -
  3099   have [simp]: "affine hull cball a 1 = UNIV"
  3100     apply auto
  3101     by (metis UNIV_I aff_dim_cball aff_dim_lt_full zero_less_one not_less_iff_gr_or_eq)
  3102   have "simply_connected (rel_frontier (cball a 1)) = simply_connected (affine hull cball a 1 - {a})"
  3103     apply (rule homotopy_eqv_simple_connectedness)
  3104     apply (rule homotopy_eqv_rel_frontier_punctured_affine_hull)
  3105       apply (force simp: rel_interior_cball intro: homotopy_eqv_simple_connectedness homotopy_eqv_rel_frontier_punctured_affine_hull)+
  3106     done
  3107   then show ?thesis
  3108     using simply_connected_sphere [of a 1, OF assms] by (auto simp: Compl_eq_Diff_UNIV)
  3109 qed
  3110 
  3111 
  3112 subsection%important\<open>The power, squaring and exponential functions as covering maps\<close>
  3113 
  3114 proposition%important covering_space_power_punctured_plane:
  3115   assumes "0 < n"
  3116     shows "covering_space (- {0}) (\<lambda>z::complex. z^n) (- {0})"
  3117 proof%unimportant -
  3118   consider "n = 1" | "2 \<le> n" using assms by linarith
  3119   then obtain e where "0 < e"
  3120                 and e: "\<And>w z. cmod(w - z) < e * cmod z \<Longrightarrow> (w^n = z^n \<longleftrightarrow> w = z)"
  3121   proof cases
  3122     assume "n = 1" then show ?thesis
  3123       by (rule_tac e=1 in that) auto
  3124   next
  3125     assume "2 \<le> n"
  3126     have eq_if_pow_eq:
  3127          "w = z" if lt: "cmod (w - z) < 2 * sin (pi / real n) * cmod z"
  3128                  and eq: "w^n = z^n" for w z
  3129     proof (cases "z = 0")
  3130       case True with eq assms show ?thesis by (auto simp: power_0_left)
  3131     next
  3132       case False
  3133       then have "z \<noteq> 0" by auto
  3134       have "(w/z)^n = 1"
  3135         by (metis False divide_self_if eq power_divide power_one)
  3136       then obtain j where j: "w / z = exp (2 * of_real pi * \<i> * j / n)" and "j < n"
  3137         using Suc_leI assms \<open>2 \<le> n\<close> complex_roots_unity [THEN eqset_imp_iff, of n "w/z"]
  3138         by force
  3139       have "cmod (w/z - 1) < 2 * sin (pi / real n)"
  3140         using lt assms \<open>z \<noteq> 0\<close> by (simp add: divide_simps norm_divide)
  3141       then have "cmod (exp (\<i> * of_real (2 * pi * j / n)) - 1) < 2 * sin (pi / real n)"
  3142         by (simp add: j field_simps)
  3143       then have "2 * \<bar>sin((2 * pi * j / n) / 2)\<bar> < 2 * sin (pi / real n)"
  3144         by (simp only: dist_exp_i_1)
  3145       then have sin_less: "sin((pi * j / n)) < sin (pi / real n)"
  3146         by (simp add: field_simps)
  3147       then have "w / z = 1"
  3148       proof (cases "j = 0")
  3149         case True then show ?thesis by (auto simp: j)
  3150       next
  3151         case False
  3152         then have "sin (pi / real n) \<le> sin((pi * j / n))"
  3153         proof (cases "j / n \<le> 1/2")
  3154           case True
  3155           show ?thesis
  3156             apply (rule sin_monotone_2pi_le)
  3157             using \<open>j \<noteq> 0 \<close> \<open>j < n\<close> True
  3158             apply (auto simp: field_simps intro: order_trans [of _ 0])
  3159             done
  3160         next
  3161           case False
  3162           then have seq: "sin(pi * j / n) = sin(pi * (n - j) / n)"
  3163             using \<open>j < n\<close> by (simp add: algebra_simps diff_divide_distrib of_nat_diff)
  3164           show ?thesis
  3165             apply (simp only: seq)
  3166             apply (rule sin_monotone_2pi_le)
  3167             using \<open>j < n\<close> False
  3168             apply (auto simp: field_simps intro: order_trans [of _ 0])
  3169             done
  3170         qed
  3171         with sin_less show ?thesis by force
  3172       qed
  3173       then show ?thesis by simp
  3174     qed
  3175     show ?thesis
  3176       apply (rule_tac e = "2 * sin(pi / n)" in that)
  3177        apply (force simp: \<open>2 \<le> n\<close> sin_pi_divide_n_gt_0)
  3178       apply (meson eq_if_pow_eq)
  3179       done
  3180   qed
  3181   have zn1: "continuous_on (- {0}) (\<lambda>z::complex. z^n)"
  3182     by (rule continuous_intros)+
  3183   have zn2: "(\<lambda>z::complex. z^n) ` (- {0}) = - {0}"
  3184     using assms by (auto simp: image_def elim: exists_complex_root_nonzero [where n = n])
  3185   have zn3: "\<exists>T. z^n \<in> T \<and> open T \<and> 0 \<notin> T \<and>
  3186                (\<exists>v. \<Union>v = -{0} \<inter> (\<lambda>z. z ^ n) -` T \<and>
  3187                     (\<forall>u\<in>v. open u \<and> 0 \<notin> u) \<and>
  3188                     pairwise disjnt v \<and>
  3189                     (\<forall>u\<in>v. Ex (homeomorphism u T (\<lambda>z. z^n))))"
  3190            if "z \<noteq> 0" for z::complex
  3191   proof -
  3192     define d where "d \<equiv> min (1/2) (e/4) * norm z"
  3193     have "0 < d"
  3194       by (simp add: d_def \<open>0 < e\<close> \<open>z \<noteq> 0\<close>)
  3195     have iff_x_eq_y: "x^n = y^n \<longleftrightarrow> x = y"
  3196          if eq: "w^n = z^n" and x: "x \<in> ball w d" and y: "y \<in> ball w d" for w x y
  3197     proof -
  3198       have [simp]: "norm z = norm w" using that
  3199         by (simp add: assms power_eq_imp_eq_norm)
  3200       show ?thesis
  3201       proof (cases "w = 0")
  3202         case True with \<open>z \<noteq> 0\<close> assms eq
  3203         show ?thesis by (auto simp: power_0_left)
  3204       next
  3205         case False
  3206         have "cmod (x - y) < 2*d"
  3207           using x y
  3208           by (simp add: dist_norm [symmetric]) (metis dist_commute mult_2 dist_triangle_less_add)
  3209         also have "... \<le> 2 * e / 4 * norm w"
  3210           using \<open>e > 0\<close> by (simp add: d_def min_mult_distrib_right)
  3211         also have "... = e * (cmod w / 2)"
  3212           by simp
  3213         also have "... \<le> e * cmod y"
  3214           apply (rule mult_left_mono)
  3215           using \<open>e > 0\<close> y
  3216            apply (simp_all add: dist_norm d_def min_mult_distrib_right del: divide_const_simps)
  3217           apply (metis dist_0_norm dist_complex_def dist_triangle_half_l linorder_not_less order_less_irrefl)
  3218           done
  3219         finally have "cmod (x - y) < e * cmod y" .
  3220         then show ?thesis by (rule e)
  3221       qed
  3222     qed
  3223     then have inj: "inj_on (\<lambda>w. w^n) (ball z d)"
  3224       by (simp add: inj_on_def)
  3225     have cont: "continuous_on (ball z d) (\<lambda>w. w ^ n)"
  3226       by (intro continuous_intros)
  3227     have noncon: "\<not> (\<lambda>w::complex. w^n) constant_on UNIV"
  3228       by (metis UNIV_I assms constant_on_def power_one zero_neq_one zero_power)
  3229     have im_eq: "(\<lambda>w. w^n) ` ball z' d = (\<lambda>w. w^n) ` ball z d"
  3230                 if z': "z'^n = z^n" for z'
  3231     proof -
  3232       have nz': "norm z' = norm z" using that assms power_eq_imp_eq_norm by blast
  3233       have "(w \<in> (\<lambda>w. w^n) ` ball z' d) = (w \<in> (\<lambda>w. w^n) ` ball z d)" for w
  3234       proof (cases "w=0")
  3235         case True with assms show ?thesis
  3236           by (simp add: image_def ball_def nz')
  3237       next
  3238         case False
  3239         have "z' \<noteq> 0" using \<open>z \<noteq> 0\<close> nz' by force
  3240         have [simp]: "(z*x / z')^n = x^n" if "x \<noteq> 0" for x
  3241           using z' that by (simp add: field_simps \<open>z \<noteq> 0\<close>)
  3242         have [simp]: "cmod (z - z * x / z') = cmod (z' - x)" if "x \<noteq> 0" for x
  3243         proof -
  3244           have "cmod (z - z * x / z') = cmod z * cmod (1 - x / z')"
  3245             by (metis (no_types) ab_semigroup_mult_class.mult_ac(1) divide_complex_def mult.right_neutral norm_mult right_diff_distrib')
  3246           also have "... = cmod z' * cmod (1 - x / z')"
  3247             by (simp add: nz')
  3248           also have "... = cmod (z' - x)"
  3249             by (simp add: \<open>z' \<noteq> 0\<close> diff_divide_eq_iff norm_divide)
  3250           finally show ?thesis .
  3251         qed
  3252         have [simp]: "(z'*x / z)^n = x^n" if "x \<noteq> 0" for x
  3253           using z' that by (simp add: field_simps \<open>z \<noteq> 0\<close>)
  3254         have [simp]: "cmod (z' - z' * x / z) = cmod (z - x)" if "x \<noteq> 0" for x
  3255         proof -
  3256           have "cmod (z * (1 - x * inverse z)) = cmod (z - x)"
  3257             by (metis \<open>z \<noteq> 0\<close> diff_divide_distrib divide_complex_def divide_self_if nonzero_eq_divide_eq semiring_normalization_rules(7))
  3258           then show ?thesis
  3259             by (metis (no_types) mult.assoc divide_complex_def mult.right_neutral norm_mult nz' right_diff_distrib')
  3260         qed
  3261         show ?thesis
  3262           unfolding image_def ball_def
  3263           apply safe
  3264           apply simp_all
  3265           apply (rule_tac x="z/z' * x" in exI)
  3266           using assms False apply (simp add: dist_norm)
  3267           apply (rule_tac x="z'/z * x" in exI)
  3268           using assms False apply (simp add: dist_norm)
  3269           done
  3270       qed
  3271       then show ?thesis by blast
  3272     qed
  3273 
  3274     have ex_ball: "\<exists>B. (\<exists>z'. B = ball z' d \<and> z'^n = z^n) \<and> x \<in> B"
  3275                   if "x \<noteq> 0" and eq: "x^n = w^n" and dzw: "dist z w < d" for x w
  3276     proof -
  3277       have "w \<noteq> 0" by (metis assms power_eq_0_iff that(1) that(2))
  3278       have [simp]: "cmod x = cmod w"
  3279         using assms power_eq_imp_eq_norm eq by blast
  3280       have [simp]: "cmod (x * z / w - x) = cmod (z - w)"
  3281       proof -
  3282         have "cmod (x * z / w - x) = cmod x * cmod (z / w - 1)"
  3283           by (metis (no_types) mult.right_neutral norm_mult right_diff_distrib' times_divide_eq_right)
  3284         also have "... = cmod w * cmod (z / w - 1)"
  3285           by simp
  3286         also have "... = cmod (z - w)"
  3287           by (simp add: \<open>w \<noteq> 0\<close> divide_diff_eq_iff nonzero_norm_divide)
  3288         finally show ?thesis .
  3289       qed
  3290       show ?thesis
  3291         apply (rule_tac x="ball (z / w * x) d" in exI)
  3292         using \<open>d > 0\<close> that
  3293         apply (simp add: ball_eq_ball_iff)
  3294         apply (simp add: \<open>z \<noteq> 0\<close> \<open>w \<noteq> 0\<close> field_simps)
  3295         apply (simp add: dist_norm)
  3296         done
  3297     qed
  3298 
  3299     show ?thesis
  3300     proof (rule exI, intro conjI)
  3301       show "z ^ n \<in> (\<lambda>w. w ^ n) ` ball z d"
  3302         using \<open>d > 0\<close> by simp
  3303       show "open ((\<lambda>w. w ^ n) ` ball z d)"
  3304         by (rule invariance_of_domain [OF cont open_ball inj])
  3305       show "0 \<notin> (\<lambda>w. w ^ n) ` ball z d"
  3306         using \<open>z \<noteq> 0\<close> assms by (force simp: d_def)
  3307       show "\<exists>v. \<Union>v = - {0} \<inter> (\<lambda>z. z ^ n) -` (\<lambda>w. w ^ n) ` ball z d \<and>
  3308                 (\<forall>u\<in>v. open u \<and> 0 \<notin> u) \<and>
  3309                 disjoint v \<and>
  3310                 (\<forall>u\<in>v. Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n)))"
  3311       proof (rule exI, intro ballI conjI)
  3312         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")
  3313         proof 
  3314           show "?l \<subseteq> ?r"
  3315             apply auto
  3316              apply (simp add: assms d_def power_eq_imp_eq_norm that)
  3317             by (metis im_eq image_eqI mem_ball)
  3318           show "?r \<subseteq> ?l"
  3319             by auto (meson ex_ball)
  3320         qed
  3321         show "\<And>u. u \<in> {ball z' d |z'. z' ^ n = z ^ n} \<Longrightarrow> 0 \<notin> u"
  3322           by (force simp add: assms d_def power_eq_imp_eq_norm that)
  3323 
  3324         show "disjoint {ball z' d |z'. z' ^ n = z ^ n}"
  3325         proof (clarsimp simp add: pairwise_def disjnt_iff)
  3326           fix \<xi> \<zeta> x
  3327           assume "\<xi>^n = z^n" "\<zeta>^n = z^n" "ball \<xi> d \<noteq> ball \<zeta> d"
  3328             and "dist \<xi> x < d" "dist \<zeta> x < d"
  3329           then have "dist \<xi> \<zeta> < d+d"
  3330             using dist_triangle_less_add by blast
  3331           then have "cmod (\<xi> - \<zeta>) < 2*d"
  3332             by (simp add: dist_norm)
  3333           also have "... \<le> e * cmod z"
  3334             using mult_right_mono \<open>0 < e\<close> that by (auto simp: d_def)
  3335           finally have "cmod (\<xi> - \<zeta>) < e * cmod z" .
  3336           with e have "\<xi> = \<zeta>"
  3337             by (metis \<open>\<xi>^n = z^n\<close> \<open>\<zeta>^n = z^n\<close> assms power_eq_imp_eq_norm)
  3338           then show "False"
  3339             using \<open>ball \<xi> d \<noteq> ball \<zeta> d\<close> by blast
  3340         qed
  3341         show "Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n))"
  3342           if "u \<in> {ball z' d |z'. z' ^ n = z ^ n}" for u
  3343         proof (rule invariance_of_domain_homeomorphism [of "u" "\<lambda>z. z^n"])
  3344           show "open u"
  3345             using that by auto
  3346           show "continuous_on u (\<lambda>z. z ^ n)"
  3347             by (intro continuous_intros)
  3348           show "inj_on (\<lambda>z. z ^ n) u"
  3349             using that by (auto simp: iff_x_eq_y inj_on_def)
  3350           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))"
  3351             using im_eq that by clarify metis
  3352         qed auto
  3353       qed auto
  3354     qed
  3355   qed
  3356   show ?thesis
  3357     using assms
  3358     apply (simp add: covering_space_def zn1 zn2)
  3359     apply (subst zn2 [symmetric])
  3360     apply (simp add: openin_open_eq open_Compl)
  3361     apply (blast intro: zn3)
  3362     done
  3363 qed
  3364 
  3365 corollary%important covering_space_square_punctured_plane:
  3366   "covering_space (- {0}) (\<lambda>z::complex. z^2) (- {0})"
  3367   by%unimportant (simp add: covering_space_power_punctured_plane)
  3368 
  3369 
  3370 proposition%important covering_space_exp_punctured_plane:
  3371   "covering_space UNIV (\<lambda>z::complex. exp z) (- {0})"
  3372 proof%unimportant (simp add: covering_space_def, intro conjI ballI)
  3373   show "continuous_on UNIV (\<lambda>z::complex. exp z)"
  3374     by (rule continuous_on_exp [OF continuous_on_id])
  3375   show "range exp = - {0::complex}"
  3376     by auto (metis exp_Ln range_eqI)
  3377   show "\<exists>T. z \<in> T \<and> openin (subtopology euclidean (- {0})) T \<and>
  3378              (\<exists>v. \<Union>v = exp -` T \<and> (\<forall>u\<in>v. open u) \<and> disjoint v \<and>
  3379                   (\<forall>u\<in>v. \<exists>q. homeomorphism u T exp q))"
  3380         if "z \<in> - {0::complex}" for z
  3381   proof -
  3382     have "z \<noteq> 0"
  3383       using that by auto
  3384     have inj_exp: "inj_on exp (ball (Ln z) 1)"
  3385       apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
  3386       using pi_ge_two by (simp add: ball_subset_ball_iff)
  3387     define \<V> where "\<V> \<equiv> range (\<lambda>n. (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1))"
  3388     show ?thesis
  3389     proof (intro exI conjI)
  3390       show "z \<in> exp ` (ball(Ln z) 1)"
  3391         by (metis \<open>z \<noteq> 0\<close> centre_in_ball exp_Ln rev_image_eqI zero_less_one)
  3392       have "open (- {0::complex})"
  3393         by blast
  3394       moreover have "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       ultimately show "openin (subtopology euclidean (- {0})) (exp ` ball (Ln z) 1)"
  3398         by (auto simp: openin_open_eq invariance_of_domain continuous_on_exp [OF continuous_on_id])
  3399       show "\<Union>\<V> = exp -` exp ` ball (Ln z) 1"
  3400         by (force simp: \<V>_def Complex_Transcendental.exp_eq image_iff)
  3401       show "\<forall>V\<in>\<V>. open V"
  3402         by (auto simp: \<V>_def inj_on_def continuous_intros invariance_of_domain)
  3403       have xy: "2 \<le> cmod (2 * of_int x * of_real pi * \<i> - 2 * of_int y * of_real pi * \<i>)"
  3404                if "x < y" for x y
  3405       proof -
  3406         have "1 \<le> abs (x - y)"
  3407           using that by linarith
  3408         then have "1 \<le> cmod (of_int x - of_int y) * 1"
  3409           by (metis mult.right_neutral norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
  3410         also have "... \<le> cmod (of_int x - of_int y) * of_real pi"
  3411           apply (rule mult_left_mono)
  3412           using pi_ge_two by auto
  3413         also have "... \<le> cmod ((of_int x - of_int y) * of_real pi * \<i>)"
  3414           by (simp add: norm_mult)
  3415         also have "... \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)"
  3416           by (simp add: algebra_simps)
  3417         finally have "1 \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)" .
  3418         then have "2 * 1 \<le> cmod (2 * (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>))"
  3419           by (metis mult_le_cancel_left_pos norm_mult_numeral1 zero_less_numeral)
  3420         then show ?thesis
  3421           by (simp add: algebra_simps)
  3422       qed
  3423       show "disjoint \<V>"
  3424         apply (clarsimp simp add: \<V>_def pairwise_def disjnt_def add.commute [of _ "x*y" for x y]
  3425                         image_add_ball ball_eq_ball_iff)
  3426         apply (rule disjoint_ballI)
  3427         apply (auto simp: dist_norm neq_iff)
  3428         by (metis norm_minus_commute xy)+
  3429       show "\<forall>u\<in>\<V>. \<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
  3430       proof
  3431         fix u
  3432         assume "u \<in> \<V>"
  3433         then obtain n where n: "u = (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1)"
  3434           by (auto simp: \<V>_def)
  3435         have "compact (cball (Ln z) 1)"
  3436           by simp
  3437         moreover have "continuous_on (cball (Ln z) 1) exp"
  3438           by (rule continuous_on_exp [OF continuous_on_id])
  3439         moreover have "inj_on exp (cball (Ln z) 1)"
  3440           apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
  3441           using pi_ge_two by (simp add: cball_subset_ball_iff)
  3442         ultimately obtain \<gamma> where hom: "homeomorphism (cball (Ln z) 1) (exp ` cball (Ln z) 1) exp \<gamma>"
  3443           using homeomorphism_compact  by blast
  3444         have eq1: "exp ` u = exp ` ball (Ln z) 1"
  3445           unfolding n
  3446           apply (auto simp: algebra_simps)
  3447           apply (rename_tac w)
  3448           apply (rule_tac x = "w + \<i> * (of_int n * (of_real pi * 2))" in image_eqI)
  3449           apply (auto simp: image_iff)
  3450           done
  3451         have \<gamma>exp: "\<gamma> (exp x) + 2 * of_int n * of_real pi * \<i> = x" if "x \<in> u" for x
  3452         proof -
  3453           have "exp x = exp (x - 2 * of_int n * of_real pi * \<i>)"
  3454             by (simp add: exp_eq)
  3455           then have "\<gamma> (exp x) = \<gamma> (exp (x - 2 * of_int n * of_real pi * \<i>))"
  3456             by simp
  3457           also have "... = x - 2 * of_int n * of_real pi * \<i>"
  3458             apply (rule homeomorphism_apply1 [OF hom])
  3459             using \<open>x \<in> u\<close> by (auto simp: n)
  3460           finally show ?thesis
  3461             by simp
  3462         qed
  3463         have exp2n: "exp (\<gamma> (exp x) + 2 * of_int n * complex_of_real pi * \<i>) = exp x"
  3464                 if "dist (Ln z) x < 1" for x
  3465           using that by (auto simp: exp_eq homeomorphism_apply1 [OF hom])
  3466         have cont: "continuous_on (exp ` ball (Ln z) 1) (\<lambda>x. \<gamma> x + 2 * of_int n * complex_of_real pi * \<i>)"
  3467           apply (intro continuous_intros)
  3468           apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF hom]])
  3469           apply (force simp:)
  3470           done
  3471         show "\<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
  3472           apply (rule_tac x="(\<lambda>x. x + of_real(2 * n * pi) * \<i>) \<circ> \<gamma>" in exI)
  3473           unfolding homeomorphism_def
  3474           apply (intro conjI ballI eq1 continuous_on_exp [OF continuous_on_id])
  3475              apply (auto simp: \<gamma>exp exp2n cont n)
  3476            apply (simp add:  homeomorphism_apply1 [OF hom])
  3477           apply (simp add: image_comp [symmetric])
  3478           using hom homeomorphism_apply1  apply (force simp: image_iff)
  3479           done
  3480       qed
  3481     qed
  3482   qed
  3483 qed
  3484 
  3485 
  3486 subsection%important\<open>Hence the Borsukian results about mappings into circles\<close>
  3487 
  3488 lemma%unimportant inessential_eq_continuous_logarithm:
  3489   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3490   shows "(\<exists>a. homotopic_with (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)) \<longleftrightarrow>
  3491          (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x)))"
  3492   (is "?lhs \<longleftrightarrow> ?rhs")
  3493 proof
  3494   assume ?lhs thus ?rhs
  3495     by (metis covering_space_lift_inessential_function covering_space_exp_punctured_plane)
  3496 next
  3497   assume ?rhs
  3498   then obtain g where contg: "continuous_on S g" and f: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3499     by metis
  3500   obtain a where "homotopic_with (\<lambda>h. True) S (- {of_real 0}) (exp \<circ> g) (\<lambda>x. a)"
  3501   proof (rule nullhomotopic_through_contractible [OF contg subset_UNIV _ _ contractible_UNIV])
  3502     show "continuous_on (UNIV::complex set) exp"
  3503       by (intro continuous_intros)
  3504     show "range exp \<subseteq> - {0}"
  3505       by auto
  3506   qed force
  3507   thus ?lhs
  3508     apply (rule_tac x=a in exI)
  3509     by (simp add: f homotopic_with_eq)
  3510 qed
  3511 
  3512 corollary%important inessential_imp_continuous_logarithm_circle:
  3513   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3514   assumes "homotopic_with (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)"
  3515   obtains g where "continuous_on S g" and "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3516 proof -
  3517   have "homotopic_with (\<lambda>h. True) S (- {0}) f (\<lambda>t. a)"
  3518     using assms homotopic_with_subset_right by fastforce
  3519   then show ?thesis
  3520     by (metis inessential_eq_continuous_logarithm that)
  3521 qed
  3522 
  3523 
  3524 lemma%unimportant inessential_eq_continuous_logarithm_circle:
  3525   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3526   shows "(\<exists>a. homotopic_with (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)) \<longleftrightarrow>
  3527          (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(\<i> * of_real(g x))))"
  3528   (is "?lhs \<longleftrightarrow> ?rhs")
  3529 proof
  3530   assume L: ?lhs
  3531   then obtain g where contg: "continuous_on S g" and g: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3532     using inessential_imp_continuous_logarithm_circle by blast
  3533   have "f ` S \<subseteq> sphere 0 1"
  3534     by (metis L homotopic_with_imp_subset1)
  3535   then have "\<And>x. x \<in> S \<Longrightarrow> Re (g x) = 0"
  3536     using g by auto
  3537   then show ?rhs
  3538     apply (rule_tac x="Im \<circ> g" in exI)
  3539      apply (intro conjI contg continuous_intros)
  3540     apply (auto simp: Euler g)
  3541     done
  3542 next
  3543   assume ?rhs
  3544   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))"
  3545     by metis
  3546   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)"
  3547   proof (rule nullhomotopic_through_contractible)
  3548     show "continuous_on S (complex_of_real \<circ> g)"
  3549       by (intro conjI contg continuous_intros)
  3550     show "(complex_of_real \<circ> g) ` S \<subseteq> \<real>"
  3551       by auto
  3552     show "continuous_on \<real> (exp \<circ> ( * )\<i>)"
  3553       by (intro continuous_intros)
  3554     show "(exp \<circ> ( * )\<i>) ` \<real> \<subseteq> sphere 0 1"
  3555       by (auto simp: complex_is_Real_iff)
  3556   qed (auto simp: convex_Reals convex_imp_contractible)
  3557   moreover have "\<And>x. x \<in> S \<Longrightarrow> (exp \<circ> ( * )\<i> \<circ> (complex_of_real \<circ> g)) x = f x"
  3558     by (simp add: g)
  3559   ultimately show ?lhs
  3560     apply (rule_tac x=a in exI)
  3561     by (simp add: homotopic_with_eq)
  3562 qed
  3563 
  3564 lemma%important homotopic_with_sphere_times:
  3565   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3566   assumes hom: "homotopic_with (\<lambda>x. True) S (sphere 0 1) f g" and conth: "continuous_on S h"
  3567       and hin: "\<And>x. x \<in> S \<Longrightarrow> h x \<in> sphere 0 1"
  3568     shows "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x * h x) (\<lambda>x. g x * h x)"
  3569 proof%unimportant -
  3570   obtain k where contk: "continuous_on ({0..1::real} \<times> S) k"
  3571              and kim: "k ` ({0..1} \<times> S) \<subseteq> sphere 0 1"
  3572              and k0:  "\<And>x. k(0, x) = f x"
  3573              and k1: "\<And>x. k(1, x) = g x"
  3574     using hom by (auto simp: homotopic_with_def)
  3575   show ?thesis
  3576     apply (simp add: homotopic_with)
  3577     apply (rule_tac x="\<lambda>z. k z*(h \<circ> snd)z" in exI)
  3578     apply (intro conjI contk continuous_intros)
  3579        apply (simp add: conth)
  3580     using kim hin apply (force simp: norm_mult k0 k1)+
  3581     done
  3582 qed
  3583 
  3584 
  3585 lemma%important homotopic_circlemaps_divide:
  3586   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3587     shows "homotopic_with (\<lambda>x. True) S (sphere 0 1) f g \<longleftrightarrow>
  3588            continuous_on S f \<and> f ` S \<subseteq> sphere 0 1 \<and>
  3589            continuous_on S g \<and> g ` S \<subseteq> sphere 0 1 \<and>
  3590            (\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c))"
  3591 proof%unimportant -
  3592   have "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
  3593        if "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c)" for c
  3594   proof -
  3595     have "S = {} \<or> path_component (sphere 0 1) 1 c"
  3596       using homotopic_with_imp_subset2 [OF that] path_connected_sphere [of "0::complex" 1]
  3597       by (auto simp: path_connected_component)
  3598     then have "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. 1) (\<lambda>x. c)"
  3599       by (metis homotopic_constant_maps)
  3600     then show ?thesis
  3601       using homotopic_with_symD homotopic_with_trans that by blast
  3602   qed
  3603   then have *: "(\<exists>c. homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c)) \<longleftrightarrow>
  3604                 homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
  3605     by auto
  3606   have "homotopic_with (\<lambda>x. True) S (sphere 0 1) f g \<longleftrightarrow>
  3607            continuous_on S f \<and> f ` S \<subseteq> sphere 0 1 \<and>
  3608            continuous_on S g \<and> g ` S \<subseteq> sphere 0 1 \<and>
  3609            homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
  3610         (is "?lhs \<longleftrightarrow> ?rhs")
  3611   proof
  3612     assume L: ?lhs
  3613     have geq1 [simp]: "\<And>x. x \<in> S \<Longrightarrow> cmod (g x) = 1"
  3614       using homotopic_with_imp_subset2 [OF L]
  3615       by (simp add: image_subset_iff)
  3616     have cont: "continuous_on S (inverse \<circ> g)"
  3617       apply (rule continuous_intros)
  3618       using homotopic_with_imp_continuous [OF L] apply blast
  3619       apply (rule continuous_on_subset [of "sphere 0 1", OF continuous_on_inverse])
  3620         apply (auto simp: continuous_on_id)
  3621       done
  3622     have "homotopic_with (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
  3623       using homotopic_with_sphere_times [OF L cont]
  3624       apply (rule homotopic_with_eq)
  3625          apply (auto simp: division_ring_class.divide_inverse norm_inverse)
  3626       by (metis geq1 norm_zero right_inverse zero_neq_one)
  3627     with L show ?rhs
  3628       by (auto simp: homotopic_with_imp_continuous dest: homotopic_with_imp_subset1 homotopic_with_imp_subset2)
  3629   next
  3630     assume ?rhs then show ?lhs
  3631       by (force simp: elim: homotopic_with_eq dest: homotopic_with_sphere_times [where h=g])+
  3632   qed
  3633   then show ?thesis
  3634     by (simp add: *)
  3635 qed
  3636 
  3637 subsection%important\<open>Upper and lower hemicontinuous functions\<close>
  3638 
  3639 text\<open>And relation in the case of preimage map to open and closed maps, and fact that upper and lower
  3640 hemicontinuity together imply continuity in the sense of the Hausdorff metric (at points where the
  3641 function gives a bounded and nonempty set).\<close>
  3642 
  3643 
  3644 text\<open>Many similar proofs below.\<close>
  3645 lemma%unimportant upper_hemicontinuous:
  3646   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
  3647     shows "((\<forall>U. openin (subtopology euclidean T) U
  3648                  \<longrightarrow> openin (subtopology euclidean S) {x \<in> S. f x \<subseteq> U}) \<longleftrightarrow>
  3649             (\<forall>U. closedin (subtopology euclidean T) U
  3650                  \<longrightarrow> closedin (subtopology euclidean S) {x \<in> S. f x \<inter> U \<noteq> {}}))"
  3651           (is "?lhs = ?rhs")
  3652 proof (intro iffI allI impI)
  3653   fix U
  3654   assume * [rule_format]: ?lhs and "closedin (subtopology euclidean T) U"
  3655   then have "openin (subtopology euclidean T) (T - U)"
  3656     by (simp add: openin_diff)
  3657   then have "openin (subtopology euclidean S) {x \<in> S. f x \<subseteq> T - U}"
  3658     using * [of "T-U"] by blast
  3659   moreover have "S - {x \<in> S. f x \<subseteq> T - U} = {x \<in> S. f x \<inter> U \<noteq> {}}"
  3660     using assms by blast
  3661   ultimately show "closedin (subtopology euclidean S) {x \<in> S. f x \<inter> U \<noteq> {}}"
  3662     by (simp add: openin_closedin_eq)
  3663 next
  3664   fix U
  3665   assume * [rule_format]: ?rhs and "openin (subtopology euclidean T) U"
  3666   then have "closedin (subtopology euclidean T) (T - U)"
  3667     by (simp add: closedin_diff)
  3668   then have "closedin (subtopology euclidean S) {x \<in> S. f x \<inter> (T - U) \<noteq> {}}"
  3669     using * [of "T-U"] by blast
  3670   moreover have "{x \<in> S. f x \<inter> (T - U) \<noteq> {}} = S - {x \<in> S. f x \<subseteq> U}"
  3671     using assms by auto
  3672   ultimately show "openin (subtopology euclidean S) {x \<in> S. f x \<subseteq> U}"
  3673     by (simp add: openin_closedin_eq)
  3674 qed
  3675 
  3676 lemma%unimportant lower_hemicontinuous:
  3677   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
  3678     shows "((\<forall>U. closedin (subtopology euclidean T) U
  3679                  \<longrightarrow> closedin (subtopology euclidean S) {x \<in> S. f x \<subseteq> U}) \<longleftrightarrow>
  3680             (\<forall>U. openin (subtopology euclidean T) U
  3681                  \<longrightarrow> openin (subtopology euclidean S) {x \<in> S. f x \<inter> U \<noteq> {}}))"
  3682           (is "?lhs = ?rhs")
  3683 proof (intro iffI allI impI)
  3684   fix U
  3685   assume * [rule_format]: ?lhs and "openin (subtopology euclidean T) U"
  3686   then have "closedin (subtopology euclidean T) (T - U)"
  3687     by (simp add: closedin_diff)
  3688   then have "closedin (subtopology euclidean S) {x \<in> S. f x \<subseteq> T-U}"
  3689     using * [of "T-U"] by blast
  3690   moreover have "{x \<in> S. f x \<subseteq> T-U} = S - {x \<in> S. f x \<inter> U \<noteq> {}}"
  3691     using assms by auto
  3692   ultimately show "openin (subtopology euclidean S) {x \<in> S. f x \<inter> U \<noteq> {}}"
  3693     by (simp add: openin_closedin_eq)
  3694 next
  3695   fix U
  3696   assume * [rule_format]: ?rhs and "closedin (subtopology euclidean T) U"
  3697   then have "openin (subtopology euclidean T) (T - U)"
  3698     by (simp add: openin_diff)
  3699   then have "openin (subtopology euclidean S) {x \<in> S. f x \<inter> (T - U) \<noteq> {}}"
  3700     using * [of "T-U"] by blast
  3701   moreover have "S - {x \<in> S. f x \<inter> (T - U) \<noteq> {}} = {x \<in> S. f x \<subseteq> U}"
  3702     using assms by blast
  3703   ultimately show "closedin (subtopology euclidean S) {x \<in> S. f x \<subseteq> U}"
  3704     by (simp add: openin_closedin_eq)
  3705 qed
  3706 
  3707 lemma%unimportant open_map_iff_lower_hemicontinuous_preimage:
  3708   assumes "f ` S \<subseteq> T"
  3709     shows "((\<forall>U. openin (subtopology euclidean S) U
  3710                  \<longrightarrow> openin (subtopology euclidean T) (f ` U)) \<longleftrightarrow>
  3711             (\<forall>U. closedin (subtopology euclidean S) U
  3712                  \<longrightarrow> closedin (subtopology euclidean T) {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}))"
  3713           (is "?lhs = ?rhs")
  3714 proof (intro iffI allI impI)
  3715   fix U
  3716   assume * [rule_format]: ?lhs and "closedin (subtopology euclidean S) U"
  3717   then have "openin (subtopology euclidean S) (S - U)"
  3718     by (simp add: openin_diff)
  3719   then have "openin (subtopology euclidean T) (f ` (S - U))"
  3720     using * [of "S-U"] by blast
  3721   moreover have "T - (f ` (S - U)) = {y \<in> T. {x \<in> S. f x = y} \<subseteq> U}"
  3722     using assms by blast
  3723   ultimately show "closedin (subtopology euclidean T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> U}"
  3724     by (simp add: openin_closedin_eq)
  3725 next
  3726   fix U
  3727   assume * [rule_format]: ?rhs and opeSU: "openin (subtopology euclidean S) U"
  3728   then have "closedin (subtopology euclidean S) (S - U)"
  3729     by (simp add: closedin_diff)
  3730   then have "closedin (subtopology euclidean T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
  3731     using * [of "S-U"] by blast
  3732   moreover have "{y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U} = T - (f ` U)"
  3733     using assms openin_imp_subset [OF opeSU] by auto
  3734   ultimately show "openin (subtopology euclidean T) (f ` U)"
  3735     using assms openin_imp_subset [OF opeSU] by (force simp: openin_closedin_eq)
  3736 qed
  3737 
  3738 lemma%unimportant closed_map_iff_upper_hemicontinuous_preimage:
  3739   assumes "f ` S \<subseteq> T"
  3740     shows "((\<forall>U. closedin (subtopology euclidean S) U
  3741                  \<longrightarrow> closedin (subtopology euclidean T) (f ` U)) \<longleftrightarrow>
  3742             (\<forall>U. openin (subtopology euclidean S) U
  3743                  \<longrightarrow> openin (subtopology euclidean T) {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}))"
  3744           (is "?lhs = ?rhs")
  3745 proof (intro iffI allI impI)
  3746   fix U
  3747   assume * [rule_format]: ?lhs and opeSU: "openin (subtopology euclidean S) U"
  3748   then have "closedin (subtopology euclidean S) (S - U)"
  3749     by (simp add: closedin_diff)
  3750   then have "closedin (subtopology euclidean T) (f ` (S - U))"
  3751     using * [of "S-U"] by blast
  3752   moreover have "f ` (S - U) = T -  {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}"
  3753     using assms openin_imp_subset [OF opeSU] by auto
  3754   ultimately show "openin (subtopology euclidean T)  {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}"
  3755     using assms openin_imp_subset [OF opeSU] by (force simp: openin_closedin_eq)
  3756 next
  3757   fix U
  3758   assume * [rule_format]: ?rhs and cloSU: "closedin (subtopology euclidean S) U"
  3759   then have "openin (subtopology euclidean S) (S - U)"
  3760     by (simp add: openin_diff)
  3761   then have "openin (subtopology euclidean T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
  3762     using * [of "S-U"] by blast
  3763   moreover have "(f ` U) = T - {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
  3764     using assms closedin_imp_subset [OF cloSU]  by auto
  3765   ultimately show "closedin (subtopology euclidean T) (f ` U)"
  3766     by (simp add: openin_closedin_eq)
  3767 qed
  3768 
  3769 proposition%important upper_lower_hemicontinuous_explicit:
  3770   fixes T :: "('b::{real_normed_vector,heine_borel}) set"
  3771   assumes fST: "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
  3772       and ope: "\<And>U. openin (subtopology euclidean T) U
  3773                      \<Longrightarrow> openin (subtopology euclidean S) {x \<in> S. f x \<subseteq> U}"
  3774       and clo: "\<And>U. closedin (subtopology euclidean T) U
  3775                      \<Longrightarrow> closedin (subtopology euclidean S) {x \<in> S. f x \<subseteq> U}"
  3776       and "x \<in> S" "0 < e" and bofx: "bounded(f x)" and fx_ne: "f x \<noteq> {}"
  3777   obtains d where "0 < d"
  3778              "\<And>x'. \<lbrakk>x' \<in> S; dist x x' < d\<rbrakk>
  3779                            \<Longrightarrow> (\<forall>y \<in> f x. \<exists>y'. y' \<in> f x' \<and> dist y y' < e) \<and>
  3780                                (\<forall>y' \<in> f x'. \<exists>y. y \<in> f x \<and> dist y' y < e)"
  3781 proof%unimportant -
  3782   have "openin (subtopology euclidean T) (T \<inter> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b}))"
  3783     by (auto simp: open_sums openin_open_Int)
  3784   with ope have "openin (subtopology euclidean S)
  3785                     {u \<in> S. f u \<subseteq> T \<inter> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b})}" by blast
  3786   with \<open>0 < e\<close> \<open>x \<in> S\<close> obtain d1 where "d1 > 0" and
  3787          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})"
  3788     by (force simp: openin_euclidean_subtopology_iff dest: fST)
  3789   have oo: "\<And>U. openin (subtopology euclidean T) U \<Longrightarrow>
  3790                  openin (subtopology euclidean S) {x \<in> S. f x \<inter> U \<noteq> {}}"
  3791     apply (rule lower_hemicontinuous [THEN iffD1, rule_format])
  3792     using fST clo by auto
  3793   have "compact (closure(f x))"
  3794     by (simp add: bofx)
  3795   moreover have "closure(f x) \<subseteq> (\<Union>a \<in> f x. ball a (e/2))"
  3796     using \<open>0 < e\<close> by (force simp: closure_approachable simp del: divide_const_simps)
  3797   ultimately obtain C where "C \<subseteq> f x" "finite C" "closure(f x) \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
  3798     apply (rule compactE, force)
  3799     by (metis finite_subset_image)
  3800   then have fx_cover: "f x \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
  3801     by (meson closure_subset order_trans)
  3802   with fx_ne have "C \<noteq> {}"
  3803     by blast
  3804   have xin: "x \<in> (\<Inter>a \<in> C. {x \<in> S. f x \<inter> T \<inter> ball a (e/2) \<noteq> {}})"
  3805     using \<open>x \<in> S\<close> \<open>0 < e\<close> fST \<open>C \<subseteq> f x\<close> by force
  3806   have "openin (subtopology euclidean S) {x \<in> S. f x \<inter> (T \<inter> ball a (e/2)) \<noteq> {}}" for a
  3807     by (simp add: openin_open_Int oo)
  3808   then have "openin (subtopology euclidean S) (\<Inter>a \<in> C. {x \<in> S. f x \<inter> T \<inter> ball a (e/2) \<noteq> {}})"
  3809     by (simp add: Int_assoc openin_INT2 [OF \<open>finite C\<close> \<open>C \<noteq> {}\<close>])
  3810   with xin obtain d2 where "d2>0"
  3811               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> {}"
  3812     unfolding openin_euclidean_subtopology_iff using xin by fastforce
  3813   show ?thesis
  3814   proof (intro that conjI ballI)
  3815     show "0 < min d1 d2"
  3816       using \<open>0 < d1\<close> \<open>0 < d2\<close> by linarith
  3817   next
  3818     fix x' y
  3819     assume "x' \<in> S" "dist x x' < min d1 d2" "y \<in> f x"
  3820     then have dd2: "dist x' x < d2"
  3821       by (auto simp: dist_commute)
  3822     obtain a where "a \<in> C" "y \<in> ball a (e/2)"
  3823       using fx_cover \<open>y \<in> f x\<close> by auto
  3824     then show "\<exists>y'. y' \<in> f x' \<and> dist y y' < e"
  3825       using d2 [OF \<open>x' \<in> S\<close> dd2] dist_triangle_half_r by fastforce
  3826   next
  3827     fix x' y'
  3828     assume "x' \<in> S" "dist x x' < min d1 d2" "y' \<in> f x'"
  3829     then have "dist x' x < d1"
  3830       by (auto simp: dist_commute)
  3831     then have "y' \<in> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b})"
  3832       using d1 [OF \<open>x' \<in> S\<close>] \<open>y' \<in> f x'\<close> by force
  3833     then show "\<exists>y. y \<in> f x \<and> dist y' y < e"
  3834       apply auto
  3835       by (metis add_diff_cancel_left' dist_norm)
  3836   qed
  3837 qed
  3838 
  3839 
  3840 subsection%important\<open>Complex logs exist on various "well-behaved" sets\<close>
  3841 
  3842 lemma%important continuous_logarithm_on_contractible:
  3843   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3844   assumes "continuous_on S f" "contractible S" "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3845   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3846 proof%unimportant -
  3847   obtain c where hom: "homotopic_with (\<lambda>h. True) S (-{0}) f (\<lambda>x. c)"
  3848     using nullhomotopic_from_contractible assms
  3849     by (metis imageE subset_Compl_singleton)
  3850   then show ?thesis
  3851     by (metis inessential_eq_continuous_logarithm that)
  3852 qed
  3853 
  3854 lemma%important continuous_logarithm_on_simply_connected:
  3855   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3856   assumes contf: "continuous_on S f" and S: "simply_connected S" "locally path_connected S"
  3857       and f: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3858   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3859   using%unimportant covering_space_lift [OF covering_space_exp_punctured_plane S contf]
  3860   by%unimportant (metis (full_types) f imageE subset_Compl_singleton)
  3861 
  3862 lemma%unimportant continuous_logarithm_on_cball:
  3863   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3864   assumes "continuous_on (cball a r) f" and "\<And>z. z \<in> cball a r \<Longrightarrow> f z \<noteq> 0"
  3865     obtains h where "continuous_on (cball a r) h" "\<And>z. z \<in> cball a r \<Longrightarrow> f z = exp(h z)"
  3866   using assms continuous_logarithm_on_contractible convex_imp_contractible by blast
  3867 
  3868 lemma%unimportant continuous_logarithm_on_ball:
  3869   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3870   assumes "continuous_on (ball a r) f" and "\<And>z. z \<in> ball a r \<Longrightarrow> f z \<noteq> 0"
  3871   obtains h where "continuous_on (ball a r) h" "\<And>z. z \<in> ball a r \<Longrightarrow> f z = exp(h z)"
  3872   using assms continuous_logarithm_on_contractible convex_imp_contractible by blast
  3873 
  3874 lemma%unimportant continuous_sqrt_on_contractible:
  3875   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3876   assumes "continuous_on S f" "contractible S"
  3877       and "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3878   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = (g x) ^ 2"
  3879 proof -
  3880   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3881     using continuous_logarithm_on_contractible [OF assms] by blast
  3882   show ?thesis
  3883   proof
  3884     show "continuous_on S (\<lambda>z. exp (g z / 2))"
  3885       by (rule continuous_on_compose2 [of UNIV exp]; intro continuous_intros contg subset_UNIV) auto
  3886     show "\<And>x. x \<in> S \<Longrightarrow> f x = (exp (g x / 2))\<^sup>2"
  3887       by (metis exp_double feq nonzero_mult_div_cancel_left times_divide_eq_right zero_neq_numeral)
  3888   qed
  3889 qed
  3890 
  3891 lemma%unimportant continuous_sqrt_on_simply_connected:
  3892   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  3893   assumes contf: "continuous_on S f" and S: "simply_connected S" "locally path_connected S"
  3894       and f: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3895   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = (g x) ^ 2"
  3896 proof -
  3897   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  3898     using continuous_logarithm_on_simply_connected [OF assms] by blast
  3899   show ?thesis
  3900   proof
  3901     show "continuous_on S (\<lambda>z. exp (g z / 2))"
  3902       by (rule continuous_on_compose2 [of UNIV exp]; intro continuous_intros contg subset_UNIV) auto
  3903     show "\<And>x. x \<in> S \<Longrightarrow> f x = (exp (g x / 2))\<^sup>2"
  3904       by (metis exp_double feq nonzero_mult_div_cancel_left times_divide_eq_right zero_neq_numeral)
  3905   qed
  3906 qed
  3907 
  3908 
  3909 subsection%important\<open>Another simple case where sphere maps are nullhomotopic\<close>
  3910 
  3911 lemma%important inessential_spheremap_2_aux:
  3912   fixes f :: "'a::euclidean_space \<Rightarrow> complex"
  3913   assumes 2: "2 < DIM('a)" and contf: "continuous_on (sphere a r) f" 
  3914       and fim: "f `(sphere a r) \<subseteq> (sphere 0 1)" 
  3915   obtains c where "homotopic_with (\<lambda>z. True) (sphere a r) (sphere 0 1) f (\<lambda>x. c)"
  3916 proof%unimportant -
  3917   obtain g where contg: "continuous_on (sphere a r) g" 
  3918              and feq: "\<And>x. x \<in> sphere a r \<Longrightarrow> f x = exp(g x)"
  3919   proof (rule continuous_logarithm_on_simply_connected [OF contf])
  3920     show "simply_connected (sphere a r)"
  3921       using 2 by (simp add: simply_connected_sphere_eq)
  3922     show "locally path_connected (sphere a r)"
  3923       by (simp add: locally_path_connected_sphere)
  3924     show "\<And>z.  z \<in> sphere a r \<Longrightarrow> f z \<noteq> 0"
  3925       using fim by force
  3926   qed auto
  3927   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)))"
  3928   proof (intro exI conjI)
  3929     show "continuous_on (sphere a r) (Im \<circ> g)"
  3930       by (intro contg continuous_intros continuous_on_compose)
  3931     show "\<forall>x\<in>sphere a r. f x = exp (\<i> * complex_of_real ((Im \<circ> g) x))"
  3932       using exp_eq_polar feq fim norm_exp_eq_Re by auto
  3933   qed
  3934   with inessential_eq_continuous_logarithm_circle that show ?thesis 
  3935     by metis
  3936 qed
  3937 
  3938 lemma%important inessential_spheremap_2:
  3939   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3940   assumes a2: "2 < DIM('a)" and b2: "DIM('b) = 2" 
  3941       and contf: "continuous_on (sphere a r) f" and fim: "f `(sphere a r) \<subseteq> (sphere b s)"
  3942   obtains c where "homotopic_with (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. c)"
  3943 proof%unimportant (cases "s \<le> 0")
  3944   case True
  3945   then show ?thesis
  3946     using contf contractible_sphere fim nullhomotopic_into_contractible that by blast
  3947 next
  3948   case False
  3949   then have "sphere b s homeomorphic sphere (0::complex) 1"
  3950     using assms by (simp add: homeomorphic_spheres_gen)
  3951   then obtain h k where hk: "homeomorphism (sphere b s) (sphere (0::complex) 1) h k"
  3952     by (auto simp: homeomorphic_def)
  3953   then have conth: "continuous_on (sphere b s) h"
  3954        and  contk: "continuous_on (sphere 0 1) k"
  3955        and  him: "h ` sphere b s \<subseteq> sphere 0 1"
  3956        and  kim: "k ` sphere 0 1 \<subseteq> sphere b s"
  3957     by (simp_all add: homeomorphism_def)
  3958   obtain c where "homotopic_with (\<lambda>z. True) (sphere a r) (sphere 0 1) (h \<circ> f) (\<lambda>x. c)"
  3959   proof (rule inessential_spheremap_2_aux [OF a2])
  3960     show "continuous_on (sphere a r) (h \<circ> f)"
  3961       by (meson continuous_on_compose [OF contf] conth continuous_on_subset fim)
  3962     show "(h \<circ> f) ` sphere a r \<subseteq> sphere 0 1"
  3963       using fim him by force
  3964   qed auto
  3965   then have "homotopic_with (\<lambda>f. True) (sphere a r) (sphere b s) (k \<circ> (h \<circ> f)) (k \<circ> (\<lambda>x. c))"
  3966     by (rule homotopic_compose_continuous_left [OF _ contk kim])
  3967   then have "homotopic_with (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. k c)"
  3968     apply (rule homotopic_with_eq, auto)
  3969     by (metis fim hk homeomorphism_def image_subset_iff mem_sphere)
  3970   then show ?thesis
  3971     by (metis that)
  3972 qed
  3973 
  3974 
  3975 subsection%important\<open>Holomorphic logarithms and square roots\<close>
  3976 
  3977 lemma%important contractible_imp_holomorphic_log:
  3978   assumes holf: "f holomorphic_on S"
  3979       and S: "contractible S"
  3980       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  3981   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
  3982 proof%unimportant -
  3983   have contf: "continuous_on S f"
  3984     by (simp add: holf holomorphic_on_imp_continuous_on)
  3985   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
  3986     by (metis continuous_logarithm_on_contractible [OF contf S fnz])
  3987   have "g field_differentiable at z within S" if "f field_differentiable at z within S" "z \<in> S" for z
  3988   proof -
  3989     obtain f' where f': "((\<lambda>y. (f y - f z) / (y - z)) \<longlongrightarrow> f') (at z within S)"
  3990       using \<open>f field_differentiable at z within S\<close> by (auto simp: field_differentiable_def has_field_derivative_iff)
  3991     then have ee: "((\<lambda>x. (exp(g x) - exp(g z)) / (x - z)) \<longlongrightarrow> f') (at z within S)"
  3992       by (simp add: feq \<open>z \<in> S\<close> Lim_transform_within [OF _ zero_less_one])
  3993     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))
  3994           (at z within S)"
  3995     proof (rule tendsto_compose_at)
  3996       show "(g \<longlongrightarrow> g z) (at z within S)"
  3997         using contg continuous_on \<open>z \<in> S\<close> by blast
  3998       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)"
  3999         apply (subst Lim_at_zero)
  4000         apply (simp add: DERIV_D cong: if_cong Lim_cong_within)
  4001         done
  4002       qed auto
  4003     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)"
  4004       by (simp add: o_def)
  4005     have "continuous (at z within S) g"
  4006       using contg continuous_on_eq_continuous_within \<open>z \<in> S\<close> by blast
  4007     then have "(\<forall>\<^sub>F x in at z within S. dist (g x) (g z) < 2*pi)"
  4008       by (simp add: continuous_within tendsto_iff)
  4009     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"
  4010       apply (rule eventually_mono)
  4011       apply (auto simp: exp_eq dist_norm norm_mult)
  4012       done
  4013     then have "((\<lambda>y. (g y - g z) / (y - z)) \<longlongrightarrow> f' / exp (g z)) (at z within S)"
  4014       by (auto intro!: Lim_transform_eventually [OF _ tendsto_divide [OF ee dd]])
  4015     then show ?thesis
  4016       by (auto simp: field_differentiable_def has_field_derivative_iff)
  4017   qed
  4018   then have "g holomorphic_on S"
  4019     using holf holomorphic_on_def by auto
  4020   then show ?thesis
  4021     using feq that by auto
  4022 qed
  4023 
  4024 (*Identical proofs*)
  4025 lemma%important simply_connected_imp_holomorphic_log:
  4026   assumes holf: "f holomorphic_on S"
  4027       and S: "simply_connected S" "locally path_connected S"
  4028       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  4029   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
  4030 proof%unimportant -
  4031   have contf: "continuous_on S f"
  4032     by (simp add: holf holomorphic_on_imp_continuous_on)
  4033   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
  4034     by (metis continuous_logarithm_on_simply_connected [OF contf S fnz])
  4035   have "g field_differentiable at z within S" if "f field_differentiable at z within S" "z \<in> S" for z
  4036   proof -
  4037     obtain f' where f': "((\<lambda>y. (f y - f z) / (y - z)) \<longlongrightarrow> f') (at z within S)"
  4038       using \<open>f field_differentiable at z within S\<close> by (auto simp: field_differentiable_def has_field_derivative_iff)
  4039     then have ee: "((\<lambda>x. (exp(g x) - exp(g z)) / (x - z)) \<longlongrightarrow> f') (at z within S)"
  4040       by (simp add: feq \<open>z \<in> S\<close> Lim_transform_within [OF _ zero_less_one])
  4041     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))
  4042           (at z within S)"
  4043     proof (rule tendsto_compose_at)
  4044       show "(g \<longlongrightarrow> g z) (at z within S)"
  4045         using contg continuous_on \<open>z \<in> S\<close> by blast
  4046       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)"
  4047         apply (subst Lim_at_zero)
  4048         apply (simp add: DERIV_D cong: if_cong Lim_cong_within)
  4049         done
  4050       qed auto
  4051     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)"
  4052       by (simp add: o_def)
  4053     have "continuous (at z within S) g"
  4054       using contg continuous_on_eq_continuous_within \<open>z \<in> S\<close> by blast
  4055     then have "(\<forall>\<^sub>F x in at z within S. dist (g x) (g z) < 2*pi)"
  4056       by (simp add: continuous_within tendsto_iff)
  4057     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"
  4058       apply (rule eventually_mono)
  4059       apply (auto simp: exp_eq dist_norm norm_mult)
  4060       done
  4061     then have "((\<lambda>y. (g y - g z) / (y - z)) \<longlongrightarrow> f' / exp (g z)) (at z within S)"
  4062       by (auto intro!: Lim_transform_eventually [OF _ tendsto_divide [OF ee dd]])
  4063     then show ?thesis
  4064       by (auto simp: field_differentiable_def has_field_derivative_iff)
  4065   qed
  4066   then have "g holomorphic_on S"
  4067     using holf holomorphic_on_def by auto
  4068   then show ?thesis
  4069     using feq that by auto
  4070 qed
  4071 
  4072 
  4073 lemma%unimportant contractible_imp_holomorphic_sqrt:
  4074   assumes holf: "f holomorphic_on S"
  4075       and S: "contractible S"
  4076       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  4077   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = g z ^ 2"
  4078 proof -
  4079   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
  4080     using contractible_imp_holomorphic_log [OF assms] by blast
  4081   show ?thesis
  4082   proof
  4083     show "exp \<circ> (\<lambda>z. z / 2) \<circ> g holomorphic_on S"
  4084       by (intro holomorphic_on_compose holg holomorphic_intros) auto
  4085     show "\<And>z. z \<in> S \<Longrightarrow> f z = ((exp \<circ> (\<lambda>z. z / 2) \<circ> g) z)\<^sup>2"
  4086       apply (auto simp: feq)
  4087       by (metis eq_divide_eq_numeral1(1) exp_double mult.commute zero_neq_numeral)
  4088   qed
  4089 qed
  4090 
  4091 lemma%unimportant simply_connected_imp_holomorphic_sqrt:
  4092   assumes holf: "f holomorphic_on S"
  4093       and S: "simply_connected S" "locally path_connected S"
  4094       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
  4095   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = g z ^ 2"
  4096 proof -
  4097   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
  4098     using simply_connected_imp_holomorphic_log [OF assms] by blast
  4099   show ?thesis
  4100   proof
  4101     show "exp \<circ> (\<lambda>z. z / 2) \<circ> g holomorphic_on S"
  4102       by (intro holomorphic_on_compose holg holomorphic_intros) auto
  4103     show "\<And>z. z \<in> S \<Longrightarrow> f z = ((exp \<circ> (\<lambda>z. z / 2) \<circ> g) z)\<^sup>2"
  4104       apply (auto simp: feq)
  4105       by (metis eq_divide_eq_numeral1(1) exp_double mult.commute zero_neq_numeral)
  4106   qed
  4107 qed
  4108 
  4109 text\<open> Related theorems about holomorphic inverse cosines.\<close>
  4110 
  4111 lemma%important contractible_imp_holomorphic_arccos:
  4112   assumes holf: "f holomorphic_on S" and S: "contractible S"
  4113       and non1: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 1 \<and> f z \<noteq> -1"
  4114   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = cos(g z)"
  4115 proof%unimportant -
  4116   have hol1f: "(\<lambda>z. 1 - f z ^ 2) holomorphic_on S"
  4117     by (intro holomorphic_intros holf)
  4118   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"
  4119     using contractible_imp_holomorphic_sqrt [OF hol1f S]
  4120     by (metis eq_iff_diff_eq_0 non1 power2_eq_1_iff)
  4121   have holfg: "(\<lambda>z. f z + \<i>*g z) holomorphic_on S"
  4122     by (intro holf holg holomorphic_intros)
  4123   have "\<And>z. z \<in> S \<Longrightarrow> f z + \<i>*g z \<noteq> 0"
  4124     by (metis Arccos_body_lemma eq add.commute add.inverse_unique complex_i_mult_minus power2_csqrt power2_eq_iff)
  4125   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)"
  4126     using contractible_imp_holomorphic_log [OF holfg S] by metis
  4127   show ?thesis
  4128   proof
  4129     show "(\<lambda>z. -\<i>*h z) holomorphic_on S"
  4130       by (intro holh holomorphic_intros)
  4131     show "f z = cos (- \<i>*h z)" if "z \<in> S" for z
  4132     proof -
  4133       have "(f z + \<i>*g z)*(f z - \<i>*g z) = 1"
  4134         using that eq by (auto simp: algebra_simps power2_eq_square)
  4135       then have "f z - \<i>*g z = inverse (f z + \<i>*g z)"
  4136         using inverse_unique by force
  4137       also have "... = exp (- h z)"
  4138         by (simp add: exp_minus fgeq that)
  4139       finally have "f z = exp (- h z) + \<i>*g z"
  4140         by (simp add: diff_eq_eq)
  4141       then show ?thesis
  4142         apply (simp add: cos_exp_eq)
  4143         by (metis fgeq add.assoc mult_2_right that)
  4144     qed
  4145   qed
  4146 qed
  4147 
  4148 
  4149 lemma%important contractible_imp_holomorphic_arccos_bounded:
  4150   assumes holf: "f holomorphic_on S" and S: "contractible S" and "a \<in> S"
  4151       and non1: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 1 \<and> f z \<noteq> -1"
  4152   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)"
  4153 proof%unimportant -
  4154   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = cos (g z)"
  4155     using contractible_imp_holomorphic_arccos [OF holf S non1] by blast
  4156   obtain b where "cos b = f a" "norm b \<le> pi + norm (f a)"
  4157     using cos_Arccos norm_Arccos_bounded by blast
  4158   then have "cos b = cos (g a)"
  4159     by (simp add: \<open>a \<in> S\<close> feq)
  4160   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)"
  4161     by (auto simp: complex_cos_eq)
  4162   then show ?thesis
  4163   proof cases
  4164     case 1
  4165     show ?thesis
  4166     proof
  4167       show "(\<lambda>z. g z + of_real(2*n*pi)) holomorphic_on S"
  4168         by (intro holomorphic_intros holg)
  4169       show "cmod (g a + of_real(2*n*pi)) \<le> pi + cmod (f a)"
  4170         using "1" \<open>cmod b \<le> pi + cmod (f a)\<close> by blast
  4171       show "\<And>z. z \<in> S \<Longrightarrow> f z = cos (g z + complex_of_real (2*n*pi))"
  4172         by (metis \<open>n \<in> \<int>\<close> complex_cos_eq feq)
  4173     qed
  4174   next
  4175     case 2
  4176     show ?thesis
  4177     proof
  4178       show "(\<lambda>z. -g z + of_real(2*n*pi)) holomorphic_on S"
  4179         by (intro holomorphic_intros holg)
  4180       show "cmod (-g a + of_real(2*n*pi)) \<le> pi + cmod (f a)"
  4181         using "2" \<open>cmod b \<le> pi + cmod (f a)\<close> by blast
  4182       show "\<And>z. z \<in> S \<Longrightarrow> f z = cos (-g z + complex_of_real (2*n*pi))"
  4183         by (metis \<open>n \<in> \<int>\<close> complex_cos_eq feq)
  4184     qed
  4185   qed
  4186 qed
  4187 
  4188 
  4189 subsection%important\<open>The "Borsukian" property of sets\<close>
  4190 
  4191 text\<open>This doesn't have a standard name. Kuratowski uses ``contractible with respect to $[S^1]$''
  4192  while Whyburn uses ``property b''. It's closely related to unicoherence.\<close>
  4193 
  4194 definition%important Borsukian where
  4195     "Borsukian S \<equiv>
  4196         \<forall>f. continuous_on S f \<and> f ` S \<subseteq> (- {0::complex})
  4197             \<longrightarrow> (\<exists>a. homotopic_with (\<lambda>h. True) S (- {0}) f (\<lambda>x. a))"
  4198 
  4199 lemma%important Borsukian_retraction_gen:
  4200   assumes "Borsukian S" "continuous_on S h" "h ` S = T"
  4201           "continuous_on T k"  "k ` T \<subseteq> S"  "\<And>y. y \<in> T \<Longrightarrow> h(k y) = y"
  4202     shows "Borsukian T"
  4203 proof%unimportant -
  4204   interpret R: Retracts S h T k
  4205     using assms by (simp add: Retracts.intro)
  4206   show ?thesis
  4207     using assms
  4208     apply (simp add: Borsukian_def, clarify)
  4209     apply (rule R.cohomotopically_trivial_retraction_null_gen [OF TrueI TrueI refl, of "-{0}"], auto)
  4210     done
  4211 qed
  4212 
  4213 lemma%unimportant retract_of_Borsukian: "\<lbrakk>Borsukian T; S retract_of T\<rbrakk> \<Longrightarrow> Borsukian S"
  4214   apply (auto simp: retract_of_def retraction_def)
  4215   apply (erule (1) Borsukian_retraction_gen)
  4216   apply (meson retraction retraction_def)
  4217     apply (auto simp: continuous_on_id)
  4218     done
  4219 
  4220 lemma%unimportant homeomorphic_Borsukian: "\<lbrakk>Borsukian S; S homeomorphic T\<rbrakk> \<Longrightarrow> Borsukian T"
  4221   using Borsukian_retraction_gen order_refl
  4222   by (fastforce simp add: homeomorphism_def homeomorphic_def)
  4223 
  4224 lemma%unimportant homeomorphic_Borsukian_eq:
  4225    "S homeomorphic T \<Longrightarrow> Borsukian S \<longleftrightarrow> Borsukian T"
  4226   by (meson homeomorphic_Borsukian homeomorphic_sym)
  4227 
  4228 lemma%unimportant Borsukian_translation:
  4229   fixes S :: "'a::real_normed_vector set"
  4230   shows "Borsukian (image (\<lambda>x. a + x) S) \<longleftrightarrow> Borsukian S"
  4231   apply (rule homeomorphic_Borsukian_eq)
  4232     using homeomorphic_translation homeomorphic_sym by blast
  4233 
  4234 lemma%unimportant Borsukian_injective_linear_image:
  4235   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4236   assumes "linear f" "inj f"
  4237     shows "Borsukian(f ` S) \<longleftrightarrow> Borsukian S"
  4238   apply (rule homeomorphic_Borsukian_eq)
  4239   using assms homeomorphic_sym linear_homeomorphic_image by blast
  4240 
  4241 lemma%unimportant homotopy_eqv_Borsukianness:
  4242   fixes S :: "'a::real_normed_vector set"
  4243     and T :: "'b::real_normed_vector set"
  4244    assumes "S homotopy_eqv T"
  4245      shows "(Borsukian S \<longleftrightarrow> Borsukian T)"
  4246   by (meson Borsukian_def assms homotopy_eqv_cohomotopic_triviality_null)
  4247 
  4248 lemma%unimportant Borsukian_alt:
  4249   fixes S :: "'a::real_normed_vector set"
  4250   shows
  4251    "Borsukian S \<longleftrightarrow>
  4252         (\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> -{0} \<and>
  4253                continuous_on S g \<and> g ` S \<subseteq> -{0}
  4254                \<longrightarrow> homotopic_with (\<lambda>h. True) S (- {0::complex}) f g)"
  4255   unfolding Borsukian_def homotopic_triviality
  4256   by (simp add: path_connected_punctured_universe)
  4257 
  4258 lemma%unimportant Borsukian_continuous_logarithm:
  4259   fixes S :: "'a::real_normed_vector set"
  4260   shows "Borsukian S \<longleftrightarrow>
  4261             (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> (- {0::complex})
  4262                  \<longrightarrow> (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))))"
  4263   by (simp add: Borsukian_def inessential_eq_continuous_logarithm)
  4264 
  4265 lemma%important Borsukian_continuous_logarithm_circle:
  4266   fixes S :: "'a::real_normed_vector set"
  4267   shows "Borsukian S \<longleftrightarrow>
  4268              (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
  4269                   \<longrightarrow> (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))))"
  4270    (is "?lhs = ?rhs")
  4271 proof%unimportant
  4272   assume ?lhs then show ?rhs
  4273     by (force simp: Borsukian_continuous_logarithm)
  4274 next
  4275   assume RHS [rule_format]: ?rhs
  4276   show ?lhs
  4277   proof (clarsimp simp: Borsukian_continuous_logarithm)
  4278     fix f :: "'a \<Rightarrow> complex"
  4279     assume contf: "continuous_on S f" and 0: "0 \<notin> f ` S"
  4280     then have "continuous_on S (\<lambda>x. f x / complex_of_real (cmod (f x)))"
  4281       by (intro continuous_intros) auto
  4282     moreover have "(\<lambda>x. f x / complex_of_real (cmod (f x))) ` S \<subseteq> sphere 0 1"
  4283       using 0 by (auto simp: norm_divide)
  4284     ultimately obtain g where contg: "continuous_on S g"
  4285                   and fg: "\<forall>x \<in> S. f x / complex_of_real (cmod (f x)) = exp(g x)"
  4286       using RHS [of "\<lambda>x. f x / of_real(norm(f x))"] by auto
  4287     show "\<exists>g. continuous_on S g \<and> (\<forall>x\<in>S. f x = exp (g x))"
  4288     proof (intro exI ballI conjI)
  4289       show "continuous_on S (\<lambda>x. (Ln \<circ> of_real \<circ> norm \<circ> f)x + g x)"
  4290         by (intro continuous_intros contf contg conjI) (use "0" in auto)
  4291       show "f x = exp ((Ln \<circ> complex_of_real \<circ> cmod \<circ> f) x + g x)" if "x \<in> S" for x
  4292         using 0 that
  4293         apply (clarsimp simp: exp_add)
  4294         apply (subst exp_Ln, force)
  4295         by (metis eq_divide_eq exp_not_eq_zero fg mult.commute)
  4296     qed
  4297   qed
  4298 qed
  4299 
  4300 
  4301 lemma%important Borsukian_continuous_logarithm_circle_real:
  4302   fixes S :: "'a::real_normed_vector set"
  4303   shows "Borsukian S \<longleftrightarrow>
  4304          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
  4305               \<longrightarrow> (\<exists>g. continuous_on S (complex_of_real \<circ> g) \<and> (\<forall>x \<in> S. f x = exp(\<i> * of_real(g x)))))"
  4306    (is "?lhs = ?rhs")
  4307 proof%unimportant
  4308   assume LHS: ?lhs
  4309   show ?rhs
  4310   proof (clarify)
  4311     fix f :: "'a \<Rightarrow> complex"
  4312     assume "continuous_on S f" and f01: "f ` S \<subseteq> sphere 0 1"
  4313     then obtain g where contg: "continuous_on S g" and "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  4314       using LHS by (auto simp: Borsukian_continuous_logarithm_circle)
  4315     then have "\<forall>x\<in>S. f x = exp (\<i> * complex_of_real ((Im \<circ> g) x))"
  4316       using f01 apply (simp add: image_iff subset_iff)
  4317         by (metis cis_conv_exp exp_eq_polar mult.left_neutral norm_exp_eq_Re of_real_1)
  4318     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)))"
  4319       by (rule_tac x="Im \<circ> g" in exI) (force intro: continuous_intros contg)
  4320   qed
  4321 next
  4322   assume RHS [rule_format]: ?rhs
  4323   show ?lhs
  4324   proof (clarsimp simp: Borsukian_continuous_logarithm_circle)
  4325     fix f :: "'a \<Rightarrow> complex"
  4326     assume "continuous_on S f" and f01: "f ` S \<subseteq> sphere 0 1"
  4327     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))"
  4328       by (metis RHS)
  4329     then show "\<exists>g. continuous_on S g \<and> (\<forall>x\<in>S. f x = exp (g x))"
  4330       by (rule_tac x="\<lambda>x. \<i>* of_real(g x)" in exI) (auto simp: continuous_intros contg)
  4331   qed
  4332 qed
  4333 
  4334 lemma%unimportant Borsukian_circle:
  4335   fixes S :: "'a::real_normed_vector set"
  4336   shows "Borsukian S \<longleftrightarrow>
  4337          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
  4338               \<longrightarrow> (\<exists>a. homotopic_with (\<lambda>h. True) S (sphere (0::complex) 1) f (\<lambda>x. a)))"
  4339 by (simp add: inessential_eq_continuous_logarithm_circle Borsukian_continuous_logarithm_circle_real)
  4340 
  4341 lemma%unimportant contractible_imp_Borsukian: "contractible S \<Longrightarrow> Borsukian S"
  4342   by (meson Borsukian_def nullhomotopic_from_contractible)
  4343 
  4344 lemma%unimportant simply_connected_imp_Borsukian:
  4345   fixes S :: "'a::real_normed_vector set"
  4346   shows  "\<lbrakk>simply_connected S; locally path_connected S\<rbrakk> \<Longrightarrow> Borsukian S"
  4347   apply (simp add: Borsukian_continuous_logarithm)
  4348   by (metis (no_types, lifting) continuous_logarithm_on_simply_connected image_iff)
  4349 
  4350 lemma%unimportant starlike_imp_Borsukian:
  4351   fixes S :: "'a::real_normed_vector set"
  4352   shows "starlike S \<Longrightarrow> Borsukian S"
  4353   by (simp add: contractible_imp_Borsukian starlike_imp_contractible)
  4354 
  4355 lemma%unimportant Borsukian_empty: "Borsukian {}"
  4356   by (auto simp: contractible_imp_Borsukian)
  4357 
  4358 lemma%unimportant Borsukian_UNIV: "Borsukian (UNIV :: 'a::real_normed_vector set)"
  4359   by (auto simp: contractible_imp_Borsukian)
  4360 
  4361 lemma%unimportant convex_imp_Borsukian:
  4362   fixes S :: "'a::real_normed_vector set"
  4363   shows "convex S \<Longrightarrow> Borsukian S"
  4364   by (meson Borsukian_def convex_imp_contractible nullhomotopic_from_contractible)
  4365 
  4366 lemma%unimportant Borsukian_sphere:
  4367   fixes a :: "'a::euclidean_space"
  4368   shows "3 \<le> DIM('a) \<Longrightarrow> Borsukian (sphere a r)"
  4369   apply (rule simply_connected_imp_Borsukian)
  4370   using simply_connected_sphere apply blast
  4371   using ENR_imp_locally_path_connected ENR_sphere by blast
  4372 
  4373 lemma%important Borsukian_open_Un:
  4374   fixes S :: "'a::real_normed_vector set"
  4375   assumes opeS: "openin (subtopology euclidean (S \<union> T)) S"
  4376       and opeT: "openin (subtopology euclidean (S \<union> T)) T"
  4377       and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
  4378     shows "Borsukian(S \<union> T)"
  4379 proof%unimportant (clarsimp simp add: Borsukian_continuous_logarithm)
  4380   fix f :: "'a \<Rightarrow> complex"
  4381   assume contf: "continuous_on (S \<union> T) f" and 0: "0 \<notin> f ` (S \<union> T)"
  4382   then have contfS: "continuous_on S f" and contfT: "continuous_on T f"
  4383     using continuous_on_subset by auto
  4384   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))"
  4385     using BS by (auto simp: Borsukian_continuous_logarithm)
  4386   then obtain g where contg: "continuous_on S g" and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  4387     using "0" contfS by blast
  4388   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))"
  4389     using BT by (auto simp: Borsukian_continuous_logarithm)
  4390   then obtain h where conth: "continuous_on T h" and fh: "\<And>x. x \<in> T \<Longrightarrow> f x = exp(h x)"
  4391     using "0" contfT by blast
  4392   show "\<exists>g. continuous_on (S \<union> T) g \<and> (\<forall>x\<in>S \<union> T. f x = exp (g x))"
  4393   proof (cases "S \<inter> T = {}")
  4394     case True
  4395     show ?thesis
  4396     proof (intro exI conjI)
  4397       show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
  4398         apply (rule continuous_on_cases_local_open [OF opeS opeT contg conth])
  4399         using True by blast
  4400       show "\<forall>x\<in>S \<union> T. f x = exp (if x \<in> S then g x else h x)"
  4401         using fg fh by auto
  4402     qed
  4403   next
  4404     case False
  4405     have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
  4406     proof (rule continuous_discrete_range_constant [OF ST])
  4407       show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
  4408         apply (intro continuous_intros)
  4409         apply (meson contg continuous_on_subset inf_le1)
  4410         by (meson conth continuous_on_subset inf_sup_ord(2))
  4411       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))"
  4412            if "x \<in> S \<inter> T" for x
  4413       proof -
  4414         have "g y - g x = h y - h x"
  4415               if "y \<in> S" "y \<in> T" "cmod (g y - g x - (h y - h x)) < 2 * pi" for y
  4416         proof (rule exp_complex_eqI)
  4417           have "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> \<le> cmod (g y - g x - (h y - h x))"
  4418             by (metis abs_Im_le_cmod minus_complex.simps(2))
  4419           then show "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> < 2 * pi"
  4420             using that by linarith
  4421           have "exp (g x) = exp (h x)" "exp (g y) = exp (h y)"
  4422             using fg fh that \<open>x \<in> S \<inter> T\<close> by fastforce+
  4423           then show "exp (g y - g x) = exp (h y - h x)"
  4424             by (simp add: exp_diff)
  4425         qed
  4426         then show ?thesis
  4427           by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
  4428       qed
  4429     qed 
  4430     then obtain a where a: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = a"
  4431       by (auto simp: constant_on_def)
  4432     with False have "exp a = 1"
  4433       by (metis IntI disjoint_iff_not_equal divide_self_if exp_diff exp_not_eq_zero fg fh)
  4434     with a show ?thesis
  4435       apply (rule_tac x="\<lambda>x. if x \<in> S then g x else a + h x" in exI)
  4436       apply (intro continuous_on_cases_local_open opeS opeT contg conth continuous_intros conjI)
  4437        apply (auto simp: algebra_simps fg fh exp_add)
  4438       done
  4439   qed
  4440 qed
  4441 
  4442 text\<open>The proof is a duplicate of that of \<open>Borsukian_open_Un\<close>.\<close>
  4443 lemma%important Borsukian_closed_Un:
  4444   fixes S :: "'a::real_normed_vector set"
  4445   assumes cloS: "closedin (subtopology euclidean (S \<union> T)) S"
  4446       and cloT: "closedin (subtopology euclidean (S \<union> T)) T"
  4447       and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
  4448     shows "Borsukian(S \<union> T)"
  4449 proof%unimportant (clarsimp simp add: Borsukian_continuous_logarithm)
  4450   fix f :: "'a \<Rightarrow> complex"
  4451   assume contf: "continuous_on (S \<union> T) f" and 0: "0 \<notin> f ` (S \<union> T)"
  4452   then have contfS: "continuous_on S f" and contfT: "continuous_on T f"
  4453     using continuous_on_subset by auto
  4454   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))"
  4455     using BS by (auto simp: Borsukian_continuous_logarithm)
  4456   then obtain g where contg: "continuous_on S g" and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
  4457     using "0" contfS by blast
  4458   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))"
  4459     using BT by (auto simp: Borsukian_continuous_logarithm)
  4460   then obtain h where conth: "continuous_on T h" and fh: "\<And>x. x \<in> T \<Longrightarrow> f x = exp(h x)"
  4461     using "0" contfT by blast
  4462   show "\<exists>g. continuous_on (S \<union> T) g \<and> (\<forall>x\<in>S \<union> T. f x = exp (g x))"
  4463   proof (cases "S \<inter> T = {}")
  4464     case True
  4465     show ?thesis
  4466     proof (intro exI conjI)
  4467       show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
  4468         apply (rule continuous_on_cases_local [OF cloS cloT contg conth])
  4469         using True by blast
  4470       show "\<forall>x\<in>S \<union> T. f x = exp (if x \<in> S then g x else h x)"
  4471         using fg fh by auto
  4472     qed
  4473   next
  4474     case False
  4475     have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
  4476     proof (rule continuous_discrete_range_constant [OF ST])
  4477       show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
  4478         apply (intro continuous_intros)
  4479         apply (meson contg continuous_on_subset inf_le1)
  4480         by (meson conth continuous_on_subset inf_sup_ord(2))
  4481       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))"
  4482            if "x \<in> S \<inter> T" for x
  4483       proof -
  4484         have "g y - g x = h y - h x"
  4485               if "y \<in> S" "y \<in> T" "cmod (g y - g x - (h y - h x)) < 2 * pi" for y
  4486         proof (rule exp_complex_eqI)
  4487           have "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> \<le> cmod (g y - g x - (h y - h x))"
  4488             by (metis abs_Im_le_cmod minus_complex.simps(2))
  4489           then show "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> < 2 * pi"
  4490             using that by linarith
  4491           have "exp (g x) = exp (h x)" "exp (g y) = exp (h y)"
  4492             using fg fh that \<open>x \<in> S \<inter> T\<close> by fastforce+
  4493           then show "exp (g y - g x) = exp (h y - h x)"
  4494             by (simp add: exp_diff)
  4495         qed
  4496         then show ?thesis
  4497           by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
  4498       qed
  4499     qed
  4500     then obtain a where a: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = a"
  4501       by (auto simp: constant_on_def)
  4502     with False have "exp a = 1"
  4503       by (metis IntI disjoint_iff_not_equal divide_self_if exp_diff exp_not_eq_zero fg fh)
  4504     with a show ?thesis
  4505       apply (rule_tac x="\<lambda>x. if x \<in> S then g x else a + h x" in exI)
  4506       apply (intro continuous_on_cases_local cloS cloT contg conth continuous_intros conjI)
  4507        apply (auto simp: algebra_simps fg fh exp_add)
  4508       done
  4509   qed
  4510 qed
  4511 
  4512 lemma%unimportant Borsukian_separation_compact:
  4513   fixes S :: "complex set"
  4514   assumes "compact S"
  4515     shows "Borsukian S \<longleftrightarrow> connected(- S)"
  4516   by (simp add: Borsuk_separation_theorem Borsukian_circle assms)
  4517 
  4518 lemma%important Borsukian_monotone_image_compact:
  4519   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4520   assumes "Borsukian S" and contf: "continuous_on S f" and fim: "f ` S = T"
  4521       and "compact S" and conn: "\<And>y. y \<in> T \<Longrightarrow> connected {x. x \<in> S \<and> f x = y}"
  4522     shows "Borsukian T"
  4523 proof%unimportant (clarsimp simp add: Borsukian_continuous_logarithm)
  4524   fix g :: "'b \<Rightarrow> complex"
  4525   assume contg: "continuous_on T g" and 0: "0 \<notin> g ` T"
  4526   have "continuous_on S (g \<circ> f)"
  4527     using contf contg continuous_on_compose fim by blast
  4528   moreover have "(g \<circ> f) ` S \<subseteq> -{0}"
  4529     using fim 0 by auto
  4530   ultimately obtain h where conth: "continuous_on S h" and gfh: "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> f) x = exp(h x)"
  4531     using \<open>Borsukian S\<close> by (auto simp: Borsukian_continuous_logarithm)
  4532   have "\<And>y. \<exists>x. y \<in> T \<longrightarrow> x \<in> S \<and> f x = y"
  4533     using fim by auto
  4534   then obtain f' where f': "\<And>y. y \<in> T \<longrightarrow> f' y \<in> S \<and> f (f' y) = y"
  4535     by metis
  4536   have *: "(\<lambda>x. h x - h(f' y)) constant_on {x. x \<in> S \<and> f x = y}" if "y \<in> T" for y
  4537   proof (rule continuous_discrete_range_constant [OF conn [OF that], of "\<lambda>x. h x - h (f' y)"], simp_all add: algebra_simps)
  4538     show "continuous_on {x \<in> S. f x = y} (\<lambda>x. h x - h (f' y))"
  4539       by (intro continuous_intros continuous_on_subset [OF conth]) auto
  4540     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)"
  4541       if x: "x \<in> S \<and> f x = y" for x
  4542     proof -
  4543       have "h u = h x" if "u \<in> S" "f u = y" "cmod (h u - h x) < 2 * pi" for u
  4544       proof (rule exp_complex_eqI)
  4545         have "\<bar>Im (h u) - Im (h x)\<bar> \<le> cmod (h u - h x)"
  4546           by (metis abs_Im_le_cmod minus_complex.simps(2))
  4547         then show "\<bar>Im (h u) - Im (h x)\<bar> < 2 * pi"
  4548           using that by linarith
  4549         show "exp (h u) = exp (h x)"
  4550           by (simp add: gfh [symmetric] x that)
  4551       qed
  4552       then show ?thesis
  4553         by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
  4554     qed
  4555   qed 
  4556   have "h x = h (f' (f x))" if "x \<in> S" for x
  4557     using * [of "f x"] fim that unfolding constant_on_def by clarsimp (metis f' imageI right_minus_eq)
  4558   moreover have "\<And>x. x \<in> T \<Longrightarrow> \<exists>u. u \<in> S \<and> x = f u \<and> h (f' x) = h u"
  4559     using f' by fastforce
  4560   ultimately
  4561   have eq: "((\<lambda>x. (x, (h \<circ> f') x)) ` T) =
  4562             {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})}"
  4563     using fim by (auto simp: image_iff)
  4564   show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (h x))"
  4565   proof (intro exI conjI)
  4566     show "continuous_on T (h \<circ> f')"
  4567     proof (rule continuous_from_closed_graph [of "h ` S"])
  4568       show "compact (h ` S)"
  4569         by (simp add: \<open>compact S\<close> compact_continuous_image conth)
  4570       show "(h \<circ> f') ` T \<subseteq> h ` S"
  4571         by (auto simp: f')
  4572       show "closed ((\<lambda>x. (x, (h \<circ> f') x)) ` T)"
  4573         apply (subst eq)
  4574         apply (intro closed_compact_projection [OF \<open>compact S\<close>] continuous_closed_preimage
  4575                      continuous_intros continuous_on_subset [OF contf] continuous_on_subset [OF conth])
  4576            apply (auto simp: \<open>compact S\<close> closed_Times compact_imp_closed)
  4577         done
  4578     qed
  4579   qed (use f' gfh in fastforce)
  4580 qed
  4581 
  4582 
  4583 lemma%important Borsukian_open_map_image_compact:
  4584   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4585   assumes "Borsukian S" and contf: "continuous_on S f" and fim: "f ` S = T" and "compact S"
  4586       and ope: "\<And>U. openin (subtopology euclidean S) U
  4587                      \<Longrightarrow> openin (subtopology euclidean T) (f ` U)"
  4588     shows "Borsukian T"
  4589 proof%unimportant (clarsimp simp add: Borsukian_continuous_logarithm_circle_real)
  4590   fix g :: "'b \<Rightarrow> complex"
  4591   assume contg: "continuous_on T g" and gim: "g ` T \<subseteq> sphere 0 1"
  4592   have "continuous_on S (g \<circ> f)"
  4593     using contf contg continuous_on_compose fim by blast
  4594   moreover have "(g \<circ> f) ` S \<subseteq> sphere 0 1"
  4595     using fim gim by auto
  4596   ultimately obtain h where cont_cxh: "continuous_on S (complex_of_real \<circ> h)"
  4597                        and gfh: "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> f) x = exp(\<i> * of_real(h x))"
  4598     using \<open>Borsukian S\<close> Borsukian_continuous_logarithm_circle_real  by metis
  4599   then have conth: "continuous_on S h"
  4600     by simp
  4601   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
  4602   proof -
  4603     have 1: "compact (h ` {x \<in> S. f x = y})"
  4604     proof (rule compact_continuous_image)
  4605       show "continuous_on {x \<in> S. f x = y} h"
  4606         by (rule continuous_on_subset [OF conth]) auto
  4607       have "compact (S \<inter> f -` {y})"
  4608         by (rule proper_map_from_compact [OF contf _ \<open>compact S\<close>, of T]) (simp_all add: fim that)
  4609       then show "compact {x \<in> S. f x = y}" 
  4610         by (auto simp: vimage_def Int_def)
  4611     qed
  4612     have 2: "h ` {x \<in> S. f x = y} \<noteq> {}"
  4613       using fim that by auto
  4614     have "\<exists>s \<in> h ` {x \<in> S. f x = y}. \<forall>t \<in> h ` {x \<in> S. f x = y}. s \<le> t"
  4615       using compact_attains_inf [OF 1 2] by blast
  4616     then show ?thesis by auto
  4617   qed
  4618   then obtain k where kTS: "\<And>y. y \<in> T \<Longrightarrow> k y \<in> S"
  4619                   and fk:  "\<And>y. y \<in> T \<Longrightarrow> f (k y) = y "
  4620                   and hle: "\<And>x' y. \<lbrakk>y \<in> T; x' \<in> S; f x' = y\<rbrakk> \<Longrightarrow> h (k y) \<le> h x'"
  4621     by metis
  4622   have "continuous_on T (h \<circ> k)"
  4623   proof (clarsimp simp add: continuous_on_iff)
  4624     fix y and e::real
  4625     assume "y \<in> T" "0 < e"
  4626     moreover have "uniformly_continuous_on S (complex_of_real \<circ> h)"
  4627       using \<open>compact S\<close> cont_cxh compact_uniformly_continuous by blast
  4628     ultimately obtain d where "0 < d"
  4629                   and d: "\<And>x x'. \<lbrakk>x\<in>S; x'\<in>S; dist x' x < d\<rbrakk> \<Longrightarrow> dist (h x') (h x) < e"
  4630       by (force simp: uniformly_continuous_on_def)
  4631     obtain \<delta> where "0 < \<delta>" and \<delta>:
  4632       "\<And>x'. \<lbrakk>x' \<in> T; dist y x' < \<delta>\<rbrakk>
  4633                \<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>
  4634                    (\<forall>v' \<in> {z \<in> S. f z = x'}. \<exists>v. v \<in> {z \<in> S. f z = y} \<and> dist v' v < d)"
  4635     proof (rule upper_lower_hemicontinuous_explicit [of T "\<lambda>y. {z \<in> S. f z = y}" S])
  4636       show "\<And>U. openin (subtopology euclidean S) U
  4637                  \<Longrightarrow> openin (subtopology euclidean T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
  4638         using continuous_imp_closed_map closed_map_iff_upper_hemicontinuous_preimage [OF fim [THEN equalityD1]]
  4639         by (simp add: continuous_imp_closed_map \<open>compact S\<close> contf fim)
  4640       show "\<And>U. closedin (subtopology euclidean S) U \<Longrightarrow>
  4641                  closedin (subtopology euclidean T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
  4642         using  ope open_map_iff_lower_hemicontinuous_preimage [OF fim [THEN equalityD1]]
  4643         by meson
  4644       show "bounded {z \<in> S. f z = y}"
  4645         by (metis (no_types, lifting) compact_imp_bounded [OF \<open>compact S\<close>] bounded_subset mem_Collect_eq subsetI)
  4646     qed (use \<open>y \<in> T\<close> \<open>0 < d\<close> fk kTS in \<open>force+\<close>)
  4647     have "dist (h (k y')) (h (k y)) < e" if "y' \<in> T" "dist y y' < \<delta>" for y'
  4648     proof -
  4649       have k1: "k y \<in> S" "f (k y) = y" and k2: "k y' \<in> S" "f (k y') = y'"
  4650         by (auto simp: \<open>y \<in> T\<close> \<open>y' \<in> T\<close> kTS fk)
  4651       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"
  4652        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"
  4653         using \<delta> [OF that] by auto
  4654       then obtain w' w where "w' \<in> S" "f w' = y'" "dist (k y) w' < d"
  4655         and "w \<in> S" "f w = y" "dist (k y') w < d"
  4656         using 1 [OF k1] 2 [OF k2] by auto
  4657       then show ?thesis
  4658         using d [of w "k y'"] d [of w' "k y"] k1 k2 \<open>y' \<in> T\<close>  \<open>y \<in> T\<close> hle
  4659         by (fastforce simp: dist_norm abs_diff_less_iff algebra_simps)
  4660     qed
  4661     then show "\<exists>d>0. \<forall>x'\<in>T. dist x' y < d \<longrightarrow> dist (h (k x')) (h (k y)) < e"
  4662       using  \<open>0 < \<delta>\<close> by (auto simp: dist_commute)
  4663   qed
  4664   then show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (\<i> * complex_of_real (h x)))"
  4665     using fk gfh kTS by force
  4666 qed
  4667 
  4668 
  4669 text\<open>If two points are separated by a closed set, there's a minimal one.\<close>
  4670 proposition%important closed_irreducible_separator:
  4671   fixes a :: "'a::real_normed_vector"
  4672   assumes "closed S" and ab: "\<not> connected_component (- S) a b"
  4673   obtains T where "T \<subseteq> S" "closed T" "T \<noteq> {}" "\<not> connected_component (- T) a b"
  4674                   "\<And>U. U \<subset> T \<Longrightarrow> connected_component (- U) a b"
  4675 proof%unimportant (cases "a \<in> S \<or> b \<in> S")
  4676   case True
  4677   then show ?thesis
  4678   proof
  4679     assume *: "a \<in> S"
  4680     show ?thesis
  4681     proof
  4682       show "{a} \<subseteq> S"
  4683         using * by blast
  4684       show "\<not> connected_component (- {a}) a b"
  4685         using connected_component_in by auto
  4686       show "\<And>U. U \<subset> {a} \<Longrightarrow> connected_component (- U) a b"
  4687         by (metis connected_component_UNIV UNIV_I compl_bot_eq connected_component_eq_eq less_le_not_le subset_singletonD)
  4688     qed auto
  4689   next
  4690     assume *: "b \<in> S"
  4691     show ?thesis
  4692     proof
  4693       show "{b} \<subseteq> S"
  4694         using * by blast
  4695       show "\<not> connected_component (- {b}) a b"
  4696         using connected_component_in by auto
  4697       show "\<And>U. U \<subset> {b} \<Longrightarrow> connected_component (- U) a b"
  4698         by (metis connected_component_UNIV UNIV_I compl_bot_eq connected_component_eq_eq less_le_not_le subset_singletonD)
  4699     qed auto
  4700   qed
  4701 next
  4702   case False
  4703   define A where "A \<equiv> connected_component_set (- S) a"
  4704   define B where "B \<equiv> connected_component_set (- (closure A)) b"
  4705   have "a \<in> A"
  4706     using False A_def by auto
  4707   have "b \<in> B"
  4708     unfolding A_def B_def closure_Un_frontier
  4709     using ab False \<open>closed S\<close> frontier_complement frontier_of_connected_component_subset frontier_subset_closed by force
  4710   have "frontier B \<subseteq> frontier (connected_component_set (- closure A) b)"
  4711     using B_def by blast
  4712   also have frsub: "... \<subseteq> frontier A"
  4713   proof -
  4714     have "\<And>A. closure (- closure (- A)) \<subseteq> closure A"
  4715       by (metis (no_types) closure_mono closure_subset compl_le_compl_iff double_compl)
  4716     then show ?thesis
  4717       by (metis (no_types) closure_closure double_compl frontier_closures frontier_of_connected_component_subset le_inf_iff subset_trans)
  4718   qed
  4719   finally have frBA: "frontier B \<subseteq> frontier A" .
  4720   show ?thesis
  4721   proof
  4722     show "frontier B \<subseteq> S"
  4723     proof -
  4724       have "frontier S \<subseteq> S"
  4725         by (simp add: \<open>closed S\<close> frontier_subset_closed)
  4726       then show ?thesis
  4727         using frsub frontier_complement frontier_of_connected_component_subset
  4728         unfolding A_def B_def by blast
  4729     qed
  4730     show "closed (frontier B)"
  4731       by simp
  4732     show "\<not> connected_component (- frontier B) a b"
  4733       unfolding connected_component_def
  4734     proof clarify
  4735       fix T
  4736       assume "connected T" and TB: "T \<subseteq> - frontier B" and "a \<in> T" and "b \<in> T"
  4737       have "a \<notin> B"
  4738         by (metis A_def B_def ComplD \<open>a \<in> A\<close> assms(1) closed_open connected_component_subset in_closure_connected_component set_mp)
  4739       have "T \<inter> B \<noteq> {}"
  4740         using \<open>b \<in> B\<close> \<open>b \<in> T\<close> by blast
  4741       moreover have "T - B \<noteq> {}"
  4742         using \<open>a \<notin> B\<close> \<open>a \<in> T\<close> by blast
  4743       ultimately show "False"
  4744         using connected_Int_frontier [of T B] TB \<open>connected T\<close> by blast
  4745     qed
  4746     moreover have "connected_component (- frontier B) a b" if "frontier B = {}"
  4747       apply (simp add: that)
  4748       using connected_component_eq_UNIV by blast
  4749     ultimately show "frontier B \<noteq> {}"
  4750       by blast
  4751     show "connected_component (- U) a b" if "U \<subset> frontier B" for U
  4752     proof -
  4753       obtain p where Usub: "U \<subseteq> frontier B" and p: "p \<in> frontier B" "p \<notin> U"
  4754         using \<open>U \<subset> frontier B\<close> by blast
  4755       show ?thesis
  4756         unfolding connected_component_def
  4757       proof (intro exI conjI)
  4758         have "connected ((insert p A) \<union> (insert p B))"
  4759         proof (rule connected_Un)
  4760           show "connected (insert p A)"
  4761             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)
  4762           show "connected (insert p B)"
  4763             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)
  4764         qed blast
  4765         then show "connected (insert p (B \<union> A))"
  4766           by (simp add: sup.commute)
  4767         have "A \<subseteq> - U"
  4768           using A_def Usub \<open>frontier B \<subseteq> S\<close> connected_component_subset by fastforce
  4769         moreover have "B \<subseteq> - U"
  4770           using B_def Usub connected_component_subset frBA frontier_closures by fastforce
  4771         ultimately show "insert p (B \<union> A) \<subseteq> - U"
  4772           using p by auto
  4773       qed (auto simp: \<open>a \<in> A\<close> \<open>b \<in> B\<close>)
  4774     qed
  4775   qed
  4776 qed
  4777 
  4778 lemma%unimportant frontier_minimal_separating_closed_pointwise:
  4779   fixes S :: "'a::real_normed_vector set"
  4780   assumes S: "closed S" "a \<notin> S" and nconn: "\<not> connected_component (- S) a b"
  4781       and conn: "\<And>T. \<lbrakk>closed T; T \<subset> S\<rbrakk> \<Longrightarrow> connected_component (- T) a b"
  4782     shows "frontier(connected_component_set (- S) a) = S" (is "?F = S")
  4783 proof -
  4784   have "?F \<subseteq> S"
  4785     by (simp add: S componentsI frontier_of_components_closed_complement)
  4786   moreover have False if "?F \<subset> S"
  4787   proof -
  4788     have "connected_component (- ?F) a b"
  4789       by (simp add: conn that)
  4790     then obtain T where "connected T" "T \<subseteq> -?F" "a \<in> T" "b \<in> T"
  4791       by (auto simp: connected_component_def)
  4792     moreover have "T \<inter> ?F \<noteq> {}"
  4793     proof (rule connected_Int_frontier [OF \<open>connected T\<close>])
  4794       show "T \<inter> connected_component_set (- S) a \<noteq> {}"
  4795         using \<open>a \<notin> S\<close> \<open>a \<in> T\<close> by fastforce
  4796       show "T - connected_component_set (- S) a \<noteq> {}"
  4797         using \<open>b \<in> T\<close> nconn by blast
  4798     qed
  4799     ultimately show ?thesis
  4800       by blast
  4801   qed
  4802   ultimately show ?thesis
  4803     by blast
  4804 qed
  4805 
  4806 
  4807 subsection%important\<open>Unicoherence (closed)\<close>
  4808 
  4809 definition%important unicoherent where
  4810   "unicoherent U \<equiv>
  4811   \<forall>S T. connected S \<and> connected T \<and> S \<union> T = U \<and>
  4812         closedin (subtopology euclidean U) S \<and> closedin (subtopology euclidean U) T
  4813         \<longrightarrow> connected (S \<inter> T)"
  4814 
  4815 lemma%unimportant unicoherentI [intro?]:
  4816   assumes "\<And>S T. \<lbrakk>connected S; connected T; U = S \<union> T; closedin (subtopology euclidean U) S; closedin (subtopology euclidean U) T\<rbrakk>
  4817           \<Longrightarrow> connected (S \<inter> T)"
  4818   shows "unicoherent U"
  4819   using assms unfolding unicoherent_def by blast
  4820 
  4821 lemma%unimportant unicoherentD:
  4822   assumes "unicoherent U" "connected S" "connected T" "U = S \<union> T" "closedin (subtopology euclidean U) S" "closedin (subtopology euclidean U) T"
  4823   shows "connected (S \<inter> T)"
  4824   using assms unfolding unicoherent_def by blast
  4825 
  4826 lemma%important homeomorphic_unicoherent:
  4827   assumes ST: "S homeomorphic T" and S: "unicoherent S"
  4828   shows "unicoherent T"
  4829 proof%unimportant -
  4830   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"
  4831     and contf: "continuous_on S f" and contg: "continuous_on (f ` S) g"
  4832     using ST by (auto simp: homeomorphic_def homeomorphism_def)
  4833   show ?thesis
  4834   proof
  4835     fix U V
  4836     assume "connected U" "connected V" and T: "T = U \<union> V"
  4837       and cloU: "closedin (subtopology euclidean T) U"
  4838       and cloV: "closedin (subtopology euclidean T) V"
  4839     have "f ` (g ` U \<inter> g ` V) \<subseteq> U" "f ` (g ` U \<inter> g ` V) \<subseteq> V"
  4840       using gf fim T by auto (metis UnCI image_iff)+
  4841     moreover have "U \<inter> V \<subseteq> f ` (g ` U \<inter> g ` V)"
  4842       using gf fim by (force simp: image_iff T)
  4843     ultimately have "U \<inter> V = f ` (g ` U \<inter> g ` V)" by blast
  4844     moreover have "connected (f ` (g ` U \<inter> g ` V))"
  4845     proof (rule connected_continuous_image)
  4846       show "continuous_on (g ` U \<inter> g ` V) f"
  4847         apply (rule continuous_on_subset [OF contf])
  4848         using T fim gfim by blast
  4849       show "connected (g ` U \<inter> g ` V)"
  4850       proof (intro conjI unicoherentD [OF S])
  4851         show "connected (g ` U)" "connected (g ` V)"
  4852           using \<open>connected U\<close> cloU \<open>connected V\<close> cloV
  4853           by (metis Topological_Spaces.connected_continuous_image closedin_imp_subset contg continuous_on_subset fim)+
  4854         show "S = g ` U \<union> g ` V"
  4855           using T fim gfim by auto
  4856         have hom: "homeomorphism T S g f"
  4857           by (simp add: contf contg fim gf gfim homeomorphism_def)
  4858         have "closedin (subtopology euclidean T) U" "closedin (subtopology euclidean T) V"
  4859           by (simp_all add: cloU cloV)
  4860         then show "closedin (subtopology euclidean S) (g ` U)"
  4861                   "closedin (subtopology euclidean S) (g ` V)"
  4862           by (blast intro: homeomorphism_imp_closed_map [OF hom])+
  4863       qed
  4864     qed
  4865     ultimately show "connected (U \<inter> V)" by metis
  4866   qed
  4867 qed
  4868 
  4869 
  4870 lemma%unimportant homeomorphic_unicoherent_eq:
  4871    "S homeomorphic T \<Longrightarrow> (unicoherent S \<longleftrightarrow> unicoherent T)"
  4872   by (meson homeomorphic_sym homeomorphic_unicoherent)
  4873 
  4874 lemma%unimportant unicoherent_translation:
  4875   fixes S :: "'a::real_normed_vector set"
  4876   shows
  4877    "unicoherent (image (\<lambda>x. a + x) S) \<longleftrightarrow> unicoherent S"
  4878   using homeomorphic_translation homeomorphic_unicoherent_eq by blast
  4879 
  4880 lemma%unimportant unicoherent_injective_linear_image:
  4881   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  4882   assumes "linear f" "inj f"
  4883   shows "(unicoherent(f ` S) \<longleftrightarrow> unicoherent S)"
  4884   using assms homeomorphic_unicoherent_eq linear_homeomorphic_image by blast
  4885 
  4886 
  4887 lemma%unimportant Borsukian_imp_unicoherent:
  4888   fixes U :: "'a::euclidean_space set"
  4889   assumes "Borsukian U"  shows "unicoherent U"
  4890   unfolding unicoherent_def
  4891 proof clarify
  4892   fix S T
  4893   assume "connected S" "connected T" "U = S \<union> T"
  4894      and cloS: "closedin (subtopology euclidean (S \<union> T)) S"
  4895      and cloT: "closedin (subtopology euclidean (S \<union> T)) T"
  4896   show "connected (S \<inter> T)"
  4897     unfolding connected_closedin_eq
  4898   proof clarify
  4899     fix V W
  4900     assume "closedin (subtopology euclidean (S \<inter> T)) V"
  4901        and "closedin (subtopology euclidean (S \<inter> T)) W"
  4902        and VW: "V \<union> W = S \<inter> T" "V \<inter> W = {}" and "V \<noteq> {}" "W \<noteq> {}"
  4903     then have cloV: "closedin (subtopology euclidean U) V" and cloW: "closedin (subtopology euclidean U) W"
  4904       using \<open>U = S \<union> T\<close> cloS cloT closedin_trans by blast+
  4905     obtain q where contq: "continuous_on U q"
  4906          and q01: "\<And>x. x \<in> U \<Longrightarrow> q x \<in> {0..1::real}"
  4907          and qV: "\<And>x. x \<in> V \<Longrightarrow> q x = 0" and qW: "\<And>x. x \<in> W \<Longrightarrow> q x = 1"
  4908       by (rule Urysohn_local [OF cloV cloW \<open>V \<inter> W = {}\<close>, of 0 1])
  4909          (fastforce simp: closed_segment_eq_real_ivl)
  4910     let ?h = "\<lambda>x. if x \<in> S then exp(pi * \<i> * q x) else 1 / exp(pi * \<i> * q x)"
  4911     have eqST: "exp(pi * \<i> * q x) = 1 / exp(pi * \<i> * q x)" if "x \<in> S \<inter> T" for x
  4912     proof -
  4913       have "x \<in> V \<union> W"
  4914         using that \<open>V \<union> W = S \<inter> T\<close> by blast
  4915       with qV qW show ?thesis by force
  4916     qed
  4917     obtain g where contg: "continuous_on U g"
  4918       and circle: "g ` U \<subseteq> sphere 0 1"
  4919       and S: "\<And>x. x \<in> S \<Longrightarrow> g x = exp(pi * \<i> * q x)"
  4920       and T: "\<And>x. x \<in> T \<Longrightarrow> g x = 1 / exp(pi * \<i> * q x)"
  4921     proof
  4922       show "continuous_on U ?h"
  4923         unfolding \<open>U = S \<union> T\<close>
  4924       proof (rule continuous_on_cases_local [OF cloS cloT])
  4925         show "continuous_on S (\<lambda>x. exp (pi * \<i> * q x))"
  4926           apply (intro continuous_intros)
  4927           using \<open>U = S \<union> T\<close> continuous_on_subset contq by blast
  4928         show "continuous_on T (\<lambda>x. 1 / exp (pi * \<i> * q x))"
  4929           apply (intro continuous_intros)
  4930           using \<open>U = S \<union> T\<close> continuous_on_subset contq by auto
  4931       qed (use eqST in auto)
  4932     qed (use eqST in \<open>auto simp: norm_divide\<close>)
  4933     then obtain h where conth: "continuous_on U h" and heq: "\<And>x. x \<in> U \<Longrightarrow> g x = exp (h x)"
  4934       by (metis Borsukian_continuous_logarithm_circle assms)
  4935     obtain v w where "v \<in> V" "w \<in> W"
  4936       using \<open>V \<noteq> {}\<close> \<open>W \<noteq> {}\<close> by blast
  4937     then have vw: "v \<in> S \<inter> T" "w \<in> S \<inter> T"
  4938       using VW by auto
  4939     have iff: "2 * pi \<le> cmod (2 * of_int m * of_real pi * \<i> - 2 * of_int n * of_real pi * \<i>)
  4940           \<longleftrightarrow> 1 \<le> abs (m - n)" for m n
  4941     proof -
  4942       have "2 * pi \<le> cmod (2 * of_int m * of_real pi * \<i> - 2 * of_int n * of_real pi * \<i>)
  4943             \<longleftrightarrow> 2 * pi \<le> cmod ((2 * pi * \<i>) * (of_int m - of_int n))"
  4944         by (simp add: algebra_simps)
  4945       also have "... \<longleftrightarrow> 2 * pi \<le> 2 * pi * cmod (of_int m - of_int n)"
  4946         by (simp add: norm_mult)
  4947       also have "... \<longleftrightarrow> 1 \<le> abs (m - n)"
  4948         by simp (metis norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
  4949       finally show ?thesis .
  4950     qed
  4951     have *: "\<exists>n::int. h x - (pi * \<i> * q x) = (of_int(2*n) * pi) * \<i>" if "x \<in> S" for x
  4952       using that S \<open>U = S \<union> T\<close> heq exp_eq [symmetric] by (simp add: algebra_simps)
  4953     moreover have "(\<lambda>x. h x - (pi * \<i> * q x)) constant_on S"
  4954     proof (rule continuous_discrete_range_constant [OF \<open>connected S\<close>])
  4955       have "continuous_on S h" "continuous_on S q"
  4956         using \<open>U = S \<union> T\<close> continuous_on_subset conth contq by blast+
  4957       then show "continuous_on S (\<lambda>x. h x - (pi * \<i> * q x))"
  4958         by (intro continuous_intros)
  4959       have "2*pi \<le> cmod (h y - (pi * \<i> * q y) - (h x - (pi * \<i> * q x)))"
  4960         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
  4961         using * [OF \<open>x \<in> S\<close>] * [OF \<open>y \<in> S\<close>] ne by (auto simp: iff)
  4962       then show "\<And>x. x \<in> S \<Longrightarrow>
  4963          \<exists>e>0. \<forall>y. y \<in> S \<and> h y - (pi * \<i> * q y) \<noteq> h x - (pi * \<i> * q x) \<longrightarrow>
  4964                    e \<le> cmod (h y - (pi * \<i> * q y) - (h x - (pi * \<i> * q x)))"
  4965         by (rule_tac x="2*pi" in exI) auto
  4966     qed
  4967     ultimately
  4968     obtain m where m: "\<And>x. x \<in> S \<Longrightarrow> h x - (pi * \<i> * q x) = (of_int(2*m) * pi) * \<i>"
  4969       using vw by (force simp: constant_on_def)
  4970     have *: "\<exists>n::int. h x = - (pi * \<i> * q x) + (of_int(2*n) * pi) * \<i>" if "x \<in> T" for x
  4971       unfolding exp_eq [symmetric]
  4972       using that T \<open>U = S \<union> T\<close> by (simp add: exp_minus field_simps  heq [symmetric])
  4973     moreover have "(\<lambda>x. h x + (pi * \<i> * q x)) constant_on T"
  4974     proof (rule continuous_discrete_range_constant [OF \<open>connected T\<close>])
  4975       have "continuous_on T h" "continuous_on T q"
  4976         using \<open>U = S \<union> T\<close> continuous_on_subset conth contq by blast+
  4977       then show "continuous_on T (\<lambda>x. h x + (pi * \<i> * q x))"
  4978         by (intro continuous_intros)
  4979       have "2*pi \<le> cmod (h y + (pi * \<i> * q y) - (h x + (pi * \<i> * q x)))"
  4980         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
  4981         using * [OF \<open>x \<in> T\<close>] * [OF \<open>y \<in> T\<close>] ne by (auto simp: iff)
  4982       then show "\<And>x. x \<in> T \<Longrightarrow>
  4983          \<exists>e>0. \<forall>y. y \<in> T \<and> h y + (pi * \<i> * q y) \<noteq> h x + (pi * \<i> * q x) \<longrightarrow>
  4984                    e \<le> cmod (h y + (pi * \<i> * q y) - (h x + (pi * \<i> * q x)))"
  4985         by (rule_tac x="2*pi" in exI) auto
  4986     qed
  4987     ultimately
  4988     obtain n where n: "\<And>x. x \<in> T \<Longrightarrow> h x + (pi * \<i> * q x) = (of_int(2*n) * pi) * \<i>"
  4989       using vw by (force simp: constant_on_def)
  4990     show "False"
  4991       using m [of v] m [of w] n [of v] n [of w] vw
  4992       by (auto simp: algebra_simps \<open>v \<in> V\<close> \<open>w \<in> W\<close> qV qW)
  4993   qed
  4994 qed
  4995 
  4996 
  4997 corollary%important contractible_imp_unicoherent:
  4998   fixes U :: "'a::euclidean_space set"
  4999   assumes "contractible U"  shows "unicoherent U"
  5000   by%unimportant (simp add: Borsukian_imp_unicoherent assms contractible_imp_Borsukian)
  5001 
  5002 corollary%important convex_imp_unicoherent:
  5003   fixes U :: "'a::euclidean_space set"
  5004   assumes "convex U"  shows "unicoherent U"
  5005   by%unimportant (simp add: Borsukian_imp_unicoherent assms convex_imp_Borsukian)
  5006 
  5007 text\<open>If the type class constraint can be relaxed, I don't know how!\<close>
  5008 corollary%important unicoherent_UNIV: "unicoherent (UNIV :: 'a :: euclidean_space set)"
  5009   by%unimportant (simp add: convex_imp_unicoherent)
  5010 
  5011 
  5012 lemma%important unicoherent_monotone_image_compact:
  5013   fixes T :: "'b :: t2_space set"
  5014   assumes S: "unicoherent S" "compact S" and contf: "continuous_on S f" and fim: "f ` S = T"
  5015   and conn: "\<And>y. y \<in> T \<Longrightarrow> connected (S \<inter> f -` {y})"
  5016   shows "unicoherent T"
  5017 proof%unimportant
  5018   fix U V
  5019   assume UV: "connected U" "connected V" "T = U \<union> V"
  5020      and cloU: "closedin (subtopology euclidean T) U"
  5021      and cloV: "closedin (subtopology euclidean T) V"
  5022   moreover have "compact T"
  5023     using \<open>compact S\<close> compact_continuous_image contf fim by blast
  5024   ultimately have "closed U" "closed V"
  5025     by (auto simp: closedin_closed_eq compact_imp_closed)
  5026   let ?SUV = "(S \<inter> f -` U) \<inter> (S \<inter> f -` V)"
  5027   have UV_eq: "f ` ?SUV = U \<inter> V"
  5028     using \<open>T = U \<union> V\<close> fim by force+
  5029   have "connected (f ` ?SUV)"
  5030   proof (rule connected_continuous_image)
  5031     show "continuous_on ?SUV f"
  5032       by (meson contf continuous_on_subset inf_le1)
  5033     show "connected ?SUV"
  5034     proof (rule unicoherentD [OF \<open>unicoherent S\<close>, of "S \<inter> f -` U" "S \<inter> f -` V"])
  5035       have "\<And>C. closedin (subtopology euclidean S) C \<Longrightarrow> closedin (subtopology euclidean T) (f ` C)"
  5036         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)
  5037       then show "connected (S \<inter> f -` U)" "connected (S \<inter> f -` V)"
  5038         using UV by (auto simp: conn intro: connected_closed_monotone_preimage [OF contf fim])
  5039       show "S = (S \<inter> f -` U) \<union> (S \<inter> f -` V)"
  5040         using UV fim by blast
  5041       show "closedin (subtopology euclidean S) (S \<inter> f -` U)"
  5042             "closedin (subtopology euclidean S) (S \<inter> f -` V)"
  5043         by (auto simp: continuous_on_imp_closedin cloU cloV contf fim)
  5044     qed
  5045   qed
  5046   with UV_eq show "connected (U \<inter> V)"
  5047     by simp
  5048 qed
  5049 
  5050 
  5051 subsection%important\<open>Several common variants of unicoherence\<close>
  5052 
  5053 lemma%unimportant connected_frontier_simple:
  5054   fixes S :: "'a :: euclidean_space set"
  5055   assumes "connected S" "connected(- S)" shows "connected(frontier S)"
  5056   unfolding frontier_closures
  5057   apply (rule unicoherentD [OF unicoherent_UNIV])
  5058       apply (simp_all add: assms connected_imp_connected_closure)
  5059   by (simp add: closure_def)
  5060 
  5061 lemma%unimportant connected_frontier_component_complement:
  5062   fixes S :: "'a :: euclidean_space set"
  5063   assumes "connected S" and C: "C \<in> components(- S)" shows "connected(frontier C)"
  5064   apply (rule connected_frontier_simple)
  5065   using C in_components_connected apply blast
  5066   by (metis Compl_eq_Diff_UNIV connected_UNIV assms top_greatest component_complement_connected)
  5067 
  5068 lemma%important connected_frontier_disjoint:
  5069   fixes S :: "'a :: euclidean_space set"
  5070   assumes "connected S" "connected T" "disjnt S T" and ST: "frontier S \<subseteq> frontier T"
  5071   shows "connected(frontier S)"
  5072 proof%unimportant (cases "S = UNIV")
  5073   case True then show ?thesis
  5074     by simp
  5075 next
  5076   case False
  5077   then have "-S \<noteq> {}"
  5078     by blast
  5079   then obtain C where C: "C \<in> components(- S)" and "T \<subseteq> C"
  5080     by (metis ComplI disjnt_iff subsetI exists_component_superset \<open>disjnt S T\<close> \<open>connected T\<close>)
  5081   moreover have "frontier S = frontier C"
  5082   proof -
  5083     have "frontier C \<subseteq> frontier S"
  5084       using C frontier_complement frontier_of_components_subset by blast
  5085     moreover have "x \<in> frontier C" if "x \<in> frontier S" for x
  5086     proof -
  5087       have "x \<in> closure C"
  5088         using that unfolding frontier_def
  5089         by (metis (no_types) Diff_eq ST \<open>T \<subseteq> C\<close> closure_mono contra_subsetD frontier_def le_inf_iff that)
  5090       moreover have "x \<notin> interior C"
  5091         using that unfolding frontier_def
  5092         by (metis C Compl_eq_Diff_UNIV Diff_iff subsetD in_components_subset interior_diff interior_mono)
  5093       ultimately show ?thesis
  5094         by (auto simp: frontier_def)
  5095     qed
  5096     ultimately show ?thesis
  5097       by blast
  5098   qed
  5099   ultimately show ?thesis
  5100     using \<open>connected S\<close> connected_frontier_component_complement by auto
  5101 qed
  5102 
  5103 
  5104 subsection%important\<open>Some separation results\<close>
  5105 
  5106 lemma%important separation_by_component_closed_pointwise:
  5107   fixes S :: "'a :: euclidean_space set"
  5108   assumes "closed S" "\<not> connected_component (- S) a b"
  5109   obtains C where "C \<in> components S" "\<not> connected_component(- C) a b"
  5110 proof%unimportant (cases "a \<in> S \<or> b \<in> S")
  5111   case True
  5112   then show ?thesis
  5113     using connected_component_in componentsI that by fastforce
  5114 next
  5115   case False
  5116   obtain T where "T \<subseteq> S" "closed T" "T \<noteq> {}"
  5117              and nab: "\<not> connected_component (- T) a b"
  5118              and conn: "\<And>U. U \<subset> T \<Longrightarrow> connected_component (- U) a b"
  5119     using closed_irreducible_separator [OF assms] by metis
  5120   moreover have "connected T"
  5121   proof -
  5122     have ab: "frontier(connected_component_set (- T) a) = T" "frontier(connected_component_set (- T) b) = T"
  5123       using frontier_minimal_separating_closed_pointwise
  5124       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)+
  5125     have "connected (frontier (connected_component_set (- T) a))"
  5126     proof (rule connected_frontier_disjoint)
  5127       show "disjnt (connected_component_set (- T) a) (connected_component_set (- T) b)"
  5128         unfolding disjnt_iff
  5129         by (metis connected_component_eq connected_component_eq_empty connected_component_idemp mem_Collect_eq nab)
  5130       show "frontier (connected_component_set (- T) a) \<subseteq> frontier (connected_component_set (- T) b)"
  5131         by (simp add: ab)
  5132     qed auto
  5133     with ab \<open>closed T\<close> show ?thesis
  5134       by simp
  5135   qed
  5136   ultimately obtain C where "C \<in> components S" "T \<subseteq> C"
  5137     using exists_component_superset [of T S] by blast
  5138   then show ?thesis
  5139     by (meson Compl_anti_mono connected_component_of_subset nab that)
  5140 qed
  5141 
  5142 
  5143 lemma%important separation_by_component_closed:
  5144   fixes S :: "'a :: euclidean_space set"
  5145   assumes "closed S" "\<not> connected(- S)"
  5146   obtains C where "C \<in> components S" "\<not> connected(- C)"
  5147 proof%unimportant -
  5148   obtain x y where "closed S" "x \<notin> S" "y \<notin> S" and "\<not> connected_component (- S) x y"
  5149     using assms by (auto simp: connected_iff_connected_component)
  5150   then obtain C where "C \<in> components S" "\<not> connected_component(- C) x y"
  5151     using separation_by_component_closed_pointwise by metis
  5152   then show "thesis"
  5153     apply (clarify elim!: componentsE)
  5154     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)
  5155 qed
  5156 
  5157 lemma%important separation_by_Un_closed_pointwise:
  5158   fixes S :: "'a :: euclidean_space set"
  5159   assumes ST: "closed S" "closed T" "S \<inter> T = {}"
  5160       and conS: "connected_component (- S) a b" and conT: "connected_component (- T) a b"
  5161     shows "connected_component (- (S \<union> T)) a b"
  5162 proof%unimportant (rule ccontr)
  5163   have "a \<notin> S" "b \<notin> S" "a \<notin> T" "b \<notin> T"
  5164     using conS conT connected_component_in by auto
  5165   assume "\<not> connected_component (- (S \<union> T)) a b"
  5166   then obtain C where "C \<in> components (S \<union> T)" and C: "\<not> connected_component(- C) a b"
  5167     using separation_by_component_closed_pointwise assms by blast
  5168   then have "C \<subseteq> S \<or> C \<subseteq> T"
  5169   proof -
  5170     have "connected C" "C \<subseteq> S \<union> T"
  5171       using \<open>C \<in> components (S \<union> T)\<close> in_components_subset by (blast elim: componentsE)+
  5172     moreover then have "C \<inter> T = {} \<or> C \<inter> S = {}"
  5173       by (metis Int_empty_right ST inf.commute connected_closed)
  5174     ultimately show ?thesis
  5175       by blast
  5176   qed
  5177   then show False
  5178     by (meson Compl_anti_mono C conS conT connected_component_of_subset)
  5179 qed
  5180 
  5181 lemma%unimportant separation_by_Un_closed:
  5182   fixes S :: "'a :: euclidean_space set"
  5183   assumes ST: "closed S" "closed T" "S \<inter> T = {}" and conS: "connected(- S)" and conT: "connected(- T)"
  5184   shows "connected(- (S \<union> T))"
  5185   using assms separation_by_Un_closed_pointwise
  5186   by (fastforce simp add: connected_iff_connected_component)
  5187 
  5188 lemma%unimportant open_unicoherent_UNIV:
  5189   fixes S :: "'a :: euclidean_space set"
  5190   assumes "open S" "open T" "connected S" "connected T" "S \<union> T = UNIV"
  5191   shows "connected(S \<inter> T)"
  5192 proof -
  5193   have "connected(- (-S \<union> -T))"
  5194     by (metis closed_Compl compl_sup compl_top_eq double_compl separation_by_Un_closed assms)
  5195   then show ?thesis
  5196     by simp
  5197 qed
  5198 
  5199 lemma%unimportant separation_by_component_open_aux:
  5200   fixes S :: "'a :: euclidean_space set"
  5201   assumes ST: "closed S" "closed T" "S \<inter> T = {}"
  5202       and "S \<noteq> {}" "T \<noteq> {}"
  5203   obtains C where "C \<in> components(-(S \<union> T))" "C \<noteq> {}" "frontier C \<inter> S \<noteq> {}" "frontier C \<inter> T \<noteq> {}"
  5204 proof (rule ccontr)
  5205   let ?S = "S \<union> \<Union>{C \<in> components(- (S \<union> T)). frontier C \<subseteq> S}"
  5206   let ?T = "T \<union> \<Union>{C \<in> components(- (S \<union> T)). frontier C \<subseteq> T}"
  5207   assume "~ thesis"
  5208   with that have *: "frontier C \<inter> S = {} \<or> frontier C \<inter> T = {}"
  5209             if C: "C \<in> components (- (S \<union> T))" "C \<noteq> {}" for C
  5210     using C by blast
  5211   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> {}"
  5212   proof (intro exI conjI)
  5213     have "frontier (\<Union>{C \<in> components (- S \<inter> - T). frontier C \<subseteq> S}) \<subseteq> S"
  5214       apply (rule subset_trans [OF frontier_Union_subset_closure])
  5215       by (metis (no_types, lifting) SUP_least \<open>closed S\<close> closure_minimal mem_Collect_eq)
  5216     then have "frontier ?S \<subseteq> S"
  5217       by (simp add: frontier_subset_eq assms  subset_trans [OF frontier_Un_subset])
  5218     then show "closed ?S"
  5219       using frontier_subset_eq by fastforce
  5220     have "frontier (\<Union>{C \<in> components (- S \<inter> - T). frontier C \<subseteq> T}) \<subseteq> T"
  5221       apply (rule subset_trans [OF frontier_Union_subset_closure])
  5222       by (metis (no_types, lifting) SUP_least \<open>closed T\<close> closure_minimal mem_Collect_eq)
  5223     then have "frontier ?T \<subseteq> T"
  5224       by (simp add: frontier_subset_eq assms  subset_trans [OF frontier_Un_subset])
  5225     then show "closed ?T"
  5226       using frontier_subset_eq by fastforce
  5227     have "UNIV \<subseteq> (S \<union> T) \<union> \<Union>(components(- (S \<union> T)))"
  5228       using Union_components by blast
  5229     also have "...  \<subseteq> ?S \<union> ?T"
  5230     proof -
  5231       have "C \<in> components (-(S \<union> T)) \<and> frontier C \<subseteq> S \<or>
  5232             C \<in> components (-(S \<union> T)) \<and> frontier C \<subseteq> T"
  5233         if "C \<in> components (- (S \<union> T))" "C \<noteq> {}" for C
  5234         using * [OF that] that
  5235         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)
  5236       then show ?thesis
  5237         by blast
  5238     qed
  5239     finally show "UNIV \<subseteq> ?S \<union> ?T" .
  5240     have "\<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> S} \<union>
  5241           \<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> T} \<subseteq> - (S \<union> T)"
  5242       using in_components_subset by fastforce
  5243     moreover have "\<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> S} \<inter>
  5244                    \<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> T} = {}"
  5245     proof -
  5246       have "C \<inter> C' = {}" if "C \<in> components (- (S \<union> T))" "frontier C \<subseteq> S"
  5247                             "C' \<in> components (- (S \<union> T))" "frontier C' \<subseteq> T" for C C'
  5248       proof -
  5249         have NUN: "- S \<inter> - T \<noteq> UNIV"
  5250           using \<open>T \<noteq> {}\<close> by blast
  5251         have "C \<noteq> C'"
  5252         proof
  5253           assume "C = C'"
  5254           with that have "frontier C' \<subseteq> S \<inter> T"
  5255             by simp
  5256           also have "... = {}"
  5257             using \<open>S \<inter> T = {}\<close> by blast
  5258           finally have "C' = {} \<or> C' = UNIV"
  5259             using frontier_eq_empty by auto
  5260           then show False
  5261             using \<open>C = C'\<close> NUN that by (force simp: dest: in_components_nonempty in_components_subset)
  5262         qed
  5263         with that show ?thesis
  5264           by (simp add: components_nonoverlap [of _ "-(S \<union> T)"])
  5265       qed
  5266       then show ?thesis
  5267         by blast
  5268     qed
  5269     ultimately show "?S \<inter> ?T = {}"
  5270       using ST by blast
  5271     show "?S \<noteq> {}" "?T \<noteq> {}"
  5272       using \<open>S \<noteq> {}\<close> \<open>T \<noteq> {}\<close> by blast+
  5273   qed
  5274     then show False
  5275       by (metis Compl_disjoint Convex_Euclidean_Space.connected_UNIV compl_bot_eq compl_unique connected_closedD inf_sup_absorb sup_compl_top_left1 top.extremum_uniqueI)
  5276 qed
  5277 
  5278 
  5279 lemma%important separation_by_component_open:
  5280   fixes S :: "'a :: euclidean_space set"
  5281   assumes "open S" and non: "\<not> connected(- S)"
  5282   obtains C where "C \<in> components S" "\<not> connected(- C)"
  5283 proof%unimportant -
  5284   obtain T U
  5285     where "closed T" "closed U" and TU: "T \<union> U = - S" "T \<inter> U = {}" "T \<noteq> {}" "U \<noteq> {}"
  5286     using assms by (auto simp: connected_closed_set closed_def)
  5287   then obtain C where C: "C \<in> components(-(T \<union> U))" "C \<noteq> {}"
  5288           and "frontier C \<inter> T \<noteq> {}" "frontier C \<inter> U \<noteq> {}"
  5289     using separation_by_component_open_aux [OF \<open>closed T\<close> \<open>closed U\<close> \<open>T \<inter> U = {}\<close>] by force
  5290   show "thesis"
  5291   proof
  5292     show "C \<in> components S"
  5293       using C(1) TU(1) by auto
  5294     show "\<not> connected (- C)"
  5295     proof
  5296       assume "connected (- C)"
  5297       then have "connected (frontier C)"
  5298         using connected_frontier_simple [of C] \<open>C \<in> components S\<close> in_components_connected by blast
  5299       then show False
  5300         unfolding connected_closed
  5301         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)
  5302     qed
  5303   qed
  5304 qed
  5305 
  5306 lemma%unimportant separation_by_Un_open:
  5307   fixes S :: "'a :: euclidean_space set"
  5308   assumes "open S" "open T" "S \<inter> T = {}" and cS: "connected(-S)" and cT: "connected(-T)"
  5309     shows "connected(- (S \<union> T))"
  5310   using assms unicoherent_UNIV unfolding unicoherent_def by force
  5311 
  5312 
  5313 lemma%important nonseparation_by_component_eq:
  5314   fixes S :: "'a :: euclidean_space set"
  5315   assumes "open S \<or> closed S"
  5316   shows "((\<forall>C \<in> components S. connected(-C)) \<longleftrightarrow> connected(- S))" (is "?lhs = ?rhs")
  5317 proof%unimportant
  5318   assume ?lhs with assms show ?rhs
  5319     by (meson separation_by_component_closed separation_by_component_open)
  5320 next
  5321   assume ?rhs with assms show ?lhs
  5322     using component_complement_connected by force
  5323 qed
  5324 
  5325 
  5326 text\<open>Another interesting equivalent of an inessential mapping into C-{0}\<close>
  5327 proposition%important inessential_eq_extensible:
  5328   fixes f :: "'a::euclidean_space \<Rightarrow> complex"
  5329   assumes "closed S"
  5330   shows "(\<exists>a. homotopic_with (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)) \<longleftrightarrow>
  5331          (\<exists>g. continuous_on UNIV g \<and> (\<forall>x \<in> S. g x = f x) \<and> (\<forall>x. g x \<noteq> 0))"
  5332      (is "?lhs = ?rhs")
  5333 proof%unimportant
  5334   assume ?lhs
  5335   then obtain a where a: "homotopic_with (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)" ..
  5336   show ?rhs
  5337   proof (cases "S = {}")
  5338     case True
  5339     with a show ?thesis
  5340       using continuous_on_const by force
  5341   next
  5342     case False
  5343     have anr: "ANR (-{0::complex})"
  5344       by (simp add: ANR_delete open_Compl open_imp_ANR)
  5345     obtain g where contg: "continuous_on UNIV g" and gim: "g ` UNIV \<subseteq> -{0}"
  5346                    and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  5347     proof (rule Borsuk_homotopy_extension_homotopic [OF _ _ continuous_on_const _ homotopic_with_symD [OF a]])
  5348       show "closedin (subtopology euclidean UNIV) S"
  5349         using assms by auto
  5350       show "range (\<lambda>t. a) \<subseteq> - {0}"
  5351         using a homotopic_with_imp_subset2 False by blast
  5352     qed (use anr that in \<open>force+\<close>)
  5353     then show ?thesis
  5354       by force
  5355   qed
  5356 next
  5357   assume ?rhs
  5358   then obtain g where contg: "continuous_on UNIV g"
  5359           and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x" and non0: "\<And>x. g x \<noteq> 0"
  5360     by metis
  5361   obtain h k::"'a\<Rightarrow>'a" where hk: "homeomorphism (ball 0 1) UNIV h k"
  5362     using homeomorphic_ball01_UNIV homeomorphic_def by blast
  5363   then have "continuous_on (ball 0 1) (g \<circ> h)"
  5364     by (meson contg continuous_on_compose continuous_on_subset homeomorphism_cont1 top_greatest)
  5365   then obtain j where contj: "continuous_on (ball 0 1) j"
  5366                   and j: "\<And>z. z \<in> ball 0 1 \<Longrightarrow> exp(j z) = (g \<circ> h) z"
  5367     by (metis (mono_tags, hide_lams) continuous_logarithm_on_ball comp_apply non0)
  5368   have [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (k x) = x"
  5369     using hk homeomorphism_apply2 by blast
  5370   have "\<exists>\<zeta>. continuous_on S \<zeta>\<and> (\<forall>x\<in>S. f x = exp (\<zeta> x))"
  5371   proof (intro exI conjI ballI)
  5372     show "continuous_on S (j \<circ> k)"
  5373     proof (rule continuous_on_compose)
  5374       show "continuous_on S k"
  5375         by (meson continuous_on_subset hk homeomorphism_cont2 top_greatest)
  5376       show "continuous_on (k ` S) j"
  5377         apply (rule continuous_on_subset [OF contj])
  5378         using homeomorphism_image2 [OF hk] continuous_on_subset [OF contj] by blast
  5379     qed
  5380     show "f x = exp ((j \<circ> k) x)" if "x \<in> S" for x
  5381     proof -
  5382       have "f x = (g \<circ> h) (k x)"
  5383         by (simp add: gf that)
  5384       also have "... = exp (j (k x))"
  5385         by (metis rangeI homeomorphism_image2 [OF hk] j)
  5386       finally show ?thesis by simp
  5387     qed
  5388   qed
  5389   then show ?lhs
  5390     by (simp add: inessential_eq_continuous_logarithm)
  5391 qed
  5392 
  5393 lemma%important inessential_on_clopen_Union:
  5394   fixes \<F> :: "'a::euclidean_space set set"
  5395   assumes T: "path_connected T"
  5396       and "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (subtopology euclidean (\<Union>\<F>)) S"
  5397       and "\<And>S. S \<in> \<F> \<Longrightarrow> openin (subtopology euclidean (\<Union>\<F>)) S"
  5398       and hom: "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a. homotopic_with (\<lambda>x. True) S T f (\<lambda>x. a)"
  5399   obtains a where "homotopic_with (\<lambda>x. True) (\<Union>\<F>) T f (\<lambda>x. a)"
  5400 proof%unimportant (cases "\<Union>\<F> = {}")
  5401   case True
  5402   with that show ?thesis
  5403     by force
  5404 next
  5405   case False
  5406   then obtain C where "C \<in> \<F>" "C \<noteq> {}"
  5407     by blast
  5408   then obtain a where clo: "closedin (subtopology euclidean (\<Union>\<F>)) C"
  5409     and ope: "openin (subtopology euclidean (\<Union>\<F>)) C"
  5410     and "homotopic_with (\<lambda>x. True) C T f (\<lambda>x. a)"
  5411     using assms by blast
  5412   with \<open>C \<noteq> {}\<close> have "f ` C \<subseteq> T" "a \<in> T"
  5413     using homotopic_with_imp_subset1 homotopic_with_imp_subset2 by blast+
  5414   have "homotopic_with (\<lambda>x. True) (\<Union>\<F>) T f (\<lambda>x. a)"
  5415   proof (rule homotopic_on_clopen_Union)
  5416     show "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (subtopology euclidean (\<Union>\<F>)) S"
  5417          "\<And>S. S \<in> \<F> \<Longrightarrow> openin (subtopology euclidean (\<Union>\<F>)) S"
  5418       by (simp_all add: assms)
  5419     show "homotopic_with (\<lambda>x. True) S T f (\<lambda>x. a)" if "S \<in> \<F>" for S
  5420     proof (cases "S = {}")
  5421       case True
  5422       then show ?thesis
  5423         by auto
  5424     next
  5425       case False
  5426       then obtain b where "b \<in> S"
  5427         by blast
  5428       obtain c where c: "homotopic_with (\<lambda>x. True) S T f (\<lambda>x. c)"
  5429         using \<open>S \<in> \<F>\<close> hom by blast
  5430       then have "c \<in> T"
  5431         using \<open>b \<in> S\<close> homotopic_with_imp_subset2 by blast
  5432       then have "homotopic_with (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. c)"
  5433         using T \<open>a \<in> T\<close> homotopic_constant_maps path_connected_component by blast
  5434       then show ?thesis
  5435         using c homotopic_with_symD homotopic_with_trans by blast
  5436     qed
  5437   qed
  5438   then show ?thesis ..
  5439 qed
  5440 
  5441 lemma%important Janiszewski_dual:
  5442   fixes S :: "complex set"
  5443   assumes
  5444    "compact S" "compact T" "connected S" "connected T" "connected(- (S \<union> T))"
  5445  shows "connected(S \<inter> T)"
  5446 proof%unimportant -
  5447   have ST: "compact (S \<union> T)"
  5448     by (simp add: assms compact_Un)
  5449   with Borsukian_imp_unicoherent [of "S \<union> T"] ST assms
  5450   show ?thesis
  5451     by (auto simp: closed_subset compact_imp_closed Borsukian_separation_compact unicoherent_def)
  5452 qed
  5453 
  5454 end