split off Homotopy.thy
authorimmler
Mon Jan 07 14:57:45 2019 +0100 (4 months ago)
changeset 6962019d8a59481db
parent 69619 3f7d8e05e0f2
child 69621 9c22ff18125b
split off Homotopy.thy
src/HOL/Analysis/Brouwer_Fixpoint.thy
src/HOL/Analysis/Homeomorphism.thy
src/HOL/Analysis/Homotopy.thy
src/HOL/Analysis/Path_Connected.thy
     1.1 --- a/src/HOL/Analysis/Brouwer_Fixpoint.thy	Mon Jan 07 14:06:54 2019 +0100
     1.2 +++ b/src/HOL/Analysis/Brouwer_Fixpoint.thy	Mon Jan 07 14:57:45 2019 +0100
     1.3 @@ -15,7 +15,10 @@
     1.4  section \<open>Brouwer's Fixed Point Theorem\<close>
     1.5  
     1.6  theory Brouwer_Fixpoint
     1.7 -imports Path_Connected Homeomorphism
     1.8 +  imports
     1.9 +    Path_Connected
    1.10 +    Homeomorphism
    1.11 +    Continuous_Extension
    1.12  begin
    1.13  
    1.14  (* FIXME mv topology euclidean space *)
     2.1 --- a/src/HOL/Analysis/Homeomorphism.thy	Mon Jan 07 14:06:54 2019 +0100
     2.2 +++ b/src/HOL/Analysis/Homeomorphism.thy	Mon Jan 07 14:57:45 2019 +0100
     2.3 @@ -5,7 +5,7 @@
     2.4  section%important \<open>Homeomorphism Theorems\<close>
     2.5  
     2.6  theory Homeomorphism
     2.7 -imports Path_Connected
     2.8 +imports Homotopy
     2.9  begin
    2.10  
    2.11  lemma%unimportant homeomorphic_spheres':
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/Analysis/Homotopy.thy	Mon Jan 07 14:57:45 2019 +0100
     3.3 @@ -0,0 +1,5159 @@
     3.4 +(*  Title:      HOL/Analysis/Path_Connected.thy
     3.5 +    Authors:    LC Paulson and Robert Himmelmann (TU Muenchen), based on material from HOL Light
     3.6 +*)
     3.7 +
     3.8 +section \<open>Homotopy of Maps\<close>
     3.9 +
    3.10 +theory Homotopy
    3.11 +  imports Path_Connected Continuum_Not_Denumerable
    3.12 +begin
    3.13 +
    3.14 +definition%important homotopic_with ::
    3.15 +  "[('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> bool, 'a set, 'b set, 'a \<Rightarrow> 'b, 'a \<Rightarrow> 'b] \<Rightarrow> bool"
    3.16 +where
    3.17 + "homotopic_with P X Y p q \<equiv>
    3.18 +   (\<exists>h:: real \<times> 'a \<Rightarrow> 'b.
    3.19 +       continuous_on ({0..1} \<times> X) h \<and>
    3.20 +       h ` ({0..1} \<times> X) \<subseteq> Y \<and>
    3.21 +       (\<forall>x. h(0, x) = p x) \<and>
    3.22 +       (\<forall>x. h(1, x) = q x) \<and>
    3.23 +       (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
    3.24 +
    3.25 +text\<open>\<open>p\<close>, \<open>q\<close> are functions \<open>X \<rightarrow> Y\<close>, and the property \<open>P\<close> restricts all intermediate maps.
    3.26 +We often just want to require that \<open>P\<close> fixes some subset, but to include the case of a loop homotopy,
    3.27 +it is convenient to have a general property \<open>P\<close>.\<close>
    3.28 +
    3.29 +text \<open>We often want to just localize the ending function equality or whatever.\<close>
    3.30 +text%important \<open>%whitespace\<close>
    3.31 +proposition homotopic_with:
    3.32 +  fixes X :: "'a::topological_space set" and Y :: "'b::topological_space set"
    3.33 +  assumes "\<And>h k. (\<And>x. x \<in> X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k)"
    3.34 +  shows "homotopic_with P X Y p q \<longleftrightarrow>
    3.35 +           (\<exists>h :: real \<times> 'a \<Rightarrow> 'b.
    3.36 +              continuous_on ({0..1} \<times> X) h \<and>
    3.37 +              h ` ({0..1} \<times> X) \<subseteq> Y \<and>
    3.38 +              (\<forall>x \<in> X. h(0,x) = p x) \<and>
    3.39 +              (\<forall>x \<in> X. h(1,x) = q x) \<and>
    3.40 +              (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
    3.41 +  unfolding homotopic_with_def
    3.42 +  apply (rule iffI, blast, clarify)
    3.43 +  apply (rule_tac x="\<lambda>(u,v). if v \<in> X then h(u,v) else if u = 0 then p v else q v" in exI)
    3.44 +  apply auto
    3.45 +  apply (force elim: continuous_on_eq)
    3.46 +  apply (drule_tac x=t in bspec, force)
    3.47 +  apply (subst assms; simp)
    3.48 +  done
    3.49 +
    3.50 +proposition homotopic_with_eq:
    3.51 +   assumes h: "homotopic_with P X Y f g"
    3.52 +       and f': "\<And>x. x \<in> X \<Longrightarrow> f' x = f x"
    3.53 +       and g': "\<And>x. x \<in> X \<Longrightarrow> g' x = g x"
    3.54 +       and P:  "(\<And>h k. (\<And>x. x \<in> X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k))"
    3.55 +   shows "homotopic_with P X Y f' g'"
    3.56 +  using h unfolding homotopic_with_def
    3.57 +  apply safe
    3.58 +  apply (rule_tac x="\<lambda>(u,v). if v \<in> X then h(u,v) else if u = 0 then f' v else g' v" in exI)
    3.59 +  apply (simp add: f' g', safe)
    3.60 +  apply (fastforce intro: continuous_on_eq, fastforce)
    3.61 +  apply (subst P; fastforce)
    3.62 +  done
    3.63 +
    3.64 +proposition homotopic_with_equal:
    3.65 +   assumes contf: "continuous_on X f" and fXY: "f ` X \<subseteq> Y"
    3.66 +       and gf: "\<And>x. x \<in> X \<Longrightarrow> g x = f x"
    3.67 +       and P:  "P f" "P g"
    3.68 +   shows "homotopic_with P X Y f g"
    3.69 +  unfolding homotopic_with_def
    3.70 +  apply (rule_tac x="\<lambda>(u,v). if u = 1 then g v else f v" in exI)
    3.71 +  using assms
    3.72 +  apply (intro conjI)
    3.73 +  apply (rule continuous_on_eq [where f = "f \<circ> snd"])
    3.74 +  apply (rule continuous_intros | force)+
    3.75 +  apply clarify
    3.76 +  apply (case_tac "t=1"; force)
    3.77 +  done
    3.78 +
    3.79 +
    3.80 +lemma image_Pair_const: "(\<lambda>x. (x, c)) ` A = A \<times> {c}"
    3.81 +  by auto
    3.82 +
    3.83 +lemma homotopic_constant_maps:
    3.84 +   "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b) \<longleftrightarrow> s = {} \<or> path_component t a b"
    3.85 +proof (cases "s = {} \<or> t = {}")
    3.86 +  case True with continuous_on_const show ?thesis
    3.87 +    by (auto simp: homotopic_with path_component_def)
    3.88 +next
    3.89 +  case False
    3.90 +  then obtain c where "c \<in> s" by blast
    3.91 +  show ?thesis
    3.92 +  proof
    3.93 +    assume "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b)"
    3.94 +    then obtain h :: "real \<times> 'a \<Rightarrow> 'b"
    3.95 +        where conth: "continuous_on ({0..1} \<times> s) h"
    3.96 +          and h: "h ` ({0..1} \<times> s) \<subseteq> t" "(\<forall>x\<in>s. h (0, x) = a)" "(\<forall>x\<in>s. h (1, x) = b)"
    3.97 +      by (auto simp: homotopic_with)
    3.98 +    have "continuous_on {0..1} (h \<circ> (\<lambda>t. (t, c)))"
    3.99 +      apply (rule continuous_intros conth | simp add: image_Pair_const)+
   3.100 +      apply (blast intro:  \<open>c \<in> s\<close> continuous_on_subset [OF conth])
   3.101 +      done
   3.102 +    with \<open>c \<in> s\<close> h show "s = {} \<or> path_component t a b"
   3.103 +      apply (simp_all add: homotopic_with path_component_def, auto)
   3.104 +      apply (drule_tac x="h \<circ> (\<lambda>t. (t, c))" in spec)
   3.105 +      apply (auto simp: pathstart_def pathfinish_def path_image_def path_def)
   3.106 +      done
   3.107 +  next
   3.108 +    assume "s = {} \<or> path_component t a b"
   3.109 +    with False show "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b)"
   3.110 +      apply (clarsimp simp: homotopic_with path_component_def pathstart_def pathfinish_def path_image_def path_def)
   3.111 +      apply (rule_tac x="g \<circ> fst" in exI)
   3.112 +      apply (rule conjI continuous_intros | force)+
   3.113 +      done
   3.114 +  qed
   3.115 +qed
   3.116 +
   3.117 +
   3.118 +subsection%unimportant\<open>Trivial properties\<close>
   3.119 +
   3.120 +lemma homotopic_with_imp_property: "homotopic_with P X Y f g \<Longrightarrow> P f \<and> P g"
   3.121 +  unfolding homotopic_with_def Ball_def
   3.122 +  apply clarify
   3.123 +  apply (frule_tac x=0 in spec)
   3.124 +  apply (drule_tac x=1 in spec, auto)
   3.125 +  done
   3.126 +
   3.127 +lemma continuous_on_o_Pair: "\<lbrakk>continuous_on (T \<times> X) h; t \<in> T\<rbrakk> \<Longrightarrow> continuous_on X (h \<circ> Pair t)"
   3.128 +  by (fast intro: continuous_intros elim!: continuous_on_subset)
   3.129 +
   3.130 +lemma homotopic_with_imp_continuous:
   3.131 +    assumes "homotopic_with P X Y f g"
   3.132 +    shows "continuous_on X f \<and> continuous_on X g"
   3.133 +proof -
   3.134 +  obtain h :: "real \<times> 'a \<Rightarrow> 'b"
   3.135 +    where conth: "continuous_on ({0..1} \<times> X) h"
   3.136 +      and h: "\<forall>x. h (0, x) = f x" "\<forall>x. h (1, x) = g x"
   3.137 +    using assms by (auto simp: homotopic_with_def)
   3.138 +  have *: "t \<in> {0..1} \<Longrightarrow> continuous_on X (h \<circ> (\<lambda>x. (t,x)))" for t
   3.139 +    by (rule continuous_intros continuous_on_subset [OF conth] | force)+
   3.140 +  show ?thesis
   3.141 +    using h *[of 0] *[of 1] by auto
   3.142 +qed
   3.143 +
   3.144 +proposition homotopic_with_imp_subset1:
   3.145 +     "homotopic_with P X Y f g \<Longrightarrow> f ` X \<subseteq> Y"
   3.146 +  by (simp add: homotopic_with_def image_subset_iff) (metis atLeastAtMost_iff order_refl zero_le_one)
   3.147 +
   3.148 +proposition homotopic_with_imp_subset2:
   3.149 +     "homotopic_with P X Y f g \<Longrightarrow> g ` X \<subseteq> Y"
   3.150 +  by (simp add: homotopic_with_def image_subset_iff) (metis atLeastAtMost_iff order_refl zero_le_one)
   3.151 +
   3.152 +proposition homotopic_with_mono:
   3.153 +    assumes hom: "homotopic_with P X Y f g"
   3.154 +        and Q: "\<And>h. \<lbrakk>continuous_on X h; image h X \<subseteq> Y \<and> P h\<rbrakk> \<Longrightarrow> Q h"
   3.155 +      shows "homotopic_with Q X Y f g"
   3.156 +  using hom
   3.157 +  apply (simp add: homotopic_with_def)
   3.158 +  apply (erule ex_forward)
   3.159 +  apply (force simp: intro!: Q dest: continuous_on_o_Pair)
   3.160 +  done
   3.161 +
   3.162 +proposition homotopic_with_subset_left:
   3.163 +     "\<lbrakk>homotopic_with P X Y f g; Z \<subseteq> X\<rbrakk> \<Longrightarrow> homotopic_with P Z Y f g"
   3.164 +  apply (simp add: homotopic_with_def)
   3.165 +  apply (fast elim!: continuous_on_subset ex_forward)
   3.166 +  done
   3.167 +
   3.168 +proposition homotopic_with_subset_right:
   3.169 +     "\<lbrakk>homotopic_with P X Y f g; Y \<subseteq> Z\<rbrakk> \<Longrightarrow> homotopic_with P X Z f g"
   3.170 +  apply (simp add: homotopic_with_def)
   3.171 +  apply (fast elim!: continuous_on_subset ex_forward)
   3.172 +  done
   3.173 +
   3.174 +proposition homotopic_with_compose_continuous_right:
   3.175 +    "\<lbrakk>homotopic_with (\<lambda>f. p (f \<circ> h)) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
   3.176 +     \<Longrightarrow> homotopic_with p W Y (f \<circ> h) (g \<circ> h)"
   3.177 +  apply (clarsimp simp add: homotopic_with_def)
   3.178 +  apply (rename_tac k)
   3.179 +  apply (rule_tac x="k \<circ> (\<lambda>y. (fst y, h (snd y)))" in exI)
   3.180 +  apply (rule conjI continuous_intros continuous_on_compose [where f=snd and g=h, unfolded o_def] | simp)+
   3.181 +  apply (erule continuous_on_subset)
   3.182 +  apply (fastforce simp: o_def)+
   3.183 +  done
   3.184 +
   3.185 +proposition homotopic_compose_continuous_right:
   3.186 +     "\<lbrakk>homotopic_with (\<lambda>f. True) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
   3.187 +      \<Longrightarrow> homotopic_with (\<lambda>f. True) W Y (f \<circ> h) (g \<circ> h)"
   3.188 +  using homotopic_with_compose_continuous_right by fastforce
   3.189 +
   3.190 +proposition homotopic_with_compose_continuous_left:
   3.191 +     "\<lbrakk>homotopic_with (\<lambda>f. p (h \<circ> f)) X Y f g; continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
   3.192 +      \<Longrightarrow> homotopic_with p X Z (h \<circ> f) (h \<circ> g)"
   3.193 +  apply (clarsimp simp add: homotopic_with_def)
   3.194 +  apply (rename_tac k)
   3.195 +  apply (rule_tac x="h \<circ> k" in exI)
   3.196 +  apply (rule conjI continuous_intros continuous_on_compose [where f=snd and g=h, unfolded o_def] | simp)+
   3.197 +  apply (erule continuous_on_subset)
   3.198 +  apply (fastforce simp: o_def)+
   3.199 +  done
   3.200 +
   3.201 +proposition homotopic_compose_continuous_left:
   3.202 +   "\<lbrakk>homotopic_with (\<lambda>_. True) X Y f g;
   3.203 +     continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
   3.204 +    \<Longrightarrow> homotopic_with (\<lambda>f. True) X Z (h \<circ> f) (h \<circ> g)"
   3.205 +  using homotopic_with_compose_continuous_left by fastforce
   3.206 +
   3.207 +proposition homotopic_with_Pair:
   3.208 +   assumes hom: "homotopic_with p s t f g" "homotopic_with p' s' t' f' g'"
   3.209 +       and q: "\<And>f g. \<lbrakk>p f; p' g\<rbrakk> \<Longrightarrow> q(\<lambda>(x,y). (f x, g y))"
   3.210 +     shows "homotopic_with q (s \<times> s') (t \<times> t')
   3.211 +                  (\<lambda>(x,y). (f x, f' y)) (\<lambda>(x,y). (g x, g' y))"
   3.212 +  using hom
   3.213 +  apply (clarsimp simp add: homotopic_with_def)
   3.214 +  apply (rename_tac k k')
   3.215 +  apply (rule_tac x="\<lambda>z. ((k \<circ> (\<lambda>x. (fst x, fst (snd x)))) z, (k' \<circ> (\<lambda>x. (fst x, snd (snd x)))) z)" in exI)
   3.216 +  apply (rule conjI continuous_intros | erule continuous_on_subset | clarsimp)+
   3.217 +  apply (auto intro!: q [unfolded case_prod_unfold])
   3.218 +  done
   3.219 +
   3.220 +lemma homotopic_on_empty [simp]: "homotopic_with (\<lambda>x. True) {} t f g"
   3.221 +  by (metis continuous_on_def empty_iff homotopic_with_equal image_subset_iff)
   3.222 +
   3.223 +
   3.224 +text\<open>Homotopy with P is an equivalence relation (on continuous functions mapping X into Y that satisfy P,
   3.225 +     though this only affects reflexivity.\<close>
   3.226 +
   3.227 +
   3.228 +proposition homotopic_with_refl:
   3.229 +   "homotopic_with P X Y f f \<longleftrightarrow> continuous_on X f \<and> image f X \<subseteq> Y \<and> P f"
   3.230 +  apply (rule iffI)
   3.231 +  using homotopic_with_imp_continuous homotopic_with_imp_property homotopic_with_imp_subset2 apply blast
   3.232 +  apply (simp add: homotopic_with_def)
   3.233 +  apply (rule_tac x="f \<circ> snd" in exI)
   3.234 +  apply (rule conjI continuous_intros | force)+
   3.235 +  done
   3.236 +
   3.237 +lemma homotopic_with_symD:
   3.238 +  fixes X :: "'a::real_normed_vector set"
   3.239 +    assumes "homotopic_with P X Y f g"
   3.240 +      shows "homotopic_with P X Y g f"
   3.241 +  using assms
   3.242 +  apply (clarsimp simp add: homotopic_with_def)
   3.243 +  apply (rename_tac h)
   3.244 +  apply (rule_tac x="h \<circ> (\<lambda>y. (1 - fst y, snd y))" in exI)
   3.245 +  apply (rule conjI continuous_intros | erule continuous_on_subset | force simp: image_subset_iff)+
   3.246 +  done
   3.247 +
   3.248 +proposition homotopic_with_sym:
   3.249 +    fixes X :: "'a::real_normed_vector set"
   3.250 +    shows "homotopic_with P X Y f g \<longleftrightarrow> homotopic_with P X Y g f"
   3.251 +  using homotopic_with_symD by blast
   3.252 +
   3.253 +lemma split_01: "{0..1::real} = {0..1/2} \<union> {1/2..1}"
   3.254 +  by force
   3.255 +
   3.256 +lemma split_01_prod: "{0..1::real} \<times> X = ({0..1/2} \<times> X) \<union> ({1/2..1} \<times> X)"
   3.257 +  by force
   3.258 +
   3.259 +proposition homotopic_with_trans:
   3.260 +    fixes X :: "'a::real_normed_vector set"
   3.261 +    assumes "homotopic_with P X Y f g" and "homotopic_with P X Y g h"
   3.262 +      shows "homotopic_with P X Y f h"
   3.263 +proof -
   3.264 +  have clo1: "closedin (subtopology euclidean ({0..1/2} \<times> X \<union> {1/2..1} \<times> X)) ({0..1/2::real} \<times> X)"
   3.265 +    apply (simp add: closedin_closed split_01_prod [symmetric])
   3.266 +    apply (rule_tac x="{0..1/2} \<times> UNIV" in exI)
   3.267 +    apply (force simp: closed_Times)
   3.268 +    done
   3.269 +  have clo2: "closedin (subtopology euclidean ({0..1/2} \<times> X \<union> {1/2..1} \<times> X)) ({1/2..1::real} \<times> X)"
   3.270 +    apply (simp add: closedin_closed split_01_prod [symmetric])
   3.271 +    apply (rule_tac x="{1/2..1} \<times> UNIV" in exI)
   3.272 +    apply (force simp: closed_Times)
   3.273 +    done
   3.274 +  { fix k1 k2:: "real \<times> 'a \<Rightarrow> 'b"
   3.275 +    assume cont: "continuous_on ({0..1} \<times> X) k1" "continuous_on ({0..1} \<times> X) k2"
   3.276 +       and Y: "k1 ` ({0..1} \<times> X) \<subseteq> Y" "k2 ` ({0..1} \<times> X) \<subseteq> Y"
   3.277 +       and geq: "\<forall>x. k1 (1, x) = g x" "\<forall>x. k2 (0, x) = g x"
   3.278 +       and k12: "\<forall>x. k1 (0, x) = f x" "\<forall>x. k2 (1, x) = h x"
   3.279 +       and P:   "\<forall>t\<in>{0..1}. P (\<lambda>x. k1 (t, x))" "\<forall>t\<in>{0..1}. P (\<lambda>x. k2 (t, x))"
   3.280 +    define k where "k y =
   3.281 +      (if fst y \<le> 1 / 2
   3.282 +       then (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y
   3.283 +       else (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y)" for y
   3.284 +    have keq: "k1 (2 * u, v) = k2 (2 * u - 1, v)" if "u = 1/2"  for u v
   3.285 +      by (simp add: geq that)
   3.286 +    have "continuous_on ({0..1} \<times> X) k"
   3.287 +      using cont
   3.288 +      apply (simp add: split_01_prod k_def)
   3.289 +      apply (rule clo1 clo2 continuous_on_cases_local continuous_intros | erule continuous_on_subset | simp add: linear image_subset_iff)+
   3.290 +      apply (force simp: keq)
   3.291 +      done
   3.292 +    moreover have "k ` ({0..1} \<times> X) \<subseteq> Y"
   3.293 +      using Y by (force simp: k_def)
   3.294 +    moreover have "\<forall>x. k (0, x) = f x"
   3.295 +      by (simp add: k_def k12)
   3.296 +    moreover have "(\<forall>x. k (1, x) = h x)"
   3.297 +      by (simp add: k_def k12)
   3.298 +    moreover have "\<forall>t\<in>{0..1}. P (\<lambda>x. k (t, x))"
   3.299 +      using P
   3.300 +      apply (clarsimp simp add: k_def)
   3.301 +      apply (case_tac "t \<le> 1/2", auto)
   3.302 +      done
   3.303 +    ultimately have *: "\<exists>k :: real \<times> 'a \<Rightarrow> 'b.
   3.304 +                       continuous_on ({0..1} \<times> X) k \<and> k ` ({0..1} \<times> X) \<subseteq> Y \<and>
   3.305 +                       (\<forall>x. k (0, x) = f x) \<and> (\<forall>x. k (1, x) = h x) \<and> (\<forall>t\<in>{0..1}. P (\<lambda>x. k (t, x)))"
   3.306 +      by blast
   3.307 +  } note * = this
   3.308 +  show ?thesis
   3.309 +    using assms by (auto intro: * simp add: homotopic_with_def)
   3.310 +qed
   3.311 +
   3.312 +proposition homotopic_compose:
   3.313 +      fixes s :: "'a::real_normed_vector set"
   3.314 +      shows "\<lbrakk>homotopic_with (\<lambda>x. True) s t f f'; homotopic_with (\<lambda>x. True) t u g g'\<rbrakk>
   3.315 +             \<Longrightarrow> homotopic_with (\<lambda>x. True) s u (g \<circ> f) (g' \<circ> f')"
   3.316 +  apply (rule homotopic_with_trans [where g = "g \<circ> f'"])
   3.317 +  apply (metis homotopic_compose_continuous_left homotopic_with_imp_continuous homotopic_with_imp_subset1)
   3.318 +  by (metis homotopic_compose_continuous_right homotopic_with_imp_continuous homotopic_with_imp_subset2)
   3.319 +
   3.320 +
   3.321 +text\<open>Homotopic triviality implicitly incorporates path-connectedness.\<close>
   3.322 +lemma homotopic_triviality:
   3.323 +  fixes S :: "'a::real_normed_vector set"
   3.324 +  shows  "(\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> T \<and>
   3.325 +                 continuous_on S g \<and> g ` S \<subseteq> T
   3.326 +                 \<longrightarrow> homotopic_with (\<lambda>x. True) S T f g) \<longleftrightarrow>
   3.327 +          (S = {} \<or> path_connected T) \<and>
   3.328 +          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> T \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) S T f (\<lambda>x. c)))"
   3.329 +          (is "?lhs = ?rhs")
   3.330 +proof (cases "S = {} \<or> T = {}")
   3.331 +  case True then show ?thesis by auto
   3.332 +next
   3.333 +  case False show ?thesis
   3.334 +  proof
   3.335 +    assume LHS [rule_format]: ?lhs
   3.336 +    have pab: "path_component T a b" if "a \<in> T" "b \<in> T" for a b
   3.337 +    proof -
   3.338 +      have "homotopic_with (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. b)"
   3.339 +        by (simp add: LHS continuous_on_const image_subset_iff that)
   3.340 +      then show ?thesis
   3.341 +        using False homotopic_constant_maps by blast
   3.342 +    qed
   3.343 +      moreover
   3.344 +    have "\<exists>c. homotopic_with (\<lambda>x. True) S T f (\<lambda>x. c)" if "continuous_on S f" "f ` S \<subseteq> T" for f
   3.345 +      by (metis (full_types) False LHS equals0I homotopic_constant_maps homotopic_with_imp_continuous homotopic_with_imp_subset2 pab that)
   3.346 +    ultimately show ?rhs
   3.347 +      by (simp add: path_connected_component)
   3.348 +  next
   3.349 +    assume RHS: ?rhs
   3.350 +    with False have T: "path_connected T"
   3.351 +      by blast
   3.352 +    show ?lhs
   3.353 +    proof clarify
   3.354 +      fix f g
   3.355 +      assume "continuous_on S f" "f ` S \<subseteq> T" "continuous_on S g" "g ` S \<subseteq> T"
   3.356 +      obtain c d where c: "homotopic_with (\<lambda>x. True) S T f (\<lambda>x. c)" and d: "homotopic_with (\<lambda>x. True) S T g (\<lambda>x. d)"
   3.357 +        using False \<open>continuous_on S f\<close> \<open>f ` S \<subseteq> T\<close>  RHS \<open>continuous_on S g\<close> \<open>g ` S \<subseteq> T\<close> by blast
   3.358 +      then have "c \<in> T" "d \<in> T"
   3.359 +        using False homotopic_with_imp_subset2 by fastforce+
   3.360 +      with T have "path_component T c d"
   3.361 +        using path_connected_component by blast
   3.362 +      then have "homotopic_with (\<lambda>x. True) S T (\<lambda>x. c) (\<lambda>x. d)"
   3.363 +        by (simp add: homotopic_constant_maps)
   3.364 +      with c d show "homotopic_with (\<lambda>x. True) S T f g"
   3.365 +        by (meson homotopic_with_symD homotopic_with_trans)
   3.366 +    qed
   3.367 +  qed
   3.368 +qed
   3.369 +
   3.370 +
   3.371 +subsection\<open>Homotopy of paths, maintaining the same endpoints\<close>
   3.372 +
   3.373 +
   3.374 +definition%important homotopic_paths :: "['a set, real \<Rightarrow> 'a, real \<Rightarrow> 'a::topological_space] \<Rightarrow> bool"
   3.375 +  where
   3.376 +     "homotopic_paths s p q \<equiv>
   3.377 +       homotopic_with (\<lambda>r. pathstart r = pathstart p \<and> pathfinish r = pathfinish p) {0..1} s p q"
   3.378 +
   3.379 +lemma homotopic_paths:
   3.380 +   "homotopic_paths s p q \<longleftrightarrow>
   3.381 +      (\<exists>h. continuous_on ({0..1} \<times> {0..1}) h \<and>
   3.382 +          h ` ({0..1} \<times> {0..1}) \<subseteq> s \<and>
   3.383 +          (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
   3.384 +          (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
   3.385 +          (\<forall>t \<in> {0..1::real}. pathstart(h \<circ> Pair t) = pathstart p \<and>
   3.386 +                        pathfinish(h \<circ> Pair t) = pathfinish p))"
   3.387 +  by (auto simp: homotopic_paths_def homotopic_with pathstart_def pathfinish_def)
   3.388 +
   3.389 +proposition homotopic_paths_imp_pathstart:
   3.390 +     "homotopic_paths s p q \<Longrightarrow> pathstart p = pathstart q"
   3.391 +  by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
   3.392 +
   3.393 +proposition homotopic_paths_imp_pathfinish:
   3.394 +     "homotopic_paths s p q \<Longrightarrow> pathfinish p = pathfinish q"
   3.395 +  by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
   3.396 +
   3.397 +lemma homotopic_paths_imp_path:
   3.398 +     "homotopic_paths s p q \<Longrightarrow> path p \<and> path q"
   3.399 +  using homotopic_paths_def homotopic_with_imp_continuous path_def by blast
   3.400 +
   3.401 +lemma homotopic_paths_imp_subset:
   3.402 +     "homotopic_paths s p q \<Longrightarrow> path_image p \<subseteq> s \<and> path_image q \<subseteq> s"
   3.403 +  by (simp add: homotopic_paths_def homotopic_with_imp_subset1 homotopic_with_imp_subset2 path_image_def)
   3.404 +
   3.405 +proposition homotopic_paths_refl [simp]: "homotopic_paths s p p \<longleftrightarrow> path p \<and> path_image p \<subseteq> s"
   3.406 +by (simp add: homotopic_paths_def homotopic_with_refl path_def path_image_def)
   3.407 +
   3.408 +proposition homotopic_paths_sym: "homotopic_paths s p q \<Longrightarrow> homotopic_paths s q p"
   3.409 +  by (metis (mono_tags) homotopic_paths_def homotopic_paths_imp_pathfinish homotopic_paths_imp_pathstart homotopic_with_symD)
   3.410 +
   3.411 +proposition homotopic_paths_sym_eq: "homotopic_paths s p q \<longleftrightarrow> homotopic_paths s q p"
   3.412 +  by (metis homotopic_paths_sym)
   3.413 +
   3.414 +proposition homotopic_paths_trans [trans]:
   3.415 +     "\<lbrakk>homotopic_paths s p q; homotopic_paths s q r\<rbrakk> \<Longrightarrow> homotopic_paths s p r"
   3.416 +  apply (simp add: homotopic_paths_def)
   3.417 +  apply (rule homotopic_with_trans, assumption)
   3.418 +  by (metis (mono_tags, lifting) homotopic_with_imp_property homotopic_with_mono)
   3.419 +
   3.420 +proposition homotopic_paths_eq:
   3.421 +     "\<lbrakk>path p; path_image p \<subseteq> s; \<And>t. t \<in> {0..1} \<Longrightarrow> p t = q t\<rbrakk> \<Longrightarrow> homotopic_paths s p q"
   3.422 +  apply (simp add: homotopic_paths_def)
   3.423 +  apply (rule homotopic_with_eq)
   3.424 +  apply (auto simp: path_def homotopic_with_refl pathstart_def pathfinish_def path_image_def elim: continuous_on_eq)
   3.425 +  done
   3.426 +
   3.427 +proposition homotopic_paths_reparametrize:
   3.428 +  assumes "path p"
   3.429 +      and pips: "path_image p \<subseteq> s"
   3.430 +      and contf: "continuous_on {0..1} f"
   3.431 +      and f01:"f ` {0..1} \<subseteq> {0..1}"
   3.432 +      and [simp]: "f(0) = 0" "f(1) = 1"
   3.433 +      and q: "\<And>t. t \<in> {0..1} \<Longrightarrow> q(t) = p(f t)"
   3.434 +    shows "homotopic_paths s p q"
   3.435 +proof -
   3.436 +  have contp: "continuous_on {0..1} p"
   3.437 +    by (metis \<open>path p\<close> path_def)
   3.438 +  then have "continuous_on {0..1} (p \<circ> f)"
   3.439 +    using contf continuous_on_compose continuous_on_subset f01 by blast
   3.440 +  then have "path q"
   3.441 +    by (simp add: path_def) (metis q continuous_on_cong)
   3.442 +  have piqs: "path_image q \<subseteq> s"
   3.443 +    by (metis (no_types, hide_lams) pips f01 image_subset_iff path_image_def q)
   3.444 +  have fb0: "\<And>a b. \<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> (1 - a) * f b + a * b"
   3.445 +    using f01 by force
   3.446 +  have fb1: "\<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> (1 - a) * f b + a * b \<le> 1" for a b
   3.447 +    using f01 [THEN subsetD, of "f b"] by (simp add: convex_bound_le)
   3.448 +  have "homotopic_paths s q p"
   3.449 +  proof (rule homotopic_paths_trans)
   3.450 +    show "homotopic_paths s q (p \<circ> f)"
   3.451 +      using q by (force intro: homotopic_paths_eq [OF  \<open>path q\<close> piqs])
   3.452 +  next
   3.453 +    show "homotopic_paths s (p \<circ> f) p"
   3.454 +      apply (simp add: homotopic_paths_def homotopic_with_def)
   3.455 +      apply (rule_tac x="p \<circ> (\<lambda>y. (1 - (fst y)) *\<^sub>R ((f \<circ> snd) y) + (fst y) *\<^sub>R snd y)"  in exI)
   3.456 +      apply (rule conjI contf continuous_intros continuous_on_subset [OF contp] | simp)+
   3.457 +      using pips [unfolded path_image_def]
   3.458 +      apply (auto simp: fb0 fb1 pathstart_def pathfinish_def)
   3.459 +      done
   3.460 +  qed
   3.461 +  then show ?thesis
   3.462 +    by (simp add: homotopic_paths_sym)
   3.463 +qed
   3.464 +
   3.465 +lemma homotopic_paths_subset: "\<lbrakk>homotopic_paths s p q; s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t p q"
   3.466 +  using homotopic_paths_def homotopic_with_subset_right by blast
   3.467 +
   3.468 +
   3.469 +text\<open> A slightly ad-hoc but useful lemma in constructing homotopies.\<close>
   3.470 +lemma homotopic_join_lemma:
   3.471 +  fixes q :: "[real,real] \<Rightarrow> 'a::topological_space"
   3.472 +  assumes p: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. p (fst y) (snd y))"
   3.473 +      and q: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. q (fst y) (snd y))"
   3.474 +      and pf: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish(p t) = pathstart(q t)"
   3.475 +    shows "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. (p(fst y) +++ q(fst y)) (snd y))"
   3.476 +proof -
   3.477 +  have 1: "(\<lambda>y. p (fst y) (2 * snd y)) = (\<lambda>y. p (fst y) (snd y)) \<circ> (\<lambda>y. (fst y, 2 * snd y))"
   3.478 +    by (rule ext) (simp)
   3.479 +  have 2: "(\<lambda>y. q (fst y) (2 * snd y - 1)) = (\<lambda>y. q (fst y) (snd y)) \<circ> (\<lambda>y. (fst y, 2 * snd y - 1))"
   3.480 +    by (rule ext) (simp)
   3.481 +  show ?thesis
   3.482 +    apply (simp add: joinpaths_def)
   3.483 +    apply (rule continuous_on_cases_le)
   3.484 +    apply (simp_all only: 1 2)
   3.485 +    apply (rule continuous_intros continuous_on_subset [OF p] continuous_on_subset [OF q] | force)+
   3.486 +    using pf
   3.487 +    apply (auto simp: mult.commute pathstart_def pathfinish_def)
   3.488 +    done
   3.489 +qed
   3.490 +
   3.491 +text\<open> Congruence properties of homotopy w.r.t. path-combining operations.\<close>
   3.492 +
   3.493 +lemma homotopic_paths_reversepath_D:
   3.494 +      assumes "homotopic_paths s p q"
   3.495 +      shows   "homotopic_paths s (reversepath p) (reversepath q)"
   3.496 +  using assms
   3.497 +  apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
   3.498 +  apply (rule_tac x="h \<circ> (\<lambda>x. (fst x, 1 - snd x))" in exI)
   3.499 +  apply (rule conjI continuous_intros)+
   3.500 +  apply (auto simp: reversepath_def pathstart_def pathfinish_def elim!: continuous_on_subset)
   3.501 +  done
   3.502 +
   3.503 +proposition homotopic_paths_reversepath:
   3.504 +     "homotopic_paths s (reversepath p) (reversepath q) \<longleftrightarrow> homotopic_paths s p q"
   3.505 +  using homotopic_paths_reversepath_D by force
   3.506 +
   3.507 +
   3.508 +proposition homotopic_paths_join:
   3.509 +    "\<lbrakk>homotopic_paths s p p'; homotopic_paths s q q'; pathfinish p = pathstart q\<rbrakk> \<Longrightarrow> homotopic_paths s (p +++ q) (p' +++ q')"
   3.510 +  apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
   3.511 +  apply (rename_tac k1 k2)
   3.512 +  apply (rule_tac x="(\<lambda>y. ((k1 \<circ> Pair (fst y)) +++ (k2 \<circ> Pair (fst y))) (snd y))" in exI)
   3.513 +  apply (rule conjI continuous_intros homotopic_join_lemma)+
   3.514 +  apply (auto simp: joinpaths_def pathstart_def pathfinish_def path_image_def)
   3.515 +  done
   3.516 +
   3.517 +proposition homotopic_paths_continuous_image:
   3.518 +    "\<lbrakk>homotopic_paths s f g; continuous_on s h; h ` s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t (h \<circ> f) (h \<circ> g)"
   3.519 +  unfolding homotopic_paths_def
   3.520 +  apply (rule homotopic_with_compose_continuous_left [of _ _ _ s])
   3.521 +  apply (auto simp: pathstart_def pathfinish_def elim!: homotopic_with_mono)
   3.522 +  done
   3.523 +
   3.524 +
   3.525 +subsection\<open>Group properties for homotopy of paths\<close>
   3.526 +
   3.527 +text%important\<open>So taking equivalence classes under homotopy would give the fundamental group\<close>
   3.528 +
   3.529 +proposition homotopic_paths_rid:
   3.530 +    "\<lbrakk>path p; path_image p \<subseteq> s\<rbrakk> \<Longrightarrow> homotopic_paths s (p +++ linepath (pathfinish p) (pathfinish p)) p"
   3.531 +  apply (subst homotopic_paths_sym)
   3.532 +  apply (rule homotopic_paths_reparametrize [where f = "\<lambda>t. if  t \<le> 1 / 2 then 2 *\<^sub>R t else 1"])
   3.533 +  apply (simp_all del: le_divide_eq_numeral1)
   3.534 +  apply (subst split_01)
   3.535 +  apply (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
   3.536 +  done
   3.537 +
   3.538 +proposition homotopic_paths_lid:
   3.539 +   "\<lbrakk>path p; path_image p \<subseteq> s\<rbrakk> \<Longrightarrow> homotopic_paths s (linepath (pathstart p) (pathstart p) +++ p) p"
   3.540 +  using homotopic_paths_rid [of "reversepath p" s]
   3.541 +  by (metis homotopic_paths_reversepath path_image_reversepath path_reversepath pathfinish_linepath
   3.542 +        pathfinish_reversepath reversepath_joinpaths reversepath_linepath)
   3.543 +
   3.544 +proposition homotopic_paths_assoc:
   3.545 +   "\<lbrakk>path p; path_image p \<subseteq> s; path q; path_image q \<subseteq> s; path r; path_image r \<subseteq> s; pathfinish p = pathstart q;
   3.546 +     pathfinish q = pathstart r\<rbrakk>
   3.547 +    \<Longrightarrow> homotopic_paths s (p +++ (q +++ r)) ((p +++ q) +++ r)"
   3.548 +  apply (subst homotopic_paths_sym)
   3.549 +  apply (rule homotopic_paths_reparametrize
   3.550 +           [where f = "\<lambda>t. if  t \<le> 1 / 2 then inverse 2 *\<^sub>R t
   3.551 +                           else if  t \<le> 3 / 4 then t - (1 / 4)
   3.552 +                           else 2 *\<^sub>R t - 1"])
   3.553 +  apply (simp_all del: le_divide_eq_numeral1)
   3.554 +  apply (simp add: subset_path_image_join)
   3.555 +  apply (rule continuous_on_cases_1 continuous_intros)+
   3.556 +  apply (auto simp: joinpaths_def)
   3.557 +  done
   3.558 +
   3.559 +proposition homotopic_paths_rinv:
   3.560 +  assumes "path p" "path_image p \<subseteq> s"
   3.561 +    shows "homotopic_paths s (p +++ reversepath p) (linepath (pathstart p) (pathstart p))"
   3.562 +proof -
   3.563 +  have "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. (subpath 0 (fst x) p +++ reversepath (subpath 0 (fst x) p)) (snd x))"
   3.564 +    using assms
   3.565 +    apply (simp add: joinpaths_def subpath_def reversepath_def path_def del: le_divide_eq_numeral1)
   3.566 +    apply (rule continuous_on_cases_le)
   3.567 +    apply (rule_tac [2] continuous_on_compose [of _ _ p, unfolded o_def])
   3.568 +    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
   3.569 +    apply (auto intro!: continuous_intros simp del: eq_divide_eq_numeral1)
   3.570 +    apply (force elim!: continuous_on_subset simp add: mult_le_one)+
   3.571 +    done
   3.572 +  then show ?thesis
   3.573 +    using assms
   3.574 +    apply (subst homotopic_paths_sym_eq)
   3.575 +    unfolding homotopic_paths_def homotopic_with_def
   3.576 +    apply (rule_tac x="(\<lambda>y. (subpath 0 (fst y) p +++ reversepath(subpath 0 (fst y) p)) (snd y))" in exI)
   3.577 +    apply (simp add: path_defs joinpaths_def subpath_def reversepath_def)
   3.578 +    apply (force simp: mult_le_one)
   3.579 +    done
   3.580 +qed
   3.581 +
   3.582 +proposition homotopic_paths_linv:
   3.583 +  assumes "path p" "path_image p \<subseteq> s"
   3.584 +    shows "homotopic_paths s (reversepath p +++ p) (linepath (pathfinish p) (pathfinish p))"
   3.585 +  using homotopic_paths_rinv [of "reversepath p" s] assms by simp
   3.586 +
   3.587 +
   3.588 +subsection\<open>Homotopy of loops without requiring preservation of endpoints\<close>
   3.589 +
   3.590 +definition%important homotopic_loops :: "'a::topological_space set \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool"  where
   3.591 + "homotopic_loops s p q \<equiv>
   3.592 +     homotopic_with (\<lambda>r. pathfinish r = pathstart r) {0..1} s p q"
   3.593 +
   3.594 +lemma homotopic_loops:
   3.595 +   "homotopic_loops s p q \<longleftrightarrow>
   3.596 +      (\<exists>h. continuous_on ({0..1::real} \<times> {0..1}) h \<and>
   3.597 +          image h ({0..1} \<times> {0..1}) \<subseteq> s \<and>
   3.598 +          (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
   3.599 +          (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
   3.600 +          (\<forall>t \<in> {0..1}. pathfinish(h \<circ> Pair t) = pathstart(h \<circ> Pair t)))"
   3.601 +  by (simp add: homotopic_loops_def pathstart_def pathfinish_def homotopic_with)
   3.602 +
   3.603 +proposition homotopic_loops_imp_loop:
   3.604 +     "homotopic_loops s p q \<Longrightarrow> pathfinish p = pathstart p \<and> pathfinish q = pathstart q"
   3.605 +using homotopic_with_imp_property homotopic_loops_def by blast
   3.606 +
   3.607 +proposition homotopic_loops_imp_path:
   3.608 +     "homotopic_loops s p q \<Longrightarrow> path p \<and> path q"
   3.609 +  unfolding homotopic_loops_def path_def
   3.610 +  using homotopic_with_imp_continuous by blast
   3.611 +
   3.612 +proposition homotopic_loops_imp_subset:
   3.613 +     "homotopic_loops s p q \<Longrightarrow> path_image p \<subseteq> s \<and> path_image q \<subseteq> s"
   3.614 +  unfolding homotopic_loops_def path_image_def
   3.615 +  by (metis homotopic_with_imp_subset1 homotopic_with_imp_subset2)
   3.616 +
   3.617 +proposition homotopic_loops_refl:
   3.618 +     "homotopic_loops s p p \<longleftrightarrow>
   3.619 +      path p \<and> path_image p \<subseteq> s \<and> pathfinish p = pathstart p"
   3.620 +  by (simp add: homotopic_loops_def homotopic_with_refl path_image_def path_def)
   3.621 +
   3.622 +proposition homotopic_loops_sym: "homotopic_loops s p q \<Longrightarrow> homotopic_loops s q p"
   3.623 +  by (simp add: homotopic_loops_def homotopic_with_sym)
   3.624 +
   3.625 +proposition homotopic_loops_sym_eq: "homotopic_loops s p q \<longleftrightarrow> homotopic_loops s q p"
   3.626 +  by (metis homotopic_loops_sym)
   3.627 +
   3.628 +proposition homotopic_loops_trans:
   3.629 +   "\<lbrakk>homotopic_loops s p q; homotopic_loops s q r\<rbrakk> \<Longrightarrow> homotopic_loops s p r"
   3.630 +  unfolding homotopic_loops_def by (blast intro: homotopic_with_trans)
   3.631 +
   3.632 +proposition homotopic_loops_subset:
   3.633 +   "\<lbrakk>homotopic_loops s p q; s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t p q"
   3.634 +  by (simp add: homotopic_loops_def homotopic_with_subset_right)
   3.635 +
   3.636 +proposition homotopic_loops_eq:
   3.637 +   "\<lbrakk>path p; path_image p \<subseteq> s; pathfinish p = pathstart p; \<And>t. t \<in> {0..1} \<Longrightarrow> p(t) = q(t)\<rbrakk>
   3.638 +          \<Longrightarrow> homotopic_loops s p q"
   3.639 +  unfolding homotopic_loops_def
   3.640 +  apply (rule homotopic_with_eq)
   3.641 +  apply (rule homotopic_with_refl [where f = p, THEN iffD2])
   3.642 +  apply (simp_all add: path_image_def path_def pathstart_def pathfinish_def)
   3.643 +  done
   3.644 +
   3.645 +proposition homotopic_loops_continuous_image:
   3.646 +   "\<lbrakk>homotopic_loops s f g; continuous_on s h; h ` s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t (h \<circ> f) (h \<circ> g)"
   3.647 +  unfolding homotopic_loops_def
   3.648 +  apply (rule homotopic_with_compose_continuous_left)
   3.649 +  apply (erule homotopic_with_mono)
   3.650 +  by (simp add: pathfinish_def pathstart_def)
   3.651 +
   3.652 +
   3.653 +subsection\<open>Relations between the two variants of homotopy\<close>
   3.654 +
   3.655 +proposition homotopic_paths_imp_homotopic_loops:
   3.656 +    "\<lbrakk>homotopic_paths s p q; pathfinish p = pathstart p; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> homotopic_loops s p q"
   3.657 +  by (auto simp: homotopic_paths_def homotopic_loops_def intro: homotopic_with_mono)
   3.658 +
   3.659 +proposition homotopic_loops_imp_homotopic_paths_null:
   3.660 +  assumes "homotopic_loops s p (linepath a a)"
   3.661 +    shows "homotopic_paths s p (linepath (pathstart p) (pathstart p))"
   3.662 +proof -
   3.663 +  have "path p" by (metis assms homotopic_loops_imp_path)
   3.664 +  have ploop: "pathfinish p = pathstart p" by (metis assms homotopic_loops_imp_loop)
   3.665 +  have pip: "path_image p \<subseteq> s" by (metis assms homotopic_loops_imp_subset)
   3.666 +  obtain h where conth: "continuous_on ({0..1::real} \<times> {0..1}) h"
   3.667 +             and hs: "h ` ({0..1} \<times> {0..1}) \<subseteq> s"
   3.668 +             and [simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(0,x) = p x"
   3.669 +             and [simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(1,x) = a"
   3.670 +             and ends: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish (h \<circ> Pair t) = pathstart (h \<circ> Pair t)"
   3.671 +    using assms by (auto simp: homotopic_loops homotopic_with)
   3.672 +  have conth0: "path (\<lambda>u. h (u, 0))"
   3.673 +    unfolding path_def
   3.674 +    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
   3.675 +    apply (force intro: continuous_intros continuous_on_subset [OF conth])+
   3.676 +    done
   3.677 +  have pih0: "path_image (\<lambda>u. h (u, 0)) \<subseteq> s"
   3.678 +    using hs by (force simp: path_image_def)
   3.679 +  have c1: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. h (fst x * snd x, 0))"
   3.680 +    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
   3.681 +    apply (force simp: mult_le_one intro: continuous_intros continuous_on_subset [OF conth])+
   3.682 +    done
   3.683 +  have c2: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. h (fst x - fst x * snd x, 0))"
   3.684 +    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
   3.685 +    apply (force simp: mult_left_le mult_le_one intro: continuous_intros continuous_on_subset [OF conth])+
   3.686 +    apply (rule continuous_on_subset [OF conth])
   3.687 +    apply (auto simp: algebra_simps add_increasing2 mult_left_le)
   3.688 +    done
   3.689 +  have [simp]: "\<And>t. \<lbrakk>0 \<le> t \<and> t \<le> 1\<rbrakk> \<Longrightarrow> h (t, 1) = h (t, 0)"
   3.690 +    using ends by (simp add: pathfinish_def pathstart_def)
   3.691 +  have adhoc_le: "c * 4 \<le> 1 + c * (d * 4)" if "\<not> d * 4 \<le> 3" "0 \<le> c" "c \<le> 1" for c d::real
   3.692 +  proof -
   3.693 +    have "c * 3 \<le> c * (d * 4)" using that less_eq_real_def by auto
   3.694 +    with \<open>c \<le> 1\<close> show ?thesis by fastforce
   3.695 +  qed
   3.696 +  have *: "\<And>p x. (path p \<and> path(reversepath p)) \<and>
   3.697 +                  (path_image p \<subseteq> s \<and> path_image(reversepath p) \<subseteq> s) \<and>
   3.698 +                  (pathfinish p = pathstart(linepath a a +++ reversepath p) \<and>
   3.699 +                   pathstart(reversepath p) = a) \<and> pathstart p = x
   3.700 +                  \<Longrightarrow> homotopic_paths s (p +++ linepath a a +++ reversepath p) (linepath x x)"
   3.701 +    by (metis homotopic_paths_lid homotopic_paths_join
   3.702 +              homotopic_paths_trans homotopic_paths_sym homotopic_paths_rinv)
   3.703 +  have 1: "homotopic_paths s p (p +++ linepath (pathfinish p) (pathfinish p))"
   3.704 +    using \<open>path p\<close> homotopic_paths_rid homotopic_paths_sym pip by blast
   3.705 +  moreover have "homotopic_paths s (p +++ linepath (pathfinish p) (pathfinish p))
   3.706 +                                   (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))"
   3.707 +    apply (rule homotopic_paths_sym)
   3.708 +    using homotopic_paths_lid [of "p +++ linepath (pathfinish p) (pathfinish p)" s]
   3.709 +    by (metis 1 homotopic_paths_imp_path homotopic_paths_imp_pathstart homotopic_paths_imp_subset)
   3.710 +  moreover have "homotopic_paths s (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))
   3.711 +                                   ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))"
   3.712 +    apply (simp add: homotopic_paths_def homotopic_with_def)
   3.713 +    apply (rule_tac x="\<lambda>y. (subpath 0 (fst y) (\<lambda>u. h (u, 0)) +++ (\<lambda>u. h (Pair (fst y) u)) +++ subpath (fst y) 0 (\<lambda>u. h (u, 0))) (snd y)" in exI)
   3.714 +    apply (simp add: subpath_reversepath)
   3.715 +    apply (intro conjI homotopic_join_lemma)
   3.716 +    using ploop
   3.717 +    apply (simp_all add: path_defs joinpaths_def o_def subpath_def conth c1 c2)
   3.718 +    apply (force simp: algebra_simps mult_le_one mult_left_le intro: hs [THEN subsetD] adhoc_le)
   3.719 +    done
   3.720 +  moreover have "homotopic_paths s ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))
   3.721 +                                   (linepath (pathstart p) (pathstart p))"
   3.722 +    apply (rule *)
   3.723 +    apply (simp add: pih0 pathstart_def pathfinish_def conth0)
   3.724 +    apply (simp add: reversepath_def joinpaths_def)
   3.725 +    done
   3.726 +  ultimately show ?thesis
   3.727 +    by (blast intro: homotopic_paths_trans)
   3.728 +qed
   3.729 +
   3.730 +proposition homotopic_loops_conjugate:
   3.731 +  fixes s :: "'a::real_normed_vector set"
   3.732 +  assumes "path p" "path q" and pip: "path_image p \<subseteq> s" and piq: "path_image q \<subseteq> s"
   3.733 +      and papp: "pathfinish p = pathstart q" and qloop: "pathfinish q = pathstart q"
   3.734 +    shows "homotopic_loops s (p +++ q +++ reversepath p) q"
   3.735 +proof -
   3.736 +  have contp: "continuous_on {0..1} p"  using \<open>path p\<close> [unfolded path_def] by blast
   3.737 +  have contq: "continuous_on {0..1} q"  using \<open>path q\<close> [unfolded path_def] by blast
   3.738 +  have c1: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. p ((1 - fst x) * snd x + fst x))"
   3.739 +    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
   3.740 +    apply (force simp: mult_le_one intro!: continuous_intros)
   3.741 +    apply (rule continuous_on_subset [OF contp])
   3.742 +    apply (auto simp: algebra_simps add_increasing2 mult_right_le_one_le sum_le_prod1)
   3.743 +    done
   3.744 +  have c2: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. p ((fst x - 1) * snd x + 1))"
   3.745 +    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
   3.746 +    apply (force simp: mult_le_one intro!: continuous_intros)
   3.747 +    apply (rule continuous_on_subset [OF contp])
   3.748 +    apply (auto simp: algebra_simps add_increasing2 mult_left_le_one_le)
   3.749 +    done
   3.750 +  have ps1: "\<And>a b. \<lbrakk>b * 2 \<le> 1; 0 \<le> b; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((1 - a) * (2 * b) + a) \<in> s"
   3.751 +    using sum_le_prod1
   3.752 +    by (force simp: algebra_simps add_increasing2 mult_left_le intro: pip [unfolded path_image_def, THEN subsetD])
   3.753 +  have ps2: "\<And>a b. \<lbrakk>\<not> 4 * b \<le> 3; b \<le> 1; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((a - 1) * (4 * b - 3) + 1) \<in> s"
   3.754 +    apply (rule pip [unfolded path_image_def, THEN subsetD])
   3.755 +    apply (rule image_eqI, blast)
   3.756 +    apply (simp add: algebra_simps)
   3.757 +    by (metis add_mono_thms_linordered_semiring(1) affine_ineq linear mult.commute mult.left_neutral mult_right_mono not_le
   3.758 +              add.commute zero_le_numeral)
   3.759 +  have qs: "\<And>a b. \<lbrakk>4 * b \<le> 3; \<not> b * 2 \<le> 1\<rbrakk> \<Longrightarrow> q (4 * b - 2) \<in> s"
   3.760 +    using path_image_def piq by fastforce
   3.761 +  have "homotopic_loops s (p +++ q +++ reversepath p)
   3.762 +                          (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q))"
   3.763 +    apply (simp add: homotopic_loops_def homotopic_with_def)
   3.764 +    apply (rule_tac x="(\<lambda>y. (subpath (fst y) 1 p +++ q +++ subpath 1 (fst y) p) (snd y))" in exI)
   3.765 +    apply (simp add: subpath_refl subpath_reversepath)
   3.766 +    apply (intro conjI homotopic_join_lemma)
   3.767 +    using papp qloop
   3.768 +    apply (simp_all add: path_defs joinpaths_def o_def subpath_def c1 c2)
   3.769 +    apply (force simp: contq intro: continuous_on_compose [of _ _ q, unfolded o_def] continuous_on_id continuous_on_snd)
   3.770 +    apply (auto simp: ps1 ps2 qs)
   3.771 +    done
   3.772 +  moreover have "homotopic_loops s (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q)) q"
   3.773 +  proof -
   3.774 +    have "homotopic_paths s (linepath (pathfinish q) (pathfinish q) +++ q) q"
   3.775 +      using \<open>path q\<close> homotopic_paths_lid qloop piq by auto
   3.776 +    hence 1: "\<And>f. homotopic_paths s f q \<or> \<not> homotopic_paths s f (linepath (pathfinish q) (pathfinish q) +++ q)"
   3.777 +      using homotopic_paths_trans by blast
   3.778 +    hence "homotopic_paths s (linepath (pathfinish q) (pathfinish q) +++ q +++ linepath (pathfinish q) (pathfinish q)) q"
   3.779 +    proof -
   3.780 +      have "homotopic_paths s (q +++ linepath (pathfinish q) (pathfinish q)) q"
   3.781 +        by (simp add: \<open>path q\<close> homotopic_paths_rid piq)
   3.782 +      thus ?thesis
   3.783 +        by (metis (no_types) 1 \<open>path q\<close> homotopic_paths_join homotopic_paths_rinv homotopic_paths_sym
   3.784 +                  homotopic_paths_trans qloop pathfinish_linepath piq)
   3.785 +    qed
   3.786 +    thus ?thesis
   3.787 +      by (metis (no_types) qloop homotopic_loops_sym homotopic_paths_imp_homotopic_loops homotopic_paths_imp_pathfinish homotopic_paths_sym)
   3.788 +  qed
   3.789 +  ultimately show ?thesis
   3.790 +    by (blast intro: homotopic_loops_trans)
   3.791 +qed
   3.792 +
   3.793 +lemma homotopic_paths_loop_parts:
   3.794 +  assumes loops: "homotopic_loops S (p +++ reversepath q) (linepath a a)" and "path q"
   3.795 +  shows "homotopic_paths S p q"
   3.796 +proof -
   3.797 +  have paths: "homotopic_paths S (p +++ reversepath q) (linepath (pathstart p) (pathstart p))"
   3.798 +    using homotopic_loops_imp_homotopic_paths_null [OF loops] by simp
   3.799 +  then have "path p"
   3.800 +    using \<open>path q\<close> homotopic_loops_imp_path loops path_join path_join_path_ends path_reversepath by blast
   3.801 +  show ?thesis
   3.802 +  proof (cases "pathfinish p = pathfinish q")
   3.803 +    case True
   3.804 +    have pipq: "path_image p \<subseteq> S" "path_image q \<subseteq> S"
   3.805 +      by (metis Un_subset_iff paths \<open>path p\<close> \<open>path q\<close> homotopic_loops_imp_subset homotopic_paths_imp_path loops
   3.806 +           path_image_join path_image_reversepath path_imp_reversepath path_join_eq)+
   3.807 +    have "homotopic_paths S p (p +++ (linepath (pathfinish p) (pathfinish p)))"
   3.808 +      using \<open>path p\<close> \<open>path_image p \<subseteq> S\<close> homotopic_paths_rid homotopic_paths_sym by blast
   3.809 +    moreover have "homotopic_paths S (p +++ (linepath (pathfinish p) (pathfinish p))) (p +++ (reversepath q +++ q))"
   3.810 +      by (simp add: True \<open>path p\<close> \<open>path q\<close> pipq homotopic_paths_join homotopic_paths_linv homotopic_paths_sym)
   3.811 +    moreover have "homotopic_paths S (p +++ (reversepath q +++ q)) ((p +++ reversepath q) +++ q)"
   3.812 +      by (simp add: True \<open>path p\<close> \<open>path q\<close> homotopic_paths_assoc pipq)
   3.813 +    moreover have "homotopic_paths S ((p +++ reversepath q) +++ q) (linepath (pathstart p) (pathstart p) +++ q)"
   3.814 +      by (simp add: \<open>path q\<close> homotopic_paths_join paths pipq)
   3.815 +    moreover then have "homotopic_paths S (linepath (pathstart p) (pathstart p) +++ q) q"
   3.816 +      by (metis \<open>path q\<close> homotopic_paths_imp_path homotopic_paths_lid linepath_trivial path_join_path_ends pathfinish_def pipq(2))
   3.817 +    ultimately show ?thesis
   3.818 +      using homotopic_paths_trans by metis
   3.819 +  next
   3.820 +    case False
   3.821 +    then show ?thesis
   3.822 +      using \<open>path q\<close> homotopic_loops_imp_path loops path_join_path_ends by fastforce
   3.823 +  qed
   3.824 +qed
   3.825 +
   3.826 +
   3.827 +subsection%unimportant\<open>Homotopy of "nearby" function, paths and loops\<close>
   3.828 +
   3.829 +lemma homotopic_with_linear:
   3.830 +  fixes f g :: "_ \<Rightarrow> 'b::real_normed_vector"
   3.831 +  assumes contf: "continuous_on s f"
   3.832 +      and contg:"continuous_on s g"
   3.833 +      and sub: "\<And>x. x \<in> s \<Longrightarrow> closed_segment (f x) (g x) \<subseteq> t"
   3.834 +    shows "homotopic_with (\<lambda>z. True) s t f g"
   3.835 +  apply (simp add: homotopic_with_def)
   3.836 +  apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R f(snd y) + (fst y) *\<^sub>R g(snd y))" in exI)
   3.837 +  apply (intro conjI)
   3.838 +  apply (rule subset_refl continuous_intros continuous_on_subset [OF contf] continuous_on_compose2 [where g=f]
   3.839 +                                            continuous_on_subset [OF contg] continuous_on_compose2 [where g=g]| simp)+
   3.840 +  using sub closed_segment_def apply fastforce+
   3.841 +  done
   3.842 +
   3.843 +lemma homotopic_paths_linear:
   3.844 +  fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   3.845 +  assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
   3.846 +          "\<And>t. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> s"
   3.847 +    shows "homotopic_paths s g h"
   3.848 +  using assms
   3.849 +  unfolding path_def
   3.850 +  apply (simp add: closed_segment_def pathstart_def pathfinish_def homotopic_paths_def homotopic_with_def)
   3.851 +  apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R (g \<circ> snd) y + (fst y) *\<^sub>R (h \<circ> snd) y)" in exI)
   3.852 +  apply (intro conjI subsetI continuous_intros; force)
   3.853 +  done
   3.854 +
   3.855 +lemma homotopic_loops_linear:
   3.856 +  fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   3.857 +  assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
   3.858 +          "\<And>t x. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> s"
   3.859 +    shows "homotopic_loops s g h"
   3.860 +  using assms
   3.861 +  unfolding path_def
   3.862 +  apply (simp add: pathstart_def pathfinish_def homotopic_loops_def homotopic_with_def)
   3.863 +  apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R g(snd y) + (fst y) *\<^sub>R h(snd y))" in exI)
   3.864 +  apply (auto intro!: continuous_intros intro: continuous_on_compose2 [where g=g] continuous_on_compose2 [where g=h])
   3.865 +  apply (force simp: closed_segment_def)
   3.866 +  done
   3.867 +
   3.868 +lemma homotopic_paths_nearby_explicit:
   3.869 +  assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
   3.870 +      and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> s\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
   3.871 +    shows "homotopic_paths s g h"
   3.872 +  apply (rule homotopic_paths_linear [OF assms(1-4)])
   3.873 +  by (metis no segment_bound(1) subsetI norm_minus_commute not_le)
   3.874 +
   3.875 +lemma homotopic_loops_nearby_explicit:
   3.876 +  assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
   3.877 +      and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> s\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
   3.878 +    shows "homotopic_loops s g h"
   3.879 +  apply (rule homotopic_loops_linear [OF assms(1-4)])
   3.880 +  by (metis no segment_bound(1) subsetI norm_minus_commute not_le)
   3.881 +
   3.882 +lemma homotopic_nearby_paths:
   3.883 +  fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   3.884 +  assumes "path g" "open s" "path_image g \<subseteq> s"
   3.885 +    shows "\<exists>e. 0 < e \<and>
   3.886 +               (\<forall>h. path h \<and>
   3.887 +                    pathstart h = pathstart g \<and> pathfinish h = pathfinish g \<and>
   3.888 +                    (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_paths s g h)"
   3.889 +proof -
   3.890 +  obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - s \<Longrightarrow> e \<le> dist x y"
   3.891 +    using separate_compact_closed [of "path_image g" "-s"] assms by force
   3.892 +  show ?thesis
   3.893 +    apply (intro exI conjI)
   3.894 +    using e [unfolded dist_norm]
   3.895 +    apply (auto simp: intro!: homotopic_paths_nearby_explicit assms  \<open>e > 0\<close>)
   3.896 +    by (metis atLeastAtMost_iff imageI le_less_trans not_le path_image_def)
   3.897 +qed
   3.898 +
   3.899 +lemma homotopic_nearby_loops:
   3.900 +  fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   3.901 +  assumes "path g" "open s" "path_image g \<subseteq> s" "pathfinish g = pathstart g"
   3.902 +    shows "\<exists>e. 0 < e \<and>
   3.903 +               (\<forall>h. path h \<and> pathfinish h = pathstart h \<and>
   3.904 +                    (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_loops s g h)"
   3.905 +proof -
   3.906 +  obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - s \<Longrightarrow> e \<le> dist x y"
   3.907 +    using separate_compact_closed [of "path_image g" "-s"] assms by force
   3.908 +  show ?thesis
   3.909 +    apply (intro exI conjI)
   3.910 +    using e [unfolded dist_norm]
   3.911 +    apply (auto simp: intro!: homotopic_loops_nearby_explicit assms  \<open>e > 0\<close>)
   3.912 +    by (metis atLeastAtMost_iff imageI le_less_trans not_le path_image_def)
   3.913 +qed
   3.914 +
   3.915 +
   3.916 +subsection\<open> Homotopy and subpaths\<close>
   3.917 +
   3.918 +lemma homotopic_join_subpaths1:
   3.919 +  assumes "path g" and pag: "path_image g \<subseteq> s"
   3.920 +      and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}" "u \<le> v" "v \<le> w"
   3.921 +    shows "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
   3.922 +proof -
   3.923 +  have 1: "t * 2 \<le> 1 \<Longrightarrow> u + t * (v * 2) \<le> v + t * (u * 2)" for t
   3.924 +    using affine_ineq \<open>u \<le> v\<close> by fastforce
   3.925 +  have 2: "t * 2 > 1 \<Longrightarrow> u + (2*t - 1) * v \<le> v + (2*t - 1) * w" for t
   3.926 +    by (metis add_mono_thms_linordered_semiring(1) diff_gt_0_iff_gt less_eq_real_def mult.commute mult_right_mono \<open>u \<le> v\<close> \<open>v \<le> w\<close>)
   3.927 +  have t2: "\<And>t::real. t*2 = 1 \<Longrightarrow> t = 1/2" by auto
   3.928 +  show ?thesis
   3.929 +    apply (rule homotopic_paths_subset [OF _ pag])
   3.930 +    using assms
   3.931 +    apply (cases "w = u")
   3.932 +    using homotopic_paths_rinv [of "subpath u v g" "path_image g"]
   3.933 +    apply (force simp: closed_segment_eq_real_ivl image_mono path_image_def subpath_refl)
   3.934 +      apply (rule homotopic_paths_sym)
   3.935 +      apply (rule homotopic_paths_reparametrize
   3.936 +             [where f = "\<lambda>t. if  t \<le> 1 / 2
   3.937 +                             then inverse((w - u)) *\<^sub>R (2 * (v - u)) *\<^sub>R t
   3.938 +                             else inverse((w - u)) *\<^sub>R ((v - u) + (w - v) *\<^sub>R (2 *\<^sub>R t - 1))"])
   3.939 +      using \<open>path g\<close> path_subpath u w apply blast
   3.940 +      using \<open>path g\<close> path_image_subpath_subset u w(1) apply blast
   3.941 +      apply simp_all
   3.942 +      apply (subst split_01)
   3.943 +      apply (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
   3.944 +      apply (simp_all add: field_simps not_le)
   3.945 +      apply (force dest!: t2)
   3.946 +      apply (force simp: algebra_simps mult_left_mono affine_ineq dest!: 1 2)
   3.947 +      apply (simp add: joinpaths_def subpath_def)
   3.948 +      apply (force simp: algebra_simps)
   3.949 +      done
   3.950 +qed
   3.951 +
   3.952 +lemma homotopic_join_subpaths2:
   3.953 +  assumes "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
   3.954 +    shows "homotopic_paths s (subpath w v g +++ subpath v u g) (subpath w u g)"
   3.955 +by (metis assms homotopic_paths_reversepath_D pathfinish_subpath pathstart_subpath reversepath_joinpaths reversepath_subpath)
   3.956 +
   3.957 +lemma homotopic_join_subpaths3:
   3.958 +  assumes hom: "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
   3.959 +      and "path g" and pag: "path_image g \<subseteq> s"
   3.960 +      and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}"
   3.961 +    shows "homotopic_paths s (subpath v w g +++ subpath w u g) (subpath v u g)"
   3.962 +proof -
   3.963 +  have "homotopic_paths s (subpath u w g +++ subpath w v g) ((subpath u v g +++ subpath v w g) +++ subpath w v g)"
   3.964 +    apply (rule homotopic_paths_join)
   3.965 +    using hom homotopic_paths_sym_eq apply blast
   3.966 +    apply (metis \<open>path g\<close> homotopic_paths_eq pag path_image_subpath_subset path_subpath subset_trans v w, simp)
   3.967 +    done
   3.968 +  also have "homotopic_paths s ((subpath u v g +++ subpath v w g) +++ subpath w v g) (subpath u v g +++ subpath v w g +++ subpath w v g)"
   3.969 +    apply (rule homotopic_paths_sym [OF homotopic_paths_assoc])
   3.970 +    using assms by (simp_all add: path_image_subpath_subset [THEN order_trans])
   3.971 +  also have "homotopic_paths s (subpath u v g +++ subpath v w g +++ subpath w v g)
   3.972 +                               (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g)))"
   3.973 +    apply (rule homotopic_paths_join)
   3.974 +    apply (metis \<open>path g\<close> homotopic_paths_eq order.trans pag path_image_subpath_subset path_subpath u v)
   3.975 +    apply (metis (no_types, lifting) \<open>path g\<close> homotopic_paths_linv order_trans pag path_image_subpath_subset path_subpath pathfinish_subpath reversepath_subpath v w)
   3.976 +    apply simp
   3.977 +    done
   3.978 +  also have "homotopic_paths s (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g))) (subpath u v g)"
   3.979 +    apply (rule homotopic_paths_rid)
   3.980 +    using \<open>path g\<close> path_subpath u v apply blast
   3.981 +    apply (meson \<open>path g\<close> order.trans pag path_image_subpath_subset u v)
   3.982 +    done
   3.983 +  finally have "homotopic_paths s (subpath u w g +++ subpath w v g) (subpath u v g)" .
   3.984 +  then show ?thesis
   3.985 +    using homotopic_join_subpaths2 by blast
   3.986 +qed
   3.987 +
   3.988 +proposition homotopic_join_subpaths:
   3.989 +   "\<lbrakk>path g; path_image g \<subseteq> s; u \<in> {0..1}; v \<in> {0..1}; w \<in> {0..1}\<rbrakk>
   3.990 +    \<Longrightarrow> homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
   3.991 +  apply (rule le_cases3 [of u v w])
   3.992 +using homotopic_join_subpaths1 homotopic_join_subpaths2 homotopic_join_subpaths3 by metis+
   3.993 +
   3.994 +text\<open>Relating homotopy of trivial loops to path-connectedness.\<close>
   3.995 +
   3.996 +lemma path_component_imp_homotopic_points:
   3.997 +    "path_component S a b \<Longrightarrow> homotopic_loops S (linepath a a) (linepath b b)"
   3.998 +apply (simp add: path_component_def homotopic_loops_def homotopic_with_def
   3.999 +                 pathstart_def pathfinish_def path_image_def path_def, clarify)
  3.1000 +apply (rule_tac x="g \<circ> fst" in exI)
  3.1001 +apply (intro conjI continuous_intros continuous_on_compose)+
  3.1002 +apply (auto elim!: continuous_on_subset)
  3.1003 +done
  3.1004 +
  3.1005 +lemma homotopic_loops_imp_path_component_value:
  3.1006 +   "\<lbrakk>homotopic_loops S p q; 0 \<le> t; t \<le> 1\<rbrakk>
  3.1007 +        \<Longrightarrow> path_component S (p t) (q t)"
  3.1008 +apply (simp add: path_component_def homotopic_loops_def homotopic_with_def
  3.1009 +                 pathstart_def pathfinish_def path_image_def path_def, clarify)
  3.1010 +apply (rule_tac x="h \<circ> (\<lambda>u. (u, t))" in exI)
  3.1011 +apply (intro conjI continuous_intros continuous_on_compose)+
  3.1012 +apply (auto elim!: continuous_on_subset)
  3.1013 +done
  3.1014 +
  3.1015 +lemma homotopic_points_eq_path_component:
  3.1016 +   "homotopic_loops S (linepath a a) (linepath b b) \<longleftrightarrow>
  3.1017 +        path_component S a b"
  3.1018 +by (auto simp: path_component_imp_homotopic_points
  3.1019 +         dest: homotopic_loops_imp_path_component_value [where t=1])
  3.1020 +
  3.1021 +lemma path_connected_eq_homotopic_points:
  3.1022 +    "path_connected S \<longleftrightarrow>
  3.1023 +      (\<forall>a b. a \<in> S \<and> b \<in> S \<longrightarrow> homotopic_loops S (linepath a a) (linepath b b))"
  3.1024 +by (auto simp: path_connected_def path_component_def homotopic_points_eq_path_component)
  3.1025 +
  3.1026 +
  3.1027 +subsection\<open>Simply connected sets\<close>
  3.1028 +
  3.1029 +text%important\<open>defined as "all loops are homotopic (as loops)\<close>
  3.1030 +
  3.1031 +definition%important simply_connected where
  3.1032 +  "simply_connected S \<equiv>
  3.1033 +        \<forall>p q. path p \<and> pathfinish p = pathstart p \<and> path_image p \<subseteq> S \<and>
  3.1034 +              path q \<and> pathfinish q = pathstart q \<and> path_image q \<subseteq> S
  3.1035 +              \<longrightarrow> homotopic_loops S p q"
  3.1036 +
  3.1037 +lemma simply_connected_empty [iff]: "simply_connected {}"
  3.1038 +  by (simp add: simply_connected_def)
  3.1039 +
  3.1040 +lemma simply_connected_imp_path_connected:
  3.1041 +  fixes S :: "_::real_normed_vector set"
  3.1042 +  shows "simply_connected S \<Longrightarrow> path_connected S"
  3.1043 +by (simp add: simply_connected_def path_connected_eq_homotopic_points)
  3.1044 +
  3.1045 +lemma simply_connected_imp_connected:
  3.1046 +  fixes S :: "_::real_normed_vector set"
  3.1047 +  shows "simply_connected S \<Longrightarrow> connected S"
  3.1048 +by (simp add: path_connected_imp_connected simply_connected_imp_path_connected)
  3.1049 +
  3.1050 +lemma simply_connected_eq_contractible_loop_any:
  3.1051 +  fixes S :: "_::real_normed_vector set"
  3.1052 +  shows "simply_connected S \<longleftrightarrow>
  3.1053 +            (\<forall>p a. path p \<and> path_image p \<subseteq> S \<and>
  3.1054 +                  pathfinish p = pathstart p \<and> a \<in> S
  3.1055 +                  \<longrightarrow> homotopic_loops S p (linepath a a))"
  3.1056 +apply (simp add: simply_connected_def)
  3.1057 +apply (rule iffI, force, clarify)
  3.1058 +apply (rule_tac q = "linepath (pathstart p) (pathstart p)" in homotopic_loops_trans)
  3.1059 +apply (fastforce simp add:)
  3.1060 +using homotopic_loops_sym apply blast
  3.1061 +done
  3.1062 +
  3.1063 +lemma simply_connected_eq_contractible_loop_some:
  3.1064 +  fixes S :: "_::real_normed_vector set"
  3.1065 +  shows "simply_connected S \<longleftrightarrow>
  3.1066 +                path_connected S \<and>
  3.1067 +                (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
  3.1068 +                    \<longrightarrow> (\<exists>a. a \<in> S \<and> homotopic_loops S p (linepath a a)))"
  3.1069 +apply (rule iffI)
  3.1070 + apply (fastforce simp: simply_connected_imp_path_connected simply_connected_eq_contractible_loop_any)
  3.1071 +apply (clarsimp simp add: simply_connected_eq_contractible_loop_any)
  3.1072 +apply (drule_tac x=p in spec)
  3.1073 +using homotopic_loops_trans path_connected_eq_homotopic_points
  3.1074 +  apply blast
  3.1075 +done
  3.1076 +
  3.1077 +lemma simply_connected_eq_contractible_loop_all:
  3.1078 +  fixes S :: "_::real_normed_vector set"
  3.1079 +  shows "simply_connected S \<longleftrightarrow>
  3.1080 +         S = {} \<or>
  3.1081 +         (\<exists>a \<in> S. \<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
  3.1082 +                \<longrightarrow> homotopic_loops S p (linepath a a))"
  3.1083 +        (is "?lhs = ?rhs")
  3.1084 +proof (cases "S = {}")
  3.1085 +  case True then show ?thesis by force
  3.1086 +next
  3.1087 +  case False
  3.1088 +  then obtain a where "a \<in> S" by blast
  3.1089 +  show ?thesis
  3.1090 +  proof
  3.1091 +    assume "simply_connected S"
  3.1092 +    then show ?rhs
  3.1093 +      using \<open>a \<in> S\<close> \<open>simply_connected S\<close> simply_connected_eq_contractible_loop_any
  3.1094 +      by blast
  3.1095 +  next
  3.1096 +    assume ?rhs
  3.1097 +    then show "simply_connected S"
  3.1098 +      apply (simp add: simply_connected_eq_contractible_loop_any False)
  3.1099 +      by (meson homotopic_loops_refl homotopic_loops_sym homotopic_loops_trans
  3.1100 +             path_component_imp_homotopic_points path_component_refl)
  3.1101 +  qed
  3.1102 +qed
  3.1103 +
  3.1104 +lemma simply_connected_eq_contractible_path:
  3.1105 +  fixes S :: "_::real_normed_vector set"
  3.1106 +  shows "simply_connected S \<longleftrightarrow>
  3.1107 +           path_connected S \<and>
  3.1108 +           (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
  3.1109 +            \<longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p)))"
  3.1110 +apply (rule iffI)
  3.1111 + apply (simp add: simply_connected_imp_path_connected)
  3.1112 + apply (metis simply_connected_eq_contractible_loop_some homotopic_loops_imp_homotopic_paths_null)
  3.1113 +by (meson homotopic_paths_imp_homotopic_loops pathfinish_linepath pathstart_in_path_image
  3.1114 +         simply_connected_eq_contractible_loop_some subset_iff)
  3.1115 +
  3.1116 +lemma simply_connected_eq_homotopic_paths:
  3.1117 +  fixes S :: "_::real_normed_vector set"
  3.1118 +  shows "simply_connected S \<longleftrightarrow>
  3.1119 +          path_connected S \<and>
  3.1120 +          (\<forall>p q. path p \<and> path_image p \<subseteq> S \<and>
  3.1121 +                path q \<and> path_image q \<subseteq> S \<and>
  3.1122 +                pathstart q = pathstart p \<and> pathfinish q = pathfinish p
  3.1123 +                \<longrightarrow> homotopic_paths S p q)"
  3.1124 +         (is "?lhs = ?rhs")
  3.1125 +proof
  3.1126 +  assume ?lhs
  3.1127 +  then have pc: "path_connected S"
  3.1128 +        and *:  "\<And>p. \<lbrakk>path p; path_image p \<subseteq> S;
  3.1129 +                       pathfinish p = pathstart p\<rbrakk>
  3.1130 +                      \<Longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p))"
  3.1131 +    by (auto simp: simply_connected_eq_contractible_path)
  3.1132 +  have "homotopic_paths S p q"
  3.1133 +        if "path p" "path_image p \<subseteq> S" "path q"
  3.1134 +           "path_image q \<subseteq> S" "pathstart q = pathstart p"
  3.1135 +           "pathfinish q = pathfinish p" for p q
  3.1136 +  proof -
  3.1137 +    have "homotopic_paths S p (p +++ linepath (pathfinish p) (pathfinish p))"
  3.1138 +      by (simp add: homotopic_paths_rid homotopic_paths_sym that)
  3.1139 +    also have "homotopic_paths S (p +++ linepath (pathfinish p) (pathfinish p))
  3.1140 +                                 (p +++ reversepath q +++ q)"
  3.1141 +      using that
  3.1142 +      by (metis homotopic_paths_join homotopic_paths_linv homotopic_paths_refl homotopic_paths_sym_eq pathstart_linepath)
  3.1143 +    also have "homotopic_paths S (p +++ reversepath q +++ q)
  3.1144 +                                 ((p +++ reversepath q) +++ q)"
  3.1145 +      by (simp add: that homotopic_paths_assoc)
  3.1146 +    also have "homotopic_paths S ((p +++ reversepath q) +++ q)
  3.1147 +                                 (linepath (pathstart q) (pathstart q) +++ q)"
  3.1148 +      using * [of "p +++ reversepath q"] that
  3.1149 +      by (simp add: homotopic_paths_join path_image_join)
  3.1150 +    also have "homotopic_paths S (linepath (pathstart q) (pathstart q) +++ q) q"
  3.1151 +      using that homotopic_paths_lid by blast
  3.1152 +    finally show ?thesis .
  3.1153 +  qed
  3.1154 +  then show ?rhs
  3.1155 +    by (blast intro: pc *)
  3.1156 +next
  3.1157 +  assume ?rhs
  3.1158 +  then show ?lhs
  3.1159 +    by (force simp: simply_connected_eq_contractible_path)
  3.1160 +qed
  3.1161 +
  3.1162 +proposition simply_connected_Times:
  3.1163 +  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
  3.1164 +  assumes S: "simply_connected S" and T: "simply_connected T"
  3.1165 +    shows "simply_connected(S \<times> T)"
  3.1166 +proof -
  3.1167 +  have "homotopic_loops (S \<times> T) p (linepath (a, b) (a, b))"
  3.1168 +       if "path p" "path_image p \<subseteq> S \<times> T" "p 1 = p 0" "a \<in> S" "b \<in> T"
  3.1169 +       for p a b
  3.1170 +  proof -
  3.1171 +    have "path (fst \<circ> p)"
  3.1172 +      apply (rule Path_Connected.path_continuous_image [OF \<open>path p\<close>])
  3.1173 +      apply (rule continuous_intros)+
  3.1174 +      done
  3.1175 +    moreover have "path_image (fst \<circ> p) \<subseteq> S"
  3.1176 +      using that apply (simp add: path_image_def) by force
  3.1177 +    ultimately have p1: "homotopic_loops S (fst \<circ> p) (linepath a a)"
  3.1178 +      using S that
  3.1179 +      apply (simp add: simply_connected_eq_contractible_loop_any)
  3.1180 +      apply (drule_tac x="fst \<circ> p" in spec)
  3.1181 +      apply (drule_tac x=a in spec)
  3.1182 +      apply (auto simp: pathstart_def pathfinish_def)
  3.1183 +      done
  3.1184 +    have "path (snd \<circ> p)"
  3.1185 +      apply (rule Path_Connected.path_continuous_image [OF \<open>path p\<close>])
  3.1186 +      apply (rule continuous_intros)+
  3.1187 +      done
  3.1188 +    moreover have "path_image (snd \<circ> p) \<subseteq> T"
  3.1189 +      using that apply (simp add: path_image_def) by force
  3.1190 +    ultimately have p2: "homotopic_loops T (snd \<circ> p) (linepath b b)"
  3.1191 +      using T that
  3.1192 +      apply (simp add: simply_connected_eq_contractible_loop_any)
  3.1193 +      apply (drule_tac x="snd \<circ> p" in spec)
  3.1194 +      apply (drule_tac x=b in spec)
  3.1195 +      apply (auto simp: pathstart_def pathfinish_def)
  3.1196 +      done
  3.1197 +    show ?thesis
  3.1198 +      using p1 p2
  3.1199 +      apply (simp add: homotopic_loops, clarify)
  3.1200 +      apply (rename_tac h k)
  3.1201 +      apply (rule_tac x="\<lambda>z. Pair (h z) (k z)" in exI)
  3.1202 +      apply (intro conjI continuous_intros | assumption)+
  3.1203 +      apply (auto simp: pathstart_def pathfinish_def)
  3.1204 +      done
  3.1205 +  qed
  3.1206 +  with assms show ?thesis
  3.1207 +    by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
  3.1208 +qed
  3.1209 +
  3.1210 +
  3.1211 +subsection\<open>Contractible sets\<close>
  3.1212 +
  3.1213 +definition%important contractible where
  3.1214 + "contractible S \<equiv> \<exists>a. homotopic_with (\<lambda>x. True) S S id (\<lambda>x. a)"
  3.1215 +
  3.1216 +proposition contractible_imp_simply_connected:
  3.1217 +  fixes S :: "_::real_normed_vector set"
  3.1218 +  assumes "contractible S" shows "simply_connected S"
  3.1219 +proof (cases "S = {}")
  3.1220 +  case True then show ?thesis by force
  3.1221 +next
  3.1222 +  case False
  3.1223 +  obtain a where a: "homotopic_with (\<lambda>x. True) S S id (\<lambda>x. a)"
  3.1224 +    using assms by (force simp: contractible_def)
  3.1225 +  then have "a \<in> S"
  3.1226 +    by (metis False homotopic_constant_maps homotopic_with_symD homotopic_with_trans path_component_mem(2))
  3.1227 +  show ?thesis
  3.1228 +    apply (simp add: simply_connected_eq_contractible_loop_all False)
  3.1229 +    apply (rule bexI [OF _ \<open>a \<in> S\<close>])
  3.1230 +    using a apply (simp add: homotopic_loops_def homotopic_with_def path_def path_image_def pathfinish_def pathstart_def, clarify)
  3.1231 +    apply (rule_tac x="(h \<circ> (\<lambda>y. (fst y, (p \<circ> snd) y)))" in exI)
  3.1232 +    apply (intro conjI continuous_on_compose continuous_intros)
  3.1233 +    apply (erule continuous_on_subset | force)+
  3.1234 +    done
  3.1235 +qed
  3.1236 +
  3.1237 +corollary contractible_imp_connected:
  3.1238 +  fixes S :: "_::real_normed_vector set"
  3.1239 +  shows "contractible S \<Longrightarrow> connected S"
  3.1240 +by (simp add: contractible_imp_simply_connected simply_connected_imp_connected)
  3.1241 +
  3.1242 +lemma contractible_imp_path_connected:
  3.1243 +  fixes S :: "_::real_normed_vector set"
  3.1244 +  shows "contractible S \<Longrightarrow> path_connected S"
  3.1245 +by (simp add: contractible_imp_simply_connected simply_connected_imp_path_connected)
  3.1246 +
  3.1247 +lemma nullhomotopic_through_contractible:
  3.1248 +  fixes S :: "_::topological_space set"
  3.1249 +  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  3.1250 +      and g: "continuous_on T g" "g ` T \<subseteq> U"
  3.1251 +      and T: "contractible T"
  3.1252 +    obtains c where "homotopic_with (\<lambda>h. True) S U (g \<circ> f) (\<lambda>x. c)"
  3.1253 +proof -
  3.1254 +  obtain b where b: "homotopic_with (\<lambda>x. True) T T id (\<lambda>x. b)"
  3.1255 +    using assms by (force simp: contractible_def)
  3.1256 +  have "homotopic_with (\<lambda>f. True) T U (g \<circ> id) (g \<circ> (\<lambda>x. b))"
  3.1257 +    by (rule homotopic_compose_continuous_left [OF b g])
  3.1258 +  then have "homotopic_with (\<lambda>f. True) S U (g \<circ> id \<circ> f) (g \<circ> (\<lambda>x. b) \<circ> f)"
  3.1259 +    by (rule homotopic_compose_continuous_right [OF _ f])
  3.1260 +  then show ?thesis
  3.1261 +    by (simp add: comp_def that)
  3.1262 +qed
  3.1263 +
  3.1264 +lemma nullhomotopic_into_contractible:
  3.1265 +  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  3.1266 +      and T: "contractible T"
  3.1267 +    obtains c where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. c)"
  3.1268 +apply (rule nullhomotopic_through_contractible [OF f, of id T])
  3.1269 +using assms
  3.1270 +apply (auto simp: continuous_on_id)
  3.1271 +done
  3.1272 +
  3.1273 +lemma nullhomotopic_from_contractible:
  3.1274 +  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  3.1275 +      and S: "contractible S"
  3.1276 +    obtains c where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. c)"
  3.1277 +apply (rule nullhomotopic_through_contractible [OF continuous_on_id _ f S, of S])
  3.1278 +using assms
  3.1279 +apply (auto simp: comp_def)
  3.1280 +done
  3.1281 +
  3.1282 +lemma homotopic_through_contractible:
  3.1283 +  fixes S :: "_::real_normed_vector set"
  3.1284 +  assumes "continuous_on S f1" "f1 ` S \<subseteq> T"
  3.1285 +          "continuous_on T g1" "g1 ` T \<subseteq> U"
  3.1286 +          "continuous_on S f2" "f2 ` S \<subseteq> T"
  3.1287 +          "continuous_on T g2" "g2 ` T \<subseteq> U"
  3.1288 +          "contractible T" "path_connected U"
  3.1289 +   shows "homotopic_with (\<lambda>h. True) S U (g1 \<circ> f1) (g2 \<circ> f2)"
  3.1290 +proof -
  3.1291 +  obtain c1 where c1: "homotopic_with (\<lambda>h. True) S U (g1 \<circ> f1) (\<lambda>x. c1)"
  3.1292 +    apply (rule nullhomotopic_through_contractible [of S f1 T g1 U])
  3.1293 +    using assms apply auto
  3.1294 +    done
  3.1295 +  obtain c2 where c2: "homotopic_with (\<lambda>h. True) S U (g2 \<circ> f2) (\<lambda>x. c2)"
  3.1296 +    apply (rule nullhomotopic_through_contractible [of S f2 T g2 U])
  3.1297 +    using assms apply auto
  3.1298 +    done
  3.1299 +  have *: "S = {} \<or> (\<exists>t. path_connected t \<and> t \<subseteq> U \<and> c2 \<in> t \<and> c1 \<in> t)"
  3.1300 +  proof (cases "S = {}")
  3.1301 +    case True then show ?thesis by force
  3.1302 +  next
  3.1303 +    case False
  3.1304 +    with c1 c2 have "c1 \<in> U" "c2 \<in> U"
  3.1305 +      using homotopic_with_imp_subset2 all_not_in_conv image_subset_iff by blast+
  3.1306 +    with \<open>path_connected U\<close> show ?thesis by blast
  3.1307 +  qed
  3.1308 +  show ?thesis
  3.1309 +    apply (rule homotopic_with_trans [OF c1])
  3.1310 +    apply (rule homotopic_with_symD)
  3.1311 +    apply (rule homotopic_with_trans [OF c2])
  3.1312 +    apply (simp add: path_component homotopic_constant_maps *)
  3.1313 +    done
  3.1314 +qed
  3.1315 +
  3.1316 +lemma homotopic_into_contractible:
  3.1317 +  fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
  3.1318 +  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  3.1319 +      and g: "continuous_on S g" "g ` S \<subseteq> T"
  3.1320 +      and T: "contractible T"
  3.1321 +    shows "homotopic_with (\<lambda>h. True) S T f g"
  3.1322 +using homotopic_through_contractible [of S f T id T g id]
  3.1323 +by (simp add: assms contractible_imp_path_connected continuous_on_id)
  3.1324 +
  3.1325 +lemma homotopic_from_contractible:
  3.1326 +  fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
  3.1327 +  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  3.1328 +      and g: "continuous_on S g" "g ` S \<subseteq> T"
  3.1329 +      and "contractible S" "path_connected T"
  3.1330 +    shows "homotopic_with (\<lambda>h. True) S T f g"
  3.1331 +using homotopic_through_contractible [of S id S f T id g]
  3.1332 +by (simp add: assms contractible_imp_path_connected continuous_on_id)
  3.1333 +
  3.1334 +lemma starlike_imp_contractible_gen:
  3.1335 +  fixes S :: "'a::real_normed_vector set"
  3.1336 +  assumes S: "starlike S"
  3.1337 +      and P: "\<And>a T. \<lbrakk>a \<in> S; 0 \<le> T; T \<le> 1\<rbrakk> \<Longrightarrow> P(\<lambda>x. (1 - T) *\<^sub>R x + T *\<^sub>R a)"
  3.1338 +    obtains a where "homotopic_with P S S (\<lambda>x. x) (\<lambda>x. a)"
  3.1339 +proof -
  3.1340 +  obtain a where "a \<in> S" and a: "\<And>x. x \<in> S \<Longrightarrow> closed_segment a x \<subseteq> S"
  3.1341 +    using S by (auto simp: starlike_def)
  3.1342 +  have "(\<lambda>y. (1 - fst y) *\<^sub>R snd y + fst y *\<^sub>R a) ` ({0..1} \<times> S) \<subseteq> S"
  3.1343 +    apply clarify
  3.1344 +    apply (erule a [unfolded closed_segment_def, THEN subsetD], simp)
  3.1345 +    apply (metis add_diff_cancel_right' diff_ge_0_iff_ge le_add_diff_inverse pth_c(1))
  3.1346 +    done
  3.1347 +  then show ?thesis
  3.1348 +    apply (rule_tac a=a in that)
  3.1349 +    using \<open>a \<in> S\<close>
  3.1350 +    apply (simp add: homotopic_with_def)
  3.1351 +    apply (rule_tac x="\<lambda>y. (1 - (fst y)) *\<^sub>R snd y + (fst y) *\<^sub>R a" in exI)
  3.1352 +    apply (intro conjI ballI continuous_on_compose continuous_intros)
  3.1353 +    apply (simp_all add: P)
  3.1354 +    done
  3.1355 +qed
  3.1356 +
  3.1357 +lemma starlike_imp_contractible:
  3.1358 +  fixes S :: "'a::real_normed_vector set"
  3.1359 +  shows "starlike S \<Longrightarrow> contractible S"
  3.1360 +using starlike_imp_contractible_gen contractible_def by (fastforce simp: id_def)
  3.1361 +
  3.1362 +lemma contractible_UNIV [simp]: "contractible (UNIV :: 'a::real_normed_vector set)"
  3.1363 +  by (simp add: starlike_imp_contractible)
  3.1364 +
  3.1365 +lemma starlike_imp_simply_connected:
  3.1366 +  fixes S :: "'a::real_normed_vector set"
  3.1367 +  shows "starlike S \<Longrightarrow> simply_connected S"
  3.1368 +by (simp add: contractible_imp_simply_connected starlike_imp_contractible)
  3.1369 +
  3.1370 +lemma convex_imp_simply_connected:
  3.1371 +  fixes S :: "'a::real_normed_vector set"
  3.1372 +  shows "convex S \<Longrightarrow> simply_connected S"
  3.1373 +using convex_imp_starlike starlike_imp_simply_connected by blast
  3.1374 +
  3.1375 +lemma starlike_imp_path_connected:
  3.1376 +  fixes S :: "'a::real_normed_vector set"
  3.1377 +  shows "starlike S \<Longrightarrow> path_connected S"
  3.1378 +by (simp add: simply_connected_imp_path_connected starlike_imp_simply_connected)
  3.1379 +
  3.1380 +lemma starlike_imp_connected:
  3.1381 +  fixes S :: "'a::real_normed_vector set"
  3.1382 +  shows "starlike S \<Longrightarrow> connected S"
  3.1383 +by (simp add: path_connected_imp_connected starlike_imp_path_connected)
  3.1384 +
  3.1385 +lemma is_interval_simply_connected_1:
  3.1386 +  fixes S :: "real set"
  3.1387 +  shows "is_interval S \<longleftrightarrow> simply_connected S"
  3.1388 +using convex_imp_simply_connected is_interval_convex_1 is_interval_path_connected_1 simply_connected_imp_path_connected by auto
  3.1389 +
  3.1390 +lemma contractible_empty [simp]: "contractible {}"
  3.1391 +  by (simp add: contractible_def homotopic_with)
  3.1392 +
  3.1393 +lemma contractible_convex_tweak_boundary_points:
  3.1394 +  fixes S :: "'a::euclidean_space set"
  3.1395 +  assumes "convex S" and TS: "rel_interior S \<subseteq> T" "T \<subseteq> closure S"
  3.1396 +  shows "contractible T"
  3.1397 +proof (cases "S = {}")
  3.1398 +  case True
  3.1399 +  with assms show ?thesis
  3.1400 +    by (simp add: subsetCE)
  3.1401 +next
  3.1402 +  case False
  3.1403 +  show ?thesis
  3.1404 +    apply (rule starlike_imp_contractible)
  3.1405 +    apply (rule starlike_convex_tweak_boundary_points [OF \<open>convex S\<close> False TS])
  3.1406 +    done
  3.1407 +qed
  3.1408 +
  3.1409 +lemma convex_imp_contractible:
  3.1410 +  fixes S :: "'a::real_normed_vector set"
  3.1411 +  shows "convex S \<Longrightarrow> contractible S"
  3.1412 +  using contractible_empty convex_imp_starlike starlike_imp_contractible by blast
  3.1413 +
  3.1414 +lemma contractible_sing [simp]:
  3.1415 +  fixes a :: "'a::real_normed_vector"
  3.1416 +  shows "contractible {a}"
  3.1417 +by (rule convex_imp_contractible [OF convex_singleton])
  3.1418 +
  3.1419 +lemma is_interval_contractible_1:
  3.1420 +  fixes S :: "real set"
  3.1421 +  shows  "is_interval S \<longleftrightarrow> contractible S"
  3.1422 +using contractible_imp_simply_connected convex_imp_contractible is_interval_convex_1
  3.1423 +      is_interval_simply_connected_1 by auto
  3.1424 +
  3.1425 +lemma contractible_Times:
  3.1426 +  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  3.1427 +  assumes S: "contractible S" and T: "contractible T"
  3.1428 +  shows "contractible (S \<times> T)"
  3.1429 +proof -
  3.1430 +  obtain a h where conth: "continuous_on ({0..1} \<times> S) h"
  3.1431 +             and hsub: "h ` ({0..1} \<times> S) \<subseteq> S"
  3.1432 +             and [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (0, x) = x"
  3.1433 +             and [simp]: "\<And>x. x \<in> S \<Longrightarrow>  h (1::real, x) = a"
  3.1434 +    using S by (auto simp: contractible_def homotopic_with)
  3.1435 +  obtain b k where contk: "continuous_on ({0..1} \<times> T) k"
  3.1436 +             and ksub: "k ` ({0..1} \<times> T) \<subseteq> T"
  3.1437 +             and [simp]: "\<And>x. x \<in> T \<Longrightarrow> k (0, x) = x"
  3.1438 +             and [simp]: "\<And>x. x \<in> T \<Longrightarrow>  k (1::real, x) = b"
  3.1439 +    using T by (auto simp: contractible_def homotopic_with)
  3.1440 +  show ?thesis
  3.1441 +    apply (simp add: contractible_def homotopic_with)
  3.1442 +    apply (rule exI [where x=a])
  3.1443 +    apply (rule exI [where x=b])
  3.1444 +    apply (rule exI [where x = "\<lambda>z. (h (fst z, fst(snd z)), k (fst z, snd(snd z)))"])
  3.1445 +    apply (intro conjI ballI continuous_intros continuous_on_compose2 [OF conth] continuous_on_compose2 [OF contk])
  3.1446 +    using hsub ksub
  3.1447 +    apply auto
  3.1448 +    done
  3.1449 +qed
  3.1450 +
  3.1451 +lemma homotopy_dominated_contractibility:
  3.1452 +  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
  3.1453 +  assumes S: "contractible S"
  3.1454 +      and f: "continuous_on S f" "image f S \<subseteq> T"
  3.1455 +      and g: "continuous_on T g" "image g T \<subseteq> S"
  3.1456 +      and hom: "homotopic_with (\<lambda>x. True) T T (f \<circ> g) id"
  3.1457 +    shows "contractible T"
  3.1458 +proof -
  3.1459 +  obtain b where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. b)"
  3.1460 +    using nullhomotopic_from_contractible [OF f S] .
  3.1461 +  then have homg: "homotopic_with (\<lambda>x. True) T T ((\<lambda>x. b) \<circ> g) (f \<circ> g)"
  3.1462 +    by (rule homotopic_with_compose_continuous_right [OF homotopic_with_symD g])
  3.1463 +  show ?thesis
  3.1464 +    apply (simp add: contractible_def)
  3.1465 +    apply (rule exI [where x = b])
  3.1466 +    apply (rule homotopic_with_symD)
  3.1467 +    apply (rule homotopic_with_trans [OF _ hom])
  3.1468 +    using homg apply (simp add: o_def)
  3.1469 +    done
  3.1470 +qed
  3.1471 +
  3.1472 +
  3.1473 +subsection\<open>Local versions of topological properties in general\<close>
  3.1474 +
  3.1475 +definition%important locally :: "('a::topological_space set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
  3.1476 +where
  3.1477 + "locally P S \<equiv>
  3.1478 +        \<forall>w x. openin (subtopology euclidean S) w \<and> x \<in> w
  3.1479 +              \<longrightarrow> (\<exists>u v. openin (subtopology euclidean S) u \<and> P v \<and>
  3.1480 +                        x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w)"
  3.1481 +
  3.1482 +lemma locallyI:
  3.1483 +  assumes "\<And>w x. \<lbrakk>openin (subtopology euclidean S) w; x \<in> w\<rbrakk>
  3.1484 +                  \<Longrightarrow> \<exists>u v. openin (subtopology euclidean S) u \<and> P v \<and>
  3.1485 +                        x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w"
  3.1486 +    shows "locally P S"
  3.1487 +using assms by (force simp: locally_def)
  3.1488 +
  3.1489 +lemma locallyE:
  3.1490 +  assumes "locally P S" "openin (subtopology euclidean S) w" "x \<in> w"
  3.1491 +  obtains u v where "openin (subtopology euclidean S) u"
  3.1492 +                    "P v" "x \<in> u" "u \<subseteq> v" "v \<subseteq> w"
  3.1493 +  using assms unfolding locally_def by meson
  3.1494 +
  3.1495 +lemma locally_mono:
  3.1496 +  assumes "locally P S" "\<And>t. P t \<Longrightarrow> Q t"
  3.1497 +    shows "locally Q S"
  3.1498 +by (metis assms locally_def)
  3.1499 +
  3.1500 +lemma locally_open_subset:
  3.1501 +  assumes "locally P S" "openin (subtopology euclidean S) t"
  3.1502 +    shows "locally P t"
  3.1503 +using assms
  3.1504 +apply (simp add: locally_def)
  3.1505 +apply (erule all_forward)+
  3.1506 +apply (rule impI)
  3.1507 +apply (erule impCE)
  3.1508 + using openin_trans apply blast
  3.1509 +apply (erule ex_forward)
  3.1510 +by (metis (no_types, hide_lams) Int_absorb1 Int_lower1 Int_subset_iff openin_open openin_subtopology_Int_subset)
  3.1511 +
  3.1512 +lemma locally_diff_closed:
  3.1513 +    "\<lbrakk>locally P S; closedin (subtopology euclidean S) t\<rbrakk> \<Longrightarrow> locally P (S - t)"
  3.1514 +  using locally_open_subset closedin_def by fastforce
  3.1515 +
  3.1516 +lemma locally_empty [iff]: "locally P {}"
  3.1517 +  by (simp add: locally_def openin_subtopology)
  3.1518 +
  3.1519 +lemma locally_singleton [iff]:
  3.1520 +  fixes a :: "'a::metric_space"
  3.1521 +  shows "locally P {a} \<longleftrightarrow> P {a}"
  3.1522 +apply (simp add: locally_def openin_euclidean_subtopology_iff subset_singleton_iff conj_disj_distribR cong: conj_cong)
  3.1523 +using zero_less_one by blast
  3.1524 +
  3.1525 +lemma locally_iff:
  3.1526 +    "locally P S \<longleftrightarrow>
  3.1527 +     (\<forall>T x. open T \<and> x \<in> S \<inter> T \<longrightarrow> (\<exists>U. open U \<and> (\<exists>v. P v \<and> x \<in> S \<inter> U \<and> S \<inter> U \<subseteq> v \<and> v \<subseteq> S \<inter> T)))"
  3.1528 +apply (simp add: le_inf_iff locally_def openin_open, safe)
  3.1529 +apply (metis IntE IntI le_inf_iff)
  3.1530 +apply (metis IntI Int_subset_iff)
  3.1531 +done
  3.1532 +
  3.1533 +lemma locally_Int:
  3.1534 +  assumes S: "locally P S" and t: "locally P t"
  3.1535 +      and P: "\<And>S t. P S \<and> P t \<Longrightarrow> P(S \<inter> t)"
  3.1536 +    shows "locally P (S \<inter> t)"
  3.1537 +using S t unfolding locally_iff
  3.1538 +apply clarify
  3.1539 +apply (drule_tac x=T in spec)+
  3.1540 +apply (drule_tac x=x in spec)+
  3.1541 +apply clarsimp
  3.1542 +apply (rename_tac U1 U2 V1 V2)
  3.1543 +apply (rule_tac x="U1 \<inter> U2" in exI)
  3.1544 +apply (simp add: open_Int)
  3.1545 +apply (rule_tac x="V1 \<inter> V2" in exI)
  3.1546 +apply (auto intro: P)
  3.1547 +done
  3.1548 +
  3.1549 +lemma locally_Times:
  3.1550 +  fixes S :: "('a::metric_space) set" and T :: "('b::metric_space) set"
  3.1551 +  assumes PS: "locally P S" and QT: "locally Q T" and R: "\<And>S T. P S \<and> Q T \<Longrightarrow> R(S \<times> T)"
  3.1552 +  shows "locally R (S \<times> T)"
  3.1553 +    unfolding locally_def
  3.1554 +proof (clarify)
  3.1555 +  fix W x y
  3.1556 +  assume W: "openin (subtopology euclidean (S \<times> T)) W" and xy: "(x, y) \<in> W"
  3.1557 +  then obtain U V where "openin (subtopology euclidean S) U" "x \<in> U"
  3.1558 +                        "openin (subtopology euclidean T) V" "y \<in> V" "U \<times> V \<subseteq> W"
  3.1559 +    using Times_in_interior_subtopology by metis
  3.1560 +  then obtain U1 U2 V1 V2
  3.1561 +         where opeS: "openin (subtopology euclidean S) U1 \<and> P U2 \<and> x \<in> U1 \<and> U1 \<subseteq> U2 \<and> U2 \<subseteq> U"
  3.1562 +           and opeT: "openin (subtopology euclidean T) V1 \<and> Q V2 \<and> y \<in> V1 \<and> V1 \<subseteq> V2 \<and> V2 \<subseteq> V"
  3.1563 +    by (meson PS QT locallyE)
  3.1564 +  with \<open>U \<times> V \<subseteq> W\<close> show "\<exists>u v. openin (subtopology euclidean (S \<times> T)) u \<and> R v \<and> (x,y) \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> W"
  3.1565 +    apply (rule_tac x="U1 \<times> V1" in exI)
  3.1566 +    apply (rule_tac x="U2 \<times> V2" in exI)
  3.1567 +    apply (auto simp: openin_Times R)
  3.1568 +    done
  3.1569 +qed
  3.1570 +
  3.1571 +
  3.1572 +proposition homeomorphism_locally_imp:
  3.1573 +  fixes S :: "'a::metric_space set" and t :: "'b::t2_space set"
  3.1574 +  assumes S: "locally P S" and hom: "homeomorphism S t f g"
  3.1575 +      and Q: "\<And>S S'. \<lbrakk>P S; homeomorphism S S' f g\<rbrakk> \<Longrightarrow> Q S'"
  3.1576 +    shows "locally Q t"
  3.1577 +proof (clarsimp simp: locally_def)
  3.1578 +  fix W y
  3.1579 +  assume "y \<in> W" and "openin (subtopology euclidean t) W"
  3.1580 +  then obtain T where T: "open T" "W = t \<inter> T"
  3.1581 +    by (force simp: openin_open)
  3.1582 +  then have "W \<subseteq> t" by auto
  3.1583 +  have f: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "f ` S = t" "continuous_on S f"
  3.1584 +   and g: "\<And>y. y \<in> t \<Longrightarrow> f(g y) = y" "g ` t = S" "continuous_on t g"
  3.1585 +    using hom by (auto simp: homeomorphism_def)
  3.1586 +  have gw: "g ` W = S \<inter> f -` W"
  3.1587 +    using \<open>W \<subseteq> t\<close>
  3.1588 +    apply auto
  3.1589 +    using \<open>g ` t = S\<close> \<open>W \<subseteq> t\<close> apply blast
  3.1590 +    using g \<open>W \<subseteq> t\<close> apply auto[1]
  3.1591 +    by (simp add: f rev_image_eqI)
  3.1592 +  have \<circ>: "openin (subtopology euclidean S) (g ` W)"
  3.1593 +  proof -
  3.1594 +    have "continuous_on S f"
  3.1595 +      using f(3) by blast
  3.1596 +    then show "openin (subtopology euclidean S) (g ` W)"
  3.1597 +      by (simp add: gw Collect_conj_eq \<open>openin (subtopology euclidean t) W\<close> continuous_on_open f(2))
  3.1598 +  qed
  3.1599 +  then obtain u v
  3.1600 +    where osu: "openin (subtopology euclidean S) u" and uv: "P v" "g y \<in> u" "u \<subseteq> v" "v \<subseteq> g ` W"
  3.1601 +    using S [unfolded locally_def, rule_format, of "g ` W" "g y"] \<open>y \<in> W\<close> by force
  3.1602 +  have "v \<subseteq> S" using uv by (simp add: gw)
  3.1603 +  have fv: "f ` v = t \<inter> {x. g x \<in> v}"
  3.1604 +    using \<open>f ` S = t\<close> f \<open>v \<subseteq> S\<close> by auto
  3.1605 +  have "f ` v \<subseteq> W"
  3.1606 +    using uv using Int_lower2 gw image_subsetI mem_Collect_eq subset_iff by auto
  3.1607 +  have contvf: "continuous_on v f"
  3.1608 +    using \<open>v \<subseteq> S\<close> continuous_on_subset f(3) by blast
  3.1609 +  have contvg: "continuous_on (f ` v) g"
  3.1610 +    using \<open>f ` v \<subseteq> W\<close> \<open>W \<subseteq> t\<close> continuous_on_subset [OF g(3)] by blast
  3.1611 +  have homv: "homeomorphism v (f ` v) f g"
  3.1612 +    using \<open>v \<subseteq> S\<close> \<open>W \<subseteq> t\<close> f
  3.1613 +    apply (simp add: homeomorphism_def contvf contvg, auto)
  3.1614 +    by (metis f(1) rev_image_eqI rev_subsetD)
  3.1615 +  have 1: "openin (subtopology euclidean t) (t \<inter> g -` u)"
  3.1616 +    apply (rule continuous_on_open [THEN iffD1, rule_format])
  3.1617 +    apply (rule \<open>continuous_on t g\<close>)
  3.1618 +    using \<open>g ` t = S\<close> apply (simp add: osu)
  3.1619 +    done
  3.1620 +  have 2: "\<exists>V. Q V \<and> y \<in> (t \<inter> g -` u) \<and> (t \<inter> g -` u) \<subseteq> V \<and> V \<subseteq> W"
  3.1621 +    apply (rule_tac x="f ` v" in exI)
  3.1622 +    apply (intro conjI Q [OF \<open>P v\<close> homv])
  3.1623 +    using \<open>W \<subseteq> t\<close> \<open>y \<in> W\<close>  \<open>f ` v \<subseteq> W\<close>  uv  apply (auto simp: fv)
  3.1624 +    done
  3.1625 +  show "\<exists>U. openin (subtopology euclidean t) U \<and> (\<exists>v. Q v \<and> y \<in> U \<and> U \<subseteq> v \<and> v \<subseteq> W)"
  3.1626 +    by (meson 1 2)
  3.1627 +qed
  3.1628 +
  3.1629 +lemma homeomorphism_locally:
  3.1630 +  fixes f:: "'a::metric_space \<Rightarrow> 'b::metric_space"
  3.1631 +  assumes hom: "homeomorphism S t f g"
  3.1632 +      and eq: "\<And>S t. homeomorphism S t f g \<Longrightarrow> (P S \<longleftrightarrow> Q t)"
  3.1633 +    shows "locally P S \<longleftrightarrow> locally Q t"
  3.1634 +apply (rule iffI)
  3.1635 +apply (erule homeomorphism_locally_imp [OF _ hom])
  3.1636 +apply (simp add: eq)
  3.1637 +apply (erule homeomorphism_locally_imp)
  3.1638 +using eq homeomorphism_sym homeomorphism_symD [OF hom] apply blast+
  3.1639 +done
  3.1640 +
  3.1641 +lemma homeomorphic_locally:
  3.1642 +  fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
  3.1643 +  assumes hom: "S homeomorphic T"
  3.1644 +          and iff: "\<And>X Y. X homeomorphic Y \<Longrightarrow> (P X \<longleftrightarrow> Q Y)"
  3.1645 +    shows "locally P S \<longleftrightarrow> locally Q T"
  3.1646 +proof -
  3.1647 +  obtain f g where hom: "homeomorphism S T f g"
  3.1648 +    using assms by (force simp: homeomorphic_def)
  3.1649 +  then show ?thesis
  3.1650 +    using homeomorphic_def local.iff
  3.1651 +    by (blast intro!: homeomorphism_locally)
  3.1652 +qed
  3.1653 +
  3.1654 +lemma homeomorphic_local_compactness:
  3.1655 +  fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
  3.1656 +  shows "S homeomorphic T \<Longrightarrow> locally compact S \<longleftrightarrow> locally compact T"
  3.1657 +by (simp add: homeomorphic_compactness homeomorphic_locally)
  3.1658 +
  3.1659 +lemma locally_translation:
  3.1660 +  fixes P :: "'a :: real_normed_vector set \<Rightarrow> bool"
  3.1661 +  shows
  3.1662 +   "(\<And>S. P (image (\<lambda>x. a + x) S) \<longleftrightarrow> P S)
  3.1663 +        \<Longrightarrow> locally P (image (\<lambda>x. a + x) S) \<longleftrightarrow> locally P S"
  3.1664 +apply (rule homeomorphism_locally [OF homeomorphism_translation])
  3.1665 +apply (simp add: homeomorphism_def)
  3.1666 +by metis
  3.1667 +
  3.1668 +lemma locally_injective_linear_image:
  3.1669 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3.1670 +  assumes f: "linear f" "inj f" and iff: "\<And>S. P (f ` S) \<longleftrightarrow> Q S"
  3.1671 +    shows "locally P (f ` S) \<longleftrightarrow> locally Q S"
  3.1672 +apply (rule linear_homeomorphism_image [OF f])
  3.1673 +apply (rule_tac f=g and g = f in homeomorphism_locally, assumption)
  3.1674 +by (metis iff homeomorphism_def)
  3.1675 +
  3.1676 +lemma locally_open_map_image:
  3.1677 +  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
  3.1678 +  assumes P: "locally P S"
  3.1679 +      and f: "continuous_on S f"
  3.1680 +      and oo: "\<And>t. openin (subtopology euclidean S) t
  3.1681 +                   \<Longrightarrow> openin (subtopology euclidean (f ` S)) (f ` t)"
  3.1682 +      and Q: "\<And>t. \<lbrakk>t \<subseteq> S; P t\<rbrakk> \<Longrightarrow> Q(f ` t)"
  3.1683 +    shows "locally Q (f ` S)"
  3.1684 +proof (clarsimp simp add: locally_def)
  3.1685 +  fix W y
  3.1686 +  assume oiw: "openin (subtopology euclidean (f ` S)) W" and "y \<in> W"
  3.1687 +  then have "W \<subseteq> f ` S" by (simp add: openin_euclidean_subtopology_iff)
  3.1688 +  have oivf: "openin (subtopology euclidean S) (S \<inter> f -` W)"
  3.1689 +    by (rule continuous_on_open [THEN iffD1, rule_format, OF f oiw])
  3.1690 +  then obtain x where "x \<in> S" "f x = y"
  3.1691 +    using \<open>W \<subseteq> f ` S\<close> \<open>y \<in> W\<close> by blast
  3.1692 +  then obtain U V
  3.1693 +    where "openin (subtopology euclidean S) U" "P V" "x \<in> U" "U \<subseteq> V" "V \<subseteq> S \<inter> f -` W"
  3.1694 +    using P [unfolded locally_def, rule_format, of "(S \<inter> f -` W)" x] oivf \<open>y \<in> W\<close>
  3.1695 +    by auto
  3.1696 +  then show "\<exists>X. openin (subtopology euclidean (f ` S)) X \<and> (\<exists>Y. Q Y \<and> y \<in> X \<and> X \<subseteq> Y \<and> Y \<subseteq> W)"
  3.1697 +    apply (rule_tac x="f ` U" in exI)
  3.1698 +    apply (rule conjI, blast intro!: oo)
  3.1699 +    apply (rule_tac x="f ` V" in exI)
  3.1700 +    apply (force simp: \<open>f x = y\<close> rev_image_eqI intro: Q)
  3.1701 +    done
  3.1702 +qed
  3.1703 +
  3.1704 +
  3.1705 +subsection\<open>An induction principle for connected sets\<close>
  3.1706 +
  3.1707 +proposition connected_induction:
  3.1708 +  assumes "connected S"
  3.1709 +      and opD: "\<And>T a. \<lbrakk>openin (subtopology euclidean S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
  3.1710 +      and opI: "\<And>a. a \<in> S
  3.1711 +             \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and>
  3.1712 +                     (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<and> Q x \<longrightarrow> Q y)"
  3.1713 +      and etc: "a \<in> S" "b \<in> S" "P a" "P b" "Q a"
  3.1714 +    shows "Q b"
  3.1715 +proof -
  3.1716 +  have 1: "openin (subtopology euclidean S)
  3.1717 +             {b. \<exists>T. openin (subtopology euclidean S) T \<and>
  3.1718 +                     b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> Q x)}"
  3.1719 +    apply (subst openin_subopen, clarify)
  3.1720 +    apply (rule_tac x=T in exI, auto)
  3.1721 +    done
  3.1722 +  have 2: "openin (subtopology euclidean S)
  3.1723 +             {b. \<exists>T. openin (subtopology euclidean S) T \<and>
  3.1724 +                     b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> \<not> Q x)}"
  3.1725 +    apply (subst openin_subopen, clarify)
  3.1726 +    apply (rule_tac x=T in exI, auto)
  3.1727 +    done
  3.1728 +  show ?thesis
  3.1729 +    using \<open>connected S\<close>
  3.1730 +    apply (simp only: connected_openin HOL.not_ex HOL.de_Morgan_conj)
  3.1731 +    apply (elim disjE allE)
  3.1732 +         apply (blast intro: 1)
  3.1733 +        apply (blast intro: 2, simp_all)
  3.1734 +       apply clarify apply (metis opI)
  3.1735 +      using opD apply (blast intro: etc elim: dest:)
  3.1736 +     using opI etc apply meson+
  3.1737 +    done
  3.1738 +qed
  3.1739 +
  3.1740 +lemma connected_equivalence_relation_gen:
  3.1741 +  assumes "connected S"
  3.1742 +      and etc: "a \<in> S" "b \<in> S" "P a" "P b"
  3.1743 +      and trans: "\<And>x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z"
  3.1744 +      and opD: "\<And>T a. \<lbrakk>openin (subtopology euclidean S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
  3.1745 +      and opI: "\<And>a. a \<in> S
  3.1746 +             \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and>
  3.1747 +                     (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<longrightarrow> R x y)"
  3.1748 +    shows "R a b"
  3.1749 +proof -
  3.1750 +  have "\<And>a b c. \<lbrakk>a \<in> S; P a; b \<in> S; c \<in> S; P b; P c; R a b\<rbrakk> \<Longrightarrow> R a c"
  3.1751 +    apply (rule connected_induction [OF \<open>connected S\<close> opD], simp_all)
  3.1752 +    by (meson trans opI)
  3.1753 +  then show ?thesis by (metis etc opI)
  3.1754 +qed
  3.1755 +
  3.1756 +lemma connected_induction_simple:
  3.1757 +  assumes "connected S"
  3.1758 +      and etc: "a \<in> S" "b \<in> S" "P a"
  3.1759 +      and opI: "\<And>a. a \<in> S
  3.1760 +             \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and>
  3.1761 +                     (\<forall>x \<in> T. \<forall>y \<in> T. P x \<longrightarrow> P y)"
  3.1762 +    shows "P b"
  3.1763 +apply (rule connected_induction [OF \<open>connected S\<close> _, where P = "\<lambda>x. True"], blast)
  3.1764 +apply (frule opI)
  3.1765 +using etc apply simp_all
  3.1766 +done
  3.1767 +
  3.1768 +lemma connected_equivalence_relation:
  3.1769 +  assumes "connected S"
  3.1770 +      and etc: "a \<in> S" "b \<in> S"
  3.1771 +      and sym: "\<And>x y. \<lbrakk>R x y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> R y x"
  3.1772 +      and trans: "\<And>x y z. \<lbrakk>R x y; R y z; x \<in> S; y \<in> S; z \<in> S\<rbrakk> \<Longrightarrow> R x z"
  3.1773 +      and opI: "\<And>a. a \<in> S \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. R a x)"
  3.1774 +    shows "R a b"
  3.1775 +proof -
  3.1776 +  have "\<And>a b c. \<lbrakk>a \<in> S; b \<in> S; c \<in> S; R a b\<rbrakk> \<Longrightarrow> R a c"
  3.1777 +    apply (rule connected_induction_simple [OF \<open>connected S\<close>], simp_all)
  3.1778 +    by (meson local.sym local.trans opI openin_imp_subset subsetCE)
  3.1779 +  then show ?thesis by (metis etc opI)
  3.1780 +qed
  3.1781 +
  3.1782 +lemma locally_constant_imp_constant:
  3.1783 +  assumes "connected S"
  3.1784 +      and opI: "\<And>a. a \<in> S
  3.1785 +             \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. f x = f a)"
  3.1786 +    shows "f constant_on S"
  3.1787 +proof -
  3.1788 +  have "\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f x = f y"
  3.1789 +    apply (rule connected_equivalence_relation [OF \<open>connected S\<close>], simp_all)
  3.1790 +    by (metis opI)
  3.1791 +  then show ?thesis
  3.1792 +    by (metis constant_on_def)
  3.1793 +qed
  3.1794 +
  3.1795 +lemma locally_constant:
  3.1796 +     "connected S \<Longrightarrow> locally (\<lambda>U. f constant_on U) S \<longleftrightarrow> f constant_on S"
  3.1797 +apply (simp add: locally_def)
  3.1798 +apply (rule iffI)
  3.1799 + apply (rule locally_constant_imp_constant, assumption)
  3.1800 + apply (metis (mono_tags, hide_lams) constant_on_def constant_on_subset openin_subtopology_self)
  3.1801 +by (meson constant_on_subset openin_imp_subset order_refl)
  3.1802 +
  3.1803 +
  3.1804 +subsection\<open>Basic properties of local compactness\<close>
  3.1805 +
  3.1806 +proposition locally_compact:
  3.1807 +  fixes s :: "'a :: metric_space set"
  3.1808 +  shows
  3.1809 +    "locally compact s \<longleftrightarrow>
  3.1810 +     (\<forall>x \<in> s. \<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
  3.1811 +                    openin (subtopology euclidean s) u \<and> compact v)"
  3.1812 +     (is "?lhs = ?rhs")
  3.1813 +proof
  3.1814 +  assume ?lhs
  3.1815 +  then show ?rhs
  3.1816 +    apply clarify
  3.1817 +    apply (erule_tac w = "s \<inter> ball x 1" in locallyE)
  3.1818 +    by auto
  3.1819 +next
  3.1820 +  assume r [rule_format]: ?rhs
  3.1821 +  have *: "\<exists>u v.
  3.1822 +              openin (subtopology euclidean s) u \<and>
  3.1823 +              compact v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<inter> T"
  3.1824 +          if "open T" "x \<in> s" "x \<in> T" for x T
  3.1825 +  proof -
  3.1826 +    obtain u v where uv: "x \<in> u" "u \<subseteq> v" "v \<subseteq> s" "compact v" "openin (subtopology euclidean s) u"
  3.1827 +      using r [OF \<open>x \<in> s\<close>] by auto
  3.1828 +    obtain e where "e>0" and e: "cball x e \<subseteq> T"
  3.1829 +      using open_contains_cball \<open>open T\<close> \<open>x \<in> T\<close> by blast
  3.1830 +    show ?thesis
  3.1831 +      apply (rule_tac x="(s \<inter> ball x e) \<inter> u" in exI)
  3.1832 +      apply (rule_tac x="cball x e \<inter> v" in exI)
  3.1833 +      using that \<open>e > 0\<close> e uv
  3.1834 +      apply auto
  3.1835 +      done
  3.1836 +  qed
  3.1837 +  show ?lhs
  3.1838 +    apply (rule locallyI)
  3.1839 +    apply (subst (asm) openin_open)
  3.1840 +    apply (blast intro: *)
  3.1841 +    done
  3.1842 +qed
  3.1843 +
  3.1844 +lemma locally_compactE:
  3.1845 +  fixes s :: "'a :: metric_space set"
  3.1846 +  assumes "locally compact s"
  3.1847 +  obtains u v where "\<And>x. x \<in> s \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> s \<and>
  3.1848 +                             openin (subtopology euclidean s) (u x) \<and> compact (v x)"
  3.1849 +using assms
  3.1850 +unfolding locally_compact by metis
  3.1851 +
  3.1852 +lemma locally_compact_alt:
  3.1853 +  fixes s :: "'a :: heine_borel set"
  3.1854 +  shows "locally compact s \<longleftrightarrow>
  3.1855 +         (\<forall>x \<in> s. \<exists>u. x \<in> u \<and>
  3.1856 +                    openin (subtopology euclidean s) u \<and> compact(closure u) \<and> closure u \<subseteq> s)"
  3.1857 +apply (simp add: locally_compact)
  3.1858 +apply (intro ball_cong ex_cong refl iffI)
  3.1859 +apply (metis bounded_subset closure_eq closure_mono compact_eq_bounded_closed dual_order.trans)
  3.1860 +by (meson closure_subset compact_closure)
  3.1861 +
  3.1862 +lemma locally_compact_Int_cball:
  3.1863 +  fixes s :: "'a :: heine_borel set"
  3.1864 +  shows "locally compact s \<longleftrightarrow> (\<forall>x \<in> s. \<exists>e. 0 < e \<and> closed(cball x e \<inter> s))"
  3.1865 +        (is "?lhs = ?rhs")
  3.1866 +proof
  3.1867 +  assume ?lhs
  3.1868 +  then show ?rhs
  3.1869 +    apply (simp add: locally_compact openin_contains_cball)
  3.1870 +    apply (clarify | assumption | drule bspec)+
  3.1871 +    by (metis (no_types, lifting)  compact_cball compact_imp_closed compact_Int inf.absorb_iff2 inf.orderE inf_sup_aci(2))
  3.1872 +next
  3.1873 +  assume ?rhs
  3.1874 +  then show ?lhs
  3.1875 +    apply (simp add: locally_compact openin_contains_cball)
  3.1876 +    apply (clarify | assumption | drule bspec)+
  3.1877 +    apply (rule_tac x="ball x e \<inter> s" in exI, simp)
  3.1878 +    apply (rule_tac x="cball x e \<inter> s" in exI)
  3.1879 +    using compact_eq_bounded_closed
  3.1880 +    apply auto
  3.1881 +    apply (metis open_ball le_infI1 mem_ball open_contains_cball_eq)
  3.1882 +    done
  3.1883 +qed
  3.1884 +
  3.1885 +lemma locally_compact_compact:
  3.1886 +  fixes s :: "'a :: heine_borel set"
  3.1887 +  shows "locally compact s \<longleftrightarrow>
  3.1888 +         (\<forall>k. k \<subseteq> s \<and> compact k
  3.1889 +              \<longrightarrow> (\<exists>u v. k \<subseteq> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
  3.1890 +                         openin (subtopology euclidean s) u \<and> compact v))"
  3.1891 +        (is "?lhs = ?rhs")
  3.1892 +proof
  3.1893 +  assume ?lhs
  3.1894 +  then obtain u v where
  3.1895 +    uv: "\<And>x. x \<in> s \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> s \<and>
  3.1896 +                             openin (subtopology euclidean s) (u x) \<and> compact (v x)"
  3.1897 +    by (metis locally_compactE)
  3.1898 +  have *: "\<exists>u v. k \<subseteq> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and> openin (subtopology euclidean s) u \<and> compact v"
  3.1899 +          if "k \<subseteq> s" "compact k" for k
  3.1900 +  proof -
  3.1901 +    have "\<And>C. (\<forall>c\<in>C. openin (subtopology euclidean k) c) \<and> k \<subseteq> \<Union>C \<Longrightarrow>
  3.1902 +                    \<exists>D\<subseteq>C. finite D \<and> k \<subseteq> \<Union>D"
  3.1903 +      using that by (simp add: compact_eq_openin_cover)
  3.1904 +    moreover have "\<forall>c \<in> (\<lambda>x. k \<inter> u x) ` k. openin (subtopology euclidean k) c"
  3.1905 +      using that by clarify (metis subsetD inf.absorb_iff2 openin_subset openin_subtopology_Int_subset topspace_euclidean_subtopology uv)
  3.1906 +    moreover have "k \<subseteq> \<Union>((\<lambda>x. k \<inter> u x) ` k)"
  3.1907 +      using that by clarsimp (meson subsetCE uv)
  3.1908 +    ultimately obtain D where "D \<subseteq> (\<lambda>x. k \<inter> u x) ` k" "finite D" "k \<subseteq> \<Union>D"
  3.1909 +      by metis
  3.1910 +    then obtain T where T: "T \<subseteq> k" "finite T" "k \<subseteq> \<Union>((\<lambda>x. k \<inter> u x) ` T)"
  3.1911 +      by (metis finite_subset_image)
  3.1912 +    have Tuv: "\<Union>(u ` T) \<subseteq> \<Union>(v ` T)"
  3.1913 +      using T that by (force simp: dest!: uv)
  3.1914 +    show ?thesis
  3.1915 +      apply (rule_tac x="\<Union>(u ` T)" in exI)
  3.1916 +      apply (rule_tac x="\<Union>(v ` T)" in exI)
  3.1917 +      apply (simp add: Tuv)
  3.1918 +      using T that
  3.1919 +      apply (auto simp: dest!: uv)
  3.1920 +      done
  3.1921 +  qed
  3.1922 +  show ?rhs
  3.1923 +    by (blast intro: *)
  3.1924 +next
  3.1925 +  assume ?rhs
  3.1926 +  then show ?lhs
  3.1927 +    apply (clarsimp simp add: locally_compact)
  3.1928 +    apply (drule_tac x="{x}" in spec, simp)
  3.1929 +    done
  3.1930 +qed
  3.1931 +
  3.1932 +lemma open_imp_locally_compact:
  3.1933 +  fixes s :: "'a :: heine_borel set"
  3.1934 +  assumes "open s"
  3.1935 +    shows "locally compact s"
  3.1936 +proof -
  3.1937 +  have *: "\<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and> openin (subtopology euclidean s) u \<and> compact v"
  3.1938 +          if "x \<in> s" for x
  3.1939 +  proof -
  3.1940 +    obtain e where "e>0" and e: "cball x e \<subseteq> s"
  3.1941 +      using open_contains_cball assms \<open>x \<in> s\<close> by blast
  3.1942 +    have ope: "openin (subtopology euclidean s) (ball x e)"
  3.1943 +      by (meson e open_ball ball_subset_cball dual_order.trans open_subset)
  3.1944 +    show ?thesis
  3.1945 +      apply (rule_tac x="ball x e" in exI)
  3.1946 +      apply (rule_tac x="cball x e" in exI)
  3.1947 +      using \<open>e > 0\<close> e apply (auto simp: ope)
  3.1948 +      done
  3.1949 +  qed
  3.1950 +  show ?thesis
  3.1951 +    unfolding locally_compact
  3.1952 +    by (blast intro: *)
  3.1953 +qed
  3.1954 +
  3.1955 +lemma closed_imp_locally_compact:
  3.1956 +  fixes s :: "'a :: heine_borel set"
  3.1957 +  assumes "closed s"
  3.1958 +    shows "locally compact s"
  3.1959 +proof -
  3.1960 +  have *: "\<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
  3.1961 +                 openin (subtopology euclidean s) u \<and> compact v"
  3.1962 +          if "x \<in> s" for x
  3.1963 +  proof -
  3.1964 +    show ?thesis
  3.1965 +      apply (rule_tac x = "s \<inter> ball x 1" in exI)
  3.1966 +      apply (rule_tac x = "s \<inter> cball x 1" in exI)
  3.1967 +      using \<open>x \<in> s\<close> assms apply auto
  3.1968 +      done
  3.1969 +  qed
  3.1970 +  show ?thesis
  3.1971 +    unfolding locally_compact
  3.1972 +    by (blast intro: *)
  3.1973 +qed
  3.1974 +
  3.1975 +lemma locally_compact_UNIV: "locally compact (UNIV :: 'a :: heine_borel set)"
  3.1976 +  by (simp add: closed_imp_locally_compact)
  3.1977 +
  3.1978 +lemma locally_compact_Int:
  3.1979 +  fixes s :: "'a :: t2_space set"
  3.1980 +  shows "\<lbrakk>locally compact s; locally compact t\<rbrakk> \<Longrightarrow> locally compact (s \<inter> t)"
  3.1981 +by (simp add: compact_Int locally_Int)
  3.1982 +
  3.1983 +lemma locally_compact_closedin:
  3.1984 +  fixes s :: "'a :: heine_borel set"
  3.1985 +  shows "\<lbrakk>closedin (subtopology euclidean s) t; locally compact s\<rbrakk>
  3.1986 +        \<Longrightarrow> locally compact t"
  3.1987 +unfolding closedin_closed
  3.1988 +using closed_imp_locally_compact locally_compact_Int by blast
  3.1989 +
  3.1990 +lemma locally_compact_delete:
  3.1991 +     fixes s :: "'a :: t1_space set"
  3.1992 +     shows "locally compact s \<Longrightarrow> locally compact (s - {a})"
  3.1993 +  by (auto simp: openin_delete locally_open_subset)
  3.1994 +
  3.1995 +lemma locally_closed:
  3.1996 +  fixes s :: "'a :: heine_borel set"
  3.1997 +  shows "locally closed s \<longleftrightarrow> locally compact s"
  3.1998 +        (is "?lhs = ?rhs")
  3.1999 +proof
  3.2000 +  assume ?lhs
  3.2001 +  then show ?rhs
  3.2002 +    apply (simp only: locally_def)
  3.2003 +    apply (erule all_forward imp_forward asm_rl exE)+
  3.2004 +    apply (rule_tac x = "u \<inter> ball x 1" in exI)
  3.2005 +    apply (rule_tac x = "v \<inter> cball x 1" in exI)
  3.2006 +    apply (force intro: openin_trans)
  3.2007 +    done
  3.2008 +next
  3.2009 +  assume ?rhs then show ?lhs
  3.2010 +    using compact_eq_bounded_closed locally_mono by blast
  3.2011 +qed
  3.2012 +
  3.2013 +lemma locally_compact_openin_Un:
  3.2014 +  fixes S :: "'a::euclidean_space set"
  3.2015 +  assumes LCS: "locally compact S" and LCT:"locally compact T"
  3.2016 +      and opS: "openin (subtopology euclidean (S \<union> T)) S"
  3.2017 +      and opT: "openin (subtopology euclidean (S \<union> T)) T"
  3.2018 +    shows "locally compact (S \<union> T)"
  3.2019 +proof -
  3.2020 +  have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" for x
  3.2021 +  proof -
  3.2022 +    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
  3.2023 +      using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
  3.2024 +    moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> S"
  3.2025 +      by (meson \<open>x \<in> S\<close> opS openin_contains_cball)
  3.2026 +    then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> S"
  3.2027 +      by force
  3.2028 +    ultimately show ?thesis
  3.2029 +      apply (rule_tac x="min e1 e2" in exI)
  3.2030 +      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int)
  3.2031 +      by (metis closed_Int closed_cball inf_left_commute)
  3.2032 +  qed
  3.2033 +  moreover have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> T" for x
  3.2034 +  proof -
  3.2035 +    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
  3.2036 +      using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
  3.2037 +    moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> T"
  3.2038 +      by (meson \<open>x \<in> T\<close> opT openin_contains_cball)
  3.2039 +    then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> T"
  3.2040 +      by force
  3.2041 +    ultimately show ?thesis
  3.2042 +      apply (rule_tac x="min e1 e2" in exI)
  3.2043 +      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int)
  3.2044 +      by (metis closed_Int closed_cball inf_left_commute)
  3.2045 +  qed
  3.2046 +  ultimately show ?thesis
  3.2047 +    by (force simp: locally_compact_Int_cball)
  3.2048 +qed
  3.2049 +
  3.2050 +lemma locally_compact_closedin_Un:
  3.2051 +  fixes S :: "'a::euclidean_space set"
  3.2052 +  assumes LCS: "locally compact S" and LCT:"locally compact T"
  3.2053 +      and clS: "closedin (subtopology euclidean (S \<union> T)) S"
  3.2054 +      and clT: "closedin (subtopology euclidean (S \<union> T)) T"
  3.2055 +    shows "locally compact (S \<union> T)"
  3.2056 +proof -
  3.2057 +  have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" "x \<in> T" for x
  3.2058 +  proof -
  3.2059 +    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
  3.2060 +      using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
  3.2061 +    moreover
  3.2062 +    obtain e2 where "e2 > 0" and e2: "closed (cball x e2 \<inter> T)"
  3.2063 +      using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
  3.2064 +    ultimately show ?thesis
  3.2065 +      apply (rule_tac x="min e1 e2" in exI)
  3.2066 +      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
  3.2067 +      by (metis closed_Int closed_Un closed_cball inf_left_commute)
  3.2068 +  qed
  3.2069 +  moreover
  3.2070 +  have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<in> S" "x \<notin> T" for x
  3.2071 +  proof -
  3.2072 +    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
  3.2073 +      using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
  3.2074 +    moreover
  3.2075 +    obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S - T"
  3.2076 +      using clT x by (fastforce simp: openin_contains_cball closedin_def)
  3.2077 +    then have "closed (cball x e2 \<inter> T)"
  3.2078 +    proof -
  3.2079 +      have "{} = T - (T - cball x e2)"
  3.2080 +        using Diff_subset Int_Diff \<open>cball x e2 \<inter> (S \<union> T) \<subseteq> S - T\<close> by auto
  3.2081 +      then show ?thesis
  3.2082 +        by (simp add: Diff_Diff_Int inf_commute)
  3.2083 +    qed
  3.2084 +    ultimately show ?thesis
  3.2085 +      apply (rule_tac x="min e1 e2" in exI)
  3.2086 +      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
  3.2087 +      by (metis closed_Int closed_Un closed_cball inf_left_commute)
  3.2088 +  qed
  3.2089 +  moreover
  3.2090 +  have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<notin> S" "x \<in> T" for x
  3.2091 +  proof -
  3.2092 +    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
  3.2093 +      using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
  3.2094 +    moreover
  3.2095 +    obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S \<union> T - S"
  3.2096 +      using clS x by (fastforce simp: openin_contains_cball closedin_def)
  3.2097 +    then have "closed (cball x e2 \<inter> S)"
  3.2098 +      by (metis Diff_disjoint Int_empty_right closed_empty inf.left_commute inf.orderE inf_sup_absorb)
  3.2099 +    ultimately show ?thesis
  3.2100 +      apply (rule_tac x="min e1 e2" in exI)
  3.2101 +      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
  3.2102 +      by (metis closed_Int closed_Un closed_cball inf_left_commute)
  3.2103 +  qed
  3.2104 +  ultimately show ?thesis
  3.2105 +    by (auto simp: locally_compact_Int_cball)
  3.2106 +qed
  3.2107 +
  3.2108 +lemma locally_compact_Times:
  3.2109 +  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  3.2110 +  shows "\<lbrakk>locally compact S; locally compact T\<rbrakk> \<Longrightarrow> locally compact (S \<times> T)"
  3.2111 +  by (auto simp: compact_Times locally_Times)
  3.2112 +
  3.2113 +lemma locally_compact_compact_subopen:
  3.2114 +  fixes S :: "'a :: heine_borel set"
  3.2115 +  shows
  3.2116 +   "locally compact S \<longleftrightarrow>
  3.2117 +    (\<forall>K T. K \<subseteq> S \<and> compact K \<and> open T \<and> K \<subseteq> T
  3.2118 +          \<longrightarrow> (\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
  3.2119 +                     openin (subtopology euclidean S) U \<and> compact V))"
  3.2120 +   (is "?lhs = ?rhs")
  3.2121 +proof
  3.2122 +  assume L: ?lhs
  3.2123 +  show ?rhs
  3.2124 +  proof clarify
  3.2125 +    fix K :: "'a set" and T :: "'a set"
  3.2126 +    assume "K \<subseteq> S" and "compact K" and "open T" and "K \<subseteq> T"
  3.2127 +    obtain U V where "K \<subseteq> U" "U \<subseteq> V" "V \<subseteq> S" "compact V"
  3.2128 +                 and ope: "openin (subtopology euclidean S) U"
  3.2129 +      using L unfolding locally_compact_compact by (meson \<open>K \<subseteq> S\<close> \<open>compact K\<close>)
  3.2130 +    show "\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
  3.2131 +                openin (subtopology euclidean S) U \<and> compact V"
  3.2132 +    proof (intro exI conjI)
  3.2133 +      show "K \<subseteq> U \<inter> T"
  3.2134 +        by (simp add: \<open>K \<subseteq> T\<close> \<open>K \<subseteq> U\<close>)
  3.2135 +      show "U \<inter> T \<subseteq> closure(U \<inter> T)"
  3.2136 +        by (rule closure_subset)
  3.2137 +      show "closure (U \<inter> T) \<subseteq> S"
  3.2138 +        by (metis \<open>U \<subseteq> V\<close> \<open>V \<subseteq> S\<close> \<open>compact V\<close> closure_closed closure_mono compact_imp_closed inf.cobounded1 subset_trans)
  3.2139 +      show "openin (subtopology euclidean S) (U \<inter> T)"
  3.2140 +        by (simp add: \<open>open T\<close> ope openin_Int_open)
  3.2141 +      show "compact (closure (U \<inter> T))"
  3.2142 +        by (meson Int_lower1 \<open>U \<subseteq> V\<close> \<open>compact V\<close> bounded_subset compact_closure compact_eq_bounded_closed)
  3.2143 +    qed auto
  3.2144 +  qed
  3.2145 +next
  3.2146 +  assume ?rhs then show ?lhs
  3.2147 +    unfolding locally_compact_compact
  3.2148 +    by (metis open_openin openin_topspace subtopology_superset top.extremum topspace_euclidean_subtopology)
  3.2149 +qed
  3.2150 +
  3.2151 +
  3.2152 +subsection\<open>Sura-Bura's results about compact components of sets\<close>
  3.2153 +
  3.2154 +proposition Sura_Bura_compact:
  3.2155 +  fixes S :: "'a::euclidean_space set"
  3.2156 +  assumes "compact S" and C: "C \<in> components S"
  3.2157 +  shows "C = \<Inter>{T. C \<subseteq> T \<and> openin (subtopology euclidean S) T \<and>
  3.2158 +                           closedin (subtopology euclidean S) T}"
  3.2159 +         (is "C = \<Inter>?\<T>")
  3.2160 +proof
  3.2161 +  obtain x where x: "C = connected_component_set S x" and "x \<in> S"
  3.2162 +    using C by (auto simp: components_def)
  3.2163 +  have "C \<subseteq> S"
  3.2164 +    by (simp add: C in_components_subset)
  3.2165 +  have "\<Inter>?\<T> \<subseteq> connected_component_set S x"
  3.2166 +  proof (rule connected_component_maximal)
  3.2167 +    have "x \<in> C"
  3.2168 +      by (simp add: \<open>x \<in> S\<close> x)
  3.2169 +    then show "x \<in> \<Inter>?\<T>"
  3.2170 +      by blast
  3.2171 +    have clo: "closed (\<Inter>?\<T>)"
  3.2172 +      by (simp add: \<open>compact S\<close> closed_Inter closedin_compact_eq compact_imp_closed)
  3.2173 +    have False
  3.2174 +      if K1: "closedin (subtopology euclidean (\<Inter>?\<T>)) K1" and
  3.2175 +         K2: "closedin (subtopology euclidean (\<Inter>?\<T>)) K2" and
  3.2176 +         K12_Int: "K1 \<inter> K2 = {}" and K12_Un: "K1 \<union> K2 = \<Inter>?\<T>" and "K1 \<noteq> {}" "K2 \<noteq> {}"
  3.2177 +       for K1 K2
  3.2178 +    proof -
  3.2179 +      have "closed K1" "closed K2"
  3.2180 +        using closedin_closed_trans clo K1 K2 by blast+
  3.2181 +      then obtain V1 V2 where "open V1" "open V2" "K1 \<subseteq> V1" "K2 \<subseteq> V2" and V12: "V1 \<inter> V2 = {}"
  3.2182 +        using separation_normal \<open>K1 \<inter> K2 = {}\<close> by metis
  3.2183 +      have SV12_ne: "(S - (V1 \<union> V2)) \<inter> (\<Inter>?\<T>) \<noteq> {}"
  3.2184 +      proof (rule compact_imp_fip)
  3.2185 +        show "compact (S - (V1 \<union> V2))"
  3.2186 +          by (simp add: \<open>open V1\<close> \<open>open V2\<close> \<open>compact S\<close> compact_diff open_Un)
  3.2187 +        show clo\<T>: "closed T" if "T \<in> ?\<T>" for T
  3.2188 +          using that \<open>compact S\<close>
  3.2189 +          by (force intro: closedin_closed_trans simp add: compact_imp_closed)
  3.2190 +        show "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> \<noteq> {}" if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
  3.2191 +        proof
  3.2192 +          assume djo: "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> = {}"
  3.2193 +          obtain D where opeD: "openin (subtopology euclidean S) D"
  3.2194 +                   and cloD: "closedin (subtopology euclidean S) D"
  3.2195 +                   and "C \<subseteq> D" and DV12: "D \<subseteq> V1 \<union> V2"
  3.2196 +          proof (cases "\<F> = {}")
  3.2197 +            case True
  3.2198 +            with \<open>C \<subseteq> S\<close> djo that show ?thesis
  3.2199 +              by force
  3.2200 +          next
  3.2201 +            case False show ?thesis
  3.2202 +            proof
  3.2203 +              show ope: "openin (subtopology euclidean S) (\<Inter>\<F>)"
  3.2204 +                using openin_Inter \<open>finite \<F>\<close> False \<F> by blast
  3.2205 +              then show "closedin (subtopology euclidean S) (\<Inter>\<F>)"
  3.2206 +                by (meson clo\<T> \<F> closed_Inter closed_subset openin_imp_subset subset_eq)
  3.2207 +              show "C \<subseteq> \<Inter>\<F>"
  3.2208 +                using \<F> by auto
  3.2209 +              show "\<Inter>\<F> \<subseteq> V1 \<union> V2"
  3.2210 +                using ope djo openin_imp_subset by fastforce
  3.2211 +            qed
  3.2212 +          qed
  3.2213 +          have "connected C"
  3.2214 +            by (simp add: x)
  3.2215 +          have "closed D"
  3.2216 +            using \<open>compact S\<close> cloD closedin_closed_trans compact_imp_closed by blast
  3.2217 +          have cloV1: "closedin (subtopology euclidean D) (D \<inter> closure V1)"
  3.2218 +            and cloV2: "closedin (subtopology euclidean D) (D \<inter> closure V2)"
  3.2219 +            by (simp_all add: closedin_closed_Int)
  3.2220 +          moreover have "D \<inter> closure V1 = D \<inter> V1" "D \<inter> closure V2 = D \<inter> V2"
  3.2221 +            apply safe
  3.2222 +            using \<open>D \<subseteq> V1 \<union> V2\<close> \<open>open V1\<close> \<open>open V2\<close> V12
  3.2223 +               apply (simp_all add: closure_subset [THEN subsetD] closure_iff_nhds_not_empty, blast+)
  3.2224 +            done
  3.2225 +          ultimately have cloDV1: "closedin (subtopology euclidean D) (D \<inter> V1)"
  3.2226 +                      and cloDV2:  "closedin (subtopology euclidean D) (D \<inter> V2)"
  3.2227 +            by metis+
  3.2228 +          then obtain U1 U2 where "closed U1" "closed U2"
  3.2229 +               and D1: "D \<inter> V1 = D \<inter> U1" and D2: "D \<inter> V2 = D \<inter> U2"
  3.2230 +            by (auto simp: closedin_closed)
  3.2231 +          have "D \<inter> U1 \<inter> C \<noteq> {}"
  3.2232 +          proof
  3.2233 +            assume "D \<inter> U1 \<inter> C = {}"
  3.2234 +            then have *: "C \<subseteq> D \<inter> V2"
  3.2235 +              using D1 DV12 \<open>C \<subseteq> D\<close> by auto
  3.2236 +            have "\<Inter>?\<T> \<subseteq> D \<inter> V2"
  3.2237 +              apply (rule Inter_lower)
  3.2238 +              using * apply simp
  3.2239 +              by (meson cloDV2 \<open>open V2\<close> cloD closedin_trans le_inf_iff opeD openin_Int_open)
  3.2240 +            then show False
  3.2241 +              using K1 V12 \<open>K1 \<noteq> {}\<close> \<open>K1 \<subseteq> V1\<close> closedin_imp_subset by blast
  3.2242 +          qed
  3.2243 +          moreover have "D \<inter> U2 \<inter> C \<noteq> {}"
  3.2244 +          proof
  3.2245 +            assume "D \<inter> U2 \<inter> C = {}"
  3.2246 +            then have *: "C \<subseteq> D \<inter> V1"
  3.2247 +              using D2 DV12 \<open>C \<subseteq> D\<close> by auto
  3.2248 +            have "\<Inter>?\<T> \<subseteq> D \<inter> V1"
  3.2249 +              apply (rule Inter_lower)
  3.2250 +              using * apply simp
  3.2251 +              by (meson cloDV1 \<open>open V1\<close> cloD closedin_trans le_inf_iff opeD openin_Int_open)
  3.2252 +            then show False
  3.2253 +              using K2 V12 \<open>K2 \<noteq> {}\<close> \<open>K2 \<subseteq> V2\<close> closedin_imp_subset by blast
  3.2254 +          qed
  3.2255 +          ultimately show False
  3.2256 +            using \<open>connected C\<close> unfolding connected_closed
  3.2257 +            apply (simp only: not_ex)
  3.2258 +            apply (drule_tac x="D \<inter> U1" in spec)
  3.2259 +            apply (drule_tac x="D \<inter> U2" in spec)
  3.2260 +            using \<open>C \<subseteq> D\<close> D1 D2 V12 DV12 \<open>closed U1\<close> \<open>closed U2\<close> \<open>closed D\<close>
  3.2261 +            by blast
  3.2262 +        qed
  3.2263 +      qed
  3.2264 +      show False
  3.2265 +        by (metis (full_types) DiffE UnE Un_upper2 SV12_ne \<open>K1 \<subseteq> V1\<close> \<open>K2 \<subseteq> V2\<close> disjoint_iff_not_equal subsetCE sup_ge1 K12_Un)
  3.2266 +    qed
  3.2267 +    then show "connected (\<Inter>?\<T>)"
  3.2268 +      by (auto simp: connected_closedin_eq)
  3.2269 +    show "\<Inter>?\<T> \<subseteq> S"
  3.2270 +      by (fastforce simp: C in_components_subset)
  3.2271 +  qed
  3.2272 +  with x show "\<Inter>?\<T> \<subseteq> C" by simp
  3.2273 +qed auto
  3.2274 +
  3.2275 +
  3.2276 +corollary Sura_Bura_clopen_subset:
  3.2277 +  fixes S :: "'a::euclidean_space set"
  3.2278 +  assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
  3.2279 +      and U: "open U" "C \<subseteq> U"
  3.2280 +  obtains K where "openin (subtopology euclidean S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
  3.2281 +proof (rule ccontr)
  3.2282 +  assume "\<not> thesis"
  3.2283 +  with that have neg: "\<nexists>K. openin (subtopology euclidean S) K \<and> compact K \<and> C \<subseteq> K \<and> K \<subseteq> U"
  3.2284 +    by metis
  3.2285 +  obtain V K where "C \<subseteq> V" "V \<subseteq> U" "V \<subseteq> K" "K \<subseteq> S" "compact K"
  3.2286 +               and opeSV: "openin (subtopology euclidean S) V"
  3.2287 +    using S U \<open>compact C\<close>
  3.2288 +    apply (simp add: locally_compact_compact_subopen)
  3.2289 +    by (meson C in_components_subset)
  3.2290 +  let ?\<T> = "{T. C \<subseteq> T \<and> openin (subtopology euclidean K) T \<and> compact T \<and> T \<subseteq> K}"
  3.2291 +  have CK: "C \<in> components K"
  3.2292 +    by (meson C \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> components_intermediate_subset subset_trans)
  3.2293 +  with \<open>compact K\<close>
  3.2294 +  have "C = \<Inter>{T. C \<subseteq> T \<and> openin (subtopology euclidean K) T \<and> closedin (subtopology euclidean K) T}"
  3.2295 +    by (simp add: Sura_Bura_compact)
  3.2296 +  then have Ceq: "C = \<Inter>?\<T>"
  3.2297 +    by (simp add: closedin_compact_eq \<open>compact K\<close>)
  3.2298 +  obtain W where "open W" and W: "V = S \<inter> W"
  3.2299 +    using opeSV by (auto simp: openin_open)
  3.2300 +  have "-(U \<inter> W) \<inter> \<Inter>?\<T> \<noteq> {}"
  3.2301 +  proof (rule closed_imp_fip_compact)
  3.2302 +    show "- (U \<inter> W) \<inter> \<Inter>\<F> \<noteq> {}"
  3.2303 +      if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
  3.2304 +    proof (cases "\<F> = {}")
  3.2305 +      case True
  3.2306 +      have False if "U = UNIV" "W = UNIV"
  3.2307 +      proof -
  3.2308 +        have "V = S"
  3.2309 +          by (simp add: W \<open>W = UNIV\<close>)
  3.2310 +        with neg show False
  3.2311 +          using \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> \<open>V \<subseteq> U\<close> \<open>compact K\<close> by auto
  3.2312 +      qed
  3.2313 +      with True show ?thesis
  3.2314 +        by auto
  3.2315 +    next
  3.2316 +      case False
  3.2317 +      show ?thesis
  3.2318 +      proof
  3.2319 +        assume "- (U \<inter> W) \<inter> \<Inter>\<F> = {}"
  3.2320 +        then have FUW: "\<Inter>\<F> \<subseteq> U \<inter> W"
  3.2321 +          by blast
  3.2322 +        have "C \<subseteq> \<Inter>\<F>"
  3.2323 +          using \<F> by auto
  3.2324 +        moreover have "compact (\<Inter>\<F>)"
  3.2325 +          by (metis (no_types, lifting) compact_Inter False mem_Collect_eq subsetCE \<F>)
  3.2326 +        moreover have "\<Inter>\<F> \<subseteq> K"
  3.2327 +          using False that(2) by fastforce
  3.2328 +        moreover have opeKF: "openin (subtopology euclidean K) (\<Inter>\<F>)"
  3.2329 +          using False \<F> \<open>finite \<F>\<close> by blast
  3.2330 +        then have opeVF: "openin (subtopology euclidean V) (\<Inter>\<F>)"
  3.2331 +          using W \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> opeKF \<open>\<Inter>\<F> \<subseteq> K\<close> FUW openin_subset_trans by fastforce
  3.2332 +        then have "openin (subtopology euclidean S) (\<Inter>\<F>)"
  3.2333 +          by (metis opeSV openin_trans)
  3.2334 +        moreover have "\<Inter>\<F> \<subseteq> U"
  3.2335 +          by (meson \<open>V \<subseteq> U\<close> opeVF dual_order.trans openin_imp_subset)
  3.2336 +        ultimately show False
  3.2337 +          using neg by blast
  3.2338 +      qed
  3.2339 +    qed
  3.2340 +  qed (use \<open>open W\<close> \<open>open U\<close> in auto)
  3.2341 +  with W Ceq \<open>C \<subseteq> V\<close> \<open>C \<subseteq> U\<close> show False
  3.2342 +    by auto
  3.2343 +qed
  3.2344 +
  3.2345 +
  3.2346 +corollary Sura_Bura_clopen_subset_alt:
  3.2347 +  fixes S :: "'a::euclidean_space set"
  3.2348 +  assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
  3.2349 +      and opeSU: "openin (subtopology euclidean S) U" and "C \<subseteq> U"
  3.2350 +  obtains K where "openin (subtopology euclidean S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
  3.2351 +proof -
  3.2352 +  obtain V where "open V" "U = S \<inter> V"
  3.2353 +    using opeSU by (auto simp: openin_open)
  3.2354 +  with \<open>C \<subseteq> U\<close> have "C \<subseteq> V"
  3.2355 +    by auto
  3.2356 +  then show ?thesis
  3.2357 +    using Sura_Bura_clopen_subset [OF S C \<open>compact C\<close> \<open>open V\<close>]
  3.2358 +    by (metis \<open>U = S \<inter> V\<close> inf.bounded_iff openin_imp_subset that)
  3.2359 +qed
  3.2360 +
  3.2361 +corollary Sura_Bura:
  3.2362 +  fixes S :: "'a::euclidean_space set"
  3.2363 +  assumes "locally compact S" "C \<in> components S" "compact C"
  3.2364 +  shows "C = \<Inter> {K. C \<subseteq> K \<and> compact K \<and> openin (subtopology euclidean S) K}"
  3.2365 +         (is "C = ?rhs")
  3.2366 +proof
  3.2367 +  show "?rhs \<subseteq> C"
  3.2368 +  proof (clarsimp, rule ccontr)
  3.2369 +    fix x
  3.2370 +    assume *: "\<forall>X. C \<subseteq> X \<and> compact X \<and> openin (subtopology euclidean S) X \<longrightarrow> x \<in> X"
  3.2371 +      and "x \<notin> C"
  3.2372 +    obtain U V where "open U" "open V" "{x} \<subseteq> U" "C \<subseteq> V" "U \<inter> V = {}"
  3.2373 +      using separation_normal [of "{x}" C]
  3.2374 +      by (metis Int_empty_left \<open>x \<notin> C\<close> \<open>compact C\<close> closed_empty closed_insert compact_imp_closed insert_disjoint(1))
  3.2375 +    have "x \<notin> V"
  3.2376 +      using \<open>U \<inter> V = {}\<close> \<open>{x} \<subseteq> U\<close> by blast
  3.2377 +    then show False
  3.2378 +      by (meson "*" Sura_Bura_clopen_subset \<open>C \<subseteq> V\<close> \<open>open V\<close> assms(1) assms(2) assms(3) subsetCE)
  3.2379 +  qed
  3.2380 +qed blast
  3.2381 +
  3.2382 +
  3.2383 +subsection\<open>Special cases of local connectedness and path connectedness\<close>
  3.2384 +
  3.2385 +lemma locally_connected_1:
  3.2386 +  assumes
  3.2387 +    "\<And>v x. \<lbrakk>openin (subtopology euclidean S) v; x \<in> v\<rbrakk>
  3.2388 +              \<Longrightarrow> \<exists>u. openin (subtopology euclidean S) u \<and>
  3.2389 +                      connected u \<and> x \<in> u \<and> u \<subseteq> v"
  3.2390 +   shows "locally connected S"
  3.2391 +apply (clarsimp simp add: locally_def)
  3.2392 +apply (drule assms; blast)
  3.2393 +done
  3.2394 +
  3.2395 +lemma locally_connected_2:
  3.2396 +  assumes "locally connected S"
  3.2397 +          "openin (subtopology euclidean S) t"
  3.2398 +          "x \<in> t"
  3.2399 +   shows "openin (subtopology euclidean S) (connected_component_set t x)"
  3.2400 +proof -
  3.2401 +  { fix y :: 'a
  3.2402 +    let ?SS = "subtopology euclidean S"
  3.2403 +    assume 1: "openin ?SS t"
  3.2404 +              "\<forall>w x. openin ?SS w \<and> x \<in> w \<longrightarrow> (\<exists>u. openin ?SS u \<and> (\<exists>v. connected v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w))"
  3.2405 +    and "connected_component t x y"
  3.2406 +    then have "y \<in> t" and y: "y \<in> connected_component_set t x"
  3.2407 +      using connected_component_subset by blast+
  3.2408 +    obtain F where
  3.2409 +      "\<forall>x y. (\<exists>w. openin ?SS w \<and> (\<exists>u. connected u \<and> x \<in> w \<and> w \<subseteq> u \<and> u \<subseteq> y)) = (openin ?SS (F x y) \<and> (\<exists>u. connected u \<and> x \<in> F x y \<and> F x y \<subseteq> u \<and> u \<subseteq> y))"
  3.2410 +      by moura
  3.2411 +    then obtain G where
  3.2412 +       "\<forall>a A. (\<exists>U. openin ?SS U \<and> (\<exists>V. connected V \<and> a \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> A)) = (openin ?SS (F a A) \<and> connected (G a A) \<and> a \<in> F a A \<and> F a A \<subseteq> G a A \<and> G a A \<subseteq> A)"
  3.2413 +      by moura
  3.2414 +    then have *: "openin ?SS (F y t) \<and> connected (G y t) \<and> y \<in> F y t \<and> F y t \<subseteq> G y t \<and> G y t \<subseteq> t"
  3.2415 +      using 1 \<open>y \<in> t\<close> by presburger
  3.2416 +    have "G y t \<subseteq> connected_component_set t y"
  3.2417 +      by (metis (no_types) * connected_component_eq_self connected_component_mono contra_subsetD)
  3.2418 +    then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> connected_component_set t x"
  3.2419 +      by (metis (no_types) * connected_component_eq dual_order.trans y)
  3.2420 +  }
  3.2421 +  then show ?thesis
  3.2422 +    using assms openin_subopen by (force simp: locally_def)
  3.2423 +qed
  3.2424 +
  3.2425 +lemma locally_connected_3:
  3.2426 +  assumes "\<And>t x. \<lbrakk>openin (subtopology euclidean S) t; x \<in> t\<rbrakk>
  3.2427 +              \<Longrightarrow> openin (subtopology euclidean S)
  3.2428 +                          (connected_component_set t x)"
  3.2429 +          "openin (subtopology euclidean S) v" "x \<in> v"
  3.2430 +   shows  "\<exists>u. openin (subtopology euclidean S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v"
  3.2431 +using assms connected_component_subset by fastforce
  3.2432 +
  3.2433 +lemma locally_connected:
  3.2434 +  "locally connected S \<longleftrightarrow>
  3.2435 +   (\<forall>v x. openin (subtopology euclidean S) v \<and> x \<in> v
  3.2436 +          \<longrightarrow> (\<exists>u. openin (subtopology euclidean S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v))"
  3.2437 +by (metis locally_connected_1 locally_connected_2 locally_connected_3)
  3.2438 +
  3.2439 +lemma locally_connected_open_connected_component:
  3.2440 +  "locally connected S \<longleftrightarrow>
  3.2441 +   (\<forall>t x. openin (subtopology euclidean S) t \<and> x \<in> t
  3.2442 +          \<longrightarrow> openin (subtopology euclidean S) (connected_component_set t x))"
  3.2443 +by (metis locally_connected_1 locally_connected_2 locally_connected_3)
  3.2444 +
  3.2445 +lemma locally_path_connected_1:
  3.2446 +  assumes
  3.2447 +    "\<And>v x. \<lbrakk>openin (subtopology euclidean S) v; x \<in> v\<rbrakk>
  3.2448 +              \<Longrightarrow> \<exists>u. openin (subtopology euclidean S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
  3.2449 +   shows "locally path_connected S"
  3.2450 +apply (clarsimp simp add: locally_def)
  3.2451 +apply (drule assms; blast)
  3.2452 +done
  3.2453 +
  3.2454 +lemma locally_path_connected_2:
  3.2455 +  assumes "locally path_connected S"
  3.2456 +          "openin (subtopology euclidean S) t"
  3.2457 +          "x \<in> t"
  3.2458 +   shows "openin (subtopology euclidean S) (path_component_set t x)"
  3.2459 +proof -
  3.2460 +  { fix y :: 'a
  3.2461 +    let ?SS = "subtopology euclidean S"
  3.2462 +    assume 1: "openin ?SS t"
  3.2463 +              "\<forall>w x. openin ?SS w \<and> x \<in> w \<longrightarrow> (\<exists>u. openin ?SS u \<and> (\<exists>v. path_connected v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w))"
  3.2464 +    and "path_component t x y"
  3.2465 +    then have "y \<in> t" and y: "y \<in> path_component_set t x"
  3.2466 +      using path_component_mem(2) by blast+
  3.2467 +    obtain F where
  3.2468 +      "\<forall>x y. (\<exists>w. openin ?SS w \<and> (\<exists>u. path_connected u \<and> x \<in> w \<and> w \<subseteq> u \<and> u \<subseteq> y)) = (openin ?SS (F x y) \<and> (\<exists>u. path_connected u \<and> x \<in> F x y \<and> F x y \<subseteq> u \<and> u \<subseteq> y))"
  3.2469 +      by moura
  3.2470 +    then obtain G where
  3.2471 +       "\<forall>a A. (\<exists>U. openin ?SS U \<and> (\<exists>V. path_connected V \<and> a \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> A)) = (openin ?SS (F a A) \<and> path_connected (G a A) \<and> a \<in> F a A \<and> F a A \<subseteq> G a A \<and> G a A \<subseteq> A)"
  3.2472 +      by moura
  3.2473 +    then have *: "openin ?SS (F y t) \<and> path_connected (G y t) \<and> y \<in> F y t \<and> F y t \<subseteq> G y t \<and> G y t \<subseteq> t"
  3.2474 +      using 1 \<open>y \<in> t\<close> by presburger
  3.2475 +    have "G y t \<subseteq> path_component_set t y"
  3.2476 +      using * path_component_maximal set_rev_mp by blast
  3.2477 +    then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> path_component_set t x"
  3.2478 +      by (metis "*" \<open>G y t \<subseteq> path_component_set t y\<close> dual_order.trans path_component_eq y)
  3.2479 +  }
  3.2480 +  then show ?thesis
  3.2481 +    using assms openin_subopen by (force simp: locally_def)
  3.2482 +qed
  3.2483 +
  3.2484 +lemma locally_path_connected_3:
  3.2485 +  assumes "\<And>t x. \<lbrakk>openin (subtopology euclidean S) t; x \<in> t\<rbrakk>
  3.2486 +              \<Longrightarrow> openin (subtopology euclidean S) (path_component_set t x)"
  3.2487 +          "openin (subtopology euclidean S) v" "x \<in> v"
  3.2488 +   shows  "\<exists>u. openin (subtopology euclidean S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
  3.2489 +proof -
  3.2490 +  have "path_component v x x"
  3.2491 +    by (meson assms(3) path_component_refl)
  3.2492 +  then show ?thesis
  3.2493 +    by (metis assms(1) assms(2) assms(3) mem_Collect_eq path_component_subset path_connected_path_component)
  3.2494 +qed
  3.2495 +
  3.2496 +proposition locally_path_connected:
  3.2497 +  "locally path_connected S \<longleftrightarrow>
  3.2498 +   (\<forall>v x. openin (subtopology euclidean S) v \<and> x \<in> v
  3.2499 +          \<longrightarrow> (\<exists>u. openin (subtopology euclidean S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v))"
  3.2500 +  by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
  3.2501 +
  3.2502 +proposition locally_path_connected_open_path_component:
  3.2503 +  "locally path_connected S \<longleftrightarrow>
  3.2504 +   (\<forall>t x. openin (subtopology euclidean S) t \<and> x \<in> t
  3.2505 +          \<longrightarrow> openin (subtopology euclidean S) (path_component_set t x))"
  3.2506 +  by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
  3.2507 +
  3.2508 +lemma locally_connected_open_component:
  3.2509 +  "locally connected S \<longleftrightarrow>
  3.2510 +   (\<forall>t c. openin (subtopology euclidean S) t \<and> c \<in> components t
  3.2511 +          \<longrightarrow> openin (subtopology euclidean S) c)"
  3.2512 +by (metis components_iff locally_connected_open_connected_component)
  3.2513 +
  3.2514 +proposition locally_connected_im_kleinen:
  3.2515 +  "locally connected S \<longleftrightarrow>
  3.2516 +   (\<forall>v x. openin (subtopology euclidean S) v \<and> x \<in> v
  3.2517 +       \<longrightarrow> (\<exists>u. openin (subtopology euclidean S) u \<and>
  3.2518 +                x \<in> u \<and> u \<subseteq> v \<and>
  3.2519 +                (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> v \<and> x \<in> c \<and> y \<in> c))))"
  3.2520 +   (is "?lhs = ?rhs")
  3.2521 +proof
  3.2522 +  assume ?lhs
  3.2523 +  then show ?rhs
  3.2524 +    by (fastforce simp add: locally_connected)
  3.2525 +next
  3.2526 +  assume ?rhs
  3.2527 +  have *: "\<exists>T. openin (subtopology euclidean S) T \<and> x \<in> T \<and> T \<subseteq> c"
  3.2528 +       if "openin (subtopology euclidean S) t" and c: "c \<in> components t" and "x \<in> c" for t c x
  3.2529 +  proof -
  3.2530 +    from that \<open>?rhs\<close> [rule_format, of t x]
  3.2531 +    obtain u where u:
  3.2532 +      "openin (subtopology euclidean S) u \<and> x \<in> u \<and> u \<subseteq> t \<and>
  3.2533 +       (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> t \<and> x \<in> c \<and> y \<in> c))"
  3.2534 +      using in_components_subset by auto
  3.2535 +    obtain F :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
  3.2536 +      "\<forall>x y. (\<exists>z. z \<in> x \<and> y = connected_component_set x z) = (F x y \<in> x \<and> y = connected_component_set x (F x y))"
  3.2537 +      by moura
  3.2538 +    then have F: "F t c \<in> t \<and> c = connected_component_set t (F t c)"
  3.2539 +      by (meson components_iff c)
  3.2540 +    obtain G :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
  3.2541 +        G: "\<forall>x y. (\<exists>z. z \<in> y \<and> z \<notin> x) = (G x y \<in> y \<and> G x y \<notin> x)"
  3.2542 +      by moura
  3.2543 +     have "G c u \<notin> u \<or> G c u \<in> c"
  3.2544 +      using F by (metis (full_types) u connected_componentI connected_component_eq mem_Collect_eq that(3))
  3.2545 +    then show ?thesis
  3.2546 +      using G u by auto
  3.2547 +  qed
  3.2548 +  show ?lhs
  3.2549 +    apply (clarsimp simp add: locally_connected_open_component)
  3.2550 +    apply (subst openin_subopen)
  3.2551 +    apply (blast intro: *)
  3.2552 +    done
  3.2553 +qed
  3.2554 +
  3.2555 +proposition locally_path_connected_im_kleinen:
  3.2556 +  "locally path_connected S \<longleftrightarrow>
  3.2557 +   (\<forall>v x. openin (subtopology euclidean S) v \<and> x \<in> v
  3.2558 +       \<longrightarrow> (\<exists>u. openin (subtopology euclidean S) u \<and>
  3.2559 +                x \<in> u \<and> u \<subseteq> v \<and>
  3.2560 +                (\<forall>y. y \<in> u \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> v \<and>
  3.2561 +                                pathstart p = x \<and> pathfinish p = y))))"
  3.2562 +   (is "?lhs = ?rhs")
  3.2563 +proof
  3.2564 +  assume ?lhs
  3.2565 +  then show ?rhs
  3.2566 +    apply (simp add: locally_path_connected path_connected_def)
  3.2567 +    apply (erule all_forward ex_forward imp_forward conjE | simp)+
  3.2568 +    by (meson dual_order.trans)
  3.2569 +next
  3.2570 +  assume ?rhs
  3.2571 +  have *: "\<exists>T. openin (subtopology euclidean S) T \<and>
  3.2572 +               x \<in> T \<and> T \<subseteq> path_component_set u z"
  3.2573 +       if "openin (subtopology euclidean S) u" and "z \<in> u" and c: "path_component u z x" for u z x
  3.2574 +  proof -
  3.2575 +    have "x \<in> u"
  3.2576 +      by (meson c path_component_mem(2))
  3.2577 +    with that \<open>?rhs\<close> [rule_format, of u x]
  3.2578 +    obtain U where U:
  3.2579 +      "openin (subtopology euclidean S) U \<and> x \<in> U \<and> U \<subseteq> u \<and>
  3.2580 +       (\<forall>y. y \<in> U \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> u \<and> pathstart p = x \<and> pathfinish p = y))"
  3.2581 +       by blast
  3.2582 +    show ?thesis
  3.2583 +      apply (rule_tac x=U in exI)
  3.2584 +      apply (auto simp: U)
  3.2585 +      apply (metis U c path_component_trans path_component_def)
  3.2586 +      done
  3.2587 +  qed
  3.2588 +  show ?lhs
  3.2589 +    apply (clarsimp simp add: locally_path_connected_open_path_component)
  3.2590 +    apply (subst openin_subopen)
  3.2591 +    apply (blast intro: *)
  3.2592 +    done
  3.2593 +qed
  3.2594 +
  3.2595 +lemma locally_path_connected_imp_locally_connected:
  3.2596 +  "locally path_connected S \<Longrightarrow> locally connected S"
  3.2597 +using locally_mono path_connected_imp_connected by blast
  3.2598 +
  3.2599 +lemma locally_connected_components:
  3.2600 +  "\<lbrakk>locally connected S; c \<in> components S\<rbrakk> \<Longrightarrow> locally connected c"
  3.2601 +by (meson locally_connected_open_component locally_open_subset openin_subtopology_self)
  3.2602 +
  3.2603 +lemma locally_path_connected_components:
  3.2604 +  "\<lbrakk>locally path_connected S; c \<in> components S\<rbrakk> \<Longrightarrow> locally path_connected c"
  3.2605 +by (meson locally_connected_open_component locally_open_subset locally_path_connected_imp_locally_connected openin_subtopology_self)
  3.2606 +
  3.2607 +lemma locally_path_connected_connected_component:
  3.2608 +  "locally path_connected S \<Longrightarrow> locally path_connected (connected_component_set S x)"
  3.2609 +by (metis components_iff connected_component_eq_empty locally_empty locally_path_connected_components)
  3.2610 +
  3.2611 +lemma open_imp_locally_path_connected:
  3.2612 +  fixes S :: "'a :: real_normed_vector set"
  3.2613 +  shows "open S \<Longrightarrow> locally path_connected S"
  3.2614 +apply (rule locally_mono [of convex])
  3.2615 +apply (simp_all add: locally_def openin_open_eq convex_imp_path_connected)
  3.2616 +apply (meson open_ball centre_in_ball convex_ball openE order_trans)
  3.2617 +done
  3.2618 +
  3.2619 +lemma open_imp_locally_connected:
  3.2620 +  fixes S :: "'a :: real_normed_vector set"
  3.2621 +  shows "open S \<Longrightarrow> locally connected S"
  3.2622 +by (simp add: locally_path_connected_imp_locally_connected open_imp_locally_path_connected)
  3.2623 +
  3.2624 +lemma locally_path_connected_UNIV: "locally path_connected (UNIV::'a :: real_normed_vector set)"
  3.2625 +  by (simp add: open_imp_locally_path_connected)
  3.2626 +
  3.2627 +lemma locally_connected_UNIV: "locally connected (UNIV::'a :: real_normed_vector set)"
  3.2628 +  by (simp add: open_imp_locally_connected)
  3.2629 +
  3.2630 +lemma openin_connected_component_locally_connected:
  3.2631 +    "locally connected S
  3.2632 +     \<Longrightarrow> openin (subtopology euclidean S) (connected_component_set S x)"
  3.2633 +apply (simp add: locally_connected_open_connected_component)
  3.2634 +by (metis connected_component_eq_empty connected_component_subset open_empty open_subset openin_subtopology_self)
  3.2635 +
  3.2636 +lemma openin_components_locally_connected:
  3.2637 +    "\<lbrakk>locally connected S; c \<in> components S\<rbrakk> \<Longrightarrow> openin (subtopology euclidean S) c"
  3.2638 +  using locally_connected_open_component openin_subtopology_self by blast
  3.2639 +
  3.2640 +lemma openin_path_component_locally_path_connected:
  3.2641 +  "locally path_connected S
  3.2642 +        \<Longrightarrow> openin (subtopology euclidean S) (path_component_set S x)"
  3.2643 +by (metis (no_types) empty_iff locally_path_connected_2 openin_subopen openin_subtopology_self path_component_eq_empty)
  3.2644 +
  3.2645 +lemma closedin_path_component_locally_path_connected:
  3.2646 +    "locally path_connected S
  3.2647 +        \<Longrightarrow> closedin (subtopology euclidean S) (path_component_set S x)"
  3.2648 +apply  (simp add: closedin_def path_component_subset complement_path_component_Union)
  3.2649 +apply (rule openin_Union)
  3.2650 +using openin_path_component_locally_path_connected by auto
  3.2651 +
  3.2652 +lemma convex_imp_locally_path_connected:
  3.2653 +  fixes S :: "'a:: real_normed_vector set"
  3.2654 +  shows "convex S \<Longrightarrow> locally path_connected S"
  3.2655 +apply (clarsimp simp add: locally_path_connected)
  3.2656 +apply (subst (asm) openin_open)
  3.2657 +apply clarify
  3.2658 +apply (erule (1) openE)
  3.2659 +apply (rule_tac x = "S \<inter> ball x e" in exI)
  3.2660 +apply (force simp: convex_Int convex_imp_path_connected)
  3.2661 +done
  3.2662 +
  3.2663 +lemma convex_imp_locally_connected:
  3.2664 +  fixes S :: "'a:: real_normed_vector set"
  3.2665 +  shows "convex S \<Longrightarrow> locally connected S"
  3.2666 +  by (simp add: locally_path_connected_imp_locally_connected convex_imp_locally_path_connected)
  3.2667 +
  3.2668 +
  3.2669 +subsection\<open>Relations between components and path components\<close>
  3.2670 +
  3.2671 +lemma path_component_eq_connected_component:
  3.2672 +  assumes "locally path_connected S"
  3.2673 +    shows "(path_component S x = connected_component S x)"
  3.2674 +proof (cases "x \<in> S")
  3.2675 +  case True
  3.2676 +  have "openin (subtopology euclidean (connected_component_set S x)) (path_component_set S x)"
  3.2677 +    apply (rule openin_subset_trans [of S])
  3.2678 +    apply (intro conjI openin_path_component_locally_path_connected [OF assms])
  3.2679 +    using path_component_subset_connected_component   apply (auto simp: connected_component_subset)
  3.2680 +    done
  3.2681 +  moreover have "closedin (subtopology euclidean (connected_component_set S x)) (path_component_set S x)"
  3.2682 +    apply (rule closedin_subset_trans [of S])
  3.2683 +    apply (intro conjI closedin_path_component_locally_path_connected [OF assms])
  3.2684 +    using path_component_subset_connected_component   apply (auto simp: connected_component_subset)
  3.2685 +    done
  3.2686 +  ultimately have *: "path_component_set S x = connected_component_set S x"
  3.2687 +    by (metis connected_connected_component connected_clopen True path_component_eq_empty)
  3.2688 +  then show ?thesis
  3.2689 +    by blast
  3.2690 +next
  3.2691 +  case False then show ?thesis
  3.2692 +    by (metis Collect_empty_eq_bot connected_component_eq_empty path_component_eq_empty)
  3.2693 +qed
  3.2694 +
  3.2695 +lemma path_component_eq_connected_component_set:
  3.2696 +     "locally path_connected S \<Longrightarrow> (path_component_set S x = connected_component_set S x)"
  3.2697 +by (simp add: path_component_eq_connected_component)
  3.2698 +
  3.2699 +lemma locally_path_connected_path_component:
  3.2700 +     "locally path_connected S \<Longrightarrow> locally path_connected (path_component_set S x)"
  3.2701 +using locally_path_connected_connected_component path_component_eq_connected_component by fastforce
  3.2702 +
  3.2703 +lemma open_path_connected_component:
  3.2704 +  fixes S :: "'a :: real_normed_vector set"
  3.2705 +  shows "open S \<Longrightarrow> path_component S x = connected_component S x"
  3.2706 +by (simp add: path_component_eq_connected_component open_imp_locally_path_connected)
  3.2707 +
  3.2708 +lemma open_path_connected_component_set:
  3.2709 +  fixes S :: "'a :: real_normed_vector set"
  3.2710 +  shows "open S \<Longrightarrow> path_component_set S x = connected_component_set S x"
  3.2711 +by (simp add: open_path_connected_component)
  3.2712 +
  3.2713 +proposition locally_connected_quotient_image:
  3.2714 +  assumes lcS: "locally connected S"
  3.2715 +      and oo: "\<And>T. T \<subseteq> f ` S
  3.2716 +                \<Longrightarrow> openin (subtopology euclidean S) (S \<inter> f -` T) \<longleftrightarrow>
  3.2717 +                    openin (subtopology euclidean (f ` S)) T"
  3.2718 +    shows "locally connected (f ` S)"
  3.2719 +proof (clarsimp simp: locally_connected_open_component)
  3.2720 +  fix U C
  3.2721 +  assume opefSU: "openin (subtopology euclidean (f ` S)) U" and "C \<in> components U"
  3.2722 +  then have "C \<subseteq> U" "U \<subseteq> f ` S"
  3.2723 +    by (meson in_components_subset openin_imp_subset)+
  3.2724 +  then have "openin (subtopology euclidean (f ` S)) C \<longleftrightarrow>
  3.2725 +             openin (subtopology euclidean S) (S \<inter> f -` C)"
  3.2726 +    by (auto simp: oo)
  3.2727 +  moreover have "openin (subtopology euclidean S) (S \<inter> f -` C)"
  3.2728 +  proof (subst openin_subopen, clarify)
  3.2729 +    fix x
  3.2730 +    assume "x \<in> S" "f x \<in> C"
  3.2731 +    show "\<exists>T. openin (subtopology euclidean S) T \<and> x \<in> T \<and> T \<subseteq> (S \<inter> f -` C)"
  3.2732 +    proof (intro conjI exI)
  3.2733 +      show "openin (subtopology euclidean S) (connected_component_set (S \<inter> f -` U) x)"
  3.2734 +      proof (rule ccontr)
  3.2735 +        assume **: "\<not> openin (subtopology euclidean S) (connected_component_set (S \<inter> f -` U) x)"
  3.2736 +        then have "x \<notin> (S \<inter> f -` U)"
  3.2737 +          using \<open>U \<subseteq> f ` S\<close> opefSU lcS locally_connected_2 oo by blast
  3.2738 +        with ** show False
  3.2739 +          by (metis (no_types) connected_component_eq_empty empty_iff openin_subopen)
  3.2740 +      qed
  3.2741 +    next
  3.2742 +      show "x \<in> connected_component_set (S \<inter> f -` U) x"
  3.2743 +        using \<open>C \<subseteq> U\<close> \<open>f x \<in> C\<close> \<open>x \<in> S\<close> by auto
  3.2744 +    next
  3.2745 +      have contf: "continuous_on S f"
  3.2746 +        by (simp add: continuous_on_open oo openin_imp_subset)
  3.2747 +      then have "continuous_on (connected_component_set (S \<inter> f -` U) x) f"
  3.2748 +        apply (rule continuous_on_subset)
  3.2749 +        using connected_component_subset apply blast
  3.2750 +        done
  3.2751 +      then have "connected (f ` connected_component_set (S \<inter> f -` U) x)"
  3.2752 +        by (rule connected_continuous_image [OF _ connected_connected_component])
  3.2753 +      moreover have "f ` connected_component_set (S \<inter> f -` U) x \<subseteq> U"
  3.2754 +        using connected_component_in by blast
  3.2755 +      moreover have "C \<inter> f ` connected_component_set (S \<inter> f -` U) x \<noteq> {}"
  3.2756 +        using \<open>C \<subseteq> U\<close> \<open>f x \<in> C\<close> \<open>x \<in> S\<close> by fastforce
  3.2757 +      ultimately have fC: "f ` (connected_component_set (S \<inter> f -` U) x) \<subseteq> C"
  3.2758 +        by (rule components_maximal [OF \<open>C \<in> components U\<close>])
  3.2759 +      have cUC: "connected_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` C)"
  3.2760 +        using connected_component_subset fC by blast
  3.2761 +      have "connected_component_set (S \<inter> f -` U) x \<subseteq> connected_component_set (S \<inter> f -` C) x"
  3.2762 +      proof -
  3.2763 +        { assume "x \<in> connected_component_set (S \<inter> f -` U) x"
  3.2764 +          then have ?thesis
  3.2765 +            using cUC connected_component_idemp connected_component_mono by blast }
  3.2766 +        then show ?thesis
  3.2767 +          using connected_component_eq_empty by auto
  3.2768 +      qed
  3.2769 +      also have "\<dots> \<subseteq> (S \<inter> f -` C)"
  3.2770 +        by (rule connected_component_subset)
  3.2771 +      finally show "connected_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` C)" .
  3.2772 +    qed
  3.2773 +  qed
  3.2774 +  ultimately show "openin (subtopology euclidean (f ` S)) C"
  3.2775 +    by metis
  3.2776 +qed
  3.2777 +
  3.2778 +text\<open>The proof resembles that above but is not identical!\<close>
  3.2779 +proposition locally_path_connected_quotient_image:
  3.2780 +  assumes lcS: "locally path_connected S"
  3.2781 +      and oo: "\<And>T. T \<subseteq> f ` S
  3.2782 +                \<Longrightarrow> openin (subtopology euclidean S) (S \<inter> f -` T) \<longleftrightarrow> openin (subtopology euclidean (f ` S)) T"
  3.2783 +    shows "locally path_connected (f ` S)"
  3.2784 +proof (clarsimp simp: locally_path_connected_open_path_component)
  3.2785 +  fix U y
  3.2786 +  assume opefSU: "openin (subtopology euclidean (f ` S)) U" and "y \<in> U"
  3.2787 +  then have "path_component_set U y \<subseteq> U" "U \<subseteq> f ` S"
  3.2788 +    by (meson path_component_subset openin_imp_subset)+
  3.2789 +  then have "openin (subtopology euclidean (f ` S)) (path_component_set U y) \<longleftrightarrow>
  3.2790 +             openin (subtopology euclidean S) (S \<inter> f -` path_component_set U y)"
  3.2791 +  proof -
  3.2792 +    have "path_component_set U y \<subseteq> f ` S"
  3.2793 +      using \<open>U \<subseteq> f ` S\<close> \<open>path_component_set U y \<subseteq> U\<close> by blast
  3.2794 +    then show ?thesis
  3.2795 +      using oo by blast
  3.2796 +  qed
  3.2797 +  moreover have "openin (subtopology euclidean S) (S \<inter> f -` path_component_set U y)"
  3.2798 +  proof (subst openin_subopen, clarify)
  3.2799 +    fix x
  3.2800 +    assume "x \<in> S" and Uyfx: "path_component U y (f x)"
  3.2801 +    then have "f x \<in> U"
  3.2802 +      using path_component_mem by blast
  3.2803 +    show "\<exists>T. openin (subtopology euclidean S) T \<and> x \<in> T \<and> T \<subseteq> (S \<inter> f -` path_component_set U y)"
  3.2804 +    proof (intro conjI exI)
  3.2805 +      show "openin (subtopology euclidean S) (path_component_set (S \<inter> f -` U) x)"
  3.2806 +      proof (rule ccontr)
  3.2807 +        assume **: "\<not> openin (subtopology euclidean S) (path_component_set (S \<inter> f -` U) x)"
  3.2808 +        then have "x \<notin> (S \<inter> f -` U)"
  3.2809 +          by (metis (no_types, lifting) \<open>U \<subseteq> f ` S\<close> opefSU lcS oo locally_path_connected_open_path_component)
  3.2810 +        then show False
  3.2811 +          using ** \<open>path_component_set U y \<subseteq> U\<close>  \<open>x \<in> S\<close> \<open>path_component U y (f x)\<close> by blast
  3.2812 +      qed
  3.2813 +    next
  3.2814 +      show "x \<in> path_component_set (S \<inter> f -` U) x"
  3.2815 +        by (simp add: \<open>f x \<in> U\<close> \<open>x \<in> S\<close> path_component_refl)
  3.2816 +    next
  3.2817 +      have contf: "continuous_on S f"
  3.2818 +        by (simp add: continuous_on_open oo openin_imp_subset)
  3.2819 +      then have "continuous_on (path_component_set (S \<inter> f -` U) x) f"
  3.2820 +        apply (rule continuous_on_subset)
  3.2821 +        using path_component_subset apply blast
  3.2822 +        done
  3.2823 +      then have "path_connected (f ` path_component_set (S \<inter> f -` U) x)"
  3.2824 +        by (simp add: path_connected_continuous_image)
  3.2825 +      moreover have "f ` path_component_set (S \<inter> f -` U) x \<subseteq> U"
  3.2826 +        using path_component_mem by fastforce
  3.2827 +      moreover have "f x \<in> f ` path_component_set (S \<inter> f -` U) x"
  3.2828 +        by (force simp: \<open>x \<in> S\<close> \<open>f x \<in> U\<close> path_component_refl_eq)
  3.2829 +      ultimately have "f ` (path_component_set (S \<inter> f -` U) x) \<subseteq> path_component_set U (f x)"
  3.2830 +        by (meson path_component_maximal)
  3.2831 +       also have  "\<dots> \<subseteq> path_component_set U y"
  3.2832 +        by (simp add: Uyfx path_component_maximal path_component_subset path_component_sym)
  3.2833 +      finally have fC: "f ` (path_component_set (S \<inter> f -` U) x) \<subseteq> path_component_set U y" .
  3.2834 +      have cUC: "path_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` path_component_set U y)"
  3.2835 +        using path_component_subset fC by blast
  3.2836 +      have "path_component_set (S \<inter> f -` U) x \<subseteq> path_component_set (S \<inter> f -` path_component_set U y) x"
  3.2837 +      proof -
  3.2838 +        have "\<And>a. path_component_set (path_component_set (S \<inter> f -` U) x) a \<subseteq> path_component_set (S \<inter> f -` path_component_set U y) a"
  3.2839 +          using cUC path_component_mono by blast
  3.2840 +        then show ?thesis
  3.2841 +          using path_component_path_component by blast
  3.2842 +      qed
  3.2843 +      also have "\<dots> \<subseteq> (S \<inter> f -` path_component_set U y)"
  3.2844 +        by (rule path_component_subset)
  3.2845 +      finally show "path_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` path_component_set U y)" .
  3.2846 +    qed
  3.2847 +  qed
  3.2848 +  ultimately show "openin (subtopology euclidean (f ` S)) (path_component_set U y)"
  3.2849 +    by metis
  3.2850 +qed
  3.2851 +
  3.2852 +subsection%unimportant\<open>Components, continuity, openin, closedin\<close>
  3.2853 +
  3.2854 +lemma continuous_on_components_gen:
  3.2855 + fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
  3.2856 +  assumes "\<And>c. c \<in> components S \<Longrightarrow>
  3.2857 +              openin (subtopology euclidean S) c \<and> continuous_on c f"
  3.2858 +    shows "continuous_on S f"
  3.2859 +proof (clarsimp simp: continuous_openin_preimage_eq)
  3.2860 +  fix t :: "'b set"
  3.2861 +  assume "open t"
  3.2862 +  have *: "S \<inter> f -` t = (\<Union>c \<in> components S. c \<inter> f -` t)"
  3.2863 +    by auto
  3.2864 +  show "openin (subtopology euclidean S) (S \<inter> f -` t)"
  3.2865 +    unfolding * using \<open>open t\<close> assms continuous_openin_preimage_gen openin_trans openin_Union by blast
  3.2866 +qed
  3.2867 +
  3.2868 +lemma continuous_on_components:
  3.2869 + fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
  3.2870 +  assumes "locally connected S "
  3.2871 +          "\<And>c. c \<in> components S \<Longrightarrow> continuous_on c f"
  3.2872 +    shows "continuous_on S f"
  3.2873 +apply (rule continuous_on_components_gen)
  3.2874 +apply (auto simp: assms intro: openin_components_locally_connected)
  3.2875 +done
  3.2876 +
  3.2877 +lemma continuous_on_components_eq:
  3.2878 +    "locally connected S
  3.2879 +     \<Longrightarrow> (continuous_on S f \<longleftrightarrow> (\<forall>c \<in> components S. continuous_on c f))"
  3.2880 +by (meson continuous_on_components continuous_on_subset in_components_subset)
  3.2881 +
  3.2882 +lemma continuous_on_components_open:
  3.2883 + fixes S :: "'a::real_normed_vector set"
  3.2884 +  assumes "open S "
  3.2885 +          "\<And>c. c \<in> components S \<Longrightarrow> continuous_on c f"
  3.2886 +    shows "continuous_on S f"
  3.2887 +using continuous_on_components open_imp_locally_connected assms by blast
  3.2888 +
  3.2889 +lemma continuous_on_components_open_eq:
  3.2890 +  fixes S :: "'a::real_normed_vector set"
  3.2891 +  shows "open S \<Longrightarrow> (continuous_on S f \<longleftrightarrow> (\<forall>c \<in> components S. continuous_on c f))"
  3.2892 +using continuous_on_subset in_components_subset
  3.2893 +by (blast intro: continuous_on_components_open)
  3.2894 +
  3.2895 +lemma closedin_union_complement_components:
  3.2896 +  assumes u: "locally connected u"
  3.2897 +      and S: "closedin (subtopology euclidean u) S"
  3.2898 +      and cuS: "c \<subseteq> components(u - S)"
  3.2899 +    shows "closedin (subtopology euclidean u) (S \<union> \<Union>c)"
  3.2900 +proof -
  3.2901 +  have di: "(\<And>S t. S \<in> c \<and> t \<in> c' \<Longrightarrow> disjnt S t) \<Longrightarrow> disjnt (\<Union> c) (\<Union> c')" for c'
  3.2902 +    by (simp add: disjnt_def) blast
  3.2903 +  have "S \<subseteq> u"
  3.2904 +    using S closedin_imp_subset by blast
  3.2905 +  moreover have "u - S = \<Union>c \<union> \<Union>(components (u - S) - c)"
  3.2906 +    by (metis Diff_partition Union_components Union_Un_distrib assms(3))
  3.2907 +  moreover have "disjnt (\<Union>c) (\<Union>(components (u - S) - c))"
  3.2908 +    apply (rule di)
  3.2909 +    by (metis DiffD1 DiffD2 assms(3) components_nonoverlap disjnt_def subsetCE)
  3.2910 +  ultimately have eq: "S \<union> \<Union>c = u - (\<Union>(components(u - S) - c))"
  3.2911 +    by (auto simp: disjnt_def)
  3.2912 +  have *: "openin (subtopology euclidean u) (\<Union>(components (u - S) - c))"
  3.2913 +    apply (rule openin_Union)
  3.2914 +    apply (rule openin_trans [of "u - S"])
  3.2915 +    apply (simp add: u S locally_diff_closed openin_components_locally_connected)
  3.2916 +    apply (simp add: openin_diff S)
  3.2917 +    done
  3.2918 +  have "openin (subtopology euclidean u) (u - (u - \<Union>(components (u - S) - c)))"
  3.2919 +    apply (rule openin_diff, simp)
  3.2920 +    apply (metis closedin_diff closedin_topspace topspace_euclidean_subtopology *)
  3.2921 +    done
  3.2922 +  then show ?thesis
  3.2923 +    by (force simp: eq closedin_def)
  3.2924 +qed
  3.2925 +
  3.2926 +lemma closed_union_complement_components:
  3.2927 +  fixes S :: "'a::real_normed_vector set"
  3.2928 +  assumes S: "closed S" and c: "c \<subseteq> components(- S)"
  3.2929 +    shows "closed(S \<union> \<Union> c)"
  3.2930 +proof -
  3.2931 +  have "closedin (subtopology euclidean UNIV) (S \<union> \<Union>c)"
  3.2932 +    apply (rule closedin_union_complement_components [OF locally_connected_UNIV])
  3.2933 +    using S c apply (simp_all add: Compl_eq_Diff_UNIV)
  3.2934 +    done
  3.2935 +  then show ?thesis by simp
  3.2936 +qed
  3.2937 +
  3.2938 +lemma closedin_Un_complement_component:
  3.2939 +  fixes S :: "'a::real_normed_vector set"
  3.2940 +  assumes u: "locally connected u"
  3.2941 +      and S: "closedin (subtopology euclidean u) S"
  3.2942 +      and c: " c \<in> components(u - S)"
  3.2943 +    shows "closedin (subtopology euclidean u) (S \<union> c)"
  3.2944 +proof -
  3.2945 +  have "closedin (subtopology euclidean u) (S \<union> \<Union>{c})"
  3.2946 +    using c by (blast intro: closedin_union_complement_components [OF u S])
  3.2947 +  then show ?thesis
  3.2948 +    by simp
  3.2949 +qed
  3.2950 +
  3.2951 +lemma closed_Un_complement_component:
  3.2952 +  fixes S :: "'a::real_normed_vector set"
  3.2953 +  assumes S: "closed S" and c: " c \<in> components(-S)"
  3.2954 +    shows "closed (S \<union> c)"
  3.2955 +  by (metis Compl_eq_Diff_UNIV S c closed_closedin closedin_Un_complement_component
  3.2956 +      locally_connected_UNIV subtopology_UNIV)
  3.2957 +
  3.2958 +
  3.2959 +subsection\<open>Existence of isometry between subspaces of same dimension\<close>
  3.2960 +
  3.2961 +lemma isometry_subset_subspace:
  3.2962 +  fixes S :: "'a::euclidean_space set"
  3.2963 +    and T :: "'b::euclidean_space set"
  3.2964 +  assumes S: "subspace S"
  3.2965 +      and T: "subspace T"
  3.2966 +      and d: "dim S \<le> dim T"
  3.2967 +  obtains f where "linear f" "f ` S \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
  3.2968 +proof -
  3.2969 +  obtain B where "B \<subseteq> S" and Borth: "pairwise orthogonal B"
  3.2970 +             and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
  3.2971 +             and "independent B" "finite B" "card B = dim S" "span B = S"
  3.2972 +    by (metis orthonormal_basis_subspace [OF S] independent_finite)
  3.2973 +  obtain C where "C \<subseteq> T" and Corth: "pairwise orthogonal C"
  3.2974 +             and C1:"\<And>x. x \<in> C \<Longrightarrow> norm x = 1"
  3.2975 +             and "independent C" "finite C" "card C = dim T" "span C = T"
  3.2976 +    by (metis orthonormal_basis_subspace [OF T] independent_finite)
  3.2977 +  obtain fb where "fb ` B \<subseteq> C" "inj_on fb B"
  3.2978 +    by (metis \<open>card B = dim S\<close> \<open>card C = dim T\<close> \<open>finite B\<close> \<open>finite C\<close> card_le_inj d)
  3.2979 +  then have pairwise_orth_fb: "pairwise (\<lambda>v j. orthogonal (fb v) (fb j)) B"
  3.2980 +    using Corth
  3.2981 +    apply (auto simp: pairwise_def orthogonal_clauses)
  3.2982 +    by (meson subsetD image_eqI inj_on_def)
  3.2983 +  obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
  3.2984 +    using linear_independent_extend \<open>independent B\<close> by fastforce
  3.2985 +  have "span (f ` B) \<subseteq> span C"
  3.2986 +    by (metis \<open>fb ` B \<subseteq> C\<close> ffb image_cong span_mono)
  3.2987 +  then have "f ` S \<subseteq> T"
  3.2988 +    unfolding \<open>span B = S\<close> \<open>span C = T\<close> span_linear_image[OF \<open>linear f\<close>] .
  3.2989 +  have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
  3.2990 +    using B1 C1 \<open>fb ` B \<subseteq> C\<close> by auto
  3.2991 +  have "norm (f x) = norm x" if "x \<in> S" for x
  3.2992 +  proof -
  3.2993 +    interpret linear f by fact
  3.2994 +    obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
  3.2995 +      using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
  3.2996 +    have "norm (f x)^2 = norm (\<Sum>v\<in>B. a v *\<^sub>R fb v)^2" by (simp add: sum scale ffb x)
  3.2997 +    also have "\<dots> = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
  3.2998 +      apply (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
  3.2999 +      apply (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
  3.3000 +      done
  3.3001 +    also have "\<dots> = norm x ^2"
  3.3002 +      by (simp add: x pairwise_ortho_scaleR Borth norm_sum_Pythagorean [OF \<open>finite B\<close>])
  3.3003 +    finally show ?thesis
  3.3004 +      by (simp add: norm_eq_sqrt_inner)
  3.3005 +  qed
  3.3006 +  then show ?thesis
  3.3007 +    by (rule that [OF \<open>linear f\<close> \<open>f ` S \<subseteq> T\<close>])
  3.3008 +qed
  3.3009 +
  3.3010 +proposition isometries_subspaces:
  3.3011 +  fixes S :: "'a::euclidean_space set"
  3.3012 +    and T :: "'b::euclidean_space set"
  3.3013 +  assumes S: "subspace S"
  3.3014 +      and T: "subspace T"
  3.3015 +      and d: "dim S = dim T"
  3.3016 +  obtains f g where "linear f" "linear g" "f ` S = T" "g ` T = S"
  3.3017 +                    "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
  3.3018 +                    "\<And>x. x \<in> T \<Longrightarrow> norm(g x) = norm x"
  3.3019 +                    "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
  3.3020 +                    "\<And>x. x \<in> T \<Longrightarrow> f(g x) = x"
  3.3021 +proof -
  3.3022 +  obtain B where "B \<subseteq> S" and Borth: "pairwise orthogonal B"
  3.3023 +             and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
  3.3024 +             and "independent B" "finite B" "card B = dim S" "span B = S"
  3.3025 +    by (metis orthonormal_basis_subspace [OF S] independent_finite)
  3.3026 +  obtain C where "C \<subseteq> T" and Corth: "pairwise orthogonal C"
  3.3027 +             and C1:"\<And>x. x \<in> C \<Longrightarrow> norm x = 1"
  3.3028 +             and "independent C" "finite C" "card C = dim T" "span C = T"
  3.3029 +    by (metis orthonormal_basis_subspace [OF T] independent_finite)
  3.3030 +  obtain fb where "bij_betw fb B C"
  3.3031 +    by (metis \<open>finite B\<close> \<open>finite C\<close> bij_betw_iff_card \<open>card B = dim S\<close> \<open>card C = dim T\<close> d)
  3.3032 +  then have pairwise_orth_fb: "pairwise (\<lambda>v j. orthogonal (fb v) (fb j)) B"
  3.3033 +    using Corth
  3.3034 +    apply (auto simp: pairwise_def orthogonal_clauses bij_betw_def)
  3.3035 +    by (meson subsetD image_eqI inj_on_def)
  3.3036 +  obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
  3.3037 +    using linear_independent_extend \<open>independent B\<close> by fastforce
  3.3038 +  interpret f: linear f by fact
  3.3039 +  define gb where "gb \<equiv> inv_into B fb"
  3.3040 +  then have pairwise_orth_gb: "pairwise (\<lambda>v j. orthogonal (gb v) (gb j)) C"
  3.3041 +    using Borth
  3.3042 +    apply (auto simp: pairwise_def orthogonal_clauses bij_betw_def)
  3.3043 +    by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on bij_betw_inv_into_right inv_into_into)
  3.3044 +  obtain g where "linear g" and ggb: "\<And>x. x \<in> C \<Longrightarrow> g x = gb x"
  3.3045 +    using linear_independent_extend \<open>independent C\<close> by fastforce
  3.3046 +  interpret g: linear g by fact
  3.3047 +  have "span (f ` B) \<subseteq> span C"
  3.3048 +    by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on eq_iff ffb image_cong)
  3.3049 +  then have "f ` S \<subseteq> T"
  3.3050 +    unfolding \<open>span B = S\<close> \<open>span C = T\<close>
  3.3051 +      span_linear_image[OF \<open>linear f\<close>] .
  3.3052 +  have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
  3.3053 +    using B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on by fastforce
  3.3054 +  have f [simp]: "norm (f x) = norm x" "g (f x) = x" if "x \<in> S" for x
  3.3055 +  proof -
  3.3056 +    obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
  3.3057 +      using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
  3.3058 +    have "f x = (\<Sum>v \<in> B. f (a v *\<^sub>R v))"
  3.3059 +      using linear_sum [OF \<open>linear f\<close>] x by auto
  3.3060 +    also have "\<dots> = (\<Sum>v \<in> B. a v *\<^sub>R f v)"
  3.3061 +      by (simp add: f.sum f.scale)
  3.3062 +    also have "\<dots> = (\<Sum>v \<in> B. a v *\<^sub>R fb v)"
  3.3063 +      by (simp add: ffb cong: sum.cong)
  3.3064 +    finally have *: "f x = (\<Sum>v\<in>B. a v *\<^sub>R fb v)" .
  3.3065 +    then have "(norm (f x))\<^sup>2 = (norm (\<Sum>v\<in>B. a v *\<^sub>R fb v))\<^sup>2" by simp
  3.3066 +    also have "\<dots> = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
  3.3067 +      apply (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
  3.3068 +      apply (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
  3.3069 +      done
  3.3070 +    also have "\<dots> = (norm x)\<^sup>2"
  3.3071 +      by (simp add: x pairwise_ortho_scaleR Borth norm_sum_Pythagorean [OF \<open>finite B\<close>])
  3.3072 +    finally show "norm (f x) = norm x"
  3.3073 +      by (simp add: norm_eq_sqrt_inner)
  3.3074 +    have "g (f x) = g (\<Sum>v\<in>B. a v *\<^sub>R fb v)" by (simp add: *)
  3.3075 +    also have "\<dots> = (\<Sum>v\<in>B. g (a v *\<^sub>R fb v))"
  3.3076 +      by (simp add: g.sum g.scale)
  3.3077 +    also have "\<dots> = (\<Sum>v\<in>B. a v *\<^sub>R g (fb v))"
  3.3078 +      by (simp add: g.scale)
  3.3079 +    also have "\<dots> = (\<Sum>v\<in>B. a v *\<^sub>R v)"
  3.3080 +      apply (rule sum.cong [OF refl])
  3.3081 +      using \<open>bij_betw fb B C\<close> gb_def bij_betwE bij_betw_inv_into_left gb_def ggb by fastforce
  3.3082 +    also have "\<dots> = x"
  3.3083 +      using x by blast
  3.3084 +    finally show "g (f x) = x" .
  3.3085 +  qed
  3.3086 +  have [simp]: "\<And>x. x \<in> C \<Longrightarrow> norm (gb x) = norm x"
  3.3087 +    by (metis B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on gb_def inv_into_into)
  3.3088 +  have g [simp]: "f (g x) = x" if "x \<in> T" for x
  3.3089 +  proof -
  3.3090 +    obtain a where x: "x = (\<Sum>v \<in> C. a v *\<^sub>R v)"
  3.3091 +      using \<open>finite C\<close> \<open>span C = T\<close> \<open>x \<in> T\<close> span_finite by fastforce
  3.3092 +    have "g x = (\<Sum>v \<in> C. g (a v *\<^sub>R v))"
  3.3093 +      by (simp add: x g.sum)
  3.3094 +    also have "\<dots> = (\<Sum>v \<in> C. a v *\<^sub>R g v)"
  3.3095 +      by (simp add: g.scale)
  3.3096 +    also have "\<dots> = (\<Sum>v \<in> C. a v *\<^sub>R gb v)"
  3.3097 +      by (simp add: ggb cong: sum.cong)
  3.3098 +    finally have "f (g x) = f (\<Sum>v\<in>C. a v *\<^sub>R gb v)" by simp
  3.3099 +    also have "\<dots> = (\<Sum>v\<in>C. f (a v *\<^sub>R gb v))"
  3.3100 +      by (simp add: f.scale f.sum)
  3.3101 +    also have "\<dots> = (\<Sum>v\<in>C. a v *\<^sub>R f (gb v))"
  3.3102 +      by (simp add: f.scale f.sum)
  3.3103 +    also have "\<dots> = (\<Sum>v\<in>C. a v *\<^sub>R v)"
  3.3104 +      using \<open>bij_betw fb B C\<close>
  3.3105 +      by (simp add: bij_betw_def gb_def bij_betw_inv_into_right ffb inv_into_into)
  3.3106 +    also have "\<dots> = x"
  3.3107 +      using x by blast
  3.3108 +    finally show "f (g x) = x" .
  3.3109 +  qed
  3.3110 +  have gim: "g ` T = S"
  3.3111 +    by (metis (full_types) S T \<open>f ` S \<subseteq> T\<close> d dim_eq_span dim_image_le f(2) g.linear_axioms
  3.3112 +        image_iff linear_subspace_image span_eq_iff subset_iff)
  3.3113 +  have fim: "f ` S = T"
  3.3114 +    using \<open>g ` T = S\<close> image_iff by fastforce
  3.3115 +  have [simp]: "norm (g x) = norm x" if "x \<in> T" for x
  3.3116 +    using fim that by auto
  3.3117 +  show ?thesis
  3.3118 +    apply (rule that [OF \<open>linear f\<close> \<open>linear g\<close>])
  3.3119 +    apply (simp_all add: fim gim)
  3.3120 +    done
  3.3121 +qed
  3.3122 +
  3.3123 +corollary isometry_subspaces:
  3.3124 +  fixes S :: "'a::euclidean_space set"
  3.3125 +    and T :: "'b::euclidean_space set"
  3.3126 +  assumes S: "subspace S"
  3.3127 +      and T: "subspace T"
  3.3128 +      and d: "dim S = dim T"
  3.3129 +  obtains f where "linear f" "f ` S = T" "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
  3.3130 +using isometries_subspaces [OF assms]
  3.3131 +by metis
  3.3132 +
  3.3133 +corollary isomorphisms_UNIV_UNIV:
  3.3134 +  assumes "DIM('M) = DIM('N)"
  3.3135 +  obtains f::"'M::euclidean_space \<Rightarrow>'N::euclidean_space" and g
  3.3136 +  where "linear f" "linear g"
  3.3137 +                    "\<And>x. norm(f x) = norm x" "\<And>y. norm(g y) = norm y"
  3.3138 +                    "\<And>x. g (f x) = x" "\<And>y. f(g y) = y"
  3.3139 +  using assms by (auto intro: isometries_subspaces [of "UNIV::'M set" "UNIV::'N set"])
  3.3140 +
  3.3141 +lemma homeomorphic_subspaces:
  3.3142 +  fixes S :: "'a::euclidean_space set"
  3.3143 +    and T :: "'b::euclidean_space set"
  3.3144 +  assumes S: "subspace S"
  3.3145 +      and T: "subspace T"
  3.3146 +      and d: "dim S = dim T"
  3.3147 +    shows "S homeomorphic T"
  3.3148 +proof -
  3.3149 +  obtain f g where "linear f" "linear g" "f ` S = T" "g ` T = S"
  3.3150 +                   "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "\<And>x. x \<in> T \<Longrightarrow> f(g x) = x"
  3.3151 +    by (blast intro: isometries_subspaces [OF assms])
  3.3152 +  then show ?thesis
  3.3153 +    apply (simp add: homeomorphic_def homeomorphism_def)
  3.3154 +    apply (rule_tac x=f in exI)
  3.3155 +    apply (rule_tac x=g in exI)
  3.3156 +    apply (auto simp: linear_continuous_on linear_conv_bounded_linear)
  3.3157 +    done
  3.3158 +qed
  3.3159 +
  3.3160 +lemma homeomorphic_affine_sets:
  3.3161 +  assumes "affine S" "affine T" "aff_dim S = aff_dim T"
  3.3162 +    shows "S homeomorphic T"
  3.3163 +proof (cases "S = {} \<or> T = {}")
  3.3164 +  case True  with assms aff_dim_empty homeomorphic_empty show ?thesis
  3.3165 +    by metis
  3.3166 +next
  3.3167 +  case False
  3.3168 +  then obtain a b where ab: "a \<in> S" "b \<in> T" by auto
  3.3169 +  then have ss: "subspace ((+) (- a) ` S)" "subspace ((+) (- b) ` T)"
  3.3170 +    using affine_diffs_subspace assms by blast+
  3.3171 +  have dd: "dim ((+) (- a) ` S) = dim ((+) (- b) ` T)"
  3.3172 +    using assms ab  by (simp add: aff_dim_eq_dim  [OF hull_inc] image_def)
  3.3173 +  have "S homeomorphic ((+) (- a) ` S)"
  3.3174 +    by (simp add: homeomorphic_translation)
  3.3175 +  also have "\<dots> homeomorphic ((+) (- b) ` T)"
  3.3176 +    by (rule homeomorphic_subspaces [OF ss dd])
  3.3177 +  also have "\<dots> homeomorphic T"
  3.3178 +    using homeomorphic_sym homeomorphic_translation by auto
  3.3179 +  finally show ?thesis .
  3.3180 +qed
  3.3181 +
  3.3182 +
  3.3183 +subsection\<open>Retracts, in a general sense, preserve (co)homotopic triviality)\<close>
  3.3184 +
  3.3185 +locale%important Retracts =
  3.3186 +  fixes s h t k
  3.3187 +  assumes conth: "continuous_on s h"
  3.3188 +      and imh: "h ` s = t"
  3.3189 +      and contk: "continuous_on t k"
  3.3190 +      and imk: "k ` t \<subseteq> s"
  3.3191 +      and idhk: "\<And>y. y \<in> t \<Longrightarrow> h(k y) = y"
  3.3192 +
  3.3193 +begin
  3.3194 +
  3.3195 +lemma homotopically_trivial_retraction_gen:
  3.3196 +  assumes P: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> t; Q f\<rbrakk> \<Longrightarrow> P(k \<circ> f)"
  3.3197 +      and Q: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; P f\<rbrakk> \<Longrightarrow> Q(h \<circ> f)"
  3.3198 +      and Qeq: "\<And>h k. (\<And>x. x \<in> u \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
  3.3199 +      and hom: "\<And>f g. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; P f;
  3.3200 +                       continuous_on u g; g ` u \<subseteq> s; P g\<rbrakk>
  3.3201 +                       \<Longrightarrow> homotopic_with P u s f g"
  3.3202 +      and contf: "continuous_on u f" and imf: "f ` u \<subseteq> t" and Qf: "Q f"
  3.3203 +      and contg: "continuous_on u g" and img: "g ` u \<subseteq> t" and Qg: "Q g"
  3.3204 +    shows "homotopic_with Q u t f g"
  3.3205 +proof -
  3.3206 +  have feq: "\<And>x. x \<in> u \<Longrightarrow> (h \<circ> (k \<circ> f)) x = f x" using idhk imf by auto
  3.3207 +  have geq: "\<And>x. x \<in> u \<Longrightarrow> (h \<circ> (k \<circ> g)) x = g x" using idhk img by auto
  3.3208 +  have "continuous_on u (k \<circ> f)"
  3.3209 +    using contf continuous_on_compose continuous_on_subset contk imf by blast
  3.3210 +  moreover have "(k \<circ> f) ` u \<subseteq> s"
  3.3211 +    using imf imk by fastforce
  3.3212 +  moreover have "P (k \<circ> f)"
  3.3213 +    by (simp add: P Qf contf imf)
  3.3214 +  moreover have "continuous_on u (k \<circ> g)"
  3.3215 +    using contg continuous_on_compose continuous_on_subset contk img by blast
  3.3216 +  moreover have "(k \<circ> g) ` u \<subseteq> s"
  3.3217 +    using img imk by fastforce
  3.3218 +  moreover have "P (k \<circ> g)"
  3.3219 +    by (simp add: P Qg contg img)
  3.3220 +  ultimately have "homotopic_with P u s (k \<circ> f) (k \<circ> g)"
  3.3221 +    by (rule hom)
  3.3222 +  then have "homotopic_with Q u t (h \<circ> (k \<circ> f)) (h \<circ> (k \<circ> g))"
  3.3223 +    apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono])
  3.3224 +    using Q by (auto simp: conth imh)
  3.3225 +  then show ?thesis
  3.3226 +    apply (rule homotopic_with_eq)
  3.3227 +    apply (metis feq)
  3.3228 +    apply (metis geq)
  3.3229 +    apply (metis Qeq)
  3.3230 +    done
  3.3231 +qed
  3.3232 +
  3.3233 +lemma homotopically_trivial_retraction_null_gen:
  3.3234 +  assumes P: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> t; Q f\<rbrakk> \<Longrightarrow> P(k \<circ> f)"
  3.3235 +      and Q: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; P f\<rbrakk> \<Longrightarrow> Q(h \<circ> f)"
  3.3236 +      and Qeq: "\<And>h k. (\<And>x. x \<in> u \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
  3.3237 +      and hom: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; P f\<rbrakk>
  3.3238 +                     \<Longrightarrow> \<exists>c. homotopic_with P u s f (\<lambda>x. c)"
  3.3239 +      and contf: "continuous_on u f" and imf:"f ` u \<subseteq> t" and Qf: "Q f"
  3.3240 +  obtains c where "homotopic_with Q u t f (\<lambda>x. c)"
  3.3241 +proof -
  3.3242 +  have feq: "\<And>x. x \<in> u \<Longrightarrow> (h \<circ> (k \<circ> f)) x = f x" using idhk imf by auto
  3.3243 +  have "continuous_on u (k \<circ> f)"
  3.3244 +    using contf continuous_on_compose continuous_on_subset contk imf by blast
  3.3245 +  moreover have "(k \<circ> f) ` u \<subseteq> s"
  3.3246 +    using imf imk by fastforce
  3.3247 +  moreover have "P (k \<circ> f)"
  3.3248 +    by (simp add: P Qf contf imf)
  3.3249 +  ultimately obtain c where "homotopic_with P u s (k \<circ> f) (\<lambda>x. c)"
  3.3250 +    by (metis hom)
  3.3251 +  then have "homotopic_with Q u t (h \<circ> (k \<circ> f)) (h \<circ> (\<lambda>x. c))"
  3.3252 +    apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono])
  3.3253 +    using Q by (auto simp: conth imh)
  3.3254 +  then show ?thesis
  3.3255 +    apply (rule_tac c = "h c" in that)
  3.3256 +    apply (erule homotopic_with_eq)
  3.3257 +    apply (metis feq, simp)
  3.3258 +    apply (metis Qeq)
  3.3259 +    done
  3.3260 +qed
  3.3261 +
  3.3262 +lemma cohomotopically_trivial_retraction_gen:
  3.3263 +  assumes P: "\<And>f. \<lbrakk>continuous_on t f; f ` t \<subseteq> u; Q f\<rbrakk> \<Longrightarrow> P(f \<circ> h)"
  3.3264 +      and Q: "\<And>f. \<lbrakk>continuous_on s f; f ` s \<subseteq> u; P f\<rbrakk> \<Longrightarrow> Q(f \<circ> k)"
  3.3265 +      and Qeq: "\<And>h k. (\<And>x. x \<in> t \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
  3.3266 +      and hom: "\<And>f g. \<lbrakk>continuous_on s f; f ` s \<subseteq> u; P f;
  3.3267 +                       continuous_on s g; g ` s \<subseteq> u; P g\<rbrakk>
  3.3268 +                       \<Longrightarrow> homotopic_with P s u f g"
  3.3269 +      and contf: "continuous_on t f" and imf: "f ` t \<subseteq> u" and Qf: "Q f"
  3.3270 +      and contg: "continuous_on t g" and img: "g ` t \<subseteq> u" and Qg: "Q g"
  3.3271 +    shows "homotopic_with Q t u f g"
  3.3272 +proof -
  3.3273 +  have feq: "\<And>x. x \<in> t \<Longrightarrow> (f \<circ> h \<circ> k) x = f x" using idhk imf by auto
  3.3274 +  have geq: "\<And>x. x \<in> t \<Longrightarrow> (g \<circ> h \<circ> k) x = g x" using idhk img by auto
  3.3275 +  have "continuous_on s (f \<circ> h)"
  3.3276 +    using contf conth continuous_on_compose imh by blast
  3.3277 +  moreover have "(f \<circ> h) ` s \<subseteq> u"
  3.3278 +    using imf imh by fastforce
  3.3279 +  moreover have "P (f \<circ> h)"
  3.3280 +    by (simp add: P Qf contf imf)
  3.3281 +  moreover have "continuous_on s (g \<circ> h)"
  3.3282 +    using contg continuous_on_compose continuous_on_subset conth imh by blast
  3.3283 +  moreover have "(g \<circ> h) ` s \<subseteq> u"
  3.3284 +    using img imh by fastforce
  3.3285 +  moreover have "P (g \<circ> h)"
  3.3286 +    by (simp add: P Qg contg img)
  3.3287 +  ultimately have "homotopic_with P s u (f \<circ> h) (g \<circ> h)"
  3.3288 +    by (rule hom)
  3.3289 +  then have "homotopic_with Q t u (f \<circ> h \<circ> k) (g \<circ> h \<circ> k)"
  3.3290 +    apply (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono])
  3.3291 +    using Q by (auto simp: contk imk)
  3.3292 +  then show ?thesis
  3.3293 +    apply (rule homotopic_with_eq)
  3.3294 +    apply (metis feq)
  3.3295 +    apply (metis geq)
  3.3296 +    apply (metis Qeq)
  3.3297 +    done
  3.3298 +qed
  3.3299 +
  3.3300 +lemma cohomotopically_trivial_retraction_null_gen:
  3.3301 +  assumes P: "\<And>f. \<lbrakk>continuous_on t f; f ` t \<subseteq> u; Q f\<rbrakk> \<Longrightarrow> P(f \<circ> h)"
  3.3302 +      and Q: "\<And>f. \<lbrakk>continuous_on s f; f ` s \<subseteq> u; P f\<rbrakk> \<Longrightarrow> Q(f \<circ> k)"
  3.3303 +      and Qeq: "\<And>h k. (\<And>x. x \<in> t \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
  3.3304 +      and hom: "\<And>f g. \<lbrakk>continuous_on s f; f ` s \<subseteq> u; P f\<rbrakk>
  3.3305 +                       \<Longrightarrow> \<exists>c. homotopic_with P s u f (\<lambda>x. c)"
  3.3306 +      and contf: "continuous_on t f" and imf: "f ` t \<subseteq> u" and Qf: "Q f"
  3.3307 +  obtains c where "homotopic_with Q t u f (\<lambda>x. c)"
  3.3308 +proof -
  3.3309 +  have feq: "\<And>x. x \<in> t \<Longrightarrow> (f \<circ> h \<circ> k) x = f x" using idhk imf by auto
  3.3310 +  have "continuous_on s (f \<circ> h)"
  3.3311 +    using contf conth continuous_on_compose imh by blast
  3.3312 +  moreover have "(f \<circ> h) ` s \<subseteq> u"
  3.3313 +    using imf imh by fastforce
  3.3314 +  moreover have "P (f \<circ> h)"
  3.3315 +    by (simp add: P Qf contf imf)
  3.3316 +  ultimately obtain c where "homotopic_with P s u (f \<circ> h) (\<lambda>x. c)"
  3.3317 +    by (metis hom)
  3.3318 +  then have "homotopic_with Q t u (f \<circ> h \<circ> k) ((\<lambda>x. c) \<circ> k)"
  3.3319 +    apply (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono])
  3.3320 +    using Q by (auto simp: contk imk)
  3.3321 +  then show ?thesis
  3.3322 +    apply (rule_tac c = c in that)
  3.3323 +    apply (erule homotopic_with_eq)
  3.3324 +    apply (metis feq, simp)
  3.3325 +    apply (metis Qeq)
  3.3326 +    done
  3.3327 +qed
  3.3328 +
  3.3329 +end
  3.3330 +
  3.3331 +lemma simply_connected_retraction_gen:
  3.3332 +  shows "\<lbrakk>simply_connected S; continuous_on S h; h ` S = T;
  3.3333 +          continuous_on T k; k ` T \<subseteq> S; \<And>y. y \<in> T \<Longrightarrow> h(k y) = y\<rbrakk>
  3.3334 +        \<Longrightarrow> simply_connected T"
  3.3335 +apply (simp add: simply_connected_def path_def path_image_def homotopic_loops_def, clarify)
  3.3336 +apply (rule Retracts.homotopically_trivial_retraction_gen
  3.3337 +        [of S h _ k _ "\<lambda>p. pathfinish p = pathstart p"  "\<lambda>p. pathfinish p = pathstart p"])
  3.3338 +apply (simp_all add: Retracts_def pathfinish_def pathstart_def)
  3.3339 +done
  3.3340 +
  3.3341 +lemma homeomorphic_simply_connected:
  3.3342 +    "\<lbrakk>S homeomorphic T; simply_connected S\<rbrakk> \<Longrightarrow> simply_connected T"
  3.3343 +  by (auto simp: homeomorphic_def homeomorphism_def intro: simply_connected_retraction_gen)
  3.3344 +
  3.3345 +lemma homeomorphic_simply_connected_eq:
  3.3346 +    "S homeomorphic T \<Longrightarrow> (simply_connected S \<longleftrightarrow> simply_connected T)"
  3.3347 +  by (metis homeomorphic_simply_connected homeomorphic_sym)
  3.3348 +
  3.3349 +
  3.3350 +subsection\<open>Homotopy equivalence\<close>
  3.3351 +
  3.3352 +definition%important homotopy_eqv :: "'a::topological_space set \<Rightarrow> 'b::topological_space set \<Rightarrow> bool"
  3.3353 +             (infix "homotopy'_eqv" 50)
  3.3354 +  where "S homotopy_eqv T \<equiv>
  3.3355 +        \<exists>f g. continuous_on S f \<and> f ` S \<subseteq> T \<and>
  3.3356 +              continuous_on T g \<and> g ` T \<subseteq> S \<and>
  3.3357 +              homotopic_with (\<lambda>x. True) S S (g \<circ> f) id \<and>
  3.3358 +              homotopic_with (\<lambda>x. True) T T (f \<circ> g) id"
  3.3359 +
  3.3360 +lemma homeomorphic_imp_homotopy_eqv: "S homeomorphic T \<Longrightarrow> S homotopy_eqv T"
  3.3361 +  unfolding homeomorphic_def homotopy_eqv_def homeomorphism_def
  3.3362 +  by (fastforce intro!: homotopic_with_equal continuous_on_compose)
  3.3363 +
  3.3364 +lemma homotopy_eqv_refl: "S homotopy_eqv S"
  3.3365 +  by (rule homeomorphic_imp_homotopy_eqv homeomorphic_refl)+
  3.3366 +
  3.3367 +lemma homotopy_eqv_sym: "S homotopy_eqv T \<longleftrightarrow> T homotopy_eqv S"
  3.3368 +  by (auto simp: homotopy_eqv_def)
  3.3369 +
  3.3370 +lemma homotopy_eqv_trans [trans]:
  3.3371 +    fixes S :: "'a::real_normed_vector set" and U :: "'c::real_normed_vector set"
  3.3372 +  assumes ST: "S homotopy_eqv T" and TU: "T homotopy_eqv U"
  3.3373 +    shows "S homotopy_eqv U"
  3.3374 +proof -
  3.3375 +  obtain f1 g1 where f1: "continuous_on S f1" "f1 ` S \<subseteq> T"
  3.3376 +                 and g1: "continuous_on T g1" "g1 ` T \<subseteq> S"
  3.3377 +                 and hom1: "homotopic_with (\<lambda>x. True) S S (g1 \<circ> f1) id"
  3.3378 +                           "homotopic_with (\<lambda>x. True) T T (f1 \<circ> g1) id"
  3.3379 +    using ST by (auto simp: homotopy_eqv_def)
  3.3380 +  obtain f2 g2 where f2: "continuous_on T f2" "f2 ` T \<subseteq> U"
  3.3381 +                 and g2: "continuous_on U g2" "g2 ` U \<subseteq> T"
  3.3382 +                 and hom2: "homotopic_with (\<lambda>x. True) T T (g2 \<circ> f2) id"
  3.3383 +                           "homotopic_with (\<lambda>x. True) U U (f2 \<circ> g2) id"
  3.3384 +    using TU by (auto simp: homotopy_eqv_def)
  3.3385 +  have "homotopic_with (\<lambda>f. True) S T (g2 \<circ> f2 \<circ> f1) (id \<circ> f1)"
  3.3386 +    by (rule homotopic_with_compose_continuous_right hom2 f1)+
  3.3387 +  then have "homotopic_with (\<lambda>f. True) S T (g2 \<circ> (f2 \<circ> f1)) (id \<circ> f1)"
  3.3388 +    by (simp add: o_assoc)
  3.3389 +  then have "homotopic_with (\<lambda>x. True) S S
  3.3390 +         (g1 \<circ> (g2 \<circ> (f2 \<circ> f1))) (g1 \<circ> (id \<circ> f1))"
  3.3391 +    by (simp add: g1 homotopic_with_compose_continuous_left)
  3.3392 +  moreover have "homotopic_with (\<lambda>x. True) S S (g1 \<circ> id \<circ> f1) id"
  3.3393 +    using hom1 by simp
  3.3394 +  ultimately have SS: "homotopic_with (\<lambda>x. True) S S (g1 \<circ> g2 \<circ> (f2 \<circ> f1)) id"
  3.3395 +    apply (simp add: o_assoc)
  3.3396 +    apply (blast intro: homotopic_with_trans)
  3.3397 +    done
  3.3398 +  have "homotopic_with (\<lambda>f. True) U T (f1 \<circ> g1 \<circ> g2) (id \<circ> g2)"
  3.3399 +    by (rule homotopic_with_compose_continuous_right hom1 g2)+
  3.3400 +  then have "homotopic_with (\<lambda>f. True) U T (f1 \<circ> (g1 \<circ> g2)) (id \<circ> g2)"
  3.3401 +    by (simp add: o_assoc)
  3.3402 +  then have "homotopic_with (\<lambda>x. True) U U
  3.3403 +         (f2 \<circ> (f1 \<circ> (g1 \<circ> g2))) (f2 \<circ> (id \<circ> g2))"
  3.3404 +    by (simp add: f2 homotopic_with_compose_continuous_left)
  3.3405 +  moreover have "homotopic_with (\<lambda>x. True) U U (f2 \<circ> id \<circ> g2) id"
  3.3406 +    using hom2 by simp
  3.3407 +  ultimately have UU: "homotopic_with (\<lambda>x. True) U U (f2 \<circ> f1 \<circ> (g1 \<circ> g2)) id"
  3.3408 +    apply (simp add: o_assoc)
  3.3409 +    apply (blast intro: homotopic_with_trans)
  3.3410 +    done
  3.3411 +  show ?thesis
  3.3412 +    unfolding homotopy_eqv_def
  3.3413 +    apply (rule_tac x = "f2 \<circ> f1" in exI)
  3.3414 +    apply (rule_tac x = "g1 \<circ> g2" in exI)
  3.3415 +    apply (intro conjI continuous_on_compose SS UU)
  3.3416 +    using f1 f2 g1 g2  apply (force simp: elim!: continuous_on_subset)+
  3.3417 +    done
  3.3418 +qed
  3.3419 +
  3.3420 +lemma homotopy_eqv_inj_linear_image:
  3.3421 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  3.3422 +  assumes "linear f" "inj f"
  3.3423 +    shows "(f ` S) homotopy_eqv S"
  3.3424 +apply (rule homeomorphic_imp_homotopy_eqv)
  3.3425 +using assms homeomorphic_sym linear_homeomorphic_image by auto
  3.3426 +
  3.3427 +lemma homotopy_eqv_translation:
  3.3428 +    fixes S :: "'a::real_normed_vector set"
  3.3429 +    shows "(+) a ` S homotopy_eqv S"
  3.3430 +  apply (rule homeomorphic_imp_homotopy_eqv)
  3.3431 +  using homeomorphic_translation homeomorphic_sym by blast
  3.3432 +
  3.3433 +lemma homotopy_eqv_homotopic_triviality_imp:
  3.3434 +  fixes S :: "'a::real_normed_vector set"
  3.3435 +    and T :: "'b::real_normed_vector set"
  3.3436 +    and U :: "'c::real_normed_vector set"
  3.3437 +  assumes "S homotopy_eqv T"
  3.3438 +      and f: "continuous_on U f" "f ` U \<subseteq> T"
  3.3439 +      and g: "continuous_on U g" "g ` U \<subseteq> T"
  3.3440 +      and homUS: "\<And>f g. \<lbrakk>continuous_on U f; f ` U \<subseteq> S;
  3.3441 +                         continuous_on U g; g ` U \<subseteq> S\<rbrakk>
  3.3442 +                         \<Longrightarrow> homotopic_with (\<lambda>x. True) U S f g"
  3.3443 +    shows "homotopic_with (\<lambda>x. True) U T f g"
  3.3444 +proof -
  3.3445 +  obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
  3.3446 +               and k: "continuous_on T k" "k ` T \<subseteq> S"
  3.3447 +               and hom: "homotopic_with (\<lambda>x. True) S S (k \<circ> h) id"
  3.3448 +                        "homotopic_with (\<lambda>x. True) T T (h \<circ> k) id"
  3.3449 +    using assms by (auto simp: homotopy_eqv_def)
  3.3450 +  have "homotopic_with (\<lambda>f. True) U S (k \<circ> f) (k \<circ> g)"
  3.3451 +    apply (rule homUS)
  3.3452 +    using f g k
  3.3453 +    apply (safe intro!: continuous_on_compose h k f elim!: continuous_on_subset)
  3.3454 +    apply (force simp: o_def)+
  3.3455 +    done
  3.3456 +  then have "homotopic_with (\<lambda>x. True) U T (h \<circ> (k \<circ> f)) (h \<circ> (k \<circ> g))"
  3.3457 +    apply (rule homotopic_with_compose_continuous_left)
  3.3458 +    apply (simp_all add: h)
  3.3459 +    done
  3.3460 +  moreover have "homotopic_with (\<lambda>x. True) U T (h \<circ> k \<circ> f) (id \<circ> f)"
  3.3461 +    apply (rule homotopic_with_compose_continuous_right [where X=T and Y=T])
  3.3462 +    apply (auto simp: hom f)
  3.3463 +    done
  3.3464 +  moreover have "homotopic_with (\<lambda>x. True) U T (h \<circ> k \<circ> g) (id \<circ> g)"
  3.3465 +    apply (rule homotopic_with_compose_continuous_right [where X=T and Y=T])
  3.3466 +    apply (auto simp: hom g)
  3.3467 +    done
  3.3468 +  ultimately show "homotopic_with (\<lambda>x. True) U T f g"
  3.3469 +    apply (simp add: o_assoc)
  3.3470 +    using homotopic_with_trans homotopic_with_sym by blast
  3.3471 +qed
  3.3472 +
  3.3473 +lemma homotopy_eqv_homotopic_triviality:
  3.3474 +  fixes S :: "'a::real_normed_vector set"
  3.3475 +    and T :: "'b::real_normed_vector set"
  3.3476 +    and U :: "'c::real_normed_vector set"
  3.3477 +  assumes "S homotopy_eqv T"
  3.3478 +    shows "(\<forall>f g. continuous_on U f \<and> f ` U \<subseteq> S \<and>
  3.3479 +                   continuous_on U g \<and> g ` U \<subseteq> S
  3.3480 +                   \<longrightarrow> homotopic_with (\<lambda>x. True) U S f g) \<longleftrightarrow>
  3.3481 +           (\<forall>f g. continuous_on U f \<and> f ` U \<subseteq> T \<and>
  3.3482 +                  continuous_on U g \<and> g ` U \<subseteq> T
  3.3483 +                  \<longrightarrow> homotopic_with (\<lambda>x. True) U T f g)"
  3.3484 +apply (rule iffI)
  3.3485 +apply (metis assms homotopy_eqv_homotopic_triviality_imp)
  3.3486 +by (metis (no_types) assms homotopy_eqv_homotopic_triviality_imp homotopy_eqv_sym)
  3.3487 +
  3.3488 +lemma homotopy_eqv_cohomotopic_triviality_null_imp:
  3.3489 +  fixes S :: "'a::real_normed_vector set"
  3.3490 +    and T :: "'b::real_normed_vector set"
  3.3491 +    and U :: "'c::real_normed_vector set"
  3.3492 +  assumes "S homotopy_eqv T"
  3.3493 +      and f: "continuous_on T f" "f ` T \<subseteq> U"
  3.3494 +      and homSU: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> U\<rbrakk>
  3.3495 +                      \<Longrightarrow> \<exists>c. homotopic_with (\<lambda>x. True) S U f (\<lambda>x. c)"
  3.3496 +  obtains c where "homotopic_with (\<lambda>x. True) T U f (\<lambda>x. c)"
  3.3497 +proof -
  3.3498 +  obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
  3.3499 +               and k: "continuous_on T k" "k ` T \<subseteq> S"
  3.3500 +               and hom: "homotopic_with (\<lambda>x. True) S S (k \<circ> h) id"
  3.3501 +                        "homotopic_with (\<lambda>x. True) T T (h \<circ> k) id"
  3.3502 +    using assms by (auto simp: homotopy_eqv_def)
  3.3503 +  obtain c where "homotopic_with (\<lambda>x. True) S U (f \<circ> h) (\<lambda>x. c)"
  3.3504 +    apply (rule exE [OF homSU [of "f \<circ> h"]])
  3.3505 +    apply (intro continuous_on_compose h)
  3.3506 +    using h f  apply (force elim!: continuous_on_subset)+
  3.3507 +    done
  3.3508 +  then have "homotopic_with (\<lambda>x. True) T U ((f \<circ> h) \<circ> k) ((\<lambda>x. c) \<circ> k)"
  3.3509 +    apply (rule homotopic_with_compose_continuous_right [where X=S])
  3.3510 +    using k by auto
  3.3511 +  moreover have "homotopic_with (\<lambda>x. True) T U (f \<circ> id) (f \<circ> (h \<circ> k))"
  3.3512 +    apply (rule homotopic_with_compose_continuous_left [where Y=T])
  3.3513 +      apply (simp add: hom homotopic_with_symD)
  3.3514 +     using f apply auto
  3.3515 +    done
  3.3516 +  ultimately show ?thesis
  3.3517 +    apply (rule_tac c=c in that)
  3.3518 +    apply (simp add: o_def)
  3.3519 +    using homotopic_with_trans by blast
  3.3520 +qed
  3.3521 +
  3.3522 +lemma homotopy_eqv_cohomotopic_triviality_null:
  3.3523 +  fixes S :: "'a::real_normed_vector set"
  3.3524 +    and T :: "'b::real_normed_vector set"
  3.3525 +    and U :: "'c::real_normed_vector set"
  3.3526 +  assumes "S homotopy_eqv T"
  3.3527 +    shows "(\<forall>f. continuous_on S f \<and> f ` S \<subseteq> U
  3.3528 +                \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) S U f (\<lambda>x. c))) \<longleftrightarrow>
  3.3529 +           (\<forall>f. continuous_on T f \<and> f ` T \<subseteq> U
  3.3530 +                \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) T U f (\<lambda>x. c)))"
  3.3531 +apply (rule iffI)
  3.3532 +apply (metis assms homotopy_eqv_cohomotopic_triviality_null_imp)
  3.3533 +by (metis assms homotopy_eqv_cohomotopic_triviality_null_imp homotopy_eqv_sym)
  3.3534 +
  3.3535 +lemma homotopy_eqv_homotopic_triviality_null_imp:
  3.3536 +  fixes S :: "'a::real_normed_vector set"
  3.3537 +    and T :: "'b::real_normed_vector set"
  3.3538 +    and U :: "'c::real_normed_vector set"
  3.3539 +  assumes "S homotopy_eqv T"
  3.3540 +      and f: "continuous_on U f" "f ` U \<subseteq> T"
  3.3541 +      and homSU: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S\<rbrakk>
  3.3542 +                      \<Longrightarrow> \<exists>c. homotopic_with (\<lambda>x. True) U S f (\<lambda>x. c)"
  3.3543 +    shows "\<exists>c. homotopic_with (\<lambda>x. True) U T f (\<lambda>x. c)"
  3.3544 +proof -
  3.3545 +  obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
  3.3546 +               and k: "continuous_on T k" "k ` T \<subseteq> S"
  3.3547 +               and hom: "homotopic_with (\<lambda>x. True) S S (k \<circ> h) id"
  3.3548 +                        "homotopic_with (\<lambda>x. True) T T (h \<circ> k) id"
  3.3549 +    using assms by (auto simp: homotopy_eqv_def)
  3.3550 +  obtain c::'a where "homotopic_with (\<lambda>x. True) U S (k \<circ> f) (\<lambda>x. c)"
  3.3551 +    apply (rule exE [OF homSU [of "k \<circ> f"]])
  3.3552 +    apply (intro continuous_on_compose h)
  3.3553 +    using k f  apply (force elim!: continuous_on_subset)+
  3.3554 +    done
  3.3555 +  then have "homotopic_with (\<lambda>x. True) U T (h \<circ> (k \<circ> f)) (h \<circ> (\<lambda>x. c))"
  3.3556 +    apply (rule homotopic_with_compose_continuous_left [where Y=S])
  3.3557 +    using h by auto
  3.3558 +  moreover have "homotopic_with (\<lambda>x. True) U T (id \<circ> f) ((h \<circ> k) \<circ> f)"
  3.3559 +    apply (rule homotopic_with_compose_continuous_right [where X=T])
  3.3560 +      apply (simp add: hom homotopic_with_symD)
  3.3561 +     using f apply auto
  3.3562 +    done
  3.3563 +  ultimately show ?thesis
  3.3564 +    using homotopic_with_trans by (fastforce simp add: o_def)
  3.3565 +qed
  3.3566 +
  3.3567 +lemma homotopy_eqv_homotopic_triviality_null:
  3.3568 +  fixes S :: "'a::real_normed_vector set"
  3.3569 +    and T :: "'b::real_normed_vector set"
  3.3570 +    and U :: "'c::real_normed_vector set"
  3.3571 +  assumes "S homotopy_eqv T"
  3.3572 +    shows "(\<forall>f. continuous_on U f \<and> f ` U \<subseteq> S
  3.3573 +                  \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) U S f (\<lambda>x. c))) \<longleftrightarrow>
  3.3574 +           (\<forall>f. continuous_on U f \<and> f ` U \<subseteq> T
  3.3575 +                  \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) U T f (\<lambda>x. c)))"
  3.3576 +apply (rule iffI)
  3.3577 +apply (metis assms homotopy_eqv_homotopic_triviality_null_imp)
  3.3578 +by (metis assms homotopy_eqv_homotopic_triviality_null_imp homotopy_eqv_sym)
  3.3579 +
  3.3580 +lemma homotopy_eqv_contractible_sets:
  3.3581 +  fixes S :: "'a::real_normed_vector set"
  3.3582 +    and T :: "'b::real_normed_vector set"
  3.3583 +  assumes "contractible S" "contractible T" "S = {} \<longleftrightarrow> T = {}"
  3.3584 +    shows "S homotopy_eqv T"
  3.3585 +proof (cases "S = {}")
  3.3586 +  case True with assms show ?thesis
  3.3587 +    by (simp add: homeomorphic_imp_homotopy_eqv)
  3.3588 +next
  3.3589 +  case False
  3.3590 +  with assms obtain a b where "a \<in> S" "b \<in> T"
  3.3591 +    by auto
  3.3592 +  then show ?thesis
  3.3593 +    unfolding homotopy_eqv_def
  3.3594 +    apply (rule_tac x="\<lambda>x. b" in exI)
  3.3595 +    apply (rule_tac x="\<lambda>x. a" in exI)
  3.3596 +    apply (intro assms conjI continuous_on_id' homotopic_into_contractible)
  3.3597 +    apply (auto simp: o_def continuous_on_const)
  3.3598 +    done
  3.3599 +qed
  3.3600 +
  3.3601 +lemma homotopy_eqv_empty1 [simp]:
  3.3602 +  fixes S :: "'a::real_normed_vector set"
  3.3603 +  shows "S homotopy_eqv ({}::'b::real_normed_vector set) \<longleftrightarrow> S = {}"
  3.3604 +apply (rule iffI)
  3.3605 +using homotopy_eqv_def apply fastforce
  3.3606 +by (simp add: homotopy_eqv_contractible_sets)
  3.3607 +
  3.3608 +lemma homotopy_eqv_empty2 [simp]:
  3.3609 +  fixes S :: "'a::real_normed_vector set"
  3.3610 +  shows "({}::'b::real_normed_vector set) homotopy_eqv S \<longleftrightarrow> S = {}"
  3.3611 +by (metis homotopy_eqv_empty1 homotopy_eqv_sym)
  3.3612 +
  3.3613 +lemma homotopy_eqv_contractibility:
  3.3614 +  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
  3.3615 +  shows "S homotopy_eqv T \<Longrightarrow> (contractible S \<longleftrightarrow> contractible T)"
  3.3616 +unfolding homotopy_eqv_def
  3.3617 +by (blast intro: homotopy_dominated_contractibility)
  3.3618 +
  3.3619 +lemma homotopy_eqv_sing:
  3.3620 +  fixes S :: "'a::real_normed_vector set" and a :: "'b::real_normed_vector"
  3.3621 +  shows "S homotopy_eqv {a} \<longleftrightarrow> S \<noteq> {} \<and> contractible S"
  3.3622 +proof (cases "S = {}")
  3.3623 +  case True then show ?thesis
  3.3624 +    by simp
  3.3625 +next
  3.3626 +  case False then show ?thesis
  3.3627 +    by (metis contractible_sing empty_not_insert homotopy_eqv_contractibility homotopy_eqv_contractible_sets)
  3.3628 +qed
  3.3629 +
  3.3630 +lemma homeomorphic_contractible_eq:
  3.3631 +  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
  3.3632 +  shows "S homeomorphic T \<Longrightarrow> (contractible S \<longleftrightarrow> contractible T)"
  3.3633 +by (simp add: homeomorphic_imp_homotopy_eqv homotopy_eqv_contractibility)
  3.3634 +
  3.3635 +lemma homeomorphic_contractible:
  3.3636 +  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
  3.3637 +  shows "\<lbrakk>contractible S; S homeomorphic T\<rbrakk> \<Longrightarrow> contractible T"
  3.3638 +  by (metis homeomorphic_contractible_eq)
  3.3639 +
  3.3640 +
  3.3641 +subsection%unimportant\<open>Misc other results\<close>
  3.3642 +
  3.3643 +lemma bounded_connected_Compl_real:
  3.3644 +  fixes S :: "real set"
  3.3645 +  assumes "bounded S" and conn: "connected(- S)"
  3.3646 +    shows "S = {}"
  3.3647 +proof -
  3.3648 +  obtain a b where "S \<subseteq> box a b"
  3.3649 +    by (meson assms bounded_subset_box_symmetric)
  3.3650 +  then have "a \<notin> S" "b \<notin> S"
  3.3651 +    by auto
  3.3652 +  then have "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> x \<in> - S"
  3.3653 +    by (meson Compl_iff conn connected_iff_interval)
  3.3654 +  then show ?thesis
  3.3655 +    using \<open>S \<subseteq> box a b\<close> by auto
  3.3656 +qed
  3.3657 +
  3.3658 +lemma bounded_connected_Compl_1:
  3.3659 +  fixes S :: "'a::{euclidean_space} set"
  3.3660 +  assumes "bounded S" and conn: "connected(- S)" and 1: "DIM('a) = 1"
  3.3661 +    shows "S = {}"
  3.3662 +proof -
  3.3663 +  have "DIM('a) = DIM(real)"
  3.3664 +    by (simp add: "1")
  3.3665 +  then obtain f::"'a \<Rightarrow> real" and g
  3.3666 +  where "linear f" "\<And>x. norm(f x) = norm x" "\<And>x. g(f x) = x" "\<And>y. f(g y) = y"
  3.3667 +    by (rule isomorphisms_UNIV_UNIV) blast
  3.3668 +  with \<open>bounded S\<close> have "bounded (f ` S)"
  3.3669 +    using bounded_linear_image linear_linear by blast
  3.3670 +  have "connected (f ` (-S))"
  3.3671 +    using connected_linear_image assms \<open>linear f\<close> by blast
  3.3672 +  moreover have "f ` (-S) = - (f ` S)"
  3.3673 +    apply (rule bij_image_Compl_eq)
  3.3674 +    apply (auto simp: bij_def)
  3.3675 +     apply (metis \<open>\<And>x. g (f x) = x\<close> injI)
  3.3676 +    by (metis UNIV_I \<open>\<And>y. f (g y) = y\<close> image_iff)
  3.3677 +  finally have "connected (- (f ` S))"
  3.3678 +    by simp
  3.3679 +  then have "f ` S = {}"
  3.3680 +    using \<open>bounded (f ` S)\<close> bounded_connected_Compl_real by blast
  3.3681 +  then show ?thesis
  3.3682 +    by blast
  3.3683 +qed
  3.3684 +
  3.3685 +
  3.3686 +subsection%unimportant\<open>Some Uncountable Sets\<close>
  3.3687 +
  3.3688 +lemma uncountable_closed_segment:
  3.3689 +  fixes a :: "'a::real_normed_vector"
  3.3690 +  assumes "a \<noteq> b" shows "uncountable (closed_segment a b)"
  3.3691 +unfolding path_image_linepath [symmetric] path_image_def
  3.3692 +  using inj_on_linepath [OF assms] uncountable_closed_interval [of 0 1]
  3.3693 +        countable_image_inj_on by auto
  3.3694 +
  3.3695 +lemma uncountable_open_segment:
  3.3696 +  fixes a :: "'a::real_normed_vector"
  3.3697 +  assumes "a \<noteq> b" shows "uncountable (open_segment a b)"
  3.3698 +  by (simp add: assms open_segment_def uncountable_closed_segment uncountable_minus_countable)
  3.3699 +
  3.3700 +lemma uncountable_convex:
  3.3701 +  fixes a :: "'a::real_normed_vector"
  3.3702 +  assumes "convex S" "a \<in> S" "b \<in> S" "a \<noteq> b"
  3.3703 +    shows "uncountable S"
  3.3704 +proof -
  3.3705 +  have "uncountable (closed_segment a b)"
  3.3706 +    by (simp add: uncountable_closed_segment assms)
  3.3707 +  then show ?thesis
  3.3708 +    by (meson assms convex_contains_segment countable_subset)
  3.3709 +qed
  3.3710 +
  3.3711 +lemma uncountable_ball:
  3.3712 +  fixes a :: "'a::euclidean_space"
  3.3713 +  assumes "r > 0"
  3.3714 +    shows "uncountable (ball a r)"
  3.3715 +proof -
  3.3716 +  have "uncountable (open_segment a (a + r *\<^sub>R (SOME i. i \<in> Basis)))"
  3.3717 +    by (metis Basis_zero SOME_Basis add_cancel_right_right assms less_le scale_eq_0_iff uncountable_open_segment)
  3.3718 +  moreover have "open_segment a (a + r *\<^sub>R (SOME i. i \<in> Basis)) \<subseteq> ball a r"
  3.3719 +    using assms by (auto simp: in_segment algebra_simps dist_norm SOME_Basis)
  3.3720 +  ultimately show ?thesis
  3.3721 +    by (metis countable_subset)
  3.3722 +qed
  3.3723 +
  3.3724 +lemma ball_minus_countable_nonempty:
  3.3725 +  assumes "countable (A :: 'a :: euclidean_space set)" "r > 0"
  3.3726 +  shows   "ball z r - A \<noteq> {}"
  3.3727 +proof
  3.3728 +  assume *: "ball z r - A = {}"
  3.3729 +  have "uncountable (ball z r - A)"
  3.3730 +    by (intro uncountable_minus_countable assms uncountable_ball)
  3.3731 +  thus False by (subst (asm) *) auto
  3.3732 +qed
  3.3733 +
  3.3734 +lemma uncountable_cball:
  3.3735 +  fixes a :: "'a::euclidean_space"
  3.3736 +  assumes "r > 0"
  3.3737 +  shows "uncountable (cball a r)"
  3.3738 +  using assms countable_subset uncountable_ball by auto
  3.3739 +
  3.3740 +lemma pairwise_disjnt_countable:
  3.3741 +  fixes \<N> :: "nat set set"
  3.3742 +  assumes "pairwise disjnt \<N>"
  3.3743 +    shows "countable \<N>"
  3.3744 +proof -
  3.3745 +  have "inj_on (\<lambda>X. SOME n. n \<in> X) (\<N> - {{}})"
  3.3746 +    apply (clarsimp simp add: inj_on_def)
  3.3747 +    by (metis assms disjnt_insert2 insert_absorb pairwise_def subsetI subset_empty tfl_some)
  3.3748 +  then show ?thesis
  3.3749 +    by (metis countable_Diff_eq countable_def)
  3.3750 +qed
  3.3751 +
  3.3752 +lemma pairwise_disjnt_countable_Union:
  3.3753 +    assumes "countable (\<Union>\<N>)" and pwd: "pairwise disjnt \<N>"
  3.3754 +    shows "countable \<N>"
  3.3755 +proof -
  3.3756 +  obtain f :: "_ \<Rightarrow> nat" where f: "inj_on f (\<Union>\<N>)"
  3.3757 +    using assms by blast
  3.3758 +  then have "pairwise disjnt (\<Union> X \<in> \<N>. {f ` X})"
  3.3759 +    using assms by (force simp: pairwise_def disjnt_inj_on_iff [OF f])
  3.3760 +  then have "countable (\<Union> X \<in> \<N>. {f ` X})"
  3.3761 +    using pairwise_disjnt_countable by blast
  3.3762 +  then show ?thesis
  3.3763 +    by (meson pwd countable_image_inj_on disjoint_image f inj_on_image pairwise_disjnt_countable)
  3.3764 +qed
  3.3765 +
  3.3766 +lemma connected_uncountable:
  3.3767 +  fixes S :: "'a::metric_space set"
  3.3768 +  assumes "connected S" "a \<in> S" "b \<in> S" "a \<noteq> b" shows "uncountable S"
  3.3769 +proof -
  3.3770 +  have "continuous_on S (dist a)"
  3.3771 +    by (intro continuous_intros)
  3.3772 +  then have "connected (dist a ` S)"
  3.3773 +    by (metis connected_continuous_image \<open>connected S\<close>)
  3.3774 +  then have "closed_segment 0 (dist a b) \<subseteq> (dist a ` S)"
  3.3775 +    by (simp add: assms closed_segment_subset is_interval_connected_1 is_interval_convex)
  3.3776 +  then have "uncountable (dist a ` S)"
  3.3777 +    by (metis \<open>a \<noteq> b\<close> countable_subset dist_eq_0_iff uncountable_closed_segment)
  3.3778 +  then show ?thesis
  3.3779 +    by blast
  3.3780 +qed
  3.3781 +
  3.3782 +lemma path_connected_uncountable:
  3.3783 +  fixes S :: "'a::metric_space set"
  3.3784 +  assumes "path_connected S" "a \<in> S" "b \<in> S" "a \<noteq> b" shows "uncountable S"
  3.3785 +  using path_connected_imp_connected assms connected_uncountable by metis
  3.3786 +
  3.3787 +lemma connected_finite_iff_sing:
  3.3788 +  fixes S :: "'a::metric_space set"
  3.3789 +  assumes "connected S"
  3.3790 +  shows "finite S \<longleftrightarrow> S = {} \<or> (\<exists>a. S = {a})"  (is "_ = ?rhs")
  3.3791 +proof -
  3.3792 +  have "uncountable S" if "\<not> ?rhs"
  3.3793 +    using connected_uncountable assms that by blast
  3.3794 +  then show ?thesis
  3.3795 +    using uncountable_infinite by auto
  3.3796 +qed
  3.3797 +
  3.3798 +lemma connected_card_eq_iff_nontrivial:
  3.3799 +  fixes S :: "'a::metric_space set"
  3.3800 +  shows "connected S \<Longrightarrow> uncountable S \<longleftrightarrow> \<not>(\<exists>a. S \<subseteq> {a})"
  3.3801 +  apply (auto simp: countable_finite finite_subset)
  3.3802 +  by (metis connected_uncountable is_singletonI' is_singleton_the_elem subset_singleton_iff)
  3.3803 +
  3.3804 +lemma simple_path_image_uncountable:
  3.3805 +  fixes g :: "real \<Rightarrow> 'a::metric_space"
  3.3806 +  assumes "simple_path g"
  3.3807 +  shows "uncountable (path_image g)"
  3.3808 +proof -
  3.3809 +  have "g 0 \<in> path_image g" "g (1/2) \<in> path_image g"
  3.3810 +    by (simp_all add: path_defs)
  3.3811 +  moreover have "g 0 \<noteq> g (1/2)"
  3.3812 +    using assms by (fastforce simp add: simple_path_def)
  3.3813 +  ultimately show ?thesis
  3.3814 +    apply (simp add: assms connected_card_eq_iff_nontrivial connected_simple_path_image)
  3.3815 +    by blast
  3.3816 +qed
  3.3817 +
  3.3818 +lemma arc_image_uncountable:
  3.3819 +  fixes g :: "real \<Rightarrow> 'a::metric_space"
  3.3820 +  assumes "arc g"
  3.3821 +  shows "uncountable (path_image g)"
  3.3822 +  by (simp add: arc_imp_simple_path assms simple_path_image_uncountable)
  3.3823 +
  3.3824 +
  3.3825 +subsection%unimportant\<open> Some simple positive connection theorems\<close>
  3.3826 +
  3.3827 +proposition path_connected_convex_diff_countable:
  3.3828 +  fixes U :: "'a::euclidean_space set"
  3.3829 +  assumes "convex U" "\<not> collinear U" "countable S"
  3.3830 +    shows "path_connected(U - S)"
  3.3831 +proof (clarsimp simp add: path_connected_def)
  3.3832 +  fix a b
  3.3833 +  assume "a \<in> U" "a \<notin> S" "b \<in> U" "b \<notin> S"
  3.3834 +  let ?m = "midpoint a b"
  3.3835 +  show "\<exists>g. path g \<and> path_image g \<subseteq> U - S \<and> pathstart g = a \<and> pathfinish g = b"
  3.3836 +  proof (cases "a = b")
  3.3837 +    case True
  3.3838 +    then show ?thesis
  3.3839 +      by (metis DiffI \<open>a \<in> U\<close> \<open>a \<notin> S\<close> path_component_def path_component_refl)
  3.3840 +  next
  3.3841 +    case False
  3.3842 +    then have "a \<noteq> ?m" "b \<noteq> ?m"
  3.3843 +      using midpoint_eq_endpoint by fastforce+
  3.3844 +    have "?m \<in> U"
  3.3845 +      using \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>convex U\<close> convex_contains_segment by force
  3.3846 +    obtain c where "c \<in> U" and nc_abc: "\<not> collinear {a,b,c}"
  3.3847 +      by (metis False \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>\<not> collinear U\<close> collinear_triples insert_absorb)
  3.3848 +    have ncoll_mca: "\<not> collinear {?m,c,a}"
  3.3849 +      by (metis (full_types) \<open>a \<noteq> ?m\<close> collinear_3_trans collinear_midpoint insert_commute nc_abc)
  3.3850 +    have ncoll_mcb: "\<not> collinear {?m,c,b}"
  3.3851 +      by (metis (full_types) \<open>b \<noteq> ?m\<close> collinear_3_trans collinear_midpoint insert_commute nc_abc)
  3.3852 +    have "c \<noteq> ?m"
  3.3853 +      by (metis collinear_midpoint insert_commute nc_abc)
  3.3854 +    then have "closed_segment ?m c \<subseteq> U"
  3.3855 +      by (simp add: \<open>c \<in> U\<close> \<open>?m \<in> U\<close> \<open>convex U\<close> closed_segment_subset)
  3.3856 +    then obtain z where z: "z \<in> closed_segment ?m c"
  3.3857 +                    and disjS: "(closed_segment a z \<union> closed_segment z b) \<inter> S = {}"
  3.3858 +    proof -
  3.3859 +      have False if "closed_segment ?m c \<subseteq> {z. (closed_segment a z \<union> closed_segment z b) \<inter> S \<noteq> {}}"
  3.3860 +      proof -
  3.3861 +        have closb: "closed_segment ?m c \<subseteq>
  3.3862 +                 {z \<in> closed_segment ?m c. closed_segment a z \<inter> S \<noteq> {}} \<union> {z \<in> closed_segment ?m c. closed_segment z b \<inter> S \<noteq> {}}"
  3.3863 +          using that by blast
  3.3864 +        have *: "countable {z \<in> closed_segment ?m c. closed_segment z u \<inter> S \<noteq> {}}"
  3.3865 +          if "u \<in> U" "u \<notin> S" and ncoll: "\<not> collinear {?m, c, u}" for u
  3.3866 +        proof -
  3.3867 +          have **: False if x1: "x1 \<in> closed_segment ?m c" and x2: "x2 \<in> closed_segment ?m c"
  3.3868 +                            and "x1 \<noteq> x2" "x1 \<noteq> u"
  3.3869 +                            and w: "w \<in> closed_segment x1 u" "w \<in> closed_segment x2 u"
  3.3870 +                            and "w \<in> S" for x1 x2 w
  3.3871 +          proof -
  3.3872 +            have "x1 \<in> affine hull {?m,c}" "x2 \<in> affine hull {?m,c}"
  3.3873 +              using segment_as_ball x1 x2 by auto
  3.3874 +            then have coll_x1: "collinear {x1, ?m, c}" and coll_x2: "collinear {?m, c, x2}"
  3.3875 +              by (simp_all add: affine_hull_3_imp_collinear) (metis affine_hull_3_imp_collinear insert_commute)
  3.3876 +            have "\<not> collinear {x1, u, x2}"
  3.3877 +            proof
  3.3878 +              assume "collinear {x1, u, x2}"
  3.3879 +              then have "collinear {?m, c, u}"
  3.3880 +                by (metis (full_types) \<open>c \<noteq> ?m\<close> coll_x1 coll_x2 collinear_3_trans insert_commute ncoll \<open>x1 \<noteq> x2\<close>)
  3.3881 +              with ncoll show False ..
  3.3882 +            qed
  3.3883 +            then have "closed_segment x1 u \<inter> closed_segment u x2 = {u}"
  3.3884 +              by (blast intro!: Int_closed_segment)
  3.3885 +            then have "w = u"
  3.3886 +              using closed_segment_commute w by auto
  3.3887 +            show ?thesis
  3.3888 +              using \<open>u \<notin> S\<close> \<open>w = u\<close> that(7) by auto
  3.3889 +          qed
  3.3890 +          then have disj: "disjoint ((\<Union>z\<in>closed_segment ?m c. {closed_segment z u \<inter> S}))"
  3.3891 +            by (fastforce simp: pairwise_def disjnt_def)
  3.3892 +          have cou: "countable ((\<Union>z \<in> closed_segment ?m c. {closed_segment z u \<inter> S}) - {{}})"
  3.3893 +            apply (rule pairwise_disjnt_countable_Union [OF _ pairwise_subset [OF disj]])
  3.3894 +             apply (rule countable_subset [OF _ \<open>countable S\<close>], auto)
  3.3895 +            done
  3.3896 +          define f where "f \<equiv> \<lambda>X. (THE z. z \<in> closed_segment ?m c \<and> X = closed_segment z u \<inter> S)"
  3.3897 +          show ?thesis
  3.3898 +          proof (rule countable_subset [OF _ countable_image [OF cou, where f=f]], clarify)
  3.3899 +            fix x
  3.3900 +            assume x: "x \<in> closed_segment ?m c" "closed_segment x u \<inter> S \<noteq> {}"
  3.3901 +            show "x \<in> f ` ((\<Union>z\<in>closed_segment ?m c. {closed_segment z u \<inter> S}) - {{}})"
  3.3902 +            proof (rule_tac x="closed_segment x u \<inter> S" in image_eqI)
  3.3903 +              show "x = f (closed_segment x u \<inter> S)"
  3.3904 +                unfolding f_def
  3.3905 +                apply (rule the_equality [symmetric])
  3.3906 +                using x  apply (auto simp: dest: **)
  3.3907 +                done
  3.3908 +            qed (use x in auto)
  3.3909 +          qed
  3.3910 +        qed
  3.3911 +        have "uncountable (closed_segment ?m c)"
  3.3912 +          by (metis \<open>c \<noteq> ?m\<close> uncountable_closed_segment)
  3.3913 +        then show False
  3.3914 +          using closb * [OF \<open>a \<in> U\<close> \<open>a \<notin> S\<close> ncoll_mca] * [OF \<open>b \<in> U\<close> \<open>b \<notin> S\<close> ncoll_mcb]
  3.3915 +          apply (simp add: closed_segment_commute)
  3.3916 +          by (simp add: countable_subset)
  3.3917 +      qed
  3.3918 +      then show ?thesis
  3.3919 +        by (force intro: that)
  3.3920 +    qed
  3.3921 +    show ?thesis
  3.3922 +    proof (intro exI conjI)
  3.3923 +      have "path_image (linepath a z +++ linepath z b) \<subseteq> U"
  3.3924 +        by (metis \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>closed_segment ?m c \<subseteq> U\<close> z \<open>convex U\<close> closed_segment_subset contra_subsetD path_image_linepath subset_path_image_join)
  3.3925 +      with disjS show "path_image (linepath a z +++ linepath z b) \<subseteq> U - S"
  3.3926 +        by (force simp: path_image_join)
  3.3927 +    qed auto
  3.3928 +  qed
  3.3929 +qed
  3.3930 +
  3.3931 +
  3.3932 +corollary connected_convex_diff_countable:
  3.3933 +  fixes U :: "'a::euclidean_space set"
  3.3934 +  assumes "convex U" "\<not> collinear U" "countable S"
  3.3935 +  shows "connected(U - S)"
  3.3936 +  by (simp add: assms path_connected_convex_diff_countable path_connected_imp_connected)
  3.3937 +
  3.3938 +lemma path_connected_punctured_convex:
  3.3939 +  assumes "convex S" and aff: "aff_dim S \<noteq> 1"
  3.3940 +    shows "path_connected(S - {a})"
  3.3941 +proof -
  3.3942 +  consider "aff_dim S = -1" | "aff_dim S = 0" | "aff_dim S \<ge> 2"
  3.3943 +    using assms aff_dim_geq [of S] by linarith
  3.3944 +  then show ?thesis
  3.3945 +  proof cases
  3.3946 +    assume "aff_dim S = -1"
  3.3947 +    then show ?thesis
  3.3948 +      by (metis aff_dim_empty empty_Diff path_connected_empty)
  3.3949 +  next
  3.3950 +    assume "aff_dim S = 0"
  3.3951 +    then show ?thesis
  3.3952 +      by (metis aff_dim_eq_0 Diff_cancel Diff_empty Diff_insert0 convex_empty convex_imp_path_connected path_connected_singleton singletonD)
  3.3953 +  next
  3.3954 +    assume ge2: "aff_dim S \<ge> 2"
  3.3955 +    then have "\<not> collinear S"
  3.3956 +    proof (clarsimp simp add: collinear_affine_hull)
  3.3957 +      fix u v
  3.3958 +      assume "S \<subseteq> affine hull {u, v}"
  3.3959 +      then have "aff_dim S \<le> aff_dim {u, v}"
  3.3960 +        by (metis (no_types) aff_dim_affine_hull aff_dim_subset)
  3.3961 +      with ge2 show False
  3.3962 +        by (metis (no_types) aff_dim_2 antisym aff not_numeral_le_zero one_le_numeral order_trans)
  3.3963 +    qed
  3.3964 +    then show ?thesis
  3.3965 +      apply (rule path_connected_convex_diff_countable [OF \<open>convex S\<close>])
  3.3966 +      by simp
  3.3967 +  qed
  3.3968 +qed
  3.3969 +
  3.3970 +lemma connected_punctured_convex:
  3.3971 +  shows "\<lbrakk>convex S; aff_dim S \<noteq> 1\<rbrakk> \<Longrightarrow> connected(S - {a})"
  3.3972 +  using path_connected_imp_connected path_connected_punctured_convex by blast
  3.3973 +
  3.3974 +lemma path_connected_complement_countable:
  3.3975 +  fixes S :: "'a::euclidean_space set"
  3.3976 +  assumes "2 \<le> DIM('a)" "countable S"
  3.3977 +  shows "path_connected(- S)"
  3.3978 +proof -
  3.3979 +  have "path_connected(UNIV - S)"
  3.3980 +    apply (rule path_connected_convex_diff_countable)
  3.3981 +    using assms by (auto simp: collinear_aff_dim [of "UNIV :: 'a set"])
  3.3982 +  then show ?thesis
  3.3983 +    by (simp add: Compl_eq_Diff_UNIV)
  3.3984 +qed
  3.3985 +
  3.3986 +proposition path_connected_openin_diff_countable:
  3.3987 +  fixes S :: "'a::euclidean_space set"
  3.3988 +  assumes "connected S" and ope: "openin (subtopology euclidean (affine hull S)) S"
  3.3989 +      and "\<not> collinear S" "countable T"
  3.3990 +    shows "path_connected(S - T)"
  3.3991 +proof (clarsimp simp add: path_connected_component)
  3.3992 +  fix x y
  3.3993 +  assume xy: "x \<in> S" "x \<notin> T" "y \<in> S" "y \<notin> T"
  3.3994 +  show "path_component (S - T) x y"
  3.3995 +  proof (rule connected_equivalence_relation_gen [OF \<open>connected S\<close>, where P = "\<lambda>x. x \<notin> T"])
  3.3996 +    show "\<exists>z. z \<in> U \<and> z \<notin> T" if opeU: "openin (subtopology euclidean S) U" and "x \<in> U" for U x
  3.3997 +    proof -
  3.3998 +      have "openin (subtopology euclidean (affine hull S)) U"
  3.3999 +        using opeU ope openin_trans by blast
  3.4000 +      with \<open>x \<in> U\<close> obtain r where Usub: "U \<subseteq> affine hull S" and "r > 0"
  3.4001 +                              and subU: "ball x r \<inter> affine hull S \<subseteq> U"
  3.4002 +        by (auto simp: openin_contains_ball)
  3.4003 +      with \<open>x \<in> U\<close> have x: "x \<in> ball x r \<inter> affine hull S"
  3.4004 +        by auto
  3.4005 +      have "\<not> S \<subseteq> {x}"
  3.4006 +        using \<open>\<not> collinear S\<close>  collinear_subset by blast
  3.4007 +      then obtain x' where "x' \<noteq> x" "x' \<in> S"
  3.4008 +        by blast
  3.4009 +      obtain y where y: "y \<noteq> x" "y \<in> ball x r \<inter> affine hull S"
  3.4010 +      proof
  3.4011 +        show "x + (r / 2 / norm(x' - x)) *\<^sub>R (x' - x) \<noteq> x"
  3.4012 +          using \<open>x' \<noteq> x\<close> \<open>r > 0\<close> by auto
  3.4013 +        show "x + (r / 2 / norm (x' - x)) *\<^sub>R (x' - x) \<in> ball x r \<inter> affine hull S"
  3.4014 +          using \<open>x' \<noteq> x\<close> \<open>r > 0\<close> \<open>x' \<in> S\<close> x
  3.4015 +          by (simp add: dist_norm mem_affine_3_minus hull_inc)
  3.4016 +      qed
  3.4017 +      have "convex (ball x r \<inter> affine hull S)"
  3.4018 +        by (simp add: affine_imp_convex convex_Int)
  3.4019 +      with x y subU have "uncountable U"
  3.4020 +        by (meson countable_subset uncountable_convex)
  3.4021 +      then have "\<not> U \<subseteq> T"
  3.4022 +        using \<open>countable T\<close> countable_subset by blast
  3.4023 +      then show ?thesis by blast
  3.4024 +    qed
  3.4025 +    show "\<exists>U. openin (subtopology euclidean S) U \<and> x \<in> U \<and>
  3.4026 +              (\<forall>x\<in>U. \<forall>y\<in>U. x \<notin> T \<and> y \<notin> T \<longrightarrow> path_component (S - T) x y)"
  3.4027 +          if "x \<in> S" for x
  3.4028 +    proof -
  3.4029 +      obtain r where Ssub: "S \<subseteq> affine hull S" and "r > 0"
  3.4030 +                 and subS: "ball x r \<inter> affine hull S \<subseteq> S"
  3.4031 +        using ope \<open>x \<in> S\<close> by (auto simp: openin_contains_ball)
  3.4032 +      then have conv: "convex (ball x r \<inter> affine hull S)"
  3.4033 +        by (simp add: affine_imp_convex convex_Int)
  3.4034 +      have "\<not> aff_dim (affine hull S) \<le> 1"
  3.4035 +        using \<open>\<not> collinear S\<close> collinear_aff_dim by auto
  3.4036 +      then have "\<not> collinear (ball x r \<inter> affine hull S)"
  3.4037 +        apply (simp add: collinear_aff_dim)
  3.4038 +        by (metis (no_types, hide_lams) aff_dim_convex_Int_open IntI open_ball \<open>0 < r\<close> aff_dim_affine_hull affine_affine_hull affine_imp_convex centre_in_ball empty_iff hull_subset inf_commute subsetCE that)
  3.4039 +      then have *: "path_connected ((ball x r \<inter> affine hull S) - T)"
  3.4040 +        by (rule path_connected_convex_diff_countable [OF conv _ \<open>countable T\<close>])
  3.4041 +      have ST: "ball x r \<inter> affine hull S - T \<subseteq> S - T"
  3.4042 +        using subS by auto
  3.4043 +      show ?thesis
  3.4044 +      proof (intro exI conjI)
  3.4045 +        show "x \<in> ball x r \<inter> affine hull S"
  3.4046 +          using \<open>x \<in> S\<close> \<open>r > 0\<close> by (simp add: hull_inc)
  3.4047 +        have "openin (subtopology euclidean (affine hull S)) (ball x r \<inter> affine hull S)"
  3.4048 +          by (subst inf.commute) (simp add: openin_Int_open)
  3.4049 +        then show "openin (subtopology euclidean S) (ball x r \<inter> affine hull S)"
  3.4050 +          by (rule openin_subset_trans [OF _ subS Ssub])
  3.4051 +      qed (use * path_component_trans in \<open>auto simp: path_connected_component path_component_of_subset [OF ST]\<close>)
  3.4052 +    qed
  3.4053 +  qed (use xy path_component_trans in auto)
  3.4054 +qed
  3.4055 +
  3.4056 +corollary connected_openin_diff_countable:
  3.4057 +  fixes S :: "'a::euclidean_space set"
  3.4058 +  assumes "connected S" and ope: "openin (subtopology euclidean (affine hull S)) S"
  3.4059 +      and "\<not> collinear S" "countable T"
  3.4060 +    shows "connected(S - T)"
  3.4061 +  by (metis path_connected_imp_connected path_connected_openin_diff_countable [OF assms])
  3.4062 +
  3.4063 +corollary path_connected_open_diff_countable:
  3.4064 +  fixes S :: "'a::euclidean_space set"
  3.4065 +  assumes "2 \<le> DIM('a)" "open S" "connected S" "countable T"
  3.4066 +  shows "path_connected(S - T)"
  3.4067 +proof (cases "S = {}")
  3.4068 +  case True
  3.4069 +  then show ?thesis
  3.4070 +    by (simp add: path_connected_empty)
  3.4071 +next
  3.4072 +  case False
  3.4073 +  show ?thesis
  3.4074 +  proof (rule path_connected_openin_diff_countable)
  3.4075 +    show "openin (subtopology euclidean (affine hull S)) S"
  3.4076 +      by (simp add: assms hull_subset open_subset)
  3.4077 +    show "\<not> collinear S"
  3.4078 +      using assms False by (simp add: collinear_aff_dim aff_dim_open)
  3.4079 +  qed (simp_all add: assms)
  3.4080 +qed
  3.4081 +
  3.4082 +corollary connected_open_diff_countable:
  3.4083 +  fixes S :: "'a::euclidean_space set"
  3.4084 +  assumes "2 \<le> DIM('a)" "open S" "connected S" "countable T"
  3.4085 +  shows "connected(S - T)"
  3.4086 +by (simp add: assms path_connected_imp_connected path_connected_open_diff_countable)
  3.4087 +
  3.4088 +
  3.4089 +
  3.4090 +subsection%unimportant \<open>Self-homeomorphisms shuffling points about\<close>
  3.4091 +
  3.4092 +subsubsection%unimportant\<open>The theorem \<open>homeomorphism_moving_points_exists\<close>\<close>
  3.4093 +
  3.4094 +lemma homeomorphism_moving_point_1:
  3.4095 +  fixes a :: "'a::euclidean_space"
  3.4096 +  assumes "affine T" "a \<in> T" and u: "u \<in> ball a r \<inter> T"
  3.4097 +  obtains f g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
  3.4098 +                    "f a = u" "\<And>x. x \<in> sphere a r \<Longrightarrow> f x = x"
  3.4099 +proof -
  3.4100 +  have nou: "norm (u - a) < r" and "u \<in> T"
  3.4101 +    using u by (auto simp: dist_norm norm_minus_commute)
  3.4102 +  then have "0 < r"
  3.4103 +    by (metis DiffD1 Diff_Diff_Int ball_eq_empty centre_in_ball not_le u)
  3.4104 +  define f where "f \<equiv> \<lambda>x. (1 - norm(x - a) / r) *\<^sub>R (u - a) + x"
  3.4105 +  have *: "False" if eq: "x + (norm y / r) *\<^sub>R u = y + (norm x / r) *\<^sub>R u"
  3.4106 +                  and nou: "norm u < r" and yx: "norm y < norm x" for x y and u::'a
  3.4107 +  proof -
  3.4108 +    have "x = y + (norm x / r - (norm y / r)) *\<^sub>R u"
  3.4109 +      using eq by (simp add: algebra_simps)
  3.4110 +    then have "norm x = norm (y + ((norm x - norm y) / r) *\<^sub>R u)"
  3.4111 +      by (metis diff_divide_distrib)
  3.4112 +    also have "\<dots> \<le> norm y + norm(((norm x - norm y) / r) *\<^sub>R u)"
  3.4113 +      using norm_triangle_ineq by blast
  3.4114 +    also have "\<dots> = norm y + (norm x - norm y) * (norm u / r)"
  3.4115 +      using yx \<open>r > 0\<close>
  3.4116 +      by (simp add: divide_simps)
  3.4117 +    also have "\<dots> < norm y + (norm x - norm y) * 1"
  3.4118 +      apply (subst add_less_cancel_left)
  3.4119 +      apply (rule mult_strict_left_mono)
  3.4120 +      using nou \<open>0 < r\<close> yx
  3.4121 +       apply (simp_all add: field_simps)
  3.4122 +      done
  3.4123 +    also have "\<dots> = norm x"
  3.4124 +      by simp
  3.4125 +    finally show False by simp
  3.4126 +  qed
  3.4127 +  have "inj f"
  3.4128 +    unfolding f_def
  3.4129 +  proof (clarsimp simp: inj_on_def)
  3.4130 +    fix x y
  3.4131 +    assume "(1 - norm (x - a) / r) *\<^sub>R (u - a) + x =
  3.4132 +            (1 - norm (y - a) / r) *\<^sub>R (u - a) + y"
  3.4133 +    then have eq: "(x - a) + (norm (y - a) / r) *\<^sub>R (u - a) = (y - a) + (norm (x - a) / r) *\<^sub>R (u - a)"
  3.4134 +      by (auto simp: algebra_simps)
  3.4135 +    show "x=y"
  3.4136 +    proof (cases "norm (x - a) = norm (y - a)")
  3.4137 +      case True
  3.4138 +      then show ?thesis
  3.4139 +        using eq by auto
  3.4140 +    next
  3.4141 +      case False
  3.4142 +      then consider "norm (x - a) < norm (y - a)" | "norm (x - a) > norm (y - a)"
  3.4143 +        by linarith
  3.4144 +      then have "False"
  3.4145 +      proof cases
  3.4146 +        case 1 show False
  3.4147 +          using * [OF _ nou 1] eq by simp
  3.4148 +      next
  3.4149 +        case 2 with * [OF eq nou] show False
  3.4150 +          by auto
  3.4151 +      qed
  3.4152 +      then show "x=y" ..
  3.4153 +    qed
  3.4154 +  qed
  3.4155 +  then have inj_onf: "inj_on f (cball a r \<inter> T)"
  3.4156 +    using inj_on_Int by fastforce
  3.4157 +  have contf: "continuous_on (cball a r \<inter> T) f"
  3.4158 +    unfolding f_def using \<open>0 < r\<close>  by (intro continuous_intros) blast
  3.4159 +  have fim: "f ` (cball a r \<inter> T) = cball a r \<inter> T"
  3.4160 +  proof
  3.4161 +    have *: "norm (y + (1 - norm y / r) *\<^sub>R u) \<le> r" if "norm y \<le> r" "norm u < r" for y u::'a
  3.4162 +    proof -
  3.4163 +      have "norm (y + (1 - norm y / r) *\<^sub>R u) \<le> norm y + norm((1 - norm y / r) *\<^sub>R u)"
  3.4164 +        using norm_triangle_ineq by blast
  3.4165 +      also have "\<dots> = norm y + abs(1 - norm y / r) * norm u"
  3.4166 +        by simp
  3.4167 +      also have "\<dots> \<le> r"
  3.4168 +      proof -
  3.4169 +        have "(r - norm u) * (r - norm y) \<ge> 0"
  3.4170 +          using that by auto
  3.4171 +        then have "r * norm u + r * norm y \<le> r * r + norm u * norm y"
  3.4172 +          by (simp add: algebra_simps)
  3.4173 +        then show ?thesis
  3.4174 +        using that \<open>0 < r\<close> by (simp add: abs_if field_simps)
  3.4175 +      qed
  3.4176 +      finally show ?thesis .
  3.4177 +    qed
  3.4178 +    have "f ` (cball a r) \<subseteq> cball a r"
  3.4179 +      apply (clarsimp simp add: dist_norm norm_minus_commute f_def)
  3.4180 +      using * by (metis diff_add_eq diff_diff_add diff_diff_eq2 norm_minus_commute nou)
  3.4181 +    moreover have "f ` T \<subseteq> T"
  3.4182 +      unfolding f_def using \<open>affine T\<close> \<open>a \<in> T\<close> \<open>u \<in> T\<close>
  3.4183 +      by (force simp: add.commute mem_affine_3_minus)
  3.4184 +    ultimately show "f ` (cball a r \<inter> T) \<subseteq> cball a r \<inter> T"
  3.4185 +      by blast
  3.4186 +  next
  3.4187 +    show "cball a r \<inter> T \<subseteq> f ` (cball a r \<inter> T)"
  3.4188 +    proof (clarsimp simp add: dist_norm norm_minus_commute)
  3.4189 +      fix x
  3.4190 +      assume x: "norm (x - a) \<le> r" and "x \<in> T"
  3.4191 +      have "\<exists>v \<in> {0..1}. ((1 - v) * r - norm ((x - a) - v *\<^sub>R (u - a))) \<bullet> 1 = 0"
  3.4192 +        by (rule ivt_decreasing_component_on_1) (auto simp: x continuous_intros)
  3.4193 +      then obtain v where "0\<le>v" "v\<le>1" and v: "(1 - v) * r = norm ((x - a) - v *\<^sub>R (u - a))"
  3.4194 +        by auto
  3.4195 +      show "x \<in> f ` (cball a r \<inter> T)"
  3.4196 +      proof (rule image_eqI)
  3.4197 +        show "x = f (x - v *\<^sub>R (u - a))"
  3.4198 +          using \<open>r > 0\<close> v by (simp add: f_def field_simps)
  3.4199 +        have "x - v *\<^sub>R (u - a) \<in> cball a r"
  3.4200 +          using \<open>r > 0\<close> v \<open>0 \<le> v\<close>
  3.4201 +          apply (simp add: field_simps dist_norm norm_minus_commute)
  3.4202 +          by (metis le_add_same_cancel2 order.order_iff_strict zero_le_mult_iff)
  3.4203 +        moreover have "x - v *\<^sub>R (u - a) \<in> T"
  3.4204 +          by (simp add: f_def \<open>affine T\<close> \<open>u \<in> T\<close> \<open>x \<in> T\<close> assms mem_affine_3_minus2)
  3.4205 +        ultimately show "x - v *\<^sub>R (u - a) \<in> cball a r \<inter> T"
  3.4206 +          by blast
  3.4207 +      qed
  3.4208 +    qed
  3.4209 +  qed
  3.4210 +  have "\<exists>g. homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
  3.4211 +    apply (rule homeomorphism_compact [OF _ contf fim inj_onf])
  3.4212 +    apply (simp add: affine_closed compact_Int_closed \<open>affine T\<close>)
  3.4213 +    done
  3.4214 +  then show ?thesis
  3.4215 +    apply (rule exE)
  3.4216 +    apply (erule_tac f=f in that)
  3.4217 +    using \<open>r > 0\<close>
  3.4218 +     apply (simp_all add: f_def dist_norm norm_minus_commute)
  3.4219 +    done
  3.4220 +qed
  3.4221 +
  3.4222 +corollary%unimportant homeomorphism_moving_point_2:
  3.4223 +  fixes a :: "'a::euclidean_space"
  3.4224 +  assumes "affine T" "a \<in> T" and u: "u \<in> ball a r \<inter> T" and v: "v \<in> ball a r \<inter> T"
  3.4225 +  obtains f g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
  3.4226 +                    "f u = v" "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> f x = x"
  3.4227 +proof -
  3.4228 +  have "0 < r"
  3.4229 +    by (metis DiffD1 Diff_Diff_Int ball_eq_empty centre_in_ball not_le u)
  3.4230 +  obtain f1 g1 where hom1: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f1 g1"
  3.4231 +                 and "f1 a = u" and f1: "\<And>x. x \<in> sphere a r \<Longrightarrow> f1 x = x"
  3.4232 +    using homeomorphism_moving_point_1 [OF \<open>affine T\<close> \<open>a \<in> T\<close> u] by blast
  3.4233 +  obtain f2 g2 where hom2: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f2 g2"
  3.4234 +                 and "f2 a = v" and f2: "\<And>x. x \<in> sphere a r \<Longrightarrow> f2 x = x"
  3.4235 +    using homeomorphism_moving_point_1 [OF \<open>affine T\<close> \<open>a \<in> T\<close> v] by blast
  3.4236 +  show ?thesis
  3.4237 +  proof
  3.4238 +    show "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) (f2 \<circ> g1) (f1 \<circ> g2)"
  3.4239 +      by (metis homeomorphism_compose homeomorphism_symD hom1 hom2)
  3.4240 +    have "g1 u = a"
  3.4241 +      using \<open>0 < r\<close> \<open>f1 a = u\<close> assms hom1 homeomorphism_apply1 by fastforce
  3.4242 +    then show "(f2 \<circ> g1) u = v"
  3.4243 +      by (simp add: \<open>f2 a = v\<close>)
  3.4244 +    show "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> (f2 \<circ> g1) x = x"
  3.4245 +      using f1 f2 hom1 homeomorphism_apply1 by fastforce
  3.4246 +  qed
  3.4247 +qed
  3.4248 +
  3.4249 +
  3.4250 +corollary%unimportant homeomorphism_moving_point_3:
  3.4251 +  fixes a :: "'a::euclidean_space"
  3.4252 +  assumes "affine T" "a \<in> T" and ST: "ball a r \<inter> T \<subseteq> S" "S \<subseteq> T"
  3.4253 +      and u: "u \<in> ball a r \<inter> T" and v: "v \<in> ball a r \<inter> T"
  3.4254 +  obtains f g where "homeomorphism S S f g"
  3.4255 +                    "f u = v" "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> ball a r \<inter> T"
  3.4256 +proof -
  3.4257 +  obtain f g where hom: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
  3.4258 +               and "f u = v" and fid: "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> f x = x"
  3.4259 +    using homeomorphism_moving_point_2 [OF \<open>affine T\<close> \<open>a \<in> T\<close> u v] by blast
  3.4260 +  have gid: "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> g x = x"
  3.4261 +    using fid hom homeomorphism_apply1 by fastforce
  3.4262 +  define ff where "ff \<equiv> \<lambda>x. if x \<in> ball a r \<inter> T then f x else x"
  3.4263 +  define gg where "gg \<equiv> \<lambda>x. if x \<in> ball a r \<inter> T then g x else x"
  3.4264 +  show ?thesis
  3.4265 +  proof
  3.4266 +    show "homeomorphism S S ff gg"
  3.4267 +    proof (rule homeomorphismI)
  3.4268 +      have "continuous_on ((cball a r \<inter> T) \<union> (T - ball a r)) ff"
  3.4269 +        apply (simp add: ff_def)
  3.4270 +        apply (rule continuous_on_cases)
  3.4271 +        using homeomorphism_cont1 [OF hom]
  3.4272 +            apply (auto simp: affine_closed \<open>affine T\<close> continuous_on_id fid)
  3.4273 +        done
  3.4274 +      then show "continuous_on S ff"
  3.4275 +        apply (rule continuous_on_subset)
  3.4276 +        using ST by auto
  3.4277 +      have "continuous_on ((cball a r \<inter> T) \<union> (T - ball a r)) gg"
  3.4278 +        apply (simp add: gg_def)
  3.4279 +        apply (rule continuous_on_cases)
  3.4280 +        using homeomorphism_cont2 [OF hom]
  3.4281 +            apply (auto simp: affine_closed \<open>affine T\<close> continuous_on_id gid)
  3.4282 +        done
  3.4283 +      then show "continuous_on S gg"
  3.4284 +        apply (rule continuous_on_subset)
  3.4285 +        using ST by auto
  3.4286 +      show "ff ` S \<subseteq> S"
  3.4287 +      proof (clarsimp simp add: ff_def)
  3.4288 +        fix x
  3.4289 +        assume "x \<in> S" and x: "dist a x < r" and "x \<in> T"
  3.4290 +        then have "f x \<in> cball a r \<inter> T"
  3.4291 +          using homeomorphism_image1 [OF hom] by force
  3.4292 +        then show "f x \<in> S"
  3.4293 +          using ST(1) \<open>x \<in> T\<close> gid hom homeomorphism_def x by fastforce
  3.4294 +      qed
  3.4295 +      show "gg ` S \<subseteq> S"
  3.4296 +      proof (clarsimp simp add: gg_def)
  3.4297 +        fix x
  3.4298 +        assume "x \<in> S" and x: "dist a x < r" and "x \<in> T"
  3.4299 +        then have "g x \<in> cball a r \<inter> T"
  3.4300 +          using homeomorphism_image2 [OF hom] by force
  3.4301 +        then have "g x \<in> ball a r"
  3.4302 +          using homeomorphism_apply2 [OF hom]
  3.4303 +            by (metis Diff_Diff_Int Diff_iff  \<open>x \<in> T\<close> cball_def fid le_less mem_Collect_eq mem_ball mem_sphere x)
  3.4304 +        then show "g x \<in> S"
  3.4305 +          using ST(1) \<open>g x \<in> cball a r \<inter> T\<close> by force
  3.4306 +        qed
  3.4307 +      show "\<And>x. x \<in> S \<Longrightarrow> gg (ff x) = x"
  3.4308 +        apply (simp add: ff_def gg_def)
  3.4309 +        using homeomorphism_apply1 [OF hom] homeomorphism_image1 [OF hom]
  3.4310 +        apply auto
  3.4311 +        apply (metis Int_iff homeomorphism_apply1 [OF hom] fid image_eqI less_eq_real_def mem_cball mem_sphere)
  3.4312 +        done
  3.4313 +      show "\<And>x. x \<in> S \<Longrightarrow> ff (gg x) = x"
  3.4314 +        apply (simp add: ff_def gg_def)
  3.4315 +        using homeomorphism_apply2 [OF hom] homeomorphism_image2 [OF hom]
  3.4316 +        apply auto
  3.4317 +        apply (metis Int_iff fid image_eqI less_eq_real_def mem_cball mem_sphere)
  3.4318 +        done
  3.4319 +    qed
  3.4320 +    show "ff u = v"
  3.4321 +      using u by (auto simp: ff_def \<open>f u = v\<close>)
  3.4322 +    show "{x. \<not> (ff x = x \<and> gg x = x)} \<subseteq> ball a r \<inter> T"
  3.4323 +      by (auto simp: ff_def gg_def)
  3.4324 +  qed
  3.4325 +qed
  3.4326 +
  3.4327 +
  3.4328 +proposition%unimportant homeomorphism_moving_point:
  3.4329 +  fixes a :: "'a::euclidean_space"
  3.4330 +  assumes ope: "openin (subtopology euclidean (affine hull S)) S"
  3.4331 +      and "S \<subseteq> T"
  3.4332 +      and TS: "T \<subseteq> affine hull S"
  3.4333 +      and S: "connected S" "a \<in> S" "b \<in> S"
  3.4334 +  obtains f g where "homeomorphism T T f g" "f a = b"
  3.4335 +                    "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
  3.4336 +                    "bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4337 +proof -
  3.4338 +  have 1: "\<exists>h k. homeomorphism T T h k \<and> h (f d) = d \<and>
  3.4339 +              {x. \<not> (h x = x \<and> k x = x)} \<subseteq> S \<and> bounded {x. \<not> (h x = x \<and> k x = x)}"
  3.4340 +        if "d \<in> S" "f d \<in> S" and homfg: "homeomorphism T T f g"
  3.4341 +        and S: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
  3.4342 +        and bo: "bounded {x. \<not> (f x = x \<and> g x = x)}" for d f g
  3.4343 +  proof (intro exI conjI)
  3.4344 +    show homgf: "homeomorphism T T g f"
  3.4345 +      by (metis homeomorphism_symD homfg)
  3.4346 +    then show "g (f d) = d"
  3.4347 +      by (meson \<open>S \<subseteq> T\<close> homeomorphism_def subsetD \<open>d \<in> S\<close>)
  3.4348 +    show "{x. \<not> (g x = x \<and> f x = x)} \<subseteq> S"
  3.4349 +      using S by blast
  3.4350 +    show "bounded {x. \<not> (g x = x \<and> f x = x)}"
  3.4351 +      using bo by (simp add: conj_commute)
  3.4352 +  qed
  3.4353 +  have 2: "\<exists>f g. homeomorphism T T f g \<and> f x = f2 (f1 x) \<and>
  3.4354 +                 {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4355 +             if "x \<in> S" "f1 x \<in> S" "f2 (f1 x) \<in> S"
  3.4356 +                and hom: "homeomorphism T T f1 g1" "homeomorphism T T f2 g2"
  3.4357 +                and sub: "{x. \<not> (f1 x = x \<and> g1 x = x)} \<subseteq> S"   "{x. \<not> (f2 x = x \<and> g2 x = x)} \<subseteq> S"
  3.4358 +                and bo: "bounded {x. \<not> (f1 x = x \<and> g1 x = x)}"  "bounded {x. \<not> (f2 x = x \<and> g2 x = x)}"
  3.4359 +             for x f1 f2 g1 g2
  3.4360 +  proof (intro exI conjI)
  3.4361 +    show homgf: "homeomorphism T T (f2 \<circ> f1) (g1 \<circ> g2)"
  3.4362 +      by (metis homeomorphism_compose hom)
  3.4363 +    then show "(f2 \<circ> f1) x = f2 (f1 x)"
  3.4364 +      by force
  3.4365 +    show "{x. \<not> ((f2 \<circ> f1) x = x \<and> (g1 \<circ> g2) x = x)} \<subseteq> S"
  3.4366 +      using sub by force
  3.4367 +    have "bounded ({x. \<not>(f1 x = x \<and> g1 x = x)} \<union> {x. \<not>(f2 x = x \<and> g2 x = x)})"
  3.4368 +      using bo by simp
  3.4369 +    then show "bounded {x. \<not> ((f2 \<circ> f1) x = x \<and> (g1 \<circ> g2) x = x)}"
  3.4370 +      by (rule bounded_subset) auto
  3.4371 +  qed
  3.4372 +  have 3: "\<exists>U. openin (subtopology euclidean S) U \<and>
  3.4373 +              d \<in> U \<and>
  3.4374 +              (\<forall>x\<in>U.
  3.4375 +                  \<exists>f g. homeomorphism T T f g \<and> f d = x \<and>
  3.4376 +                        {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and>
  3.4377 +                        bounded {x. \<not> (f x = x \<and> g x = x)})"
  3.4378 +           if "d \<in> S" for d
  3.4379 +  proof -
  3.4380 +    obtain r where "r > 0" and r: "ball d r \<inter> affine hull S \<subseteq> S"
  3.4381 +      by (metis \<open>d \<in> S\<close> ope openin_contains_ball)
  3.4382 +    have *: "\<exists>f g. homeomorphism T T f g \<and> f d = e \<and>
  3.4383 +                   {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and>
  3.4384 +                   bounded {x. \<not> (f x = x \<and> g x = x)}" if "e \<in> S" "e \<in> ball d r" for e
  3.4385 +      apply (rule homeomorphism_moving_point_3 [of "affine hull S" d r T d e])
  3.4386 +      using r \<open>S \<subseteq> T\<close> TS that
  3.4387 +            apply (auto simp: \<open>d \<in> S\<close> \<open>0 < r\<close> hull_inc)
  3.4388 +      using bounded_subset by blast
  3.4389 +    show ?thesis
  3.4390 +      apply (rule_tac x="S \<inter> ball d r" in exI)
  3.4391 +      apply (intro conjI)
  3.4392 +        apply (simp add: openin_open_Int)
  3.4393 +       apply (simp add: \<open>0 < r\<close> that)
  3.4394 +      apply (blast intro: *)
  3.4395 +      done
  3.4396 +  qed
  3.4397 +  have "\<exists>f g. homeomorphism T T f g \<and> f a = b \<and>
  3.4398 +              {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4399 +    apply (rule connected_equivalence_relation [OF S], safe)
  3.4400 +      apply (blast intro: 1 2 3)+
  3.4401 +    done
  3.4402 +  then show ?thesis
  3.4403 +    using that by auto
  3.4404 +qed
  3.4405 +
  3.4406 +
  3.4407 +lemma homeomorphism_moving_points_exists_gen:
  3.4408 +  assumes K: "finite K" "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
  3.4409 +             "pairwise (\<lambda>i j. (x i \<noteq> x j) \<and> (y i \<noteq> y j)) K"
  3.4410 +      and "2 \<le> aff_dim S"
  3.4411 +      and ope: "openin (subtopology euclidean (affine hull S)) S"
  3.4412 +      and "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
  3.4413 +  shows "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(x i) = y i) \<and>
  3.4414 +               {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4415 +  using assms
  3.4416 +proof (induction K)
  3.4417 +  case empty
  3.4418 +  then show ?case
  3.4419 +    by (force simp: homeomorphism_ident)
  3.4420 +next
  3.4421 +  case (insert i K)
  3.4422 +  then have xney: "\<And>j. \<lbrakk>j \<in> K; j \<noteq> i\<rbrakk> \<Longrightarrow> x i \<noteq> x j \<and> y i \<noteq> y j"
  3.4423 +       and pw: "pairwise (\<lambda>i j. x i \<noteq> x j \<and> y i \<noteq> y j) K"
  3.4424 +       and "x i \<in> S" "y i \<in> S"
  3.4425 +       and xyS: "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
  3.4426 +    by (simp_all add: pairwise_insert)
  3.4427 +  obtain f g where homfg: "homeomorphism T T f g" and feq: "\<And>i. i \<in> K \<Longrightarrow> f(x i) = y i"
  3.4428 +               and fg_sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
  3.4429 +               and bo_fg: "bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4430 +    using insert.IH [OF xyS pw] insert.prems by (blast intro: that)
  3.4431 +  then have "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(x i) = y i) \<and>
  3.4432 +                   {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4433 +    using insert by blast
  3.4434 +  have aff_eq: "affine hull (S - y ` K) = affine hull S"
  3.4435 +    apply (rule affine_hull_Diff)
  3.4436 +    apply (auto simp: insert)
  3.4437 +    using \<open>y i \<in> S\<close> insert.hyps(2) xney xyS by fastforce
  3.4438 +  have f_in_S: "f x \<in> S" if "x \<in> S" for x
  3.4439 +    using homfg fg_sub homeomorphism_apply1 \<open>S \<subseteq> T\<close>
  3.4440 +  proof -
  3.4441 +    have "(f (f x) \<noteq> f x \<or> g (f x) \<noteq> f x) \<or> f x \<in> S"
  3.4442 +      by (metis \<open>S \<subseteq> T\<close> homfg subsetD homeomorphism_apply1 that)
  3.4443 +    then show ?thesis
  3.4444 +      using fg_sub by force
  3.4445 +  qed
  3.4446 +  obtain h k where homhk: "homeomorphism T T h k" and heq: "h (f (x i)) = y i"
  3.4447 +               and hk_sub: "{x. \<not> (h x = x \<and> k x = x)} \<subseteq> S - y ` K"
  3.4448 +               and bo_hk:  "bounded {x. \<not> (h x = x \<and> k x = x)}"
  3.4449 +  proof (rule homeomorphism_moving_point [of "S - y`K" T "f(x i)" "y i"])
  3.4450 +    show "openin (subtopology euclidean (affine hull (S - y ` K))) (S - y ` K)"
  3.4451 +      by (simp add: aff_eq openin_diff finite_imp_closedin image_subset_iff hull_inc insert xyS)
  3.4452 +    show "S - y ` K \<subseteq> T"
  3.4453 +      using \<open>S \<subseteq> T\<close> by auto
  3.4454 +    show "T \<subseteq> affine hull (S - y ` K)"
  3.4455 +      using insert by (simp add: aff_eq)
  3.4456 +    show "connected (S - y ` K)"
  3.4457 +    proof (rule connected_openin_diff_countable [OF \<open>connected S\<close> ope])
  3.4458 +      show "\<not> collinear S"
  3.4459 +        using collinear_aff_dim \<open>2 \<le> aff_dim S\<close> by force
  3.4460 +      show "countable (y ` K)"
  3.4461 +        using countable_finite insert.hyps(1) by blast
  3.4462 +    qed
  3.4463 +    show "f (x i) \<in> S - y ` K"
  3.4464 +      apply (auto simp: f_in_S \<open>x i \<in> S\<close>)
  3.4465 +        by (metis feq homfg \<open>x i \<in> S\<close> homeomorphism_def \<open>S \<subseteq> T\<close> \<open>i \<notin> K\<close> subsetCE xney xyS)
  3.4466 +    show "y i \<in> S - y ` K"
  3.4467 +      using insert.hyps xney by (auto simp: \<open>y i \<in> S\<close>)
  3.4468 +  qed blast
  3.4469 +  show ?case
  3.4470 +  proof (intro exI conjI)
  3.4471 +    show "homeomorphism T T (h \<circ> f) (g \<circ> k)"
  3.4472 +      using homfg homhk homeomorphism_compose by blast
  3.4473 +    show "\<forall>i \<in> insert i K. (h \<circ> f) (x i) = y i"
  3.4474 +      using feq hk_sub by (auto simp: heq)
  3.4475 +    show "{x. \<not> ((h \<circ> f) x = x \<and> (g \<circ> k) x = x)} \<subseteq> S"
  3.4476 +      using fg_sub hk_sub by force
  3.4477 +    have "bounded ({x. \<not>(f x = x \<and> g x = x)} \<union> {x. \<not>(h x = x \<and> k x = x)})"
  3.4478 +      using bo_fg bo_hk bounded_Un by blast
  3.4479 +    then show "bounded {x. \<not> ((h \<circ> f) x = x \<and> (g \<circ> k) x = x)}"
  3.4480 +      by (rule bounded_subset) auto
  3.4481 +  qed
  3.4482 +qed
  3.4483 +
  3.4484 +proposition%unimportant homeomorphism_moving_points_exists:
  3.4485 +  fixes S :: "'a::euclidean_space set"
  3.4486 +  assumes 2: "2 \<le> DIM('a)" "open S" "connected S" "S \<subseteq> T" "finite K"
  3.4487 +      and KS: "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
  3.4488 +      and pw: "pairwise (\<lambda>i j. (x i \<noteq> x j) \<and> (y i \<noteq> y j)) K"
  3.4489 +      and S: "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
  3.4490 +  obtains f g where "homeomorphism T T f g" "\<And>i. i \<in> K \<Longrightarrow> f(x i) = y i"
  3.4491 +                    "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S" "bounded {x. (\<not> (f x = x \<and> g x = x))}"
  3.4492 +proof (cases "S = {}")
  3.4493 +  case True
  3.4494 +  then show ?thesis
  3.4495 +    using KS homeomorphism_ident that by fastforce
  3.4496 +next
  3.4497 +  case False
  3.4498 +  then have affS: "affine hull S = UNIV"
  3.4499 +    by (simp add: affine_hull_open \<open>open S\<close>)
  3.4500 +  then have ope: "openin (subtopology euclidean (affine hull S)) S"
  3.4501 +    using \<open>open S\<close> open_openin by auto
  3.4502 +  have "2 \<le> DIM('a)" by (rule 2)
  3.4503 +  also have "\<dots> = aff_dim (UNIV :: 'a set)"
  3.4504 +    by simp
  3.4505 +  also have "\<dots> \<le> aff_dim S"
  3.4506 +    by (metis aff_dim_UNIV aff_dim_affine_hull aff_dim_le_DIM affS)
  3.4507 +  finally have "2 \<le> aff_dim S"
  3.4508 +    by linarith
  3.4509 +  then show ?thesis
  3.4510 +    using homeomorphism_moving_points_exists_gen [OF \<open>finite K\<close> KS pw _ ope S] that by fastforce
  3.4511 +qed
  3.4512 +
  3.4513 +subsubsection%unimportant\<open>The theorem \<open>homeomorphism_grouping_points_exists\<close>\<close>
  3.4514 +
  3.4515 +lemma homeomorphism_grouping_point_1:
  3.4516 +  fixes a::real and c::real
  3.4517 +  assumes "a < b" "c < d"
  3.4518 +  obtains f g where "homeomorphism (cbox a b) (cbox c d) f g" "f a = c" "f b = d"
  3.4519 +proof -
  3.4520 +  define f where "f \<equiv> \<lambda>x. ((d - c) / (b - a)) * x + (c - a * ((d - c) / (b - a)))"
  3.4521 +  have "\<exists>g. homeomorphism (cbox a b) (cbox c d) f g"
  3.4522 +  proof (rule homeomorphism_compact)
  3.4523 +    show "continuous_on (cbox a b) f"
  3.4524 +      apply (simp add: f_def)
  3.4525 +      apply (intro continuous_intros)
  3.4526 +      using assms by auto
  3.4527 +    have "f ` {a..b} = {c..d}"
  3.4528 +      unfolding f_def image_affinity_atLeastAtMost
  3.4529 +      using assms sum_sqs_eq by (auto simp: divide_simps algebra_simps)
  3.4530 +    then show "f ` cbox a b = cbox c d"
  3.4531 +      by auto
  3.4532 +    show "inj_on f (cbox a b)"
  3.4533 +      unfolding f_def inj_on_def using assms by auto
  3.4534 +  qed auto
  3.4535 +  then obtain g where "homeomorphism (cbox a b) (cbox c d) f g" ..
  3.4536 +  then show ?thesis
  3.4537 +  proof
  3.4538 +    show "f a = c"
  3.4539 +      by (simp add: f_def)
  3.4540 +    show "f b = d"
  3.4541 +      using assms sum_sqs_eq [of a b] by (auto simp: f_def divide_simps algebra_simps)
  3.4542 +  qed
  3.4543 +qed
  3.4544 +
  3.4545 +lemma homeomorphism_grouping_point_2:
  3.4546 +  fixes a::real and w::real
  3.4547 +  assumes hom_ab: "homeomorphism (cbox a b) (cbox u v) f1 g1"
  3.4548 +      and hom_bc: "homeomorphism (cbox b c) (cbox v w) f2 g2"
  3.4549 +      and "b \<in> cbox a c" "v \<in> cbox u w"
  3.4550 +      and eq: "f1 a = u" "f1 b = v" "f2 b = v" "f2 c = w"
  3.4551 + obtains f g where "homeomorphism (cbox a c) (cbox u w) f g" "f a = u" "f c = w"
  3.4552 +                   "\<And>x. x \<in> cbox a b \<Longrightarrow> f x = f1 x" "\<And>x. x \<in> cbox b c \<Longrightarrow> f x = f2 x"
  3.4553 +proof -
  3.4554 +  have le: "a \<le> b" "b \<le> c" "u \<le> v" "v \<le> w"
  3.4555 +    using assms by simp_all
  3.4556 +  then have ac: "cbox a c = cbox a b \<union> cbox b c" and uw: "cbox u w = cbox u v \<union> cbox v w"
  3.4557 +    by auto
  3.4558 +  define f where "f \<equiv> \<lambda>x. if x \<le> b then f1 x else f2 x"
  3.4559 +  have "\<exists>g. homeomorphism (cbox a c) (cbox u w) f g"
  3.4560 +  proof (rule homeomorphism_compact)
  3.4561 +    have cf1: "continuous_on (cbox a b) f1"
  3.4562 +      using hom_ab homeomorphism_cont1 by blast
  3.4563 +    have cf2: "continuous_on (cbox b c) f2"
  3.4564 +      using hom_bc homeomorphism_cont1 by blast
  3.4565 +    show "continuous_on (cbox a c) f"
  3.4566 +      apply (simp add: f_def)
  3.4567 +      apply (rule continuous_on_cases_le [OF continuous_on_subset [OF cf1] continuous_on_subset [OF cf2]])
  3.4568 +      using le eq apply (force simp: continuous_on_id)+
  3.4569 +      done
  3.4570 +    have "f ` cbox a b = f1 ` cbox a b" "f ` cbox b c = f2 ` cbox b c"
  3.4571 +      unfolding f_def using eq by force+
  3.4572 +    then show "f ` cbox a c = cbox u w"
  3.4573 +      apply (simp only: ac uw image_Un)
  3.4574 +      by (metis hom_ab hom_bc homeomorphism_def)
  3.4575 +    have neq12: "f1 x \<noteq> f2 y" if x: "a \<le> x" "x \<le> b" and y: "b < y" "y \<le> c" for x y
  3.4576 +    proof -
  3.4577 +      have "f1 x \<in> cbox u v"
  3.4578 +        by (metis hom_ab homeomorphism_def image_eqI mem_box_real(2) x)
  3.4579 +      moreover have "f2 y \<in> cbox v w"
  3.4580 +        by (metis (full_types) hom_bc homeomorphism_def image_subset_iff mem_box_real(2) not_le not_less_iff_gr_or_eq order_refl y)
  3.4581 +      moreover have "f2 y \<noteq> f2 b"
  3.4582 +        by (metis cancel_comm_monoid_add_class.diff_cancel diff_gt_0_iff_gt hom_bc homeomorphism_def le(2) less_imp_le less_numeral_extra(3) mem_box_real(2) order_refl y)
  3.4583 +      ultimately show ?thesis
  3.4584 +        using le eq by simp
  3.4585 +    qed
  3.4586 +    have "inj_on f1 (cbox a b)"
  3.4587 +      by (metis (full_types) hom_ab homeomorphism_def inj_onI)
  3.4588 +    moreover have "inj_on f2 (cbox b c)"
  3.4589 +      by (metis (full_types) hom_bc homeomorphism_def inj_onI)
  3.4590 +    ultimately show "inj_on f (cbox a c)"
  3.4591 +      apply (simp (no_asm) add: inj_on_def)
  3.4592 +      apply (simp add: f_def inj_on_eq_iff)
  3.4593 +      using neq12  apply force
  3.4594 +      done
  3.4595 +  qed auto
  3.4596 +  then obtain g where "homeomorphism (cbox a c) (cbox u w) f g" ..
  3.4597 +  then show ?thesis
  3.4598 +    apply (rule that)
  3.4599 +    using eq le by (auto simp: f_def)
  3.4600 +qed
  3.4601 +
  3.4602 +lemma homeomorphism_grouping_point_3:
  3.4603 +  fixes a::real
  3.4604 +  assumes cbox_sub: "cbox c d \<subseteq> box a b" "cbox u v \<subseteq> box a b"
  3.4605 +      and box_ne: "box c d \<noteq> {}" "box u v \<noteq> {}"
  3.4606 +  obtains f g where "homeomorphism (cbox a b) (cbox a b) f g" "f a = a" "f b = b"
  3.4607 +                    "\<And>x. x \<in> cbox c d \<Longrightarrow> f x \<in> cbox u v"
  3.4608 +proof -
  3.4609 +  have less: "a < c" "a < u" "d < b" "v < b" "c < d" "u < v" "cbox c d \<noteq> {}"
  3.4610 +    using assms
  3.4611 +    by (simp_all add: cbox_sub subset_eq)
  3.4612 +  obtain f1 g1 where 1: "homeomorphism (cbox a c) (cbox a u) f1 g1"
  3.4613 +                   and f1_eq: "f1 a = a" "f1 c = u"
  3.4614 +    using homeomorphism_grouping_point_1 [OF \<open>a < c\<close> \<open>a < u\<close>] .
  3.4615 +  obtain f2 g2 where 2: "homeomorphism (cbox c d) (cbox u v) f2 g2"
  3.4616 +                   and f2_eq: "f2 c = u" "f2 d = v"
  3.4617 +    using homeomorphism_grouping_point_1 [OF \<open>c < d\<close> \<open>u < v\<close>] .
  3.4618 +  obtain f3 g3 where 3: "homeomorphism (cbox d b) (cbox v b) f3 g3"
  3.4619 +                   and f3_eq: "f3 d = v" "f3 b = b"
  3.4620 +    using homeomorphism_grouping_point_1 [OF \<open>d < b\<close> \<open>v < b\<close>] .
  3.4621 +  obtain f4 g4 where 4: "homeomorphism (cbox a d) (cbox a v) f4 g4" and "f4 a = a" "f4 d = v"
  3.4622 +                 and f4_eq: "\<And>x. x \<in> cbox a c \<Longrightarrow> f4 x = f1 x" "\<And>x. x \<in> cbox c d \<Longrightarrow> f4 x = f2 x"
  3.4623 +    using homeomorphism_grouping_point_2 [OF 1 2] less  by (auto simp: f1_eq f2_eq)
  3.4624 +  obtain f g where fg: "homeomorphism (cbox a b) (cbox a b) f g" "f a = a" "f b = b"
  3.4625 +               and f_eq: "\<And>x. x \<in> cbox a d \<Longrightarrow> f x = f4 x" "\<And>x. x \<in> cbox d b \<Longrightarrow> f x = f3 x"
  3.4626 +    using homeomorphism_grouping_point_2 [OF 4 3] less by (auto simp: f4_eq f3_eq f2_eq f1_eq)
  3.4627 +  show ?thesis
  3.4628 +    apply (rule that [OF fg])
  3.4629 +    using f4_eq f_eq homeomorphism_image1 [OF 2]
  3.4630 +    apply simp
  3.4631 +    by (metis atLeastAtMost_iff box_real(1) box_real(2) cbox_sub(1) greaterThanLessThan_iff imageI less_eq_real_def subset_eq)
  3.4632 +qed
  3.4633 +
  3.4634 +
  3.4635 +lemma homeomorphism_grouping_point_4:
  3.4636 +  fixes T :: "real set"
  3.4637 +  assumes "open U" "open S" "connected S" "U \<noteq> {}" "finite K" "K \<subseteq> S" "U \<subseteq> S" "S \<subseteq> T"
  3.4638 +  obtains f g where "homeomorphism T T f g"
  3.4639 +                    "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
  3.4640 +                    "bounded {x. (\<not> (f x = x \<and> g x = x))}"
  3.4641 +proof -
  3.4642 +  obtain c d where "box c d \<noteq> {}" "cbox c d \<subseteq> U"
  3.4643 +  proof -
  3.4644 +    obtain u where "u \<in> U"
  3.4645 +      using \<open>U \<noteq> {}\<close> by blast
  3.4646 +    then obtain e where "e > 0" "cball u e \<subseteq> U"
  3.4647 +      using \<open>open U\<close> open_contains_cball by blast
  3.4648 +    then show ?thesis
  3.4649 +      by (rule_tac c=u and d="u+e" in that) (auto simp: dist_norm subset_iff)
  3.4650 +  qed
  3.4651 +  have "compact K"
  3.4652 +    by (simp add: \<open>finite K\<close> finite_imp_compact)
  3.4653 +  obtain a b where "box a b \<noteq> {}" "K \<subseteq> cbox a b" "cbox a b \<subseteq> S"
  3.4654 +  proof (cases "K = {}")
  3.4655 +    case True then show ?thesis
  3.4656 +      using \<open>box c d \<noteq> {}\<close> \<open>cbox c d \<subseteq> U\<close> \<open>U \<subseteq> S\<close> that by blast
  3.4657 +  next
  3.4658 +    case False
  3.4659 +    then obtain a b where "a \<in> K" "b \<in> K"
  3.4660 +            and a: "\<And>x. x \<in> K \<Longrightarrow> a \<le> x" and b: "\<And>x. x \<in> K \<Longrightarrow> x \<le> b"
  3.4661 +      using compact_attains_inf compact_attains_sup by (metis \<open>compact K\<close>)+
  3.4662 +    obtain e where "e > 0" "cball b e \<subseteq> S"
  3.4663 +      using \<open>open S\<close> open_contains_cball
  3.4664 +      by (metis \<open>b \<in> K\<close> \<open>K \<subseteq> S\<close> subsetD)
  3.4665 +    show ?thesis
  3.4666 +    proof
  3.4667 +      show "box a (b + e) \<noteq> {}"
  3.4668 +        using \<open>0 < e\<close> \<open>b \<in> K\<close> a by force
  3.4669 +      show "K \<subseteq> cbox a (b + e)"
  3.4670 +        using \<open>0 < e\<close> a b by fastforce
  3.4671 +      have "a \<in> S"
  3.4672 +        using \<open>a \<in> K\<close> assms(6) by blast
  3.4673 +      have "b + e \<in> S"
  3.4674 +        using \<open>0 < e\<close> \<open>cball b e \<subseteq> S\<close>  by (force simp: dist_norm)
  3.4675 +      show "cbox a (b + e) \<subseteq> S"
  3.4676 +        using \<open>a \<in> S\<close> \<open>b + e \<in> S\<close> \<open>connected S\<close> connected_contains_Icc by auto
  3.4677 +    qed
  3.4678 +  qed
  3.4679 +  obtain w z where "cbox w z \<subseteq> S" and sub_wz: "cbox a b \<union> cbox c d \<subseteq> box w z"
  3.4680 +  proof -
  3.4681 +    have "a \<in> S" "b \<in> S"
  3.4682 +      using \<open>box a b \<noteq> {}\<close> \<open>cbox a b \<subseteq> S\<close> by auto
  3.4683 +    moreover have "c \<in> S" "d \<in> S"
  3.4684 +      using \<open>box c d \<noteq> {}\<close> \<open>cbox c d \<subseteq> U\<close> \<open>U \<subseteq> S\<close> by force+
  3.4685 +    ultimately have "min a c \<in> S" "max b d \<in> S"
  3.4686 +      by linarith+
  3.4687 +    then obtain e1 e2 where "e1 > 0" "cball (min a c) e1 \<subseteq> S" "e2 > 0" "cball (max b d) e2 \<subseteq> S"
  3.4688 +      using \<open>open S\<close> open_contains_cball by metis
  3.4689 +    then have *: "min a c - e1 \<in> S" "max b d + e2 \<in> S"
  3.4690 +      by (auto simp: dist_norm)
  3.4691 +    show ?thesis
  3.4692 +    proof
  3.4693 +      show "cbox (min a c - e1) (max b d+ e2) \<subseteq> S"
  3.4694 +        using * \<open>connected S\<close> connected_contains_Icc by auto
  3.4695 +      show "cbox a b \<union> cbox c d \<subseteq> box (min a c - e1) (max b d + e2)"
  3.4696 +        using \<open>0 < e1\<close> \<open>0 < e2\<close> by auto
  3.4697 +    qed
  3.4698 +  qed
  3.4699 +  then
  3.4700 +  obtain f g where hom: "homeomorphism (cbox w z) (cbox w z) f g"
  3.4701 +               and "f w = w" "f z = z"
  3.4702 +               and fin: "\<And>x. x \<in> cbox a b \<Longrightarrow> f x \<in> cbox c d"
  3.4703 +    using homeomorphism_grouping_point_3 [of a b w z c d]
  3.4704 +    using \<open>box a b \<noteq> {}\<close> \<open>box c d \<noteq> {}\<close> by blast
  3.4705 +  have contfg: "continuous_on (cbox w z) f" "continuous_on (cbox w z) g"
  3.4706 +    using hom homeomorphism_def by blast+
  3.4707 +  define f' where "f' \<equiv> \<lambda>x. if x \<in> cbox w z then f x else x"
  3.4708 +  define g' where "g' \<equiv> \<lambda>x. if x \<in> cbox w z then g x else x"
  3.4709 +  show ?thesis
  3.4710 +  proof
  3.4711 +    have T: "cbox w z \<union> (T - box w z) = T"
  3.4712 +      using \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> by auto
  3.4713 +    show "homeomorphism T T f' g'"
  3.4714 +    proof
  3.4715 +      have clo: "closedin (subtopology euclidean (cbox w z \<union> (T - box w z))) (T - box w z)"
  3.4716 +        by (metis Diff_Diff_Int Diff_subset T closedin_def open_box openin_open_Int topspace_euclidean_subtopology)
  3.4717 +      have "continuous_on (cbox w z \<union> (T - box w z)) f'" "continuous_on (cbox w z \<union> (T - box w z)) g'"
  3.4718 +        unfolding f'_def g'_def
  3.4719 +         apply (safe intro!: continuous_on_cases_local contfg continuous_on_id clo)
  3.4720 +         apply (simp_all add: closed_subset)
  3.4721 +        using \<open>f w = w\<close> \<open>f z = z\<close> apply force
  3.4722 +        by (metis \<open>f w = w\<close> \<open>f z = z\<close> hom homeomorphism_def less_eq_real_def mem_box_real(2))
  3.4723 +      then show "continuous_on T f'" "continuous_on T g'"
  3.4724 +        by (simp_all only: T)
  3.4725 +      show "f' ` T \<subseteq> T"
  3.4726 +        unfolding f'_def
  3.4727 +        by clarsimp (metis \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> subsetD hom homeomorphism_def imageI mem_box_real(2))
  3.4728 +      show "g' ` T \<subseteq> T"
  3.4729 +        unfolding g'_def
  3.4730 +        by clarsimp (metis \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> subsetD hom homeomorphism_def imageI mem_box_real(2))
  3.4731 +      show "\<And>x. x \<in> T \<Longrightarrow> g' (f' x) = x"
  3.4732 +        unfolding f'_def g'_def
  3.4733 +        using homeomorphism_apply1 [OF hom]  homeomorphism_image1 [OF hom] by fastforce
  3.4734 +      show "\<And>y. y \<in> T \<Longrightarrow> f' (g' y) = y"
  3.4735 +        unfolding f'_def g'_def
  3.4736 +        using homeomorphism_apply2 [OF hom]  homeomorphism_image2 [OF hom] by fastforce
  3.4737 +    qed
  3.4738 +    show "\<And>x. x \<in> K \<Longrightarrow> f' x \<in> U"
  3.4739 +      using fin sub_wz \<open>K \<subseteq> cbox a b\<close> \<open>cbox c d \<subseteq> U\<close> by (force simp: f'_def)
  3.4740 +    show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> S"
  3.4741 +      using \<open>cbox w z \<subseteq> S\<close> by (auto simp: f'_def g'_def)
  3.4742 +    show "bounded {x. \<not> (f' x = x \<and> g' x = x)}"
  3.4743 +      apply (rule bounded_subset [of "cbox w z"])
  3.4744 +      using bounded_cbox apply blast
  3.4745 +      apply (auto simp: f'_def g'_def)
  3.4746 +      done
  3.4747 +  qed
  3.4748 +qed
  3.4749 +
  3.4750 +proposition%unimportant homeomorphism_grouping_points_exists:
  3.4751 +  fixes S :: "'a::euclidean_space set"
  3.4752 +  assumes "open U" "open S" "connected S" "U \<noteq> {}" "finite K" "K \<subseteq> S" "U \<subseteq> S" "S \<subseteq> T"
  3.4753 +  obtains f g where "homeomorphism T T f g" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
  3.4754 +                    "bounded {x. (\<not> (f x = x \<and> g x = x))}" "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U"
  3.4755 +proof (cases "2 \<le> DIM('a)")
  3.4756 +  case True
  3.4757 +  have TS: "T \<subseteq> affine hull S"
  3.4758 +    using affine_hull_open assms by blast
  3.4759 +  have "infinite U"
  3.4760 +    using \<open>open U\<close> \<open>U \<noteq> {}\<close> finite_imp_not_open by blast
  3.4761 +  then obtain P where "P \<subseteq> U" "finite P" "card K = card P"
  3.4762 +    using infinite_arbitrarily_large by metis
  3.4763 +  then obtain \<gamma> where \<gamma>: "bij_betw \<gamma> K P"
  3.4764 +    using \<open>finite K\<close> finite_same_card_bij by blast
  3.4765 +  obtain f g where "homeomorphism T T f g" "\<And>i. i \<in> K \<Longrightarrow> f (id i) = \<gamma> i" "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S" "bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4766 +  proof (rule homeomorphism_moving_points_exists [OF True \<open>open S\<close> \<open>connected S\<close> \<open>S \<subseteq> T\<close> \<open>finite K\<close>])
  3.4767 +    show "\<And>i. i \<in> K \<Longrightarrow> id i \<in> S \<and> \<gamma> i \<in> S"
  3.4768 +      using \<open>P \<subseteq> U\<close> \<open>bij_betw \<gamma> K P\<close> \<open>K \<subseteq> S\<close> \<open>U \<subseteq> S\<close> bij_betwE by blast
  3.4769 +    show "pairwise (\<lambda>i j. id i \<noteq> id j \<and> \<gamma> i \<noteq> \<gamma> j) K"
  3.4770 +      using \<gamma> by (auto simp: pairwise_def bij_betw_def inj_on_def)
  3.4771 +  qed (use affine_hull_open assms that in auto)
  3.4772 +  then show ?thesis
  3.4773 +    using \<gamma> \<open>P \<subseteq> U\<close> bij_betwE by (fastforce simp add: intro!: that)
  3.4774 +next
  3.4775 +  case False
  3.4776 +  with DIM_positive have "DIM('a) = 1"
  3.4777 +    by (simp add: dual_order.antisym)
  3.4778 +  then obtain h::"'a \<Rightarrow>real" and j
  3.4779 +  where "linear h" "linear j"
  3.4780 +    and noh: "\<And>x. norm(h x) = norm x" and noj: "\<And>y. norm(j y) = norm y"
  3.4781 +    and hj:  "\<And>x. j(h x) = x" "\<And>y. h(j y) = y"
  3.4782 +    and ranh: "surj h"
  3.4783 +    using isomorphisms_UNIV_UNIV
  3.4784 +    by (metis (mono_tags, hide_lams) DIM_real UNIV_eq_I range_eqI)
  3.4785 +  obtain f g where hom: "homeomorphism (h ` T) (h ` T) f g"
  3.4786 +               and f: "\<And>x. x \<in> h ` K \<Longrightarrow> f x \<in> h ` U"
  3.4787 +               and sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> h ` S"
  3.4788 +               and bou: "bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4789 +    apply (rule homeomorphism_grouping_point_4 [of "h ` U" "h ` S" "h ` K" "h ` T"])
  3.4790 +    by (simp_all add: assms image_mono  \<open>linear h\<close> open_surjective_linear_image connected_linear_image ranh)
  3.4791 +  have jf: "j (f (h x)) = x \<longleftrightarrow> f (h x) = h x" for x
  3.4792 +    by (metis hj)
  3.4793 +  have jg: "j (g (h x)) = x \<longleftrightarrow> g (h x) = h x" for x
  3.4794 +    by (metis hj)
  3.4795 +  have cont_hj: "continuous_on X h"  "continuous_on Y j" for X Y
  3.4796 +    by (simp_all add: \<open>linear h\<close> \<open>linear j\<close> linear_linear linear_continuous_on)
  3.4797 +  show ?thesis
  3.4798 +  proof
  3.4799 +    show "homeomorphism T T (j \<circ> f \<circ> h) (j \<circ> g \<circ> h)"
  3.4800 +    proof
  3.4801 +      show "continuous_on T (j \<circ> f \<circ> h)" "continuous_on T (j \<circ> g \<circ> h)"
  3.4802 +        using hom homeomorphism_def
  3.4803 +        by (blast intro: continuous_on_compose cont_hj)+
  3.4804 +      show "(j \<circ> f \<circ> h) ` T \<subseteq> T" "(j \<circ> g \<circ> h) ` T \<subseteq> T"
  3.4805 +        by auto (metis (mono_tags, hide_lams) hj(1) hom homeomorphism_def imageE imageI)+
  3.4806 +      show "\<And>x. x \<in> T \<Longrightarrow> (j \<circ> g \<circ> h) ((j \<circ> f \<circ> h) x) = x"
  3.4807 +        using hj hom homeomorphism_apply1 by fastforce
  3.4808 +      show "\<And>y. y \<in> T \<Longrightarrow> (j \<circ> f \<circ> h) ((j \<circ> g \<circ> h) y) = y"
  3.4809 +        using hj hom homeomorphism_apply2 by fastforce
  3.4810 +    qed
  3.4811 +    show "{x. \<not> ((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)} \<subseteq> S"
  3.4812 +      apply (clarsimp simp: jf jg hj)
  3.4813 +      using sub hj
  3.4814 +      apply (drule_tac c="h x" in subsetD, force)
  3.4815 +      by (metis imageE)
  3.4816 +    have "bounded (j ` {x. (\<not> (f x = x \<and> g x = x))})"
  3.4817 +      by (rule bounded_linear_image [OF bou]) (use \<open>linear j\<close> linear_conv_bounded_linear in auto)
  3.4818 +    moreover
  3.4819 +    have *: "{x. \<not>((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)} = j ` {x. (\<not> (f x = x \<and> g x = x))}"
  3.4820 +      using hj by (auto simp: jf jg image_iff, metis+)
  3.4821 +    ultimately show "bounded {x. \<not> ((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)}"
  3.4822 +      by metis
  3.4823 +    show "\<And>x. x \<in> K \<Longrightarrow> (j \<circ> f \<circ> h) x \<in> U"
  3.4824 +      using f hj by fastforce
  3.4825 +  qed
  3.4826 +qed
  3.4827 +
  3.4828 +
  3.4829 +proposition%unimportant homeomorphism_grouping_points_exists_gen:
  3.4830 +  fixes S :: "'a::euclidean_space set"
  3.4831 +  assumes opeU: "openin (subtopology euclidean S) U"
  3.4832 +      and opeS: "openin (subtopology euclidean (affine hull S)) S"
  3.4833 +      and "U \<noteq> {}" "finite K" "K \<subseteq> S" and S: "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
  3.4834 +  obtains f g where "homeomorphism T T f g" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
  3.4835 +                    "bounded {x. (\<not> (f x = x \<and> g x = x))}" "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U"
  3.4836 +proof (cases "2 \<le> aff_dim S")
  3.4837 +  case True
  3.4838 +  have opeU': "openin (subtopology euclidean (affine hull S)) U"
  3.4839 +    using opeS opeU openin_trans by blast
  3.4840 +  obtain u where "u \<in> U" "u \<in> S"
  3.4841 +    using \<open>U \<noteq> {}\<close> opeU openin_imp_subset by fastforce+
  3.4842 +  have "infinite U"
  3.4843 +    apply (rule infinite_openin [OF opeU \<open>u \<in> U\<close>])
  3.4844 +    apply (rule connected_imp_perfect_aff_dim [OF \<open>connected S\<close> _ \<open>u \<in> S\<close>])
  3.4845 +    using True apply simp
  3.4846 +    done
  3.4847 +  then obtain P where "P \<subseteq> U" "finite P" "card K = card P"
  3.4848 +    using infinite_arbitrarily_large by metis
  3.4849 +  then obtain \<gamma> where \<gamma>: "bij_betw \<gamma> K P"
  3.4850 +    using \<open>finite K\<close> finite_same_card_bij by blast
  3.4851 +  have "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(id i) = \<gamma> i) \<and>
  3.4852 +               {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4853 +  proof (rule homeomorphism_moving_points_exists_gen [OF \<open>finite K\<close> _ _ True opeS S])
  3.4854 +    show "\<And>i. i \<in> K \<Longrightarrow> id i \<in> S \<and> \<gamma> i \<in> S"
  3.4855 +      by (metis id_apply opeU openin_contains_cball subsetCE \<open>P \<subseteq> U\<close> \<open>bij_betw \<gamma> K P\<close> \<open>K \<subseteq> S\<close> bij_betwE)
  3.4856 +    show "pairwise (\<lambda>i j. id i \<noteq> id j \<and> \<gamma> i \<noteq> \<gamma> j) K"
  3.4857 +      using \<gamma> by (auto simp: pairwise_def bij_betw_def inj_on_def)
  3.4858 +  qed
  3.4859 +  then show ?thesis
  3.4860 +    using \<gamma> \<open>P \<subseteq> U\<close> bij_betwE by (fastforce simp add: intro!: that)
  3.4861 +next
  3.4862 +  case False
  3.4863 +  with aff_dim_geq [of S] consider "aff_dim S = -1" | "aff_dim S = 0" | "aff_dim S = 1" by linarith
  3.4864 +  then show ?thesis
  3.4865 +  proof cases
  3.4866 +    assume "aff_dim S = -1"
  3.4867 +    then have "S = {}"
  3.4868 +      using aff_dim_empty by blast
  3.4869 +    then have "False"
  3.4870 +      using \<open>U \<noteq> {}\<close> \<open>K \<subseteq> S\<close> openin_imp_subset [OF opeU] by blast
  3.4871 +    then show ?thesis ..
  3.4872 +  next
  3.4873 +    assume "aff_dim S = 0"
  3.4874 +    then obtain a where "S = {a}"
  3.4875 +      using aff_dim_eq_0 by blast
  3.4876 +    then have "K \<subseteq> U"
  3.4877 +      using \<open>U \<noteq> {}\<close> \<open>K \<subseteq> S\<close> openin_imp_subset [OF opeU] by blast
  3.4878 +    show ?thesis
  3.4879 +      apply (rule that [of id id])
  3.4880 +      using \<open>K \<subseteq> U\<close> by (auto simp: continuous_on_id intro: homeomorphismI)
  3.4881 +  next
  3.4882 +    assume "aff_dim S = 1"
  3.4883 +    then have "affine hull S homeomorphic (UNIV :: real set)"
  3.4884 +      by (auto simp: homeomorphic_affine_sets)
  3.4885 +    then obtain h::"'a\<Rightarrow>real" and j where homhj: "homeomorphism (affine hull S) UNIV h j"
  3.4886 +      using homeomorphic_def by blast
  3.4887 +    then have h: "\<And>x. x \<in> affine hull S \<Longrightarrow> j(h(x)) = x" and j: "\<And>y. j y \<in> affine hull S \<and> h(j y) = y"
  3.4888 +      by (auto simp: homeomorphism_def)
  3.4889 +    have connh: "connected (h ` S)"
  3.4890 +      by (meson Topological_Spaces.connected_continuous_image \<open>connected S\<close> homeomorphism_cont1 homeomorphism_of_subsets homhj hull_subset top_greatest)
  3.4891 +    have hUS: "h ` U \<subseteq> h ` S"
  3.4892 +      by (meson homeomorphism_imp_open_map homeomorphism_of_subsets homhj hull_subset opeS opeU open_UNIV openin_open_eq)
  3.4893 +    have opn: "openin (subtopology euclidean (affine hull S)) U \<Longrightarrow> open (h ` U)" for U
  3.4894 +      using homeomorphism_imp_open_map [OF homhj]  by simp
  3.4895 +    have "open (h ` U)" "open (h ` S)"
  3.4896 +      by (auto intro: opeS opeU openin_trans opn)
  3.4897 +    then obtain f g where hom: "homeomorphism (h ` T) (h ` T) f g"
  3.4898 +                 and f: "\<And>x. x \<in> h ` K \<Longrightarrow> f x \<in> h ` U"
  3.4899 +                 and sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> h ` S"
  3.4900 +                 and bou: "bounded {x. \<not> (f x = x \<and> g x = x)}"
  3.4901 +      apply (rule homeomorphism_grouping_points_exists [of "h ` U" "h ` S" "h ` K" "h ` T"])
  3.4902 +      using assms by (auto simp: connh hUS)
  3.4903 +    have jf: "\<And>x. x \<in> affine hull S \<Longrightarrow> j (f (h x)) = x \<longleftrightarrow> f (h x) = h x"
  3.4904 +      by (metis h j)
  3.4905 +    have jg: "\<And>x. x \<in> affine hull S \<Longrightarrow> j (g (h x)) = x \<longleftrightarrow> g (h x) = h x"
  3.4906 +      by (metis h j)
  3.4907 +    have cont_hj: "continuous_on T h"  "continuous_on Y j" for Y
  3.4908 +      apply (rule continuous_on_subset [OF _ \<open>T \<subseteq> affine hull S\<close>])
  3.4909 +      using homeomorphism_def homhj apply blast
  3.4910 +      by (meson continuous_on_subset homeomorphism_def homhj top_greatest)
  3.4911 +    define f' where "f' \<equiv> \<lambda>x. if x \<in> affine hull S then (j \<circ> f \<circ> h) x else x"
  3.4912 +    define g' where "g' \<equiv> \<lambda>x. if x \<in> affine hull S then (j \<circ> g \<circ> h) x else x"
  3.4913 +    show ?thesis
  3.4914 +    proof
  3.4915 +      show "homeomorphism T T f' g'"
  3.4916 +      proof
  3.4917 +        have "continuous_on T (j \<circ> f \<circ> h)"
  3.4918 +          apply (intro continuous_on_compose cont_hj)
  3.4919 +          using hom homeomorphism_def by blast
  3.4920 +        then show "continuous_on T f'"
  3.4921 +          apply (rule continuous_on_eq)
  3.4922 +          using \<open>T \<subseteq> affine hull S\<close> f'_def by auto
  3.4923 +        have "continuous_on T (j \<circ> g \<circ> h)"
  3.4924 +          apply (intro continuous_on_compose cont_hj)
  3.4925 +          using hom homeomorphism_def by blast
  3.4926 +        then show "continuous_on T g'"
  3.4927 +          apply (rule continuous_on_eq)
  3.4928 +          using \<open>T \<subseteq> affine hull S\<close> g'_def by auto
  3.4929 +        show "f' ` T \<subseteq> T"
  3.4930 +        proof (clarsimp simp: f'_def)
  3.4931 +          fix x assume "x \<in> T"
  3.4932 +          then have "f (h x) \<in> h ` T"
  3.4933 +            by (metis (no_types) hom homeomorphism_def image_subset_iff subset_refl)
  3.4934 +          then show "j (f (h x)) \<in> T"
  3.4935 +            using \<open>T \<subseteq> affine hull S\<close> h by auto
  3.4936 +        qed
  3.4937 +        show "g' ` T \<subseteq> T"
  3.4938 +        proof (clarsimp simp: g'_def)
  3.4939 +          fix x assume "x \<in> T"
  3.4940 +          then have "g (h x) \<in> h ` T"
  3.4941 +            by (metis (no_types) hom homeomorphism_def image_subset_iff subset_refl)
  3.4942 +          then show "j (g (h x)) \<in> T"
  3.4943 +            using \<open>T \<subseteq> affine hull S\<close> h by auto
  3.4944 +        qed
  3.4945 +        show "\<And>x. x \<in> T \<Longrightarrow> g' (f' x) = x"
  3.4946 +          using h j hom homeomorphism_apply1 by (fastforce simp add: f'_def g'_def)
  3.4947 +        show "\<And>y. y \<in> T \<Longrightarrow> f' (g' y) = y"
  3.4948 +          using h j hom homeomorphism_apply2 by (fastforce simp add: f'_def g'_def)
  3.4949 +      qed
  3.4950 +    next
  3.4951 +      show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> S"
  3.4952 +        apply (clarsimp simp: f'_def g'_def jf jg)
  3.4953 +        apply (rule imageE [OF subsetD [OF sub]], force)
  3.4954 +        by (metis h hull_inc)
  3.4955 +    next
  3.4956 +      have "compact (j ` closure {x. \<not> (f x = x \<and> g x = x)})"
  3.4957 +        using bou by (auto simp: compact_continuous_image cont_hj)
  3.4958 +      then have "bounded (j ` {x. \<not> (f x = x \<and> g x = x)})"
  3.4959 +        by (rule bounded_closure_image [OF compact_imp_bounded])
  3.4960 +      moreover
  3.4961 +      have *: "{x \<in> affine hull S. j (f (h x)) \<noteq> x \<or> j (g (h x)) \<noteq> x} = j ` {x. (\<not> (f x = x \<and> g x = x))}"
  3.4962 +        using h j by (auto simp: image_iff; metis)
  3.4963 +      ultimately have "bounded {x \<in> affine hull S. j (f (h x)) \<noteq> x \<or> j (g (h x)) \<noteq> x}"
  3.4964 +        by metis
  3.4965 +      then show "bounded {x. \<not> (f' x = x \<and> g' x = x)}"
  3.4966 +        by (simp add: f'_def g'_def Collect_mono bounded_subset)
  3.4967 +    next
  3.4968 +      show "f' x \<in> U" if "x \<in> K" for x
  3.4969 +      proof -
  3.4970 +        have "U \<subseteq> S"
  3.4971 +          using opeU openin_imp_subset by blast
  3.4972 +        then have "j (f (h x)) \<in> U"
  3.4973 +          using f h hull_subset that by fastforce
  3.4974 +        then show "f' x \<in> U"
  3.4975 +          using \<open>K \<subseteq> S\<close> S f'_def that by auto
  3.4976 +      qed
  3.4977 +    qed
  3.4978 +  qed
  3.4979 +qed
  3.4980 +
  3.4981 +
  3.4982 +subsection\<open>Nullhomotopic mappings\<close>
  3.4983 +
  3.4984 +text\<open> A mapping out of a sphere is nullhomotopic iff it extends to the ball.
  3.4985 +This even works out in the degenerate cases when the radius is \<open>\<le>\<close> 0, and
  3.4986 +we also don't need to explicitly assume continuity since it's already implicit
  3.4987 +in both sides of the equivalence.\<close>
  3.4988 +
  3.4989 +lemma nullhomotopic_from_lemma:
  3.4990 +  assumes contg: "continuous_on (cball a r - {a}) g"
  3.4991 +      and fa: "\<And>e. 0 < e
  3.4992 +               \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>x. x \<noteq> a \<and> norm(x - a) < d \<longrightarrow> norm(g x - f a) < e)"
  3.4993 +      and r: "\<And>x. x \<in> cball a r \<and> x \<noteq> a \<Longrightarrow> f x = g x"
  3.4994 +    shows "continuous_on (cball a r) f"
  3.4995 +proof (clarsimp simp: continuous_on_eq_continuous_within Ball_def)
  3.4996 +  fix x
  3.4997 +  assume x: "dist a x \<le> r"
  3.4998 +  show "continuous (at x within cball a r) f"
  3.4999 +  proof (cases "x=a")
  3.5000 +    case True
  3.5001 +    then show ?thesis
  3.5002 +      by (metis continuous_within_eps_delta fa dist_norm dist_self r)
  3.5003 +  next
  3.5004 +    case False
  3.5005 +    show ?thesis
  3.5006 +    proof (rule continuous_transform_within [where f=g and d = "norm(x-a)"])
  3.5007 +      have "\<exists>d>0. \<forall>x'\<in>cball a r.
  3.5008 +                      dist x' x < d \<longrightarrow> dist (g x') (g x) < e" if "e>0" for e
  3.5009 +      proof -
  3.5010 +        obtain d where "d > 0"
  3.5011 +           and d: "\<And>x'. \<lbrakk>dist x' a \<le> r; x' \<noteq> a; dist x' x < d\<rbrakk> \<Longrightarrow>
  3.5012 +                                 dist (g x') (g x) < e"
  3.5013 +          using contg False x \<open>e>0\<close>
  3.5014 +          unfolding continuous_on_iff by (fastforce simp add: dist_commute intro: that)
  3.5015 +        show ?thesis
  3.5016 +          using \<open>d > 0\<close> \<open>x \<noteq> a\<close>
  3.5017 +          by (rule_tac x="min d (norm(x - a))" in exI)
  3.5018 +             (auto simp: dist_commute dist_norm [symmetric]  intro!: d)
  3.5019 +      qed
  3.5020 +      then show "continuous (at x within cball a r) g"
  3.5021 +        using contg False by (auto simp: continuous_within_eps_delta)
  3.5022 +      show "0 < norm (x - a)"
  3.5023 +        using False by force
  3.5024 +      show "x \<in> cball a r"
  3.5025 +        by (simp add: x)
  3.5026 +      show "\<And>x'. \<lbrakk>x' \<in> cball a r; dist x' x < norm (x - a)\<rbrakk>
  3.5027 +        \<Longrightarrow> g x' = f x'"
  3.5028 +        by (metis dist_commute dist_norm less_le r)
  3.5029 +    qed
  3.5030 +  qed
  3.5031 +qed
  3.5032 +
  3.5033 +proposition nullhomotopic_from_sphere_extension:
  3.5034 +  fixes f :: "'M::euclidean_space \<Rightarrow> 'a::real_normed_vector"
  3.5035 +  shows  "(\<exists>c. homotopic_with (\<lambda>x. True) (sphere a r) S f (\<lambda>x. c)) \<longleftrightarrow>
  3.5036 +          (\<exists>g. continuous_on (cball a r) g \<and> g ` (cball a r) \<subseteq> S \<and>
  3.5037 +               (\<forall>x \<in> sphere a r. g x = f x))"
  3.5038 +         (is "?lhs = ?rhs")
  3.5039 +proof (cases r "0::real" rule: linorder_cases)
  3.5040 +  case equal
  3.5041 +  then show ?thesis
  3.5042 +    apply (auto simp: homotopic_with)
  3.5043 +    apply (rule_tac x="\<lambda>x. h (0, a)" in exI)
  3.5044 +     apply (fastforce simp add:)
  3.5045 +    using continuous_on_const by blast
  3.5046 +next
  3.5047 +  case greater
  3.5048 +  let ?P = "continuous_on {x. norm(x - a) = r} f \<and> f ` {x. norm(x - a) = r} \<subseteq> S"
  3.5049 +  have ?P if ?lhs using that
  3.5050 +  proof
  3.5051 +    fix c
  3.5052 +    assume c: "homotopic_with (\<lambda>x. True) (sphere a r) S f (\<lambda>x. c)"
  3.5053 +    then have contf: "continuous_on (sphere a r) f" and fim: "f ` sphere a r \<subseteq> S"
  3.5054 +      by (auto simp: homotopic_with_imp_subset1 homotopic_with_imp_continuous)
  3.5055 +    show ?P
  3.5056 +      using contf fim by (auto simp: sphere_def dist_norm norm_minus_commute)
  3.5057 +  qed
  3.5058 +  moreover have ?P if ?rhs using that
  3.5059 +  proof
  3.5060 +    fix g
  3.5061 +    assume g: "continuous_on (cball a r) g \<and> g ` cball a r \<subseteq> S \<and> (\<forall>xa\<in>sphere a r. g xa = f xa)"
  3.5062 +    then
  3.5063 +    show ?P
  3.5064 +      apply (safe elim!: continuous_on_eq [OF continuous_on_subset])
  3.5065 +      apply (auto simp: dist_norm norm_minus_commute)
  3.5066 +      by (metis dist_norm image_subset_iff mem_sphere norm_minus_commute sphere_cball subsetCE)
  3.5067 +  qed
  3.5068 +  moreover have ?thesis if ?P
  3.5069 +  proof
  3.5070 +    assume ?lhs
  3.5071 +    then obtain c where "homotopic_with (\<lambda>x. True) (sphere a r) S (\<lambda>x. c) f"
  3.5072 +      using homotopic_with_sym by blast
  3.5073 +    then obtain h where conth: "continuous_on ({0..1::real} \<times> sphere a r) h"
  3.5074 +                    and him: "h ` ({0..1} \<times> sphere a r) \<subseteq> S"
  3.5075 +                    and h: "\<And>x. h(0, x) = c" "\<And>x. h(1, x) = f x"
  3.5076 +      by (auto simp: homotopic_with_def)
  3.5077 +    obtain b1::'M where "b1 \<in> Basis"
  3.5078 +      using SOME_Basis by auto
  3.5079 +    have "c \<in> S"
  3.5080 +      apply (rule him [THEN subsetD])
  3.5081 +      apply (rule_tac x = "(0, a + r *\<^sub>R b1)" in image_eqI)
  3.5082 +      using h greater \<open>b1 \<in> Basis\<close>
  3.5083 +       apply (auto simp: dist_norm)
  3.5084 +      done
  3.5085 +    have uconth: "uniformly_continuous_on ({0..1::real} \<times> (sphere a r)) h"
  3.5086 +      by (force intro: compact_Times conth compact_uniformly_continuous)
  3.5087 +    let ?g = "\<lambda>x. h (norm (x - a)/r,
  3.5088 +                     a + (if x = a then r *\<^sub>R b1 else (r / norm(x - a)) *\<^sub>R (x - a)))"
  3.5089 +    let ?g' = "\<lambda>x. h (norm (x - a)/r, a + (r / norm(x - a)) *\<^sub>R (x - a))"
  3.5090 +    show ?rhs
  3.5091 +    proof (intro exI conjI)
  3.5092 +      have "continuous_on (cball a r - {a}) ?g'"
  3.5093 +        apply (rule continuous_on_compose2 [OF conth])
  3.5094 +         apply (intro continuous_intros)
  3.5095 +        using greater apply (auto simp: dist_norm norm_minus_commute)
  3.5096 +        done
  3.5097 +      then show "continuous_on (cball a r) ?g"
  3.5098 +      proof (rule nullhomotopic_from_lemma)
  3.5099 +        show "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> norm (?g' x - ?g a) < e" if "0 < e" for e
  3.5100 +        proof -
  3.5101 +          obtain d where "0 < d"
  3.5102 +             and d: "\<And>x x'. \<lbrakk>x \<in> {0..1} \<times> sphere a r; x' \<in> {0..1} \<times> sphere a r; dist x' x < d\<rbrakk>
  3.5103 +                        \<Longrightarrow> dist (h x') (h x) < e"
  3.5104 +            using uniformly_continuous_onE [OF uconth \<open>0 < e\<close>] by auto
  3.5105 +          have *: "norm (h (norm (x - a) / r,
  3.5106 +                         a + (r / norm (x - a)) *\<^sub>R (x - a)) - h (0, a + r *\<^sub>R b1)) < e"
  3.5107 +                   if "x \<noteq> a" "norm (x - a) < r" "norm (x - a) < d * r" for x
  3.5108 +          proof -
  3.5109 +            have "norm (h (norm (x - a) / r, a + (r / norm (x - a)) *\<^sub>R (x - a)) - h (0, a + r *\<^sub>R b1)) =
  3.5110 +                  norm (h (norm (x - a) / r, a + (r / norm (x - a)) *\<^sub>R (x - a)) - h (0, a + (r / norm (x - a)) *\<^sub>R (x - a)))"
  3.5111 +              by (simp add: h)
  3.5112 +            also have "\<dots> < e"
  3.5113 +              apply (rule d [unfolded dist_norm])
  3.5114 +              using greater \<open>0 < d\<close> \<open>b1 \<in> Basis\<close> that
  3.5115 +                by (auto simp: dist_norm divide_simps)
  3.5116 +            finally show ?thesis .
  3.5117 +          qed
  3.5118 +          show ?thesis
  3.5119 +            apply (rule_tac x = "min r (d * r)" in exI)
  3.5120 +            using greater \<open>0 < d\<close> by (auto simp: *)
  3.5121 +        qed
  3.5122 +        show "\<And>x. x \<in> cball a r \<and> x \<noteq> a \<Longrightarrow> ?g x = ?g' x"
  3.5123 +          by auto
  3.5124 +      qed
  3.5125 +    next
  3.5126 +      show "?g ` cball a r \<subseteq> S"
  3.5127 +        using greater him \<open>c \<in> S\<close>
  3.5128 +        by (force simp: h dist_norm norm_minus_commute)
  3.5129 +    next
  3.5130 +      show "\<forall>x\<in>sphere a r. ?g x = f x"
  3.5131 +        using greater by (auto simp: h dist_norm norm_minus_commute)
  3.5132 +    qed
  3.5133 +  next
  3.5134 +    assume ?rhs
  3.5135 +    then obtain g where contg: "continuous_on (cball a r) g"
  3.5136 +                    and gim: "g ` cball a r \<subseteq> S"
  3.5137 +                    and gf: "\<forall>x \<in> sphere a r. g x = f x"
  3.5138 +      by auto
  3.5139 +    let ?h = "\<lambda>y. g (a + (fst y) *\<^sub>R (snd y - a))"
  3.5140 +    have "continuous_on ({0..1} \<times> sphere a r) ?h"
  3.5141 +      apply (rule continuous_on_compose2 [OF contg])
  3.5142 +       apply (intro continuous_intros)
  3.5143 +      apply (auto simp: dist_norm norm_minus_commute mult_left_le_one_le)
  3.5144 +      done
  3.5145 +    moreover
  3.5146 +    have "?h ` ({0..1} \<times> sphere a r) \<subseteq> S"
  3.5147 +      by (auto simp: dist_norm norm_minus_commute mult_left_le_one_le gim [THEN subsetD])
  3.5148 +    moreover
  3.5149 +    have "\<forall>x\<in>sphere a r. ?h (0, x) = g a" "\<forall>x\<in>sphere a r. ?h (1, x) = f x"
  3.5150 +      by (auto simp: dist_norm norm_minus_commute mult_left_le_one_le gf)
  3.5151 +    ultimately
  3.5152 +    show ?lhs
  3.5153 +      apply (subst homotopic_with_sym)
  3.5154 +      apply (rule_tac x="g a" in exI)
  3.5155 +      apply (auto simp: homotopic_with)
  3.5156 +      done
  3.5157 +  qed
  3.5158 +  ultimately
  3.5159 +  show ?thesis by meson
  3.5160 +qed simp
  3.5161 +
  3.5162 +end
  3.5163 \ No newline at end of file
     4.1 --- a/src/HOL/Analysis/Path_Connected.thy	Mon Jan 07 14:06:54 2019 +0100
     4.2 +++ b/src/HOL/Analysis/Path_Connected.thy	Mon Jan 07 14:57:45 2019 +0100
     4.3 @@ -2,10 +2,10 @@
     4.4      Authors:    LC Paulson and Robert Himmelmann (TU Muenchen), based on material from HOL Light
     4.5  *)
     4.6  
     4.7 -section \<open>Continuous Paths\<close>
     4.8 +section \<open>Path-Connectedness\<close>
     4.9  
    4.10  theory Path_Connected
    4.11 -  imports Continuous_Extension Continuum_Not_Denumerable
    4.12 +  imports Starlike
    4.13  begin
    4.14  
    4.15  subsection \<open>Paths and Arcs\<close>
    4.16 @@ -295,7 +295,7 @@
    4.17  qed
    4.18  
    4.19  
    4.20 -section%unimportant \<open>Path Images\<close>
    4.21 +subsection%unimportant \<open>Path Images\<close>
    4.22  
    4.23  lemma bounded_path_image: "path g \<Longrightarrow> bounded(path_image g)"
    4.24    by (simp add: compact_imp_bounded compact_path_image)
    4.25 @@ -1421,8 +1421,6 @@
    4.26      by (rule_tac x="e/2" in exI) auto
    4.27  qed
    4.28  
    4.29 -section "Path-Connectedness" (* TODO: separate theory? *)
    4.30 -
    4.31  subsection \<open>Path component\<close>
    4.32  
    4.33  text \<open>Original formalization by Tom Hales\<close>
    4.34 @@ -2531,7 +2529,7 @@
    4.35    by (meson cobounded_unique_unbounded_components connected_eq_connected_components_eq assms)
    4.36  
    4.37  
    4.38 -section\<open>The \<open>inside\<close> and \<open>outside\<close> of a Set\<close>
    4.39 +subsection\<open>The \<open>inside\<close> and \<open>outside\<close> of a Set\<close>
    4.40  
    4.41  text%important\<open>The inside comprises the points in a bounded connected component of the set's complement.
    4.42    The outside comprises the points in unbounded connected component of the complement.\<close>
    4.43 @@ -3386,5156 +3384,4 @@
    4.44        by (metis dw_le norm_minus_commute not_less order_trans rle wy)
    4.45  qed
    4.46  
    4.47 -
    4.48 -section \<open>Homotopy of Maps\<close> (* TODO separate theory? *)
    4.49 -
    4.50 -
    4.51 -definition%important homotopic_with ::
    4.52 -  "[('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> bool, 'a set, 'b set, 'a \<Rightarrow> 'b, 'a \<Rightarrow> 'b] \<Rightarrow> bool"
    4.53 -where
    4.54 - "homotopic_with P X Y p q \<equiv>
    4.55 -   (\<exists>h:: real \<times> 'a \<Rightarrow> 'b.
    4.56 -       continuous_on ({0..1} \<times> X) h \<and>
    4.57 -       h ` ({0..1} \<times> X) \<subseteq> Y \<and>
    4.58 -       (\<forall>x. h(0, x) = p x) \<and>
    4.59 -       (\<forall>x. h(1, x) = q x) \<and>
    4.60 -       (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
    4.61 -
    4.62 -text\<open>\<open>p\<close>, \<open>q\<close> are functions \<open>X \<rightarrow> Y\<close>, and the property \<open>P\<close> restricts all intermediate maps.
    4.63 -We often just want to require that \<open>P\<close> fixes some subset, but to include the case of a loop homotopy,
    4.64 -it is convenient to have a general property \<open>P\<close>.\<close>
    4.65 -
    4.66 -text \<open>We often want to just localize the ending function equality or whatever.\<close>
    4.67 -text%important \<open>%whitespace\<close>
    4.68 -proposition homotopic_with:
    4.69 -  fixes X :: "'a::topological_space set" and Y :: "'b::topological_space set"
    4.70 -  assumes "\<And>h k. (\<And>x. x \<in> X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k)"
    4.71 -  shows "homotopic_with P X Y p q \<longleftrightarrow>
    4.72 -           (\<exists>h :: real \<times> 'a \<Rightarrow> 'b.
    4.73 -              continuous_on ({0..1} \<times> X) h \<and>
    4.74 -              h ` ({0..1} \<times> X) \<subseteq> Y \<and>
    4.75 -              (\<forall>x \<in> X. h(0,x) = p x) \<and>
    4.76 -              (\<forall>x \<in> X. h(1,x) = q x) \<and>
    4.77 -              (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
    4.78 -  unfolding homotopic_with_def
    4.79 -  apply (rule iffI, blast, clarify)
    4.80 -  apply (rule_tac x="\<lambda>(u,v). if v \<in> X then h(u,v) else if u = 0 then p v else q v" in exI)
    4.81 -  apply auto
    4.82 -  apply (force elim: continuous_on_eq)
    4.83 -  apply (drule_tac x=t in bspec, force)
    4.84 -  apply (subst assms; simp)
    4.85 -  done
    4.86 -
    4.87 -proposition homotopic_with_eq:
    4.88 -   assumes h: "homotopic_with P X Y f g"
    4.89 -       and f': "\<And>x. x \<in> X \<Longrightarrow> f' x = f x"
    4.90 -       and g': "\<And>x. x \<in> X \<Longrightarrow> g' x = g x"
    4.91 -       and P:  "(\<And>h k. (\<And>x. x \<in> X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k))"
    4.92 -   shows "homotopic_with P X Y f' g'"
    4.93 -  using h unfolding homotopic_with_def
    4.94 -  apply safe
    4.95 -  apply (rule_tac x="\<lambda>(u,v). if v \<in> X then h(u,v) else if u = 0 then f' v else g' v" in exI)
    4.96 -  apply (simp add: f' g', safe)
    4.97 -  apply (fastforce intro: continuous_on_eq, fastforce)
    4.98 -  apply (subst P; fastforce)
    4.99 -  done
   4.100 -
   4.101 -proposition homotopic_with_equal:
   4.102 -   assumes contf: "continuous_on X f" and fXY: "f ` X \<subseteq> Y"
   4.103 -       and gf: "\<And>x. x \<in> X \<Longrightarrow> g x = f x"
   4.104 -       and P:  "P f" "P g"
   4.105 -   shows "homotopic_with P X Y f g"
   4.106 -  unfolding homotopic_with_def
   4.107 -  apply (rule_tac x="\<lambda>(u,v). if u = 1 then g v else f v" in exI)
   4.108 -  using assms
   4.109 -  apply (intro conjI)
   4.110 -  apply (rule continuous_on_eq [where f = "f \<circ> snd"])
   4.111 -  apply (rule continuous_intros | force)+
   4.112 -  apply clarify
   4.113 -  apply (case_tac "t=1"; force)
   4.114 -  done
   4.115 -
   4.116 -
   4.117 -lemma image_Pair_const: "(\<lambda>x. (x, c)) ` A = A \<times> {c}"
   4.118 -  by auto
   4.119 -
   4.120 -lemma homotopic_constant_maps:
   4.121 -   "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b) \<longleftrightarrow> s = {} \<or> path_component t a b"
   4.122 -proof (cases "s = {} \<or> t = {}")
   4.123 -  case True with continuous_on_const show ?thesis
   4.124 -    by (auto simp: homotopic_with path_component_def)
   4.125 -next
   4.126 -  case False
   4.127 -  then obtain c where "c \<in> s" by blast
   4.128 -  show ?thesis
   4.129 -  proof
   4.130 -    assume "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b)"
   4.131 -    then obtain h :: "real \<times> 'a \<Rightarrow> 'b"
   4.132 -        where conth: "continuous_on ({0..1} \<times> s) h"
   4.133 -          and h: "h ` ({0..1} \<times> s) \<subseteq> t" "(\<forall>x\<in>s. h (0, x) = a)" "(\<forall>x\<in>s. h (1, x) = b)"
   4.134 -      by (auto simp: homotopic_with)
   4.135 -    have "continuous_on {0..1} (h \<circ> (\<lambda>t. (t, c)))"
   4.136 -      apply (rule continuous_intros conth | simp add: image_Pair_const)+
   4.137 -      apply (blast intro:  \<open>c \<in> s\<close> continuous_on_subset [OF conth])
   4.138 -      done
   4.139 -    with \<open>c \<in> s\<close> h show "s = {} \<or> path_component t a b"
   4.140 -      apply (simp_all add: homotopic_with path_component_def, auto)
   4.141 -      apply (drule_tac x="h \<circ> (\<lambda>t. (t, c))" in spec)
   4.142 -      apply (auto simp: pathstart_def pathfinish_def path_image_def path_def)
   4.143 -      done
   4.144 -  next
   4.145 -    assume "s = {} \<or> path_component t a b"
   4.146 -    with False show "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b)"
   4.147 -      apply (clarsimp simp: homotopic_with path_component_def pathstart_def pathfinish_def path_image_def path_def)
   4.148 -      apply (rule_tac x="g \<circ> fst" in exI)
   4.149 -      apply (rule conjI continuous_intros | force)+
   4.150 -      done
   4.151 -  qed
   4.152 -qed
   4.153 -
   4.154 -
   4.155 -subsection%unimportant\<open>Trivial properties\<close>
   4.156 -
   4.157 -lemma homotopic_with_imp_property: "homotopic_with P X Y f g \<Longrightarrow> P f \<and> P g"
   4.158 -  unfolding homotopic_with_def Ball_def
   4.159 -  apply clarify
   4.160 -  apply (frule_tac x=0 in spec)
   4.161 -  apply (drule_tac x=1 in spec, auto)
   4.162 -  done
   4.163 -
   4.164 -lemma continuous_on_o_Pair: "\<lbrakk>continuous_on (T \<times> X) h; t \<in> T\<rbrakk> \<Longrightarrow> continuous_on X (h \<circ> Pair t)"
   4.165 -  by (fast intro: continuous_intros elim!: continuous_on_subset)
   4.166 -
   4.167 -lemma homotopic_with_imp_continuous:
   4.168 -    assumes "homotopic_with P X Y f g"
   4.169 -    shows "continuous_on X f \<and> continuous_on X g"
   4.170 -proof -
   4.171 -  obtain h :: "real \<times> 'a \<Rightarrow> 'b"
   4.172 -    where conth: "continuous_on ({0..1} \<times> X) h"
   4.173 -      and h: "\<forall>x. h (0, x) = f x" "\<forall>x. h (1, x) = g x"
   4.174 -    using assms by (auto simp: homotopic_with_def)
   4.175 -  have *: "t \<in> {0..1} \<Longrightarrow> continuous_on X (h \<circ> (\<lambda>x. (t,x)))" for t
   4.176 -    by (rule continuous_intros continuous_on_subset [OF conth] | force)+
   4.177 -  show ?thesis
   4.178 -    using h *[of 0] *[of 1] by auto
   4.179 -qed
   4.180 -
   4.181 -proposition homotopic_with_imp_subset1:
   4.182 -     "homotopic_with P X Y f g \<Longrightarrow> f ` X \<subseteq> Y"
   4.183 -  by (simp add: homotopic_with_def image_subset_iff) (metis atLeastAtMost_iff order_refl zero_le_one)
   4.184 -
   4.185 -proposition homotopic_with_imp_subset2:
   4.186 -     "homotopic_with P X Y f g \<Longrightarrow> g ` X \<subseteq> Y"
   4.187 -  by (simp add: homotopic_with_def image_subset_iff) (metis atLeastAtMost_iff order_refl zero_le_one)
   4.188 -
   4.189 -proposition homotopic_with_mono:
   4.190 -    assumes hom: "homotopic_with P X Y f g"
   4.191 -        and Q: "\<And>h. \<lbrakk>continuous_on X h; image h X \<subseteq> Y \<and> P h\<rbrakk> \<Longrightarrow> Q h"
   4.192 -      shows "homotopic_with Q X Y f g"
   4.193 -  using hom
   4.194 -  apply (simp add: homotopic_with_def)
   4.195 -  apply (erule ex_forward)
   4.196 -  apply (force simp: intro!: Q dest: continuous_on_o_Pair)
   4.197 -  done
   4.198 -
   4.199 -proposition homotopic_with_subset_left:
   4.200 -     "\<lbrakk>homotopic_with P X Y f g; Z \<subseteq> X\<rbrakk> \<Longrightarrow> homotopic_with P Z Y f g"
   4.201 -  apply (simp add: homotopic_with_def)
   4.202 -  apply (fast elim!: continuous_on_subset ex_forward)
   4.203 -  done
   4.204 -
   4.205 -proposition homotopic_with_subset_right:
   4.206 -     "\<lbrakk>homotopic_with P X Y f g; Y \<subseteq> Z\<rbrakk> \<Longrightarrow> homotopic_with P X Z f g"
   4.207 -  apply (simp add: homotopic_with_def)
   4.208 -  apply (fast elim!: continuous_on_subset ex_forward)
   4.209 -  done
   4.210 -
   4.211 -proposition homotopic_with_compose_continuous_right:
   4.212 -    "\<lbrakk>homotopic_with (\<lambda>f. p (f \<circ> h)) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
   4.213 -     \<Longrightarrow> homotopic_with p W Y (f \<circ> h) (g \<circ> h)"
   4.214 -  apply (clarsimp simp add: homotopic_with_def)
   4.215 -  apply (rename_tac k)
   4.216 -  apply (rule_tac x="k \<circ> (\<lambda>y. (fst y, h (snd y)))" in exI)
   4.217 -  apply (rule conjI continuous_intros continuous_on_compose [where f=snd and g=h, unfolded o_def] | simp)+
   4.218 -  apply (erule continuous_on_subset)
   4.219 -  apply (fastforce simp: o_def)+
   4.220 -  done
   4.221 -
   4.222 -proposition homotopic_compose_continuous_right:
   4.223 -     "\<lbrakk>homotopic_with (\<lambda>f. True) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
   4.224 -      \<Longrightarrow> homotopic_with (\<lambda>f. True) W Y (f \<circ> h) (g \<circ> h)"
   4.225 -  using homotopic_with_compose_continuous_right by fastforce
   4.226 -
   4.227 -proposition homotopic_with_compose_continuous_left:
   4.228 -     "\<lbrakk>homotopic_with (\<lambda>f. p (h \<circ> f)) X Y f g; continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
   4.229 -      \<Longrightarrow> homotopic_with p X Z (h \<circ> f) (h \<circ> g)"
   4.230 -  apply (clarsimp simp add: homotopic_with_def)
   4.231 -  apply (rename_tac k)
   4.232 -  apply (rule_tac x="h \<circ> k" in exI)
   4.233 -  apply (rule conjI continuous_intros continuous_on_compose [where f=snd and g=h, unfolded o_def] | simp)+
   4.234 -  apply (erule continuous_on_subset)
   4.235 -  apply (fastforce simp: o_def)+
   4.236 -  done
   4.237 -
   4.238 -proposition homotopic_compose_continuous_left:
   4.239 -   "\<lbrakk>homotopic_with (\<lambda>_. True) X Y f g;
   4.240 -     continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
   4.241 -    \<Longrightarrow> homotopic_with (\<lambda>f. True) X Z (h \<circ> f) (h \<circ> g)"
   4.242 -  using homotopic_with_compose_continuous_left by fastforce
   4.243 -
   4.244 -proposition homotopic_with_Pair:
   4.245 -   assumes hom: "homotopic_with p s t f g" "homotopic_with p' s' t' f' g'"
   4.246 -       and q: "\<And>f g. \<lbrakk>p f; p' g\<rbrakk> \<Longrightarrow> q(\<lambda>(x,y). (f x, g y))"
   4.247 -     shows "homotopic_with q (s \<times> s') (t \<times> t')
   4.248 -                  (\<lambda>(x,y). (f x, f' y)) (\<lambda>(x,y). (g x, g' y))"
   4.249 -  using hom
   4.250 -  apply (clarsimp simp add: homotopic_with_def)
   4.251 -  apply (rename_tac k k')
   4.252 -  apply (rule_tac x="\<lambda>z. ((k \<circ> (\<lambda>x. (fst x, fst (snd x)))) z, (k' \<circ> (\<lambda>x. (fst x, snd (snd x)))) z)" in exI)
   4.253 -  apply (rule conjI continuous_intros | erule continuous_on_subset | clarsimp)+
   4.254 -  apply (auto intro!: q [unfolded case_prod_unfold])
   4.255 -  done
   4.256 -
   4.257 -lemma homotopic_on_empty [simp]: "homotopic_with (\<lambda>x. True) {} t f g"
   4.258 -  by (metis continuous_on_def empty_iff homotopic_with_equal image_subset_iff)
   4.259 -
   4.260 -
   4.261 -text\<open>Homotopy with P is an equivalence relation (on continuous functions mapping X into Y that satisfy P,
   4.262 -     though this only affects reflexivity.\<close>
   4.263 -
   4.264 -
   4.265 -proposition homotopic_with_refl:
   4.266 -   "homotopic_with P X Y f f \<longleftrightarrow> continuous_on X f \<and> image f X \<subseteq> Y \<and> P f"
   4.267 -  apply (rule iffI)
   4.268 -  using homotopic_with_imp_continuous homotopic_with_imp_property homotopic_with_imp_subset2 apply blast
   4.269 -  apply (simp add: homotopic_with_def)
   4.270 -  apply (rule_tac x="f \<circ> snd" in exI)
   4.271 -  apply (rule conjI continuous_intros | force)+
   4.272 -  done
   4.273 -
   4.274 -lemma homotopic_with_symD:
   4.275 -  fixes X :: "'a::real_normed_vector set"
   4.276 -    assumes "homotopic_with P X Y f g"
   4.277 -      shows "homotopic_with P X Y g f"
   4.278 -  using assms
   4.279 -  apply (clarsimp simp add: homotopic_with_def)
   4.280 -  apply (rename_tac h)
   4.281 -  apply (rule_tac x="h \<circ> (\<lambda>y. (1 - fst y, snd y))" in exI)
   4.282 -  apply (rule conjI continuous_intros | erule continuous_on_subset | force simp: image_subset_iff)+
   4.283 -  done
   4.284 -
   4.285 -proposition homotopic_with_sym:
   4.286 -    fixes X :: "'a::real_normed_vector set"
   4.287 -    shows "homotopic_with P X Y f g \<longleftrightarrow> homotopic_with P X Y g f"
   4.288 -  using homotopic_with_symD by blast
   4.289 -
   4.290 -lemma split_01: "{0..1::real} = {0..1/2} \<union> {1/2..1}"
   4.291 -  by force
   4.292 -
   4.293 -lemma split_01_prod: "{0..1::real} \<times> X = ({0..1/2} \<times> X) \<union> ({1/2..1} \<times> X)"
   4.294 -  by force
   4.295 -
   4.296 -proposition homotopic_with_trans:
   4.297 -    fixes X :: "'a::real_normed_vector set"
   4.298 -    assumes "homotopic_with P X Y f g" and "homotopic_with P X Y g h"
   4.299 -      shows "homotopic_with P X Y f h"
   4.300 -proof -
   4.301 -  have clo1: "closedin (subtopology euclidean ({0..1/2} \<times> X \<union> {1/2..1} \<times> X)) ({0..1/2::real} \<times> X)"
   4.302 -    apply (simp add: closedin_closed split_01_prod [symmetric])
   4.303 -    apply (rule_tac x="{0..1/2} \<times> UNIV" in exI)
   4.304 -    apply (force simp: closed_Times)
   4.305 -    done
   4.306 -  have clo2: "closedin (subtopology euclidean ({0..1/2} \<times> X \<union> {1/2..1} \<times> X)) ({1/2..1::real} \<times> X)"
   4.307 -    apply (simp add: closedin_closed split_01_prod [symmetric])
   4.308 -    apply (rule_tac x="{1/2..1} \<times> UNIV" in exI)
   4.309 -    apply (force simp: closed_Times)
   4.310 -    done
   4.311 -  { fix k1 k2:: "real \<times> 'a \<Rightarrow> 'b"
   4.312 -    assume cont: "continuous_on ({0..1} \<times> X) k1" "continuous_on ({0..1} \<times> X) k2"
   4.313 -       and Y: "k1 ` ({0..1} \<times> X) \<subseteq> Y" "k2 ` ({0..1} \<times> X) \<subseteq> Y"
   4.314 -       and geq: "\<forall>x. k1 (1, x) = g x" "\<forall>x. k2 (0, x) = g x"
   4.315 -       and k12: "\<forall>x. k1 (0, x) = f x" "\<forall>x. k2 (1, x) = h x"
   4.316 -       and P:   "\<forall>t\<in>{0..1}. P (\<lambda>x. k1 (t, x))" "\<forall>t\<in>{0..1}. P (\<lambda>x. k2 (t, x))"
   4.317 -    define k where "k y =
   4.318 -      (if fst y \<le> 1 / 2
   4.319 -       then (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y
   4.320 -       else (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y)" for y
   4.321 -    have keq: "k1 (2 * u, v) = k2 (2 * u - 1, v)" if "u = 1/2"  for u v
   4.322 -      by (simp add: geq that)
   4.323 -    have "continuous_on ({0..1} \<times> X) k"
   4.324 -      using cont
   4.325 -      apply (simp add: split_01_prod k_def)
   4.326 -      apply (rule clo1 clo2 continuous_on_cases_local continuous_intros | erule continuous_on_subset | simp add: linear image_subset_iff)+
   4.327 -      apply (force simp: keq)
   4.328 -      done
   4.329 -    moreover have "k ` ({0..1} \<times> X) \<subseteq> Y"
   4.330 -      using Y by (force simp: k_def)
   4.331 -    moreover have "\<forall>x. k (0, x) = f x"
   4.332 -      by (simp add: k_def k12)
   4.333 -    moreover have "(\<forall>x. k (1, x) = h x)"
   4.334 -      by (simp add: k_def k12)
   4.335 -    moreover have "\<forall>t\<in>{0..1}. P (\<lambda>x. k (t, x))"
   4.336 -      using P
   4.337 -      apply (clarsimp simp add: k_def)
   4.338 -      apply (case_tac "t \<le> 1/2", auto)
   4.339 -      done
   4.340 -    ultimately have *: "\<exists>k :: real \<times> 'a \<Rightarrow> 'b.
   4.341 -                       continuous_on ({0..1} \<times> X) k \<and> k ` ({0..1} \<times> X) \<subseteq> Y \<and>
   4.342 -                       (\<forall>x. k (0, x) = f x) \<and> (\<forall>x. k (1, x) = h x) \<and> (\<forall>t\<in>{0..1}. P (\<lambda>x. k (t, x)))"
   4.343 -      by blast
   4.344 -  } note * = this
   4.345 -  show ?thesis
   4.346 -    using assms by (auto intro: * simp add: homotopic_with_def)
   4.347 -qed
   4.348 -
   4.349 -proposition homotopic_compose:
   4.350 -      fixes s :: "'a::real_normed_vector set"
   4.351 -      shows "\<lbrakk>homotopic_with (\<lambda>x. True) s t f f'; homotopic_with (\<lambda>x. True) t u g g'\<rbrakk>
   4.352 -             \<Longrightarrow> homotopic_with (\<lambda>x. True) s u (g \<circ> f) (g' \<circ> f')"
   4.353 -  apply (rule homotopic_with_trans [where g = "g \<circ> f'"])
   4.354 -  apply (metis homotopic_compose_continuous_left homotopic_with_imp_continuous homotopic_with_imp_subset1)
   4.355 -  by (metis homotopic_compose_continuous_right homotopic_with_imp_continuous homotopic_with_imp_subset2)
   4.356 -
   4.357 -
   4.358 -text\<open>Homotopic triviality implicitly incorporates path-connectedness.\<close>
   4.359 -lemma homotopic_triviality:
   4.360 -  fixes S :: "'a::real_normed_vector set"
   4.361 -  shows  "(\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> T \<and>
   4.362 -                 continuous_on S g \<and> g ` S \<subseteq> T
   4.363 -                 \<longrightarrow> homotopic_with (\<lambda>x. True) S T f g) \<longleftrightarrow>
   4.364 -          (S = {} \<or> path_connected T) \<and>
   4.365 -          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> T \<longrightarrow> (\<exists>c. homotopic_with (\<lambda>x. True) S T f (\<lambda>x. c)))"
   4.366 -          (is "?lhs = ?rhs")
   4.367 -proof (cases "S = {} \<or> T = {}")
   4.368 -  case True then show ?thesis by auto
   4.369 -next
   4.370 -  case False show ?thesis
   4.371 -  proof
   4.372 -    assume LHS [rule_format]: ?lhs
   4.373 -    have pab: "path_component T a b" if "a \<in> T" "b \<in> T" for a b
   4.374 -    proof -
   4.375 -      have "homotopic_with (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. b)"
   4.376 -        by (simp add: LHS continuous_on_const image_subset_iff that)
   4.377 -      then show ?thesis
   4.378 -        using False homotopic_constant_maps by blast
   4.379 -    qed
   4.380 -      moreover
   4.381 -    have "\<exists>c. homotopic_with (\<lambda>x. True) S T f (\<lambda>x. c)" if "continuous_on S f" "f ` S \<subseteq> T" for f
   4.382 -      by (metis (full_types) False LHS equals0I homotopic_constant_maps homotopic_with_imp_continuous homotopic_with_imp_subset2 pab that)
   4.383 -    ultimately show ?rhs
   4.384 -      by (simp add: path_connected_component)
   4.385 -  next
   4.386 -    assume RHS: ?rhs
   4.387 -    with False have T: "path_connected T"
   4.388 -      by blast
   4.389 -    show ?lhs
   4.390 -    proof clarify
   4.391 -      fix f g
   4.392 -      assume "continuous_on S f" "f ` S \<subseteq> T" "continuous_on S g" "g ` S \<subseteq> T"
   4.393 -      obtain c d where c: "homotopic_with (\<lambda>x. True) S T f (\<lambda>x. c)" and d: "homotopic_with (\<lambda>x. True) S T g (\<lambda>x. d)"
   4.394 -        using False \<open>continuous_on S f\<close> \<open>f ` S \<subseteq> T\<close>  RHS \<open>continuous_on S g\<close> \<open>g ` S \<subseteq> T\<close> by blast
   4.395 -      then have "c \<in> T" "d \<in> T"
   4.396 -        using False homotopic_with_imp_subset2 by fastforce+
   4.397 -      with T have "path_component T c d"
   4.398 -        using path_connected_component by blast
   4.399 -      then have "homotopic_with (\<lambda>x. True) S T (\<lambda>x. c) (\<lambda>x. d)"
   4.400 -        by (simp add: homotopic_constant_maps)
   4.401 -      with c d show "homotopic_with (\<lambda>x. True) S T f g"
   4.402 -        by (meson homotopic_with_symD homotopic_with_trans)
   4.403 -    qed
   4.404 -  qed
   4.405 -qed
   4.406 -
   4.407 -
   4.408 -subsection\<open>Homotopy of paths, maintaining the same endpoints\<close>
   4.409 -
   4.410 -
   4.411 -definition%important homotopic_paths :: "['a set, real \<Rightarrow> 'a, real \<Rightarrow> 'a::topological_space] \<Rightarrow> bool"
   4.412 -  where
   4.413 -     "homotopic_paths s p q \<equiv>
   4.414 -       homotopic_with (\<lambda>r. pathstart r = pathstart p \<and> pathfinish r = pathfinish p) {0..1} s p q"
   4.415 -
   4.416 -lemma homotopic_paths:
   4.417 -   "homotopic_paths s p q \<longleftrightarrow>
   4.418 -      (\<exists>h. continuous_on ({0..1} \<times> {0..1}) h \<and>
   4.419 -          h ` ({0..1} \<times> {0..1}) \<subseteq> s \<and>
   4.420 -          (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
   4.421 -          (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
   4.422 -          (\<forall>t \<in> {0..1::real}. pathstart(h \<circ> Pair t) = pathstart p \<and>
   4.423 -                        pathfinish(h \<circ> Pair t) = pathfinish p))"
   4.424 -  by (auto simp: homotopic_paths_def homotopic_with pathstart_def pathfinish_def)
   4.425 -
   4.426 -proposition homotopic_paths_imp_pathstart:
   4.427 -     "homotopic_paths s p q \<Longrightarrow> pathstart p = pathstart q"
   4.428 -  by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
   4.429 -
   4.430 -proposition homotopic_paths_imp_pathfinish:
   4.431 -     "homotopic_paths s p q \<Longrightarrow> pathfinish p = pathfinish q"
   4.432 -  by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
   4.433 -
   4.434 -lemma homotopic_paths_imp_path:
   4.435 -     "homotopic_paths s p q \<Longrightarrow> path p \<and> path q"
   4.436 -  using homotopic_paths_def homotopic_with_imp_continuous path_def by blast
   4.437 -
   4.438 -lemma homotopic_paths_imp_subset:
   4.439 -     "homotopic_paths s p q \<Longrightarrow> path_image p \<subseteq> s \<and> path_image q \<subseteq> s"
   4.440 -  by (simp add: homotopic_paths_def homotopic_with_imp_subset1 homotopic_with_imp_subset2 path_image_def)
   4.441 -
   4.442 -proposition homotopic_paths_refl [simp]: "homotopic_paths s p p \<longleftrightarrow> path p \<and> path_image p \<subseteq> s"
   4.443 -by (simp add: homotopic_paths_def homotopic_with_refl path_def path_image_def)
   4.444 -
   4.445 -proposition homotopic_paths_sym: "homotopic_paths s p q \<Longrightarrow> homotopic_paths s q p"
   4.446 -  by (metis (mono_tags) homotopic_paths_def homotopic_paths_imp_pathfinish homotopic_paths_imp_pathstart homotopic_with_symD)
   4.447 -
   4.448 -proposition homotopic_paths_sym_eq: "homotopic_paths s p q \<longleftrightarrow> homotopic_paths s q p"
   4.449 -  by (metis homotopic_paths_sym)
   4.450 -
   4.451 -proposition homotopic_paths_trans [trans]:
   4.452 -     "\<lbrakk>homotopic_paths s p q; homotopic_paths s q r\<rbrakk> \<Longrightarrow> homotopic_paths s p r"
   4.453 -  apply (simp add: homotopic_paths_def)
   4.454 -  apply (rule homotopic_with_trans, assumption)
   4.455 -  by (metis (mono_tags, lifting) homotopic_with_imp_property homotopic_with_mono)
   4.456 -
   4.457 -proposition homotopic_paths_eq:
   4.458 -     "\<lbrakk>path p; path_image p \<subseteq> s; \<And>t. t \<in> {0..1} \<Longrightarrow> p t = q t\<rbrakk> \<Longrightarrow> homotopic_paths s p q"
   4.459 -  apply (simp add: homotopic_paths_def)
   4.460 -  apply (rule homotopic_with_eq)
   4.461 -  apply (auto simp: path_def homotopic_with_refl pathstart_def pathfinish_def path_image_def elim: continuous_on_eq)
   4.462 -  done
   4.463 -
   4.464 -proposition homotopic_paths_reparametrize:
   4.465 -  assumes "path p"
   4.466 -      and pips: "path_image p \<subseteq> s"
   4.467 -      and contf: "continuous_on {0..1} f"
   4.468 -      and f01:"f ` {0..1} \<subseteq> {0..1}"
   4.469 -      and [simp]: "f(0) = 0" "f(1) = 1"
   4.470 -      and q: "\<And>t. t \<in> {0..1} \<Longrightarrow> q(t) = p(f t)"
   4.471 -    shows "homotopic_paths s p q"
   4.472 -proof -
   4.473 -  have contp: "continuous_on {0..1} p"
   4.474 -    by (metis \<open>path p\<close> path_def)
   4.475 -  then have "continuous_on {0..1} (p \<circ> f)"
   4.476 -    using contf continuous_on_compose continuous_on_subset f01 by blast
   4.477 -  then have "path q"
   4.478 -    by (simp add: path_def) (metis q continuous_on_cong)
   4.479 -  have piqs: "path_image q \<subseteq> s"
   4.480 -    by (metis (no_types, hide_lams) pips f01 image_subset_iff path_image_def q)
   4.481 -  have fb0: "\<And>a b. \<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> (1 - a) * f b + a * b"
   4.482 -    using f01 by force
   4.483 -  have fb1: "\<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> (1 - a) * f b + a * b \<le> 1" for a b
   4.484 -    using f01 [THEN subsetD, of "f b"] by (simp add: convex_bound_le)
   4.485 -  have "homotopic_paths s q p"
   4.486 -  proof (rule homotopic_paths_trans)
   4.487 -    show "homotopic_paths s q (p \<circ> f)"
   4.488 -      using q by (force intro: homotopic_paths_eq [OF  \<open>path q\<close> piqs])
   4.489 -  next
   4.490 -    show "homotopic_paths s (p \<circ> f) p"
   4.491 -      apply (simp add: homotopic_paths_def homotopic_with_def)
   4.492 -      apply (rule_tac x="p \<circ> (\<lambda>y. (1 - (fst y)) *\<^sub>R ((f \<circ> snd) y) + (fst y) *\<^sub>R snd y)"  in exI)
   4.493 -      apply (rule conjI contf continuous_intros continuous_on_subset [OF contp] | simp)+
   4.494 -      using pips [unfolded path_image_def]
   4.495 -      apply (auto simp: fb0 fb1 pathstart_def pathfinish_def)
   4.496 -      done
   4.497 -  qed
   4.498 -  then show ?thesis
   4.499 -    by (simp add: homotopic_paths_sym)
   4.500 -qed
   4.501 -
   4.502 -lemma homotopic_paths_subset: "\<lbrakk>homotopic_paths s p q; s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t p q"
   4.503 -  using homotopic_paths_def homotopic_with_subset_right by blast
   4.504 -
   4.505 -
   4.506 -text\<open> A slightly ad-hoc but useful lemma in constructing homotopies.\<close>
   4.507 -lemma homotopic_join_lemma:
   4.508 -  fixes q :: "[real,real] \<Rightarrow> 'a::topological_space"
   4.509 -  assumes p: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. p (fst y) (snd y))"
   4.510 -      and q: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. q (fst y) (snd y))"
   4.511 -      and pf: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish(p t) = pathstart(q t)"
   4.512 -    shows "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. (p(fst y) +++ q(fst y)) (snd y))"
   4.513 -proof -
   4.514 -  have 1: "(\<lambda>y. p (fst y) (2 * snd y)) = (\<lambda>y. p (fst y) (snd y)) \<circ> (\<lambda>y. (fst y, 2 * snd y))"
   4.515 -    by (rule ext) (simp)
   4.516 -  have 2: "(\<lambda>y. q (fst y) (2 * snd y - 1)) = (\<lambda>y. q (fst y) (snd y)) \<circ> (\<lambda>y. (fst y, 2 * snd y - 1))"
   4.517 -    by (rule ext) (simp)
   4.518 -  show ?thesis
   4.519 -    apply (simp add: joinpaths_def)
   4.520 -    apply (rule continuous_on_cases_le)
   4.521 -    apply (simp_all only: 1 2)
   4.522 -    apply (rule continuous_intros continuous_on_subset [OF p] continuous_on_subset [OF q] | force)+
   4.523 -    using pf
   4.524 -    apply (auto simp: mult.commute pathstart_def pathfinish_def)
   4.525 -    done
   4.526 -qed
   4.527 -
   4.528 -text\<open> Congruence properties of homotopy w.r.t. path-combining operations.\<close>
   4.529 -
   4.530 -lemma homotopic_paths_reversepath_D:
   4.531 -      assumes "homotopic_paths s p q"
   4.532 -      shows   "homotopic_paths s (reversepath p) (reversepath q)"
   4.533 -  using assms
   4.534 -  apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
   4.535 -  apply (rule_tac x="h \<circ> (\<lambda>x. (fst x, 1 - snd x))" in exI)
   4.536 -  apply (rule conjI continuous_intros)+
   4.537 -  apply (auto simp: reversepath_def pathstart_def pathfinish_def elim!: continuous_on_subset)
   4.538 -  done
   4.539 -
   4.540 -proposition homotopic_paths_reversepath:
   4.541 -     "homotopic_paths s (reversepath p) (reversepath q) \<longleftrightarrow> homotopic_paths s p q"
   4.542 -  using homotopic_paths_reversepath_D by force
   4.543 -
   4.544 -
   4.545 -proposition homotopic_paths_join:
   4.546 -    "\<lbrakk>homotopic_paths s p p'; homotopic_paths s q q'; pathfinish p = pathstart q\<rbrakk> \<Longrightarrow> homotopic_paths s (p +++ q) (p' +++ q')"
   4.547 -  apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
   4.548 -  apply (rename_tac k1 k2)
   4.549 -  apply (rule_tac x="(\<lambda>y. ((k1 \<circ> Pair (fst y)) +++ (k2 \<circ> Pair (fst y))) (snd y))" in exI)
   4.550 -  apply (rule conjI continuous_intros homotopic_join_lemma)+
   4.551 -  apply (auto simp: joinpaths_def pathstart_def pathfinish_def path_image_def)
   4.552 -  done
   4.553 -
   4.554 -proposition homotopic_paths_continuous_image:
   4.555 -    "\<lbrakk>homotopic_paths s f g; continuous_on s h; h ` s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t (h \<circ> f) (h \<circ> g)"
   4.556 -  unfolding homotopic_paths_def
   4.557 -  apply (rule homotopic_with_compose_continuous_left [of _ _ _ s])
   4.558 -  apply (auto simp: pathstart_def pathfinish_def elim!: homotopic_with_mono)
   4.559 -  done
   4.560 -
   4.561 -
   4.562 -subsection\<open>Group properties for homotopy of paths\<close>
   4.563 -
   4.564 -text%important\<open>So taking equivalence classes under homotopy would give the fundamental group\<close>
   4.565 -
   4.566 -proposition homotopic_paths_rid:
   4.567 -    "\<lbrakk>path p; path_image p \<subseteq> s\<rbrakk> \<Longrightarrow> homotopic_paths s (p +++ linepath (pathfinish p) (pathfinish p)) p"
   4.568 -  apply (subst homotopic_paths_sym)
   4.569 -  apply (rule homotopic_paths_reparametrize [where f = "\<lambda>t. if  t \<le> 1 / 2 then 2 *\<^sub>R t else 1"])
   4.570 -  apply (simp_all del: le_divide_eq_numeral1)
   4.571 -  apply (subst split_01)
   4.572 -  apply (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
   4.573 -  done
   4.574 -
   4.575 -proposition homotopic_paths_lid:
   4.576 -   "\<lbrakk>path p; path_image p \<subseteq> s\<rbrakk> \<Longrightarrow> homotopic_paths s (linepath (pathstart p) (pathstart p) +++ p) p"
   4.577 -  using homotopic_paths_rid [of "reversepath p" s]
   4.578 -  by (metis homotopic_paths_reversepath path_image_reversepath path_reversepath pathfinish_linepath
   4.579 -        pathfinish_reversepath reversepath_joinpaths reversepath_linepath)
   4.580 -
   4.581 -proposition homotopic_paths_assoc:
   4.582 -   "\<lbrakk>path p; path_image p \<subseteq> s; path q; path_image q \<subseteq> s; path r; path_image r \<subseteq> s; pathfinish p = pathstart q;
   4.583 -     pathfinish q = pathstart r\<rbrakk>
   4.584 -    \<Longrightarrow> homotopic_paths s (p +++ (q +++ r)) ((p +++ q) +++ r)"
   4.585 -  apply (subst homotopic_paths_sym)
   4.586 -  apply (rule homotopic_paths_reparametrize
   4.587 -           [where f = "\<lambda>t. if  t \<le> 1 / 2 then inverse 2 *\<^sub>R t
   4.588 -                           else if  t \<le> 3 / 4 then t - (1 / 4)
   4.589 -                           else 2 *\<^sub>R t - 1"])
   4.590 -  apply (simp_all del: le_divide_eq_numeral1)
   4.591 -  apply (simp add: subset_path_image_join)
   4.592 -  apply (rule continuous_on_cases_1 continuous_intros)+
   4.593 -  apply (auto simp: joinpaths_def)
   4.594 -  done
   4.595 -
   4.596 -proposition homotopic_paths_rinv:
   4.597 -  assumes "path p" "path_image p \<subseteq> s"
   4.598 -    shows "homotopic_paths s (p +++ reversepath p) (linepath (pathstart p) (pathstart p))"
   4.599 -proof -
   4.600 -  have "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. (subpath 0 (fst x) p +++ reversepath (subpath 0 (fst x) p)) (snd x))"
   4.601 -    using assms
   4.602 -    apply (simp add: joinpaths_def subpath_def reversepath_def path_def del: le_divide_eq_numeral1)
   4.603 -    apply (rule continuous_on_cases_le)
   4.604 -    apply (rule_tac [2] continuous_on_compose [of _ _ p, unfolded o_def])
   4.605 -    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
   4.606 -    apply (auto intro!: continuous_intros simp del: eq_divide_eq_numeral1)
   4.607 -    apply (force elim!: continuous_on_subset simp add: mult_le_one)+
   4.608 -    done
   4.609 -  then show ?thesis
   4.610 -    using assms
   4.611 -    apply (subst homotopic_paths_sym_eq)
   4.612 -    unfolding homotopic_paths_def homotopic_with_def
   4.613 -    apply (rule_tac x="(\<lambda>y. (subpath 0 (fst y) p +++ reversepath(subpath 0 (fst y) p)) (snd y))" in exI)
   4.614 -    apply (simp add: path_defs joinpaths_def subpath_def reversepath_def)
   4.615 -    apply (force simp: mult_le_one)
   4.616 -    done
   4.617 -qed
   4.618 -
   4.619 -proposition homotopic_paths_linv:
   4.620 -  assumes "path p" "path_image p \<subseteq> s"
   4.621 -    shows "homotopic_paths s (reversepath p +++ p) (linepath (pathfinish p) (pathfinish p))"
   4.622 -  using homotopic_paths_rinv [of "reversepath p" s] assms by simp
   4.623 -
   4.624 -
   4.625 -subsection\<open>Homotopy of loops without requiring preservation of endpoints\<close>
   4.626 -
   4.627 -definition%important homotopic_loops :: "'a::topological_space set \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool"  where
   4.628 - "homotopic_loops s p q \<equiv>
   4.629 -     homotopic_with (\<lambda>r. pathfinish r = pathstart r) {0..1} s p q"
   4.630 -
   4.631 -lemma homotopic_loops:
   4.632 -   "homotopic_loops s p q \<longleftrightarrow>
   4.633 -      (\<exists>h. continuous_on ({0..1::real} \<times> {0..1}) h \<and>
   4.634 -          image h ({0..1} \<times> {0..1}) \<subseteq> s \<and>
   4.635 -          (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
   4.636 -          (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
   4.637 -          (\<forall>t \<in> {0..1}. pathfinish(h \<circ> Pair t) = pathstart(h \<circ> Pair t)))"
   4.638 -  by (simp add: homotopic_loops_def pathstart_def pathfinish_def homotopic_with)
   4.639 -
   4.640 -proposition homotopic_loops_imp_loop:
   4.641 -     "homotopic_loops s p q \<Longrightarrow> pathfinish p = pathstart p \<and> pathfinish q = pathstart q"
   4.642 -using homotopic_with_imp_property homotopic_loops_def by blast
   4.643 -
   4.644 -proposition homotopic_loops_imp_path:
   4.645 -     "homotopic_loops s p q \<Longrightarrow> path p \<and> path q"
   4.646 -  unfolding homotopic_loops_def path_def
   4.647 -  using homotopic_with_imp_continuous by blast
   4.648 -
   4.649 -proposition homotopic_loops_imp_subset:
   4.650 -     "homotopic_loops s p q \<Longrightarrow> path_image p \<subseteq> s \<and> path_image q \<subseteq> s"
   4.651 -  unfolding homotopic_loops_def path_image_def
   4.652 -  by (metis homotopic_with_imp_subset1 homotopic_with_imp_subset2)
   4.653 -
   4.654 -proposition homotopic_loops_refl:
   4.655 -     "homotopic_loops s p p \<longleftrightarrow>
   4.656 -      path p \<and> path_image p \<subseteq> s \<and> pathfinish p = pathstart p"
   4.657 -  by (simp add: homotopic_loops_def homotopic_with_refl path_image_def path_def)
   4.658 -
   4.659 -proposition homotopic_loops_sym: "homotopic_loops s p q \<Longrightarrow> homotopic_loops s q p"
   4.660 -  by (simp add: homotopic_loops_def homotopic_with_sym)
   4.661 -
   4.662 -proposition homotopic_loops_sym_eq: "homotopic_loops s p q \<longleftrightarrow> homotopic_loops s q p"
   4.663 -  by (metis homotopic_loops_sym)
   4.664 -
   4.665 -proposition homotopic_loops_trans:
   4.666 -   "\<lbrakk>homotopic_loops s p q; homotopic_loops s q r\<rbrakk> \<Longrightarrow> homotopic_loops s p r"
   4.667 -  unfolding homotopic_loops_def by (blast intro: homotopic_with_trans)
   4.668 -
   4.669 -proposition homotopic_loops_subset:
   4.670 -   "\<lbrakk>homotopic_loops s p q; s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t p q"
   4.671 -  by (simp add: homotopic_loops_def homotopic_with_subset_right)
   4.672 -
   4.673 -proposition homotopic_loops_eq:
   4.674 -   "\<lbrakk>path p; path_image p \<subseteq> s; pathfinish p = pathstart p; \<And>t. t \<in> {0..1} \<Longrightarrow> p(t) = q(t)\<rbrakk>
   4.675 -          \<Longrightarrow> homotopic_loops s p q"
   4.676 -  unfolding homotopic_loops_def
   4.677 -  apply (rule homotopic_with_eq)
   4.678 -  apply (rule homotopic_with_refl [where f = p, THEN iffD2])
   4.679 -  apply (simp_all add: path_image_def path_def pathstart_def pathfinish_def)
   4.680 -  done
   4.681 -
   4.682 -proposition homotopic_loops_continuous_image:
   4.683 -   "\<lbrakk>homotopic_loops s f g; continuous_on s h; h ` s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t (h \<circ> f) (h \<circ> g)"
   4.684 -  unfolding homotopic_loops_def
   4.685 -  apply (rule homotopic_with_compose_continuous_left)
   4.686 -  apply (erule homotopic_with_mono)
   4.687 -  by (simp add: pathfinish_def pathstart_def)
   4.688 -
   4.689 -
   4.690 -subsection\<open>Relations between the two variants of homotopy\<close>
   4.691 -
   4.692 -proposition homotopic_paths_imp_homotopic_loops:
   4.693 -    "\<lbrakk>homotopic_paths s p q; pathfinish p = pathstart p; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> homotopic_loops s p q"
   4.694 -  by (auto simp: homotopic_paths_def homotopic_loops_def intro: homotopic_with_mono)
   4.695 -
   4.696 -proposition homotopic_loops_imp_homotopic_paths_null:
   4.697 -  assumes "homotopic_loops s p (linepath a a)"
   4.698 -    shows "homotopic_paths s p (linepath (pathstart p) (pathstart p))"
   4.699 -proof -
   4.700 -  have "path p" by (metis assms homotopic_loops_imp_path)
   4.701 -  have ploop: "pathfinish p = pathstart p" by (metis assms homotopic_loops_imp_loop)
   4.702 -  have pip: "path_image p \<subseteq> s" by (metis assms homotopic_loops_imp_subset)
   4.703 -  obtain h where conth: "continuous_on ({0..1::real} \<times> {0..1}) h"
   4.704 -             and hs: "h ` ({0..1} \<times> {0..1}) \<subseteq> s"
   4.705 -             and [simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(0,x) = p x"
   4.706 -             and [simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(1,x) = a"
   4.707 -             and ends: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish (h \<circ> Pair t) = pathstart (h \<circ> Pair t)"
   4.708 -    using assms by (auto simp: homotopic_loops homotopic_with)
   4.709 -  have conth0: "path (\<lambda>u. h (u, 0))"
   4.710 -    unfolding path_def
   4.711 -    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
   4.712 -    apply (force intro: continuous_intros continuous_on_subset [OF conth])+
   4.713 -    done
   4.714 -  have pih0: "path_image (\<lambda>u. h (u, 0)) \<subseteq> s"
   4.715 -    using hs by (force simp: path_image_def)
   4.716 -  have c1: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. h (fst x * snd x, 0))"
   4.717 -    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
   4.718 -    apply (force simp: mult_le_one intro: continuous_intros continuous_on_subset [OF conth])+
   4.719 -    done
   4.720 -  have c2: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. h (fst x - fst x * snd x, 0))"
   4.721 -    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
   4.722 -    apply (force simp: mult_left_le mult_le_one intro: continuous_intros continuous_on_subset [OF conth])+
   4.723 -    apply (rule continuous_on_subset [OF conth])
   4.724 -    apply (auto simp: algebra_simps add_increasing2 mult_left_le)
   4.725 -    done
   4.726 -  have [simp]: "\<And>t. \<lbrakk>0 \<le> t \<and> t \<le> 1\<rbrakk> \<Longrightarrow> h (t, 1) = h (t, 0)"
   4.727 -    using ends by (simp add: pathfinish_def pathstart_def)
   4.728 -  have adhoc_le: "c * 4 \<le> 1 + c * (d * 4)" if "\<not> d * 4 \<le> 3" "0 \<le> c" "c \<le> 1" for c d::real
   4.729 -  proof -
   4.730 -    have "c * 3 \<le> c * (d * 4)" using that less_eq_real_def by auto
   4.731 -    with \<open>c \<le> 1\<close> show ?thesis by fastforce
   4.732 -  qed
   4.733 -  have *: "\<And>p x. (path p \<and> path(reversepath p)) \<and>
   4.734 -                  (path_image p \<subseteq> s \<and> path_image(reversepath p) \<subseteq> s) \<and>
   4.735 -                  (pathfinish p = pathstart(linepath a a +++ reversepath p) \<and>
   4.736 -                   pathstart(reversepath p) = a) \<and> pathstart p = x
   4.737 -                  \<Longrightarrow> homotopic_paths s (p +++ linepath a a +++ reversepath p) (linepath x x)"
   4.738 -    by (metis homotopic_paths_lid homotopic_paths_join
   4.739 -              homotopic_paths_trans homotopic_paths_sym homotopic_paths_rinv)
   4.740 -  have 1: "homotopic_paths s p (p +++ linepath (pathfinish p) (pathfinish p))"
   4.741 -    using \<open>path p\<close> homotopic_paths_rid homotopic_paths_sym pip by blast
   4.742 -  moreover have "homotopic_paths s (p +++ linepath (pathfinish p) (pathfinish p))
   4.743 -                                   (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))"
   4.744 -    apply (rule homotopic_paths_sym)
   4.745 -    using homotopic_paths_lid [of "p +++ linepath (pathfinish p) (pathfinish p)" s]
   4.746 -    by (metis 1 homotopic_paths_imp_path homotopic_paths_imp_pathstart homotopic_paths_imp_subset)
   4.747 -  moreover have "homotopic_paths s (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))
   4.748 -                                   ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))"
   4.749 -    apply (simp add: homotopic_paths_def homotopic_with_def)
   4.750 -    apply (rule_tac x="\<lambda>y. (subpath 0 (fst y) (\<lambda>u. h (u, 0)) +++ (\<lambda>u. h (Pair (fst y) u)) +++ subpath (fst y) 0 (\<lambda>u. h (u, 0))) (snd y)" in exI)
   4.751 -    apply (simp add: subpath_reversepath)
   4.752 -    apply (intro conjI homotopic_join_lemma)
   4.753 -    using ploop
   4.754 -    apply (simp_all add: path_defs joinpaths_def o_def subpath_def conth c1 c2)
   4.755 -    apply (force simp: algebra_simps mult_le_one mult_left_le intro: hs [THEN subsetD] adhoc_le)
   4.756 -    done
   4.757 -  moreover have "homotopic_paths s ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))
   4.758 -                                   (linepath (pathstart p) (pathstart p))"
   4.759 -    apply (rule *)
   4.760 -    apply (simp add: pih0 pathstart_def pathfinish_def conth0)
   4.761 -    apply (simp add: reversepath_def joinpaths_def)
   4.762 -    done
   4.763 -  ultimately show ?thesis
   4.764 -    by (blast intro: homotopic_paths_trans)
   4.765 -qed
   4.766 -
   4.767 -proposition homotopic_loops_conjugate:
   4.768 -  fixes s :: "'a::real_normed_vector set"
   4.769 -  assumes "path p" "path q" and pip: "path_image p \<subseteq> s" and piq: "path_image q \<subseteq> s"
   4.770 -      and papp: "pathfinish p = pathstart q" and qloop: "pathfinish q = pathstart q"
   4.771 -    shows "homotopic_loops s (p +++ q +++ reversepath p) q"
   4.772 -proof -
   4.773 -  have contp: "continuous_on {0..1} p"  using \<open>path p\<close> [unfolded path_def] by blast
   4.774 -  have contq: "continuous_on {0..1} q"  using \<open>path q\<close> [unfolded path_def] by blast
   4.775 -  have c1: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. p ((1 - fst x) * snd x + fst x))"
   4.776 -    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
   4.777 -    apply (force simp: mult_le_one intro!: continuous_intros)
   4.778 -    apply (rule continuous_on_subset [OF contp])
   4.779 -    apply (auto simp: algebra_simps add_increasing2 mult_right_le_one_le sum_le_prod1)
   4.780 -    done
   4.781 -  have c2: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. p ((fst x - 1) * snd x + 1))"
   4.782 -    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
   4.783 -    apply (force simp: mult_le_one intro!: continuous_intros)
   4.784 -    apply (rule continuous_on_subset [OF contp])
   4.785 -    apply (auto simp: algebra_simps add_increasing2 mult_left_le_one_le)
   4.786 -    done
   4.787 -  have ps1: "\<And>a b. \<lbrakk>b * 2 \<le> 1; 0 \<le> b; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((1 - a) * (2 * b) + a) \<in> s"
   4.788 -    using sum_le_prod1
   4.789 -    by (force simp: algebra_simps add_increasing2 mult_left_le intro: pip [unfolded path_image_def, THEN subsetD])
   4.790 -  have ps2: "\<And>a b. \<lbrakk>\<not> 4 * b \<le> 3; b \<le> 1; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((a - 1) * (4 * b - 3) + 1) \<in> s"
   4.791 -    apply (rule pip [unfolded path_image_def, THEN subsetD])
   4.792 -    apply (rule image_eqI, blast)
   4.793 -    apply (simp add: algebra_simps)
   4.794 -    by (metis add_mono_thms_linordered_semiring(1) affine_ineq linear mult.commute mult.left_neutral mult_right_mono not_le
   4.795 -              add.commute zero_le_numeral)
   4.796 -  have qs: "\<And>a b. \<lbrakk>4 * b \<le> 3; \<not> b * 2 \<le> 1\<rbrakk> \<Longrightarrow> q (4 * b - 2) \<in> s"
   4.797 -    using path_image_def piq by fastforce
   4.798 -  have "homotopic_loops s (p +++ q +++ reversepath p)
   4.799 -                          (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q))"
   4.800 -    apply (simp add: homotopic_loops_def homotopic_with_def)
   4.801 -    apply (rule_tac x="(\<lambda>y. (subpath (fst y) 1 p +++ q +++ subpath 1 (fst y) p) (snd y))" in exI)
   4.802 -    apply (simp add: subpath_refl subpath_reversepath)
   4.803 -    apply (intro conjI homotopic_join_lemma)
   4.804 -    using papp qloop
   4.805 -    apply (simp_all add: path_defs joinpaths_def o_def subpath_def c1 c2)
   4.806 -    apply (force simp: contq intro: continuous_on_compose [of _ _ q, unfolded o_def] continuous_on_id continuous_on_snd)
   4.807 -    apply (auto simp: ps1 ps2 qs)
   4.808 -    done
   4.809 -  moreover have "homotopic_loops s (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q)) q"
   4.810 -  proof -
   4.811 -    have "homotopic_paths s (linepath (pathfinish q) (pathfinish q) +++ q) q"
   4.812 -      using \<open>path q\<close> homotopic_paths_lid qloop piq by auto
   4.813 -    hence 1: "\<And>f. homotopic_paths s f q \<or> \<not> homotopic_paths s f (linepath (pathfinish q) (pathfinish q) +++ q)"
   4.814 -      using homotopic_paths_trans by blast
   4.815 -    hence "homotopic_paths s (linepath (pathfinish q) (pathfinish q) +++ q +++ linepath (pathfinish q) (pathfinish q)) q"
   4.816 -    proof -
   4.817 -      have "homotopic_paths s (q +++ linepath (pathfinish q) (pathfinish q)) q"
   4.818 -        by (simp add: \<open>path q\<close> homotopic_paths_rid piq)
   4.819 -      thus ?thesis
   4.820 -        by (metis (no_types) 1 \<open>path q\<close> homotopic_paths_join homotopic_paths_rinv homotopic_paths_sym
   4.821 -                  homotopic_paths_trans qloop pathfinish_linepath piq)
   4.822 -    qed
   4.823 -    thus ?thesis
   4.824 -      by (metis (no_types) qloop homotopic_loops_sym homotopic_paths_imp_homotopic_loops homotopic_paths_imp_pathfinish homotopic_paths_sym)
   4.825 -  qed
   4.826 -  ultimately show ?thesis
   4.827 -    by (blast intro: homotopic_loops_trans)
   4.828 -qed
   4.829 -
   4.830 -lemma homotopic_paths_loop_parts:
   4.831 -  assumes loops: "homotopic_loops S (p +++ reversepath q) (linepath a a)" and "path q"
   4.832 -  shows "homotopic_paths S p q"
   4.833 -proof -
   4.834 -  have paths: "homotopic_paths S (p +++ reversepath q) (linepath (pathstart p) (pathstart p))"
   4.835 -    using homotopic_loops_imp_homotopic_paths_null [OF loops] by simp
   4.836 -  then have "path p"
   4.837 -    using \<open>path q\<close> homotopic_loops_imp_path loops path_join path_join_path_ends path_reversepath by blast
   4.838 -  show ?thesis
   4.839 -  proof (cases "pathfinish p = pathfinish q")
   4.840 -    case True
   4.841 -    have pipq: "path_image p \<subseteq> S" "path_image q \<subseteq> S"
   4.842 -      by (metis Un_subset_iff paths \<open>path p\<close> \<open>path q\<close> homotopic_loops_imp_subset homotopic_paths_imp_path loops
   4.843 -           path_image_join path_image_reversepath path_imp_reversepath path_join_eq)+
   4.844 -    have "homotopic_paths S p (p +++ (linepath (pathfinish p) (pathfinish p)))"
   4.845 -      using \<open>path p\<close> \<open>path_image p \<subseteq> S\<close> homotopic_paths_rid homotopic_paths_sym by blast
   4.846 -    moreover have "homotopic_paths S (p +++ (linepath (pathfinish p) (pathfinish p))) (p +++ (reversepath q +++ q))"
   4.847 -      by (simp add: True \<open>path p\<close> \<open>path q\<close> pipq homotopic_paths_join homotopic_paths_linv homotopic_paths_sym)
   4.848 -    moreover have "homotopic_paths S (p +++ (reversepath q +++ q)) ((p +++ reversepath q) +++ q)"
   4.849 -      by (simp add: True \<open>path p\<close> \<open>path q\<close> homotopic_paths_assoc pipq)
   4.850 -    moreover have "homotopic_paths S ((p +++ reversepath q) +++ q) (linepath (pathstart p) (pathstart p) +++ q)"
   4.851 -      by (simp add: \<open>path q\<close> homotopic_paths_join paths pipq)
   4.852 -    moreover then have "homotopic_paths S (linepath (pathstart p) (pathstart p) +++ q) q"
   4.853 -      by (metis \<open>path q\<close> homotopic_paths_imp_path homotopic_paths_lid linepath_trivial path_join_path_ends pathfinish_def pipq(2))
   4.854 -    ultimately show ?thesis
   4.855 -      using homotopic_paths_trans by metis
   4.856 -  next
   4.857 -    case False
   4.858 -    then show ?thesis
   4.859 -      using \<open>path q\<close> homotopic_loops_imp_path loops path_join_path_ends by fastforce
   4.860 -  qed
   4.861 -qed
   4.862 -
   4.863 -
   4.864 -subsection%unimportant\<open>Homotopy of "nearby" function, paths and loops\<close>
   4.865 -
   4.866 -lemma homotopic_with_linear:
   4.867 -  fixes f g :: "_ \<Rightarrow> 'b::real_normed_vector"
   4.868 -  assumes contf: "continuous_on s f"
   4.869 -      and contg:"continuous_on s g"
   4.870 -      and sub: "\<And>x. x \<in> s \<Longrightarrow> closed_segment (f x) (g x) \<subseteq> t"
   4.871 -    shows "homotopic_with (\<lambda>z. True) s t f g"
   4.872 -  apply (simp add: homotopic_with_def)
   4.873 -  apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R f(snd y) + (fst y) *\<^sub>R g(snd y))" in exI)
   4.874 -  apply (intro conjI)
   4.875 -  apply (rule subset_refl continuous_intros continuous_on_subset [OF contf] continuous_on_compose2 [where g=f]
   4.876 -                                            continuous_on_subset [OF contg] continuous_on_compose2 [where g=g]| simp)+
   4.877 -  using sub closed_segment_def apply fastforce+
   4.878 -  done
   4.879 -
   4.880 -lemma homotopic_paths_linear:
   4.881 -  fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   4.882 -  assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
   4.883 -          "\<And>t. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> s"
   4.884 -    shows "homotopic_paths s g h"
   4.885 -  using assms
   4.886 -  unfolding path_def
   4.887 -  apply (simp add: closed_segment_def pathstart_def pathfinish_def homotopic_paths_def homotopic_with_def)
   4.888 -  apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R (g \<circ> snd) y + (fst y) *\<^sub>R (h \<circ> snd) y)" in exI)
   4.889 -  apply (intro conjI subsetI continuous_intros; force)
   4.890 -  done
   4.891 -
   4.892 -lemma homotopic_loops_linear:
   4.893 -  fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   4.894 -  assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
   4.895 -          "\<And>t x. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> s"
   4.896 -    shows "homotopic_loops s g h"
   4.897 -  using assms
   4.898 -  unfolding path_def
   4.899 -  apply (simp add: pathstart_def pathfinish_def homotopic_loops_def homotopic_with_def)
   4.900 -  apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R g(snd y) + (fst y) *\<^sub>R h(snd y))" in exI)
   4.901 -  apply (auto intro!: continuous_intros intro: continuous_on_compose2 [where g=g] continuous_on_compose2 [where g=h])
   4.902 -  apply (force simp: closed_segment_def)
   4.903 -  done
   4.904 -
   4.905 -lemma homotopic_paths_nearby_explicit:
   4.906 -  assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
   4.907 -      and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> s\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
   4.908 -    shows "homotopic_paths s g h"
   4.909 -  apply (rule homotopic_paths_linear [OF assms(1-4)])
   4.910 -  by (metis no segment_bound(1) subsetI norm_minus_commute not_le)
   4.911 -
   4.912 -lemma homotopic_loops_nearby_explicit:
   4.913 -  assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
   4.914 -      and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> s\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
   4.915 -    shows "homotopic_loops s g h"
   4.916 -  apply (rule homotopic_loops_linear [OF assms(1-4)])
   4.917 -  by (metis no segment_bound(1) subsetI norm_minus_commute not_le)
   4.918 -
   4.919 -lemma homotopic_nearby_paths:
   4.920 -  fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   4.921 -  assumes "path g" "open s" "path_image g \<subseteq> s"
   4.922 -    shows "\<exists>e. 0 < e \<and>
   4.923 -               (\<forall>h. path h \<and>
   4.924 -                    pathstart h = pathstart g \<and> pathfinish h = pathfinish g \<and>
   4.925 -                    (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_paths s g h)"
   4.926 -proof -
   4.927 -  obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - s \<Longrightarrow> e \<le> dist x y"
   4.928 -    using separate_compact_closed [of "path_image g" "-s"] assms by force
   4.929 -  show ?thesis
   4.930 -    apply (intro exI conjI)
   4.931 -    using e [unfolded dist_norm]
   4.932 -    apply (auto simp: intro!: homotopic_paths_nearby_explicit assms  \<open>e > 0\<close>)
   4.933 -    by (metis atLeastAtMost_iff imageI le_less_trans not_le path_image_def)
   4.934 -qed
   4.935 -
   4.936 -lemma homotopic_nearby_loops:
   4.937 -  fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   4.938 -  assumes "path g" "open s" "path_image g \<subseteq> s" "pathfinish g = pathstart g"
   4.939 -    shows "\<exists>e. 0 < e \<and>
   4.940 -               (\<forall>h. path h \<and> pathfinish h = pathstart h \<and>
   4.941 -                    (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_loops s g h)"
   4.942 -proof -
   4.943 -  obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - s \<Longrightarrow> e \<le> dist x y"
   4.944 -    using separate_compact_closed [of "path_image g" "-s"] assms by force
   4.945 -  show ?thesis
   4.946 -    apply (intro exI conjI)
   4.947 -    using e [unfolded dist_norm]
   4.948 -    apply (auto simp: intro!: homotopic_loops_nearby_explicit assms  \<open>e > 0\<close>)
   4.949 -    by (metis atLeastAtMost_iff imageI le_less_trans not_le path_image_def)
   4.950 -qed
   4.951 -
   4.952 -
   4.953 -subsection\<open> Homotopy and subpaths\<close>
   4.954 -
   4.955 -lemma homotopic_join_subpaths1:
   4.956 -  assumes "path g" and pag: "path_image g \<subseteq> s"
   4.957 -      and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}" "u \<le> v" "v \<le> w"
   4.958 -    shows "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
   4.959 -proof -
   4.960 -  have 1: "t * 2 \<le> 1 \<Longrightarrow> u + t * (v * 2) \<le> v + t * (u * 2)" for t
   4.961 -    using affine_ineq \<open>u \<le> v\<close> by fastforce
   4.962 -  have 2: "t * 2 > 1 \<Longrightarrow> u + (2*t - 1) * v \<le> v + (2*t - 1) * w" for t
   4.963 -    by (metis add_mono_thms_linordered_semiring(1) diff_gt_0_iff_gt less_eq_real_def mult.commute mult_right_mono \<open>u \<le> v\<close> \<open>v \<le> w\<close>)
   4.964 -  have t2: "\<And>t::real. t*2 = 1 \<Longrightarrow> t = 1/2" by auto
   4.965 -  show ?thesis
   4.966 -    apply (rule homotopic_paths_subset [OF _ pag])
   4.967 -    using assms
   4.968 -    apply (cases "w = u")
   4.969 -    using homotopic_paths_rinv [of "subpath u v g" "path_image g"]
   4.970 -    apply (force simp: closed_segment_eq_real_ivl image_mono path_image_def subpath_refl)
   4.971 -      apply (rule homotopic_paths_sym)
   4.972 -      apply (rule homotopic_paths_reparametrize
   4.973 -             [where f = "\<lambda>t. if  t \<le> 1 / 2
   4.974 -                             then inverse((w - u)) *\<^sub>R (2 * (v - u)) *\<^sub>R t
   4.975 -                             else inverse((w - u)) *\<^sub>R ((v - u) + (w - v) *\<^sub>R (2 *\<^sub>R t - 1))"])
   4.976 -      using \<open>path g\<close> path_subpath u w apply blast
   4.977 -      using \<open>path g\<close> path_image_subpath_subset u w(1) apply blast
   4.978 -      apply simp_all
   4.979 -      apply (subst split_01)
   4.980 -      apply (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
   4.981 -      apply (simp_all add: field_simps not_le)
   4.982 -      apply (force dest!: t2)
   4.983 -      apply (force simp: algebra_simps mult_left_mono affine_ineq dest!: 1 2)
   4.984 -      apply (simp add: joinpaths_def subpath_def)
   4.985 -      apply (force simp: algebra_simps)
   4.986 -      done
   4.987 -qed
   4.988 -
   4.989 -lemma homotopic_join_subpaths2:
   4.990 -  assumes "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
   4.991 -    shows "homotopic_paths s (subpath w v g +++ subpath v u g) (subpath w u g)"
   4.992 -by (metis assms homotopic_paths_reversepath_D pathfinish_subpath pathstart_subpath reversepath_joinpaths reversepath_subpath)
   4.993 -
   4.994 -lemma homotopic_join_subpaths3:
   4.995 -  assumes hom: "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
   4.996 -      and "path g" and pag: "path_image g \<subseteq> s"
   4.997 -      and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}"
   4.998 -    shows "homotopic_paths s (subpath v w g +++ subpath w u g) (subpath v u g)"
   4.999 -proof -
  4.1000 -  have "homotopic_paths s (subpath u w g +++ subpath w v g) ((subpath u v g +++ subpath v w g) +++ subpath w v g)"
  4.1001 -    apply (rule homotopic_paths_join)
  4.1002 -    using hom homotopic_paths_sym_eq apply blast
  4.1003 -    apply (metis \<open>path g\<close> homotopic_paths_eq pag path_image_subpath_subset path_subpath subset_trans v w, simp)
  4.1004 -    done
  4.1005 -  also have "homotopic_paths s ((subpath u v g +++ subpath v w g) +++ subpath w v g) (subpath u v g +++ subpath v w g +++ subpath w v g)"
  4.1006 -    apply (rule homotopic_paths_sym [OF homotopic_paths_assoc])
  4.1007 -    using assms by (simp_all add: path_image_subpath_subset [THEN order_trans])
  4.1008 -  also have "homotopic_paths s (subpath u v g +++ subpath v w g +++ subpath w v g)
  4.1009 -                               (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g)))"
  4.1010 -    apply (rule homotopic_paths_join)
  4.1011 -    apply (metis \<open>path g\<close> homotopic_paths_eq order.trans pag path_image_subpath_subset path_subpath u v)
  4.1012 -    apply (metis (no_types, lifting) \<open>path g\<close> homotopic_paths_linv order_trans pag path_image_subpath_subset path_subpath pathfinish_subpath reversepath_subpath v w)
  4.1013 -    apply simp
  4.1014 -    done
  4.1015 -  also have "homotopic_paths s (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g))) (subpath u v g)"
  4.1016 -    apply (rule homotopic_paths_rid)
  4.1017 -    using \<open>path g\<close> path_subpath u v apply blast
  4.1018 -    apply (meson \<open>path g\<close> order.trans pag path_image_subpath_subset u v)
  4.1019 -    done
  4.1020 -  finally have "homotopic_paths s (subpath u w g +++ subpath w v g) (subpath u v g)" .
  4.1021 -  then show ?thesis
  4.1022 -    using homotopic_join_subpaths2 by blast
  4.1023 -qed
  4.1024 -
  4.1025 -proposition homotopic_join_subpaths:
  4.1026 -   "\<lbrakk>path g; path_image g \<subseteq> s; u \<in> {0..1}; v \<in> {0..1}; w \<in> {0..1}\<rbrakk>
  4.1027 -    \<Longrightarrow> homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
  4.1028 -  apply (rule le_cases3 [of u v w])
  4.1029 -using homotopic_join_subpaths1 homotopic_join_subpaths2 homotopic_join_subpaths3 by metis+
  4.1030 -
  4.1031 -text\<open>Relating homotopy of trivial loops to path-connectedness.\<close>
  4.1032 -
  4.1033 -lemma path_component_imp_homotopic_points:
  4.1034 -    "path_component S a b \<Longrightarrow> homotopic_loops S (linepath a a) (linepath b b)"
  4.1035 -apply (simp add: path_component_def homotopic_loops_def homotopic_with_def
  4.1036 -                 pathstart_def pathfinish_def path_image_def path_def, clarify)
  4.1037 -apply (rule_tac x="g \<circ> fst" in exI)
  4.1038 -apply (intro conjI continuous_intros continuous_on_compose)+
  4.1039 -apply (auto elim!: continuous_on_subset)
  4.1040 -done
  4.1041 -
  4.1042 -lemma homotopic_loops_imp_path_component_value:
  4.1043 -   "\<lbrakk>homotopic_loops S p q; 0 \<le> t; t \<le> 1\<rbrakk>
  4.1044 -        \<Longrightarrow> path_component S (p t) (q t)"
  4.1045 -apply (simp add: path_component_def homotopic_loops_def homotopic_with_def
  4.1046 -                 pathstart_def pathfinish_def path_image_def path_def, clarify)
  4.1047 -apply (rule_tac x="h \<circ> (\<lambda>u. (u, t))" in exI)
  4.1048 -apply (intro conjI continuous_intros continuous_on_compose)+
  4.1049 -apply (auto elim!: continuous_on_subset)
  4.1050 -done
  4.1051 -
  4.1052 -lemma homotopic_points_eq_path_component:
  4.1053 -   "homotopic_loops S (linepath a a) (linepath b b) \<longleftrightarrow>
  4.1054 -        path_component S a b"
  4.1055 -by (auto simp: path_component_imp_homotopic_points
  4.1056 -         dest: homotopic_loops_imp_path_component_value [where t=1])
  4.1057 -
  4.1058 -lemma path_connected_eq_homotopic_points:
  4.1059 -    "path_connected S \<longleftrightarrow>
  4.1060 -      (\<forall>a b. a \<in> S \<and> b \<in> S \<longrightarrow> homotopic_loops S (linepath a a) (linepath b b))"
  4.1061 -by (auto simp: path_connected_def path_component_def homotopic_points_eq_path_component)
  4.1062 -
  4.1063 -
  4.1064 -subsection\<open>Simply connected sets\<close>
  4.1065 -
  4.1066 -text%important\<open>defined as "all loops are homotopic (as loops)\<close>
  4.1067 -
  4.1068 -definition%important simply_connected where
  4.1069 -  "simply_connected S \<equiv>
  4.1070 -        \<forall>p q. path p \<and> pathfinish p = pathstart p \<and> path_image p \<subseteq> S \<and>
  4.1071 -              path q \<and> pathfinish q = pathstart q \<and> path_image q \<subseteq> S
  4.1072 -              \<longrightarrow> homotopic_loops S p q"
  4.1073 -
  4.1074 -lemma simply_connected_empty [iff]: "simply_connected {}"
  4.1075 -  by (simp add: simply_connected_def)
  4.1076 -
  4.1077 -lemma simply_connected_imp_path_connected:
  4.1078 -  fixes S :: "_::real_normed_vector set"
  4.1079 -  shows "simply_connected S \<Longrightarrow> path_connected S"
  4.1080 -by (simp add: simply_connected_def path_connected_eq_homotopic_points)
  4.1081 -
  4.1082 -lemma simply_connected_imp_connected:
  4.1083 -  fixes S :: "_::real_normed_vector set"
  4.1084 -  shows "simply_connected S \<Longrightarrow> connected S"
  4.1085 -by (simp add: path_connected_imp_connected simply_connected_imp_path_connected)
  4.1086 -
  4.1087 -lemma simply_connected_eq_contractible_loop_any:
  4.1088 -  fixes S :: "_::real_normed_vector set"
  4.1089 -  shows "simply_connected S \<longleftrightarrow>
  4.1090 -            (\<forall>p a. path p \<and> path_image p \<subseteq> S \<and>
  4.1091 -                  pathfinish p = pathstart p \<and> a \<in> S
  4.1092 -                  \<longrightarrow> homotopic_loops S p (linepath a a))"
  4.1093 -apply (simp add: simply_connected_def)
  4.1094 -apply (rule iffI, force, clarify)
  4.1095 -apply (rule_tac q = "linepath (pathstart p) (pathstart p)" in homotopic_loops_trans)
  4.1096 -apply (fastforce simp add:)
  4.1097 -using homotopic_loops_sym apply blast
  4.1098 -done
  4.1099 -
  4.1100 -lemma simply_connected_eq_contractible_loop_some:
  4.1101 -  fixes S :: "_::real_normed_vector set"
  4.1102 -  shows "simply_connected S \<longleftrightarrow>
  4.1103 -                path_connected S \<and>
  4.1104 -                (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
  4.1105 -                    \<longrightarrow> (\<exists>a. a \<in> S \<and> homotopic_loops S p (linepath a a)))"
  4.1106 -apply (rule iffI)
  4.1107 - apply (fastforce simp: simply_connected_imp_path_connected simply_connected_eq_contractible_loop_any)
  4.1108 -apply (clarsimp simp add: simply_connected_eq_contractible_loop_any)
  4.1109 -apply (drule_tac x=p in spec)
  4.1110 -using homotopic_loops_trans path_connected_eq_homotopic_points
  4.1111 -  apply blast
  4.1112 -done
  4.1113 -
  4.1114 -lemma simply_connected_eq_contractible_loop_all:
  4.1115 -  fixes S :: "_::real_normed_vector set"
  4.1116 -  shows "simply_connected S \<longleftrightarrow>
  4.1117 -         S = {} \<or>
  4.1118 -         (\<exists>a \<in> S. \<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
  4.1119 -                \<longrightarrow> homotopic_loops S p (linepath a a))"
  4.1120 -        (is "?lhs = ?rhs")
  4.1121 -proof (cases "S = {}")
  4.1122 -  case True then show ?thesis by force
  4.1123 -next
  4.1124 -  case False
  4.1125 -  then obtain a where "a \<in> S" by blast
  4.1126 -  show ?thesis
  4.1127 -  proof
  4.1128 -    assume "simply_connected S"
  4.1129 -    then show ?rhs
  4.1130 -      using \<open>a \<in> S\<close> \<open>simply_connected S\<close> simply_connected_eq_contractible_loop_any
  4.1131 -      by blast
  4.1132 -  next
  4.1133 -    assume ?rhs
  4.1134 -    then show "simply_connected S"
  4.1135 -      apply (simp add: simply_connected_eq_contractible_loop_any False)
  4.1136 -      by (meson homotopic_loops_refl homotopic_loops_sym homotopic_loops_trans
  4.1137 -             path_component_imp_homotopic_points path_component_refl)
  4.1138 -  qed
  4.1139 -qed
  4.1140 -
  4.1141 -lemma simply_connected_eq_contractible_path:
  4.1142 -  fixes S :: "_::real_normed_vector set"
  4.1143 -  shows "simply_connected S \<longleftrightarrow>
  4.1144 -           path_connected S \<and>
  4.1145 -           (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
  4.1146 -            \<longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p)))"
  4.1147 -apply (rule iffI)
  4.1148 - apply (simp add: simply_connected_imp_path_connected)
  4.1149 - apply (metis simply_connected_eq_contractible_loop_some homotopic_loops_imp_homotopic_paths_null)
  4.1150 -by (meson homotopic_paths_imp_homotopic_loops pathfinish_linepath pathstart_in_path_image
  4.1151 -         simply_connected_eq_contractible_loop_some subset_iff)
  4.1152 -
  4.1153 -lemma simply_connected_eq_homotopic_paths:
  4.1154 -  fixes S :: "_::real_normed_vector set"
  4.1155 -  shows "simply_connected S \<longleftrightarrow>
  4.1156 -          path_connected S \<and>
  4.1157 -          (\<forall>p q. path p \<and> path_image p \<subseteq> S \<and>
  4.1158 -                path q \<and> path_image q \<subseteq> S \<and>
  4.1159 -                pathstart q = pathstart p \<and> pathfinish q = pathfinish p
  4.1160 -                \<longrightarrow> homotopic_paths S p q)"
  4.1161 -         (is "?lhs = ?rhs")
  4.1162 -proof
  4.1163 -  assume ?lhs
  4.1164 -  then have pc: "path_connected S"
  4.1165 -        and *:  "\<And>p. \<lbrakk>path p; path_image p \<subseteq> S;
  4.1166 -                       pathfinish p = pathstart p\<rbrakk>
  4.1167 -                      \<Longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p))"
  4.1168 -    by (auto simp: simply_connected_eq_contractible_path)
  4.1169 -  have "homotopic_paths S p q"
  4.1170 -        if "path p" "path_image p \<subseteq> S" "path q"
  4.1171 -           "path_image q \<subseteq> S" "pathstart q = pathstart p"
  4.1172 -           "pathfinish q = pathfinish p" for p q
  4.1173 -  proof -
  4.1174 -    have "homotopic_paths S p (p +++ linepath (pathfinish p) (pathfinish p))"
  4.1175 -      by (simp add: homotopic_paths_rid homotopic_paths_sym that)
  4.1176 -    also have "homotopic_paths S (p +++ linepath (pathfinish p) (pathfinish p))
  4.1177 -                                 (p +++ reversepath q +++ q)"
  4.1178 -      using that
  4.1179 -      by (metis homotopic_paths_join homotopic_paths_linv homotopic_paths_refl homotopic_paths_sym_eq pathstart_linepath)
  4.1180 -    also have "homotopic_paths S (p +++ reversepath q +++ q)
  4.1181 -                                 ((p +++ reversepath q) +++ q)"
  4.1182 -      by (simp add: that homotopic_paths_assoc)
  4.1183 -    also have "homotopic_paths S ((p +++ reversepath q) +++ q)
  4.1184 -                                 (linepath (pathstart q) (pathstart q) +++ q)"
  4.1185 -      using * [of "p +++ reversepath q"] that
  4.1186 -      by (simp add: homotopic_paths_join path_image_join)
  4.1187 -    also have "homotopic_paths S (linepath (pathstart q) (pathstart q) +++ q) q"
  4.1188 -      using that homotopic_paths_lid by blast
  4.1189 -    finally show ?thesis .
  4.1190 -  qed
  4.1191 -  then show ?rhs
  4.1192 -    by (blast intro: pc *)
  4.1193 -next
  4.1194 -  assume ?rhs
  4.1195 -  then show ?lhs
  4.1196 -    by (force simp: simply_connected_eq_contractible_path)
  4.1197 -qed
  4.1198 -
  4.1199 -proposition simply_connected_Times:
  4.1200 -  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
  4.1201 -  assumes S: "simply_connected S" and T: "simply_connected T"
  4.1202 -    shows "simply_connected(S \<times> T)"
  4.1203 -proof -
  4.1204 -  have "homotopic_loops (S \<times> T) p (linepath (a, b) (a, b))"
  4.1205 -       if "path p" "path_image p \<subseteq> S \<times> T" "p 1 = p 0" "a \<in> S" "b \<in> T"
  4.1206 -       for p a b
  4.1207 -  proof -
  4.1208 -    have "path (fst \<circ> p)"
  4.1209 -      apply (rule Path_Connected.path_continuous_image [OF \<open>path p\<close>])
  4.1210 -      apply (rule continuous_intros)+
  4.1211 -      done
  4.1212 -    moreover have "path_image (fst \<circ> p) \<subseteq> S"
  4.1213 -      using that apply (simp add: path_image_def) by force
  4.1214 -    ultimately have p1: "homotopic_loops S (fst \<circ> p) (linepath a a)"
  4.1215 -      using S that
  4.1216 -      apply (simp add: simply_connected_eq_contractible_loop_any)
  4.1217 -      apply (drule_tac x="fst \<circ> p" in spec)
  4.1218 -      apply (drule_tac x=a in spec)
  4.1219 -      apply (auto simp: pathstart_def pathfinish_def)
  4.1220 -      done
  4.1221 -    have "path (snd \<circ> p)"
  4.1222 -      apply (rule Path_Connected.path_continuous_image [OF \<open>path p\<close>])
  4.1223 -      apply (rule continuous_intros)+
  4.1224 -      done
  4.1225 -    moreover have "path_image (snd \<circ> p) \<subseteq> T"
  4.1226 -      using that apply (simp add: path_image_def) by force
  4.1227 -    ultimately have p2: "homotopic_loops T (snd \<circ> p) (linepath b b)"
  4.1228 -      using T that
  4.1229 -      apply (simp add: simply_connected_eq_contractible_loop_any)
  4.1230 -      apply (drule_tac x="snd \<circ> p" in spec)
  4.1231 -      apply (drule_tac x=b in spec)
  4.1232 -      apply (auto simp: pathstart_def pathfinish_def)
  4.1233 -      done
  4.1234 -    show ?thesis
  4.1235 -      using p1 p2
  4.1236 -      apply (simp add: homotopic_loops, clarify)
  4.1237 -      apply (rename_tac h k)
  4.1238 -      apply (rule_tac x="\<lambda>z. Pair (h z) (k z)" in exI)
  4.1239 -      apply (intro conjI continuous_intros | assumption)+
  4.1240 -      apply (auto simp: pathstart_def pathfinish_def)
  4.1241 -      done
  4.1242 -  qed
  4.1243 -  with assms show ?thesis
  4.1244 -    by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
  4.1245 -qed
  4.1246 -
  4.1247 -
  4.1248 -subsection\<open>Contractible sets\<close>
  4.1249 -
  4.1250 -definition%important contractible where
  4.1251 - "contractible S \<equiv> \<exists>a. homotopic_with (\<lambda>x. True) S S id (\<lambda>x. a)"
  4.1252 -
  4.1253 -proposition contractible_imp_simply_connected:
  4.1254 -  fixes S :: "_::real_normed_vector set"
  4.1255 -  assumes "contractible S" shows "simply_connected S"
  4.1256 -proof (cases "S = {}")
  4.1257 -  case True then show ?thesis by force
  4.1258 -next
  4.1259 -  case False
  4.1260 -  obtain a where a: "homotopic_with (\<lambda>x. True) S S id (\<lambda>x. a)"
  4.1261 -    using assms by (force simp: contractible_def)
  4.1262 -  then have "a \<in> S"
  4.1263 -    by (metis False homotopic_constant_maps homotopic_with_symD homotopic_with_trans path_component_mem(2))
  4.1264 -  show ?thesis
  4.1265 -    apply (simp add: simply_connected_eq_contractible_loop_all False)
  4.1266 -    apply (rule bexI [OF _ \<open>a \<in> S\<close>])
  4.1267 -    using a apply (simp add: homotopic_loops_def homotopic_with_def path_def path_image_def pathfinish_def pathstart_def, clarify)
  4.1268 -    apply (rule_tac x="(h \<circ> (\<lambda>y. (fst y, (p \<circ> snd) y)))" in exI)
  4.1269 -    apply (intro conjI continuous_on_compose continuous_intros)
  4.1270 -    apply (erule continuous_on_subset | force)+
  4.1271 -    done
  4.1272 -qed
  4.1273 -
  4.1274 -corollary contractible_imp_connected:
  4.1275 -  fixes S :: "_::real_normed_vector set"
  4.1276 -  shows "contractible S \<Longrightarrow> connected S"
  4.1277 -by (simp add: contractible_imp_simply_connected simply_connected_imp_connected)
  4.1278 -
  4.1279 -lemma contractible_imp_path_connected:
  4.1280 -  fixes S :: "_::real_normed_vector set"
  4.1281 -  shows "contractible S \<Longrightarrow> path_connected S"
  4.1282 -by (simp add: contractible_imp_simply_connected simply_connected_imp_path_connected)
  4.1283 -
  4.1284 -lemma nullhomotopic_through_contractible:
  4.1285 -  fixes S :: "_::topological_space set"
  4.1286 -  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  4.1287 -      and g: "continuous_on T g" "g ` T \<subseteq> U"
  4.1288 -      and T: "contractible T"
  4.1289 -    obtains c where "homotopic_with (\<lambda>h. True) S U (g \<circ> f) (\<lambda>x. c)"
  4.1290 -proof -
  4.1291 -  obtain b where b: "homotopic_with (\<lambda>x. True) T T id (\<lambda>x. b)"
  4.1292 -    using assms by (force simp: contractible_def)
  4.1293 -  have "homotopic_with (\<lambda>f. True) T U (g \<circ> id) (g \<circ> (\<lambda>x. b))"
  4.1294 -    by (rule homotopic_compose_continuous_left [OF b g])
  4.1295 -  then have "homotopic_with (\<lambda>f. True) S U (g \<circ> id \<circ> f) (g \<circ> (\<lambda>x. b) \<circ> f)"
  4.1296 -    by (rule homotopic_compose_continuous_right [OF _ f])
  4.1297 -  then show ?thesis
  4.1298 -    by (simp add: comp_def that)
  4.1299 -qed
  4.1300 -
  4.1301 -lemma nullhomotopic_into_contractible:
  4.1302 -  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  4.1303 -      and T: "contractible T"
  4.1304 -    obtains c where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. c)"
  4.1305 -apply (rule nullhomotopic_through_contractible [OF f, of id T])
  4.1306 -using assms
  4.1307 -apply (auto simp: continuous_on_id)
  4.1308 -done
  4.1309 -
  4.1310 -lemma nullhomotopic_from_contractible:
  4.1311 -  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  4.1312 -      and S: "contractible S"
  4.1313 -    obtains c where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. c)"
  4.1314 -apply (rule nullhomotopic_through_contractible [OF continuous_on_id _ f S, of S])
  4.1315 -using assms
  4.1316 -apply (auto simp: comp_def)
  4.1317 -done
  4.1318 -
  4.1319 -lemma homotopic_through_contractible:
  4.1320 -  fixes S :: "_::real_normed_vector set"
  4.1321 -  assumes "continuous_on S f1" "f1 ` S \<subseteq> T"
  4.1322 -          "continuous_on T g1" "g1 ` T \<subseteq> U"
  4.1323 -          "continuous_on S f2" "f2 ` S \<subseteq> T"
  4.1324 -          "continuous_on T g2" "g2 ` T \<subseteq> U"
  4.1325 -          "contractible T" "path_connected U"
  4.1326 -   shows "homotopic_with (\<lambda>h. True) S U (g1 \<circ> f1) (g2 \<circ> f2)"
  4.1327 -proof -
  4.1328 -  obtain c1 where c1: "homotopic_with (\<lambda>h. True) S U (g1 \<circ> f1) (\<lambda>x. c1)"
  4.1329 -    apply (rule nullhomotopic_through_contractible [of S f1 T g1 U])
  4.1330 -    using assms apply auto
  4.1331 -    done
  4.1332 -  obtain c2 where c2: "homotopic_with (\<lambda>h. True) S U (g2 \<circ> f2) (\<lambda>x. c2)"
  4.1333 -    apply (rule nullhomotopic_through_contractible [of S f2 T g2 U])
  4.1334 -    using assms apply auto
  4.1335 -    done
  4.1336 -  have *: "S = {} \<or> (\<exists>t. path_connected t \<and> t \<subseteq> U \<and> c2 \<in> t \<and> c1 \<in> t)"
  4.1337 -  proof (cases "S = {}")
  4.1338 -    case True then show ?thesis by force
  4.1339 -  next
  4.1340 -    case False
  4.1341 -    with c1 c2 have "c1 \<in> U" "c2 \<in> U"
  4.1342 -      using homotopic_with_imp_subset2 all_not_in_conv image_subset_iff by blast+
  4.1343 -    with \<open>path_connected U\<close> show ?thesis by blast
  4.1344 -  qed
  4.1345 -  show ?thesis
  4.1346 -    apply (rule homotopic_with_trans [OF c1])
  4.1347 -    apply (rule homotopic_with_symD)
  4.1348 -    apply (rule homotopic_with_trans [OF c2])
  4.1349 -    apply (simp add: path_component homotopic_constant_maps *)
  4.1350 -    done
  4.1351 -qed
  4.1352 -
  4.1353 -lemma homotopic_into_contractible:
  4.1354 -  fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
  4.1355 -  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  4.1356 -      and g: "continuous_on S g" "g ` S \<subseteq> T"
  4.1357 -      and T: "contractible T"
  4.1358 -    shows "homotopic_with (\<lambda>h. True) S T f g"
  4.1359 -using homotopic_through_contractible [of S f T id T g id]
  4.1360 -by (simp add: assms contractible_imp_path_connected continuous_on_id)
  4.1361 -
  4.1362 -lemma homotopic_from_contractible:
  4.1363 -  fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
  4.1364 -  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
  4.1365 -      and g: "continuous_on S g" "g ` S \<subseteq> T"
  4.1366 -      and "contractible S" "path_connected T"
  4.1367 -    shows "homotopic_with (\<lambda>h. True) S T f g"
  4.1368 -using homotopic_through_contractible [of S id S f T id g]
  4.1369 -by (simp add: assms contractible_imp_path_connected continuous_on_id)
  4.1370 -
  4.1371 -lemma starlike_imp_contractible_gen:
  4.1372 -  fixes S :: "'a::real_normed_vector set"
  4.1373 -  assumes S: "starlike S"
  4.1374 -      and P: "\<And>a T. \<lbrakk>a \<in> S; 0 \<le> T; T \<le> 1\<rbrakk> \<Longrightarrow> P(\<lambda>x. (1 - T) *\<^sub>R x + T *\<^sub>R a)"
  4.1375 -    obtains a where "homotopic_with P S S (\<lambda>x. x) (\<lambda>x. a)"
  4.1376 -proof -
  4.1377 -  obtain a where "a \<in> S" and a: "\<And>x. x \<in> S \<Longrightarrow> closed_segment a x \<subseteq> S"
  4.1378 -    using S by (auto simp: starlike_def)
  4.1379 -  have "(\<lambda>y. (1 - fst y) *\<^sub>R snd y + fst y *\<^sub>R a) ` ({0..1} \<times> S) \<subseteq> S"
  4.1380 -    apply clarify
  4.1381 -    apply (erule a [unfolded closed_segment_def, THEN subsetD], simp)
  4.1382 -    apply (metis add_diff_cancel_right' diff_ge_0_iff_ge le_add_diff_inverse pth_c(1))
  4.1383 -    done
  4.1384 -  then show ?thesis
  4.1385 -    apply (rule_tac a=a in that)
  4.1386 -    using \<open>a \<in> S\<close>
  4.1387 -    apply (simp add: homotopic_with_def)
  4.1388 -    apply (rule_tac x="\<lambda>y. (1 - (fst y)) *\<^sub>R snd y + (fst y) *\<^sub>R a" in exI)
  4.1389 -    apply (intro conjI ballI continuous_on_compose continuous_intros)
  4.1390 -    apply (simp_all add: P)
  4.1391 -    done
  4.1392 -qed
  4.1393 -
  4.1394 -lemma starlike_imp_contractible:
  4.1395 -  fixes S :: "'a::real_normed_vector set"
  4.1396 -  shows "starlike S \<Longrightarrow> contractible S"
  4.1397 -using starlike_imp_contractible_gen contractible_def by (fastforce simp: id_def)
  4.1398 -
  4.1399 -lemma contractible_UNIV [simp]: "contractible (UNIV :: 'a::real_normed_vector set)"
  4.1400 -  by (simp add: starlike_imp_contractible)
  4.1401 -
  4.1402 -lemma starlike_imp_simply_connected:
  4.1403 -  fixes S :: "'a::real_normed_vector set"
  4.1404 -  shows "starlike S \<Longrightarrow> simply_connected S"
  4.1405 -by (simp add: contractible_imp_simply_connected starlike_imp_contractible)
  4.1406 -
  4.1407 -lemma convex_imp_simply_connected:
  4.1408 -  fixes S :: "'a::real_normed_vector set"
  4.1409 -  shows "convex S \<Longrightarrow> simply_connected S"
  4.1410 -using convex_imp_starlike starlike_imp_simply_connected by blast
  4.1411 -
  4.1412 -lemma starlike_imp_path_connected:
  4.1413 -  fixes S :: "'a::real_normed_vector set"
  4.1414 -  shows "starlike S \<Longrightarrow> path_connected S"
  4.1415 -by (simp add: simply_connected_imp_path_connected starlike_imp_simply_connected)
  4.1416 -
  4.1417 -lemma starlike_imp_connected:
  4.1418 -  fixes S :: "'a::real_normed_vector set"
  4.1419 -  shows "starlike S \<Longrightarrow> connected S"
  4.1420 -by (simp add: path_connected_imp_connected starlike_imp_path_connected)
  4.1421 -
  4.1422 -lemma is_interval_simply_connected_1:
  4.1423 -  fixes S :: "real set"
  4.1424 -  shows "is_interval S \<longleftrightarrow> simply_connected S"
  4.1425 -using convex_imp_simply_connected is_interval_convex_1 is_interval_path_connected_1 simply_connected_imp_path_connected by auto
  4.1426 -
  4.1427 -lemma contractible_empty [simp]: "contractible {}"
  4.1428 -  by (simp add: contractible_def homotopic_with)
  4.1429 -
  4.1430 -lemma contractible_convex_tweak_boundary_points:
  4.1431 -  fixes S :: "'a::euclidean_space set"
  4.1432 -  assumes "convex S" and TS: "rel_interior S \<subseteq> T" "T \<subseteq> closure S"
  4.1433 -  shows "contractible T"
  4.1434 -proof (cases "S = {}")
  4.1435 -  case True
  4.1436 -  with assms show ?thesis
  4.1437 -    by (simp add: subsetCE)
  4.1438 -next
  4.1439 -  case False
  4.1440 -  show ?thesis
  4.1441 -    apply (rule starlike_imp_contractible)
  4.1442 -    apply (rule starlike_convex_tweak_boundary_points [OF \<open>convex S\<close> False TS])
  4.1443 -    done
  4.1444 -qed
  4.1445 -
  4.1446 -lemma convex_imp_contractible:
  4.1447 -  fixes S :: "'a::real_normed_vector set"
  4.1448 -  shows "convex S \<Longrightarrow> contractible S"
  4.1449 -  using contractible_empty convex_imp_starlike starlike_imp_contractible by blast
  4.1450 -
  4.1451 -lemma contractible_sing [simp]:
  4.1452 -  fixes a :: "'a::real_normed_vector"
  4.1453 -  shows "contractible {a}"
  4.1454 -by (rule convex_imp_contractible [OF convex_singleton])
  4.1455 -
  4.1456 -lemma is_interval_contractible_1:
  4.1457 -  fixes S :: "real set"
  4.1458 -  shows  "is_interval S \<longleftrightarrow> contractible S"
  4.1459 -using contractible_imp_simply_connected convex_imp_contractible is_interval_convex_1
  4.1460 -      is_interval_simply_connected_1 by auto
  4.1461 -
  4.1462 -lemma contractible_Times:
  4.1463 -  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
  4.1464 -  assumes S: "contractible S" and T: "contractible T"
  4.1465 -  shows "contractible (S \<times> T)"
  4.1466 -proof -
  4.1467 -  obtain a h where conth: "continuous_on ({0..1} \<times> S) h"
  4.1468 -             and hsub: "h ` ({0..1} \<times> S) \<subseteq> S"
  4.1469 -             and [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (0, x) = x"
  4.1470 -             and [simp]: "\<And>x. x \<in> S \<Longrightarrow>  h (1::real, x) = a"
  4.1471 -    using S by (auto simp: contractible_def homotopic_with)
  4.1472 -  obtain b k where contk: "continuous_on ({0..1} \<times> T) k"
  4.1473 -             and ksub: "k ` ({0..1} \<times> T) \<subseteq> T"
  4.1474 -             and [simp]: "\<And>x. x \<in> T \<Longrightarrow> k (0, x) = x"
  4.1475 -             and [simp]: "\<And>x. x \<in> T \<Longrightarrow>  k (1::real, x) = b"
  4.1476 -    using T by (auto simp: contractible_def homotopic_with)
  4.1477 -  show ?thesis
  4.1478 -    apply (simp add: contractible_def homotopic_with)
  4.1479 -    apply (rule exI [where x=a])
  4.1480 -    apply (rule exI [where x=b])
  4.1481 -    apply (rule exI [where x = "\<lambda>z. (h (fst z, fst(snd z)), k (fst z, snd(snd z)))"])
  4.1482 -    apply (intro conjI ballI continuous_intros continuous_on_compose2 [OF conth] continuous_on_compose2 [OF contk])
  4.1483 -    using hsub ksub
  4.1484 -    apply auto
  4.1485 -    done
  4.1486 -qed
  4.1487 -
  4.1488 -lemma homotopy_dominated_contractibility:
  4.1489 -  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
  4.1490 -  assumes S: "contractible S"
  4.1491 -      and f: "continuous_on S f" "image f S \<subseteq> T"
  4.1492 -      and g: "continuous_on T g" "image g T \<subseteq> S"
  4.1493 -      and hom: "homotopic_with (\<lambda>x. True) T T (f \<circ> g) id"
  4.1494 -    shows "contractible T"
  4.1495 -proof -
  4.1496 -  obtain b where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. b)"
  4.1497 -    using nullhomotopic_from_contractible [OF f S] .
  4.1498 -  then have homg: "homotopic_with (\<lambda>x. True) T T ((\<lambda>x. b) \<circ> g) (f \<circ> g)"
  4.1499 -    by (rule homotopic_with_compose_continuous_right [OF homotopic_with_symD g])
  4.1500 -  show ?thesis
  4.1501 -    apply (simp add: contractible_def)
  4.1502 -    apply (rule exI [where x = b])
  4.1503 -    apply (rule homotopic_with_symD)
  4.1504 -    apply (rule homotopic_with_trans [OF _ hom])
  4.1505 -    using homg apply (simp add: o_def)
  4.1506 -    done
  4.1507 -qed
  4.1508 -
  4.1509 -
  4.1510 -subsection\<open>Local versions of topological properties in general\<close>
  4.1511 -
  4.1512 -definition%important locally :: "('a::topological_space set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
  4.1513 -where
  4.1514 - "locally P S \<equiv>
  4.1515 -        \<forall>w x. openin (subtopology euclidean S) w \<and> x \<in> w
  4.1516 -              \<longrightarrow> (\<exists>u v. openin (subtopology euclidean S) u \<and> P v \<and>
  4.1517 -                        x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w)"
  4.1518 -
  4.1519 -lemma locallyI:
  4.1520 -  assumes "\<And>w x. \<lbrakk>openin (subtopology euclidean S) w; x \<in> w\<rbrakk>
  4.1521 -                  \<Longrightarrow> \<exists>u v. openin (subtopology euclidean S) u \<and> P v \<and>
  4.1522 -