src/HOL/Analysis/Homotopy.thy
author immler
Mon Jan 07 14:57:45 2019 +0100 (4 months ago)
changeset 69620 19d8a59481db
child 69712 dc85b5b3a532
permissions -rw-r--r--
split off Homotopy.thy
immler@69620
     1
(*  Title:      HOL/Analysis/Path_Connected.thy
immler@69620
     2
    Authors:    LC Paulson and Robert Himmelmann (TU Muenchen), based on material from HOL Light
immler@69620
     3
*)
immler@69620
     4
immler@69620
     5
section \<open>Homotopy of Maps\<close>
immler@69620
     6
immler@69620
     7
theory Homotopy
immler@69620
     8
  imports Path_Connected Continuum_Not_Denumerable
immler@69620
     9
begin
immler@69620
    10
immler@69620
    11
definition%important homotopic_with ::
immler@69620
    12
  "[('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> bool, 'a set, 'b set, 'a \<Rightarrow> 'b, 'a \<Rightarrow> 'b] \<Rightarrow> bool"
immler@69620
    13
where
immler@69620
    14
 "homotopic_with P X Y p q \<equiv>
immler@69620
    15
   (\<exists>h:: real \<times> 'a \<Rightarrow> 'b.
immler@69620
    16
       continuous_on ({0..1} \<times> X) h \<and>
immler@69620
    17
       h ` ({0..1} \<times> X) \<subseteq> Y \<and>
immler@69620
    18
       (\<forall>x. h(0, x) = p x) \<and>
immler@69620
    19
       (\<forall>x. h(1, x) = q x) \<and>
immler@69620
    20
       (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
immler@69620
    21
immler@69620
    22
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.
immler@69620
    23
We often just want to require that \<open>P\<close> fixes some subset, but to include the case of a loop homotopy,
immler@69620
    24
it is convenient to have a general property \<open>P\<close>.\<close>
immler@69620
    25
immler@69620
    26
text \<open>We often want to just localize the ending function equality or whatever.\<close>
immler@69620
    27
text%important \<open>%whitespace\<close>
immler@69620
    28
proposition homotopic_with:
immler@69620
    29
  fixes X :: "'a::topological_space set" and Y :: "'b::topological_space set"
immler@69620
    30
  assumes "\<And>h k. (\<And>x. x \<in> X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k)"
immler@69620
    31
  shows "homotopic_with P X Y p q \<longleftrightarrow>
immler@69620
    32
           (\<exists>h :: real \<times> 'a \<Rightarrow> 'b.
immler@69620
    33
              continuous_on ({0..1} \<times> X) h \<and>
immler@69620
    34
              h ` ({0..1} \<times> X) \<subseteq> Y \<and>
immler@69620
    35
              (\<forall>x \<in> X. h(0,x) = p x) \<and>
immler@69620
    36
              (\<forall>x \<in> X. h(1,x) = q x) \<and>
immler@69620
    37
              (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
immler@69620
    38
  unfolding homotopic_with_def
immler@69620
    39
  apply (rule iffI, blast, clarify)
immler@69620
    40
  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)
immler@69620
    41
  apply auto
immler@69620
    42
  apply (force elim: continuous_on_eq)
immler@69620
    43
  apply (drule_tac x=t in bspec, force)
immler@69620
    44
  apply (subst assms; simp)
immler@69620
    45
  done
immler@69620
    46
immler@69620
    47
proposition homotopic_with_eq:
immler@69620
    48
   assumes h: "homotopic_with P X Y f g"
immler@69620
    49
       and f': "\<And>x. x \<in> X \<Longrightarrow> f' x = f x"
immler@69620
    50
       and g': "\<And>x. x \<in> X \<Longrightarrow> g' x = g x"
immler@69620
    51
       and P:  "(\<And>h k. (\<And>x. x \<in> X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k))"
immler@69620
    52
   shows "homotopic_with P X Y f' g'"
immler@69620
    53
  using h unfolding homotopic_with_def
immler@69620
    54
  apply safe
immler@69620
    55
  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)
immler@69620
    56
  apply (simp add: f' g', safe)
immler@69620
    57
  apply (fastforce intro: continuous_on_eq, fastforce)
immler@69620
    58
  apply (subst P; fastforce)
immler@69620
    59
  done
immler@69620
    60
immler@69620
    61
proposition homotopic_with_equal:
immler@69620
    62
   assumes contf: "continuous_on X f" and fXY: "f ` X \<subseteq> Y"
immler@69620
    63
       and gf: "\<And>x. x \<in> X \<Longrightarrow> g x = f x"
immler@69620
    64
       and P:  "P f" "P g"
immler@69620
    65
   shows "homotopic_with P X Y f g"
immler@69620
    66
  unfolding homotopic_with_def
immler@69620
    67
  apply (rule_tac x="\<lambda>(u,v). if u = 1 then g v else f v" in exI)
immler@69620
    68
  using assms
immler@69620
    69
  apply (intro conjI)
immler@69620
    70
  apply (rule continuous_on_eq [where f = "f \<circ> snd"])
immler@69620
    71
  apply (rule continuous_intros | force)+
immler@69620
    72
  apply clarify
immler@69620
    73
  apply (case_tac "t=1"; force)
immler@69620
    74
  done
immler@69620
    75
immler@69620
    76
immler@69620
    77
lemma image_Pair_const: "(\<lambda>x. (x, c)) ` A = A \<times> {c}"
immler@69620
    78
  by auto
immler@69620
    79
immler@69620
    80
lemma homotopic_constant_maps:
immler@69620
    81
   "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b) \<longleftrightarrow> s = {} \<or> path_component t a b"
immler@69620
    82
proof (cases "s = {} \<or> t = {}")
immler@69620
    83
  case True with continuous_on_const show ?thesis
immler@69620
    84
    by (auto simp: homotopic_with path_component_def)
immler@69620
    85
next
immler@69620
    86
  case False
immler@69620
    87
  then obtain c where "c \<in> s" by blast
immler@69620
    88
  show ?thesis
immler@69620
    89
  proof
immler@69620
    90
    assume "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b)"
immler@69620
    91
    then obtain h :: "real \<times> 'a \<Rightarrow> 'b"
immler@69620
    92
        where conth: "continuous_on ({0..1} \<times> s) h"
immler@69620
    93
          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)"
immler@69620
    94
      by (auto simp: homotopic_with)
immler@69620
    95
    have "continuous_on {0..1} (h \<circ> (\<lambda>t. (t, c)))"
immler@69620
    96
      apply (rule continuous_intros conth | simp add: image_Pair_const)+
immler@69620
    97
      apply (blast intro:  \<open>c \<in> s\<close> continuous_on_subset [OF conth])
immler@69620
    98
      done
immler@69620
    99
    with \<open>c \<in> s\<close> h show "s = {} \<or> path_component t a b"
immler@69620
   100
      apply (simp_all add: homotopic_with path_component_def, auto)
immler@69620
   101
      apply (drule_tac x="h \<circ> (\<lambda>t. (t, c))" in spec)
immler@69620
   102
      apply (auto simp: pathstart_def pathfinish_def path_image_def path_def)
immler@69620
   103
      done
immler@69620
   104
  next
immler@69620
   105
    assume "s = {} \<or> path_component t a b"
immler@69620
   106
    with False show "homotopic_with (\<lambda>x. True) s t (\<lambda>x. a) (\<lambda>x. b)"
immler@69620
   107
      apply (clarsimp simp: homotopic_with path_component_def pathstart_def pathfinish_def path_image_def path_def)
immler@69620
   108
      apply (rule_tac x="g \<circ> fst" in exI)
immler@69620
   109
      apply (rule conjI continuous_intros | force)+
immler@69620
   110
      done
immler@69620
   111
  qed
immler@69620
   112
qed
immler@69620
   113
immler@69620
   114
immler@69620
   115
subsection%unimportant\<open>Trivial properties\<close>
immler@69620
   116
immler@69620
   117
lemma homotopic_with_imp_property: "homotopic_with P X Y f g \<Longrightarrow> P f \<and> P g"
immler@69620
   118
  unfolding homotopic_with_def Ball_def
immler@69620
   119
  apply clarify
immler@69620
   120
  apply (frule_tac x=0 in spec)
immler@69620
   121
  apply (drule_tac x=1 in spec, auto)
immler@69620
   122
  done
immler@69620
   123
immler@69620
   124
lemma continuous_on_o_Pair: "\<lbrakk>continuous_on (T \<times> X) h; t \<in> T\<rbrakk> \<Longrightarrow> continuous_on X (h \<circ> Pair t)"
immler@69620
   125
  by (fast intro: continuous_intros elim!: continuous_on_subset)
immler@69620
   126
immler@69620
   127
lemma homotopic_with_imp_continuous:
immler@69620
   128
    assumes "homotopic_with P X Y f g"
immler@69620
   129
    shows "continuous_on X f \<and> continuous_on X g"
immler@69620
   130
proof -
immler@69620
   131
  obtain h :: "real \<times> 'a \<Rightarrow> 'b"
immler@69620
   132
    where conth: "continuous_on ({0..1} \<times> X) h"
immler@69620
   133
      and h: "\<forall>x. h (0, x) = f x" "\<forall>x. h (1, x) = g x"
immler@69620
   134
    using assms by (auto simp: homotopic_with_def)
immler@69620
   135
  have *: "t \<in> {0..1} \<Longrightarrow> continuous_on X (h \<circ> (\<lambda>x. (t,x)))" for t
immler@69620
   136
    by (rule continuous_intros continuous_on_subset [OF conth] | force)+
immler@69620
   137
  show ?thesis
immler@69620
   138
    using h *[of 0] *[of 1] by auto
immler@69620
   139
qed
immler@69620
   140
immler@69620
   141
proposition homotopic_with_imp_subset1:
immler@69620
   142
     "homotopic_with P X Y f g \<Longrightarrow> f ` X \<subseteq> Y"
immler@69620
   143
  by (simp add: homotopic_with_def image_subset_iff) (metis atLeastAtMost_iff order_refl zero_le_one)
immler@69620
   144
immler@69620
   145
proposition homotopic_with_imp_subset2:
immler@69620
   146
     "homotopic_with P X Y f g \<Longrightarrow> g ` X \<subseteq> Y"
immler@69620
   147
  by (simp add: homotopic_with_def image_subset_iff) (metis atLeastAtMost_iff order_refl zero_le_one)
immler@69620
   148
immler@69620
   149
proposition homotopic_with_mono:
immler@69620
   150
    assumes hom: "homotopic_with P X Y f g"
immler@69620
   151
        and Q: "\<And>h. \<lbrakk>continuous_on X h; image h X \<subseteq> Y \<and> P h\<rbrakk> \<Longrightarrow> Q h"
immler@69620
   152
      shows "homotopic_with Q X Y f g"
immler@69620
   153
  using hom
immler@69620
   154
  apply (simp add: homotopic_with_def)
immler@69620
   155
  apply (erule ex_forward)
immler@69620
   156
  apply (force simp: intro!: Q dest: continuous_on_o_Pair)
immler@69620
   157
  done
immler@69620
   158
immler@69620
   159
proposition homotopic_with_subset_left:
immler@69620
   160
     "\<lbrakk>homotopic_with P X Y f g; Z \<subseteq> X\<rbrakk> \<Longrightarrow> homotopic_with P Z Y f g"
immler@69620
   161
  apply (simp add: homotopic_with_def)
immler@69620
   162
  apply (fast elim!: continuous_on_subset ex_forward)
immler@69620
   163
  done
immler@69620
   164
immler@69620
   165
proposition homotopic_with_subset_right:
immler@69620
   166
     "\<lbrakk>homotopic_with P X Y f g; Y \<subseteq> Z\<rbrakk> \<Longrightarrow> homotopic_with P X Z f g"
immler@69620
   167
  apply (simp add: homotopic_with_def)
immler@69620
   168
  apply (fast elim!: continuous_on_subset ex_forward)
immler@69620
   169
  done
immler@69620
   170
immler@69620
   171
proposition homotopic_with_compose_continuous_right:
immler@69620
   172
    "\<lbrakk>homotopic_with (\<lambda>f. p (f \<circ> h)) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
immler@69620
   173
     \<Longrightarrow> homotopic_with p W Y (f \<circ> h) (g \<circ> h)"
immler@69620
   174
  apply (clarsimp simp add: homotopic_with_def)
immler@69620
   175
  apply (rename_tac k)
immler@69620
   176
  apply (rule_tac x="k \<circ> (\<lambda>y. (fst y, h (snd y)))" in exI)
immler@69620
   177
  apply (rule conjI continuous_intros continuous_on_compose [where f=snd and g=h, unfolded o_def] | simp)+
immler@69620
   178
  apply (erule continuous_on_subset)
immler@69620
   179
  apply (fastforce simp: o_def)+
immler@69620
   180
  done
immler@69620
   181
immler@69620
   182
proposition homotopic_compose_continuous_right:
immler@69620
   183
     "\<lbrakk>homotopic_with (\<lambda>f. True) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
immler@69620
   184
      \<Longrightarrow> homotopic_with (\<lambda>f. True) W Y (f \<circ> h) (g \<circ> h)"
immler@69620
   185
  using homotopic_with_compose_continuous_right by fastforce
immler@69620
   186
immler@69620
   187
proposition homotopic_with_compose_continuous_left:
immler@69620
   188
     "\<lbrakk>homotopic_with (\<lambda>f. p (h \<circ> f)) X Y f g; continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
immler@69620
   189
      \<Longrightarrow> homotopic_with p X Z (h \<circ> f) (h \<circ> g)"
immler@69620
   190
  apply (clarsimp simp add: homotopic_with_def)
immler@69620
   191
  apply (rename_tac k)
immler@69620
   192
  apply (rule_tac x="h \<circ> k" in exI)
immler@69620
   193
  apply (rule conjI continuous_intros continuous_on_compose [where f=snd and g=h, unfolded o_def] | simp)+
immler@69620
   194
  apply (erule continuous_on_subset)
immler@69620
   195
  apply (fastforce simp: o_def)+
immler@69620
   196
  done
immler@69620
   197
immler@69620
   198
proposition homotopic_compose_continuous_left:
immler@69620
   199
   "\<lbrakk>homotopic_with (\<lambda>_. True) X Y f g;
immler@69620
   200
     continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
immler@69620
   201
    \<Longrightarrow> homotopic_with (\<lambda>f. True) X Z (h \<circ> f) (h \<circ> g)"
immler@69620
   202
  using homotopic_with_compose_continuous_left by fastforce
immler@69620
   203
immler@69620
   204
proposition homotopic_with_Pair:
immler@69620
   205
   assumes hom: "homotopic_with p s t f g" "homotopic_with p' s' t' f' g'"
immler@69620
   206
       and q: "\<And>f g. \<lbrakk>p f; p' g\<rbrakk> \<Longrightarrow> q(\<lambda>(x,y). (f x, g y))"
immler@69620
   207
     shows "homotopic_with q (s \<times> s') (t \<times> t')
immler@69620
   208
                  (\<lambda>(x,y). (f x, f' y)) (\<lambda>(x,y). (g x, g' y))"
immler@69620
   209
  using hom
immler@69620
   210
  apply (clarsimp simp add: homotopic_with_def)
immler@69620
   211
  apply (rename_tac k k')
immler@69620
   212
  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)
immler@69620
   213
  apply (rule conjI continuous_intros | erule continuous_on_subset | clarsimp)+
immler@69620
   214
  apply (auto intro!: q [unfolded case_prod_unfold])
immler@69620
   215
  done
immler@69620
   216
immler@69620
   217
lemma homotopic_on_empty [simp]: "homotopic_with (\<lambda>x. True) {} t f g"
immler@69620
   218
  by (metis continuous_on_def empty_iff homotopic_with_equal image_subset_iff)
immler@69620
   219
immler@69620
   220
immler@69620
   221
text\<open>Homotopy with P is an equivalence relation (on continuous functions mapping X into Y that satisfy P,
immler@69620
   222
     though this only affects reflexivity.\<close>
immler@69620
   223
immler@69620
   224
immler@69620
   225
proposition homotopic_with_refl:
immler@69620
   226
   "homotopic_with P X Y f f \<longleftrightarrow> continuous_on X f \<and> image f X \<subseteq> Y \<and> P f"
immler@69620
   227
  apply (rule iffI)
immler@69620
   228
  using homotopic_with_imp_continuous homotopic_with_imp_property homotopic_with_imp_subset2 apply blast
immler@69620
   229
  apply (simp add: homotopic_with_def)
immler@69620
   230
  apply (rule_tac x="f \<circ> snd" in exI)
immler@69620
   231
  apply (rule conjI continuous_intros | force)+
immler@69620
   232
  done
immler@69620
   233
immler@69620
   234
lemma homotopic_with_symD:
immler@69620
   235
  fixes X :: "'a::real_normed_vector set"
immler@69620
   236
    assumes "homotopic_with P X Y f g"
immler@69620
   237
      shows "homotopic_with P X Y g f"
immler@69620
   238
  using assms
immler@69620
   239
  apply (clarsimp simp add: homotopic_with_def)
immler@69620
   240
  apply (rename_tac h)
immler@69620
   241
  apply (rule_tac x="h \<circ> (\<lambda>y. (1 - fst y, snd y))" in exI)
immler@69620
   242
  apply (rule conjI continuous_intros | erule continuous_on_subset | force simp: image_subset_iff)+
immler@69620
   243
  done
immler@69620
   244
immler@69620
   245
proposition homotopic_with_sym:
immler@69620
   246
    fixes X :: "'a::real_normed_vector set"
immler@69620
   247
    shows "homotopic_with P X Y f g \<longleftrightarrow> homotopic_with P X Y g f"
immler@69620
   248
  using homotopic_with_symD by blast
immler@69620
   249
immler@69620
   250
lemma split_01: "{0..1::real} = {0..1/2} \<union> {1/2..1}"
immler@69620
   251
  by force
immler@69620
   252
immler@69620
   253
lemma split_01_prod: "{0..1::real} \<times> X = ({0..1/2} \<times> X) \<union> ({1/2..1} \<times> X)"
immler@69620
   254
  by force
immler@69620
   255
immler@69620
   256
proposition homotopic_with_trans:
immler@69620
   257
    fixes X :: "'a::real_normed_vector set"
immler@69620
   258
    assumes "homotopic_with P X Y f g" and "homotopic_with P X Y g h"
immler@69620
   259
      shows "homotopic_with P X Y f h"
immler@69620
   260
proof -
immler@69620
   261
  have clo1: "closedin (subtopology euclidean ({0..1/2} \<times> X \<union> {1/2..1} \<times> X)) ({0..1/2::real} \<times> X)"
immler@69620
   262
    apply (simp add: closedin_closed split_01_prod [symmetric])
immler@69620
   263
    apply (rule_tac x="{0..1/2} \<times> UNIV" in exI)
immler@69620
   264
    apply (force simp: closed_Times)
immler@69620
   265
    done
immler@69620
   266
  have clo2: "closedin (subtopology euclidean ({0..1/2} \<times> X \<union> {1/2..1} \<times> X)) ({1/2..1::real} \<times> X)"
immler@69620
   267
    apply (simp add: closedin_closed split_01_prod [symmetric])
immler@69620
   268
    apply (rule_tac x="{1/2..1} \<times> UNIV" in exI)
immler@69620
   269
    apply (force simp: closed_Times)
immler@69620
   270
    done
immler@69620
   271
  { fix k1 k2:: "real \<times> 'a \<Rightarrow> 'b"
immler@69620
   272
    assume cont: "continuous_on ({0..1} \<times> X) k1" "continuous_on ({0..1} \<times> X) k2"
immler@69620
   273
       and Y: "k1 ` ({0..1} \<times> X) \<subseteq> Y" "k2 ` ({0..1} \<times> X) \<subseteq> Y"
immler@69620
   274
       and geq: "\<forall>x. k1 (1, x) = g x" "\<forall>x. k2 (0, x) = g x"
immler@69620
   275
       and k12: "\<forall>x. k1 (0, x) = f x" "\<forall>x. k2 (1, x) = h x"
immler@69620
   276
       and P:   "\<forall>t\<in>{0..1}. P (\<lambda>x. k1 (t, x))" "\<forall>t\<in>{0..1}. P (\<lambda>x. k2 (t, x))"
immler@69620
   277
    define k where "k y =
immler@69620
   278
      (if fst y \<le> 1 / 2
immler@69620
   279
       then (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y
immler@69620
   280
       else (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y)" for y
immler@69620
   281
    have keq: "k1 (2 * u, v) = k2 (2 * u - 1, v)" if "u = 1/2"  for u v
immler@69620
   282
      by (simp add: geq that)
immler@69620
   283
    have "continuous_on ({0..1} \<times> X) k"
immler@69620
   284
      using cont
immler@69620
   285
      apply (simp add: split_01_prod k_def)
immler@69620
   286
      apply (rule clo1 clo2 continuous_on_cases_local continuous_intros | erule continuous_on_subset | simp add: linear image_subset_iff)+
immler@69620
   287
      apply (force simp: keq)
immler@69620
   288
      done
immler@69620
   289
    moreover have "k ` ({0..1} \<times> X) \<subseteq> Y"
immler@69620
   290
      using Y by (force simp: k_def)
immler@69620
   291
    moreover have "\<forall>x. k (0, x) = f x"
immler@69620
   292
      by (simp add: k_def k12)
immler@69620
   293
    moreover have "(\<forall>x. k (1, x) = h x)"
immler@69620
   294
      by (simp add: k_def k12)
immler@69620
   295
    moreover have "\<forall>t\<in>{0..1}. P (\<lambda>x. k (t, x))"
immler@69620
   296
      using P
immler@69620
   297
      apply (clarsimp simp add: k_def)
immler@69620
   298
      apply (case_tac "t \<le> 1/2", auto)
immler@69620
   299
      done
immler@69620
   300
    ultimately have *: "\<exists>k :: real \<times> 'a \<Rightarrow> 'b.
immler@69620
   301
                       continuous_on ({0..1} \<times> X) k \<and> k ` ({0..1} \<times> X) \<subseteq> Y \<and>
immler@69620
   302
                       (\<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)))"
immler@69620
   303
      by blast
immler@69620
   304
  } note * = this
immler@69620
   305
  show ?thesis
immler@69620
   306
    using assms by (auto intro: * simp add: homotopic_with_def)
immler@69620
   307
qed
immler@69620
   308
immler@69620
   309
proposition homotopic_compose:
immler@69620
   310
      fixes s :: "'a::real_normed_vector set"
immler@69620
   311
      shows "\<lbrakk>homotopic_with (\<lambda>x. True) s t f f'; homotopic_with (\<lambda>x. True) t u g g'\<rbrakk>
immler@69620
   312
             \<Longrightarrow> homotopic_with (\<lambda>x. True) s u (g \<circ> f) (g' \<circ> f')"
immler@69620
   313
  apply (rule homotopic_with_trans [where g = "g \<circ> f'"])
immler@69620
   314
  apply (metis homotopic_compose_continuous_left homotopic_with_imp_continuous homotopic_with_imp_subset1)
immler@69620
   315
  by (metis homotopic_compose_continuous_right homotopic_with_imp_continuous homotopic_with_imp_subset2)
immler@69620
   316
immler@69620
   317
immler@69620
   318
text\<open>Homotopic triviality implicitly incorporates path-connectedness.\<close>
immler@69620
   319
lemma homotopic_triviality:
immler@69620
   320
  fixes S :: "'a::real_normed_vector set"
immler@69620
   321
  shows  "(\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> T \<and>
immler@69620
   322
                 continuous_on S g \<and> g ` S \<subseteq> T
immler@69620
   323
                 \<longrightarrow> homotopic_with (\<lambda>x. True) S T f g) \<longleftrightarrow>
immler@69620
   324
          (S = {} \<or> path_connected T) \<and>
immler@69620
   325
          (\<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)))"
immler@69620
   326
          (is "?lhs = ?rhs")
immler@69620
   327
proof (cases "S = {} \<or> T = {}")
immler@69620
   328
  case True then show ?thesis by auto
immler@69620
   329
next
immler@69620
   330
  case False show ?thesis
immler@69620
   331
  proof
immler@69620
   332
    assume LHS [rule_format]: ?lhs
immler@69620
   333
    have pab: "path_component T a b" if "a \<in> T" "b \<in> T" for a b
immler@69620
   334
    proof -
immler@69620
   335
      have "homotopic_with (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. b)"
immler@69620
   336
        by (simp add: LHS continuous_on_const image_subset_iff that)
immler@69620
   337
      then show ?thesis
immler@69620
   338
        using False homotopic_constant_maps by blast
immler@69620
   339
    qed
immler@69620
   340
      moreover
immler@69620
   341
    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
immler@69620
   342
      by (metis (full_types) False LHS equals0I homotopic_constant_maps homotopic_with_imp_continuous homotopic_with_imp_subset2 pab that)
immler@69620
   343
    ultimately show ?rhs
immler@69620
   344
      by (simp add: path_connected_component)
immler@69620
   345
  next
immler@69620
   346
    assume RHS: ?rhs
immler@69620
   347
    with False have T: "path_connected T"
immler@69620
   348
      by blast
immler@69620
   349
    show ?lhs
immler@69620
   350
    proof clarify
immler@69620
   351
      fix f g
immler@69620
   352
      assume "continuous_on S f" "f ` S \<subseteq> T" "continuous_on S g" "g ` S \<subseteq> T"
immler@69620
   353
      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)"
immler@69620
   354
        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
immler@69620
   355
      then have "c \<in> T" "d \<in> T"
immler@69620
   356
        using False homotopic_with_imp_subset2 by fastforce+
immler@69620
   357
      with T have "path_component T c d"
immler@69620
   358
        using path_connected_component by blast
immler@69620
   359
      then have "homotopic_with (\<lambda>x. True) S T (\<lambda>x. c) (\<lambda>x. d)"
immler@69620
   360
        by (simp add: homotopic_constant_maps)
immler@69620
   361
      with c d show "homotopic_with (\<lambda>x. True) S T f g"
immler@69620
   362
        by (meson homotopic_with_symD homotopic_with_trans)
immler@69620
   363
    qed
immler@69620
   364
  qed
immler@69620
   365
qed
immler@69620
   366
immler@69620
   367
immler@69620
   368
subsection\<open>Homotopy of paths, maintaining the same endpoints\<close>
immler@69620
   369
immler@69620
   370
immler@69620
   371
definition%important homotopic_paths :: "['a set, real \<Rightarrow> 'a, real \<Rightarrow> 'a::topological_space] \<Rightarrow> bool"
immler@69620
   372
  where
immler@69620
   373
     "homotopic_paths s p q \<equiv>
immler@69620
   374
       homotopic_with (\<lambda>r. pathstart r = pathstart p \<and> pathfinish r = pathfinish p) {0..1} s p q"
immler@69620
   375
immler@69620
   376
lemma homotopic_paths:
immler@69620
   377
   "homotopic_paths s p q \<longleftrightarrow>
immler@69620
   378
      (\<exists>h. continuous_on ({0..1} \<times> {0..1}) h \<and>
immler@69620
   379
          h ` ({0..1} \<times> {0..1}) \<subseteq> s \<and>
immler@69620
   380
          (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
immler@69620
   381
          (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
immler@69620
   382
          (\<forall>t \<in> {0..1::real}. pathstart(h \<circ> Pair t) = pathstart p \<and>
immler@69620
   383
                        pathfinish(h \<circ> Pair t) = pathfinish p))"
immler@69620
   384
  by (auto simp: homotopic_paths_def homotopic_with pathstart_def pathfinish_def)
immler@69620
   385
immler@69620
   386
proposition homotopic_paths_imp_pathstart:
immler@69620
   387
     "homotopic_paths s p q \<Longrightarrow> pathstart p = pathstart q"
immler@69620
   388
  by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
immler@69620
   389
immler@69620
   390
proposition homotopic_paths_imp_pathfinish:
immler@69620
   391
     "homotopic_paths s p q \<Longrightarrow> pathfinish p = pathfinish q"
immler@69620
   392
  by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
immler@69620
   393
immler@69620
   394
lemma homotopic_paths_imp_path:
immler@69620
   395
     "homotopic_paths s p q \<Longrightarrow> path p \<and> path q"
immler@69620
   396
  using homotopic_paths_def homotopic_with_imp_continuous path_def by blast
immler@69620
   397
immler@69620
   398
lemma homotopic_paths_imp_subset:
immler@69620
   399
     "homotopic_paths s p q \<Longrightarrow> path_image p \<subseteq> s \<and> path_image q \<subseteq> s"
immler@69620
   400
  by (simp add: homotopic_paths_def homotopic_with_imp_subset1 homotopic_with_imp_subset2 path_image_def)
immler@69620
   401
immler@69620
   402
proposition homotopic_paths_refl [simp]: "homotopic_paths s p p \<longleftrightarrow> path p \<and> path_image p \<subseteq> s"
immler@69620
   403
by (simp add: homotopic_paths_def homotopic_with_refl path_def path_image_def)
immler@69620
   404
immler@69620
   405
proposition homotopic_paths_sym: "homotopic_paths s p q \<Longrightarrow> homotopic_paths s q p"
immler@69620
   406
  by (metis (mono_tags) homotopic_paths_def homotopic_paths_imp_pathfinish homotopic_paths_imp_pathstart homotopic_with_symD)
immler@69620
   407
immler@69620
   408
proposition homotopic_paths_sym_eq: "homotopic_paths s p q \<longleftrightarrow> homotopic_paths s q p"
immler@69620
   409
  by (metis homotopic_paths_sym)
immler@69620
   410
immler@69620
   411
proposition homotopic_paths_trans [trans]:
immler@69620
   412
     "\<lbrakk>homotopic_paths s p q; homotopic_paths s q r\<rbrakk> \<Longrightarrow> homotopic_paths s p r"
immler@69620
   413
  apply (simp add: homotopic_paths_def)
immler@69620
   414
  apply (rule homotopic_with_trans, assumption)
immler@69620
   415
  by (metis (mono_tags, lifting) homotopic_with_imp_property homotopic_with_mono)
immler@69620
   416
immler@69620
   417
proposition homotopic_paths_eq:
immler@69620
   418
     "\<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"
immler@69620
   419
  apply (simp add: homotopic_paths_def)
immler@69620
   420
  apply (rule homotopic_with_eq)
immler@69620
   421
  apply (auto simp: path_def homotopic_with_refl pathstart_def pathfinish_def path_image_def elim: continuous_on_eq)
immler@69620
   422
  done
immler@69620
   423
immler@69620
   424
proposition homotopic_paths_reparametrize:
immler@69620
   425
  assumes "path p"
immler@69620
   426
      and pips: "path_image p \<subseteq> s"
immler@69620
   427
      and contf: "continuous_on {0..1} f"
immler@69620
   428
      and f01:"f ` {0..1} \<subseteq> {0..1}"
immler@69620
   429
      and [simp]: "f(0) = 0" "f(1) = 1"
immler@69620
   430
      and q: "\<And>t. t \<in> {0..1} \<Longrightarrow> q(t) = p(f t)"
immler@69620
   431
    shows "homotopic_paths s p q"
immler@69620
   432
proof -
immler@69620
   433
  have contp: "continuous_on {0..1} p"
immler@69620
   434
    by (metis \<open>path p\<close> path_def)
immler@69620
   435
  then have "continuous_on {0..1} (p \<circ> f)"
immler@69620
   436
    using contf continuous_on_compose continuous_on_subset f01 by blast
immler@69620
   437
  then have "path q"
immler@69620
   438
    by (simp add: path_def) (metis q continuous_on_cong)
immler@69620
   439
  have piqs: "path_image q \<subseteq> s"
immler@69620
   440
    by (metis (no_types, hide_lams) pips f01 image_subset_iff path_image_def q)
immler@69620
   441
  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"
immler@69620
   442
    using f01 by force
immler@69620
   443
  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
immler@69620
   444
    using f01 [THEN subsetD, of "f b"] by (simp add: convex_bound_le)
immler@69620
   445
  have "homotopic_paths s q p"
immler@69620
   446
  proof (rule homotopic_paths_trans)
immler@69620
   447
    show "homotopic_paths s q (p \<circ> f)"
immler@69620
   448
      using q by (force intro: homotopic_paths_eq [OF  \<open>path q\<close> piqs])
immler@69620
   449
  next
immler@69620
   450
    show "homotopic_paths s (p \<circ> f) p"
immler@69620
   451
      apply (simp add: homotopic_paths_def homotopic_with_def)
immler@69620
   452
      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)
immler@69620
   453
      apply (rule conjI contf continuous_intros continuous_on_subset [OF contp] | simp)+
immler@69620
   454
      using pips [unfolded path_image_def]
immler@69620
   455
      apply (auto simp: fb0 fb1 pathstart_def pathfinish_def)
immler@69620
   456
      done
immler@69620
   457
  qed
immler@69620
   458
  then show ?thesis
immler@69620
   459
    by (simp add: homotopic_paths_sym)
immler@69620
   460
qed
immler@69620
   461
immler@69620
   462
lemma homotopic_paths_subset: "\<lbrakk>homotopic_paths s p q; s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t p q"
immler@69620
   463
  using homotopic_paths_def homotopic_with_subset_right by blast
immler@69620
   464
immler@69620
   465
immler@69620
   466
text\<open> A slightly ad-hoc but useful lemma in constructing homotopies.\<close>
immler@69620
   467
lemma homotopic_join_lemma:
immler@69620
   468
  fixes q :: "[real,real] \<Rightarrow> 'a::topological_space"
immler@69620
   469
  assumes p: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. p (fst y) (snd y))"
immler@69620
   470
      and q: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. q (fst y) (snd y))"
immler@69620
   471
      and pf: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish(p t) = pathstart(q t)"
immler@69620
   472
    shows "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. (p(fst y) +++ q(fst y)) (snd y))"
immler@69620
   473
proof -
immler@69620
   474
  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))"
immler@69620
   475
    by (rule ext) (simp)
immler@69620
   476
  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))"
immler@69620
   477
    by (rule ext) (simp)
immler@69620
   478
  show ?thesis
immler@69620
   479
    apply (simp add: joinpaths_def)
immler@69620
   480
    apply (rule continuous_on_cases_le)
immler@69620
   481
    apply (simp_all only: 1 2)
immler@69620
   482
    apply (rule continuous_intros continuous_on_subset [OF p] continuous_on_subset [OF q] | force)+
immler@69620
   483
    using pf
immler@69620
   484
    apply (auto simp: mult.commute pathstart_def pathfinish_def)
immler@69620
   485
    done
immler@69620
   486
qed
immler@69620
   487
immler@69620
   488
text\<open> Congruence properties of homotopy w.r.t. path-combining operations.\<close>
immler@69620
   489
immler@69620
   490
lemma homotopic_paths_reversepath_D:
immler@69620
   491
      assumes "homotopic_paths s p q"
immler@69620
   492
      shows   "homotopic_paths s (reversepath p) (reversepath q)"
immler@69620
   493
  using assms
immler@69620
   494
  apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
immler@69620
   495
  apply (rule_tac x="h \<circ> (\<lambda>x. (fst x, 1 - snd x))" in exI)
immler@69620
   496
  apply (rule conjI continuous_intros)+
immler@69620
   497
  apply (auto simp: reversepath_def pathstart_def pathfinish_def elim!: continuous_on_subset)
immler@69620
   498
  done
immler@69620
   499
immler@69620
   500
proposition homotopic_paths_reversepath:
immler@69620
   501
     "homotopic_paths s (reversepath p) (reversepath q) \<longleftrightarrow> homotopic_paths s p q"
immler@69620
   502
  using homotopic_paths_reversepath_D by force
immler@69620
   503
immler@69620
   504
immler@69620
   505
proposition homotopic_paths_join:
immler@69620
   506
    "\<lbrakk>homotopic_paths s p p'; homotopic_paths s q q'; pathfinish p = pathstart q\<rbrakk> \<Longrightarrow> homotopic_paths s (p +++ q) (p' +++ q')"
immler@69620
   507
  apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
immler@69620
   508
  apply (rename_tac k1 k2)
immler@69620
   509
  apply (rule_tac x="(\<lambda>y. ((k1 \<circ> Pair (fst y)) +++ (k2 \<circ> Pair (fst y))) (snd y))" in exI)
immler@69620
   510
  apply (rule conjI continuous_intros homotopic_join_lemma)+
immler@69620
   511
  apply (auto simp: joinpaths_def pathstart_def pathfinish_def path_image_def)
immler@69620
   512
  done
immler@69620
   513
immler@69620
   514
proposition homotopic_paths_continuous_image:
immler@69620
   515
    "\<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)"
immler@69620
   516
  unfolding homotopic_paths_def
immler@69620
   517
  apply (rule homotopic_with_compose_continuous_left [of _ _ _ s])
immler@69620
   518
  apply (auto simp: pathstart_def pathfinish_def elim!: homotopic_with_mono)
immler@69620
   519
  done
immler@69620
   520
immler@69620
   521
immler@69620
   522
subsection\<open>Group properties for homotopy of paths\<close>
immler@69620
   523
immler@69620
   524
text%important\<open>So taking equivalence classes under homotopy would give the fundamental group\<close>
immler@69620
   525
immler@69620
   526
proposition homotopic_paths_rid:
immler@69620
   527
    "\<lbrakk>path p; path_image p \<subseteq> s\<rbrakk> \<Longrightarrow> homotopic_paths s (p +++ linepath (pathfinish p) (pathfinish p)) p"
immler@69620
   528
  apply (subst homotopic_paths_sym)
immler@69620
   529
  apply (rule homotopic_paths_reparametrize [where f = "\<lambda>t. if  t \<le> 1 / 2 then 2 *\<^sub>R t else 1"])
immler@69620
   530
  apply (simp_all del: le_divide_eq_numeral1)
immler@69620
   531
  apply (subst split_01)
immler@69620
   532
  apply (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
immler@69620
   533
  done
immler@69620
   534
immler@69620
   535
proposition homotopic_paths_lid:
immler@69620
   536
   "\<lbrakk>path p; path_image p \<subseteq> s\<rbrakk> \<Longrightarrow> homotopic_paths s (linepath (pathstart p) (pathstart p) +++ p) p"
immler@69620
   537
  using homotopic_paths_rid [of "reversepath p" s]
immler@69620
   538
  by (metis homotopic_paths_reversepath path_image_reversepath path_reversepath pathfinish_linepath
immler@69620
   539
        pathfinish_reversepath reversepath_joinpaths reversepath_linepath)
immler@69620
   540
immler@69620
   541
proposition homotopic_paths_assoc:
immler@69620
   542
   "\<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;
immler@69620
   543
     pathfinish q = pathstart r\<rbrakk>
immler@69620
   544
    \<Longrightarrow> homotopic_paths s (p +++ (q +++ r)) ((p +++ q) +++ r)"
immler@69620
   545
  apply (subst homotopic_paths_sym)
immler@69620
   546
  apply (rule homotopic_paths_reparametrize
immler@69620
   547
           [where f = "\<lambda>t. if  t \<le> 1 / 2 then inverse 2 *\<^sub>R t
immler@69620
   548
                           else if  t \<le> 3 / 4 then t - (1 / 4)
immler@69620
   549
                           else 2 *\<^sub>R t - 1"])
immler@69620
   550
  apply (simp_all del: le_divide_eq_numeral1)
immler@69620
   551
  apply (simp add: subset_path_image_join)
immler@69620
   552
  apply (rule continuous_on_cases_1 continuous_intros)+
immler@69620
   553
  apply (auto simp: joinpaths_def)
immler@69620
   554
  done
immler@69620
   555
immler@69620
   556
proposition homotopic_paths_rinv:
immler@69620
   557
  assumes "path p" "path_image p \<subseteq> s"
immler@69620
   558
    shows "homotopic_paths s (p +++ reversepath p) (linepath (pathstart p) (pathstart p))"
immler@69620
   559
proof -
immler@69620
   560
  have "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. (subpath 0 (fst x) p +++ reversepath (subpath 0 (fst x) p)) (snd x))"
immler@69620
   561
    using assms
immler@69620
   562
    apply (simp add: joinpaths_def subpath_def reversepath_def path_def del: le_divide_eq_numeral1)
immler@69620
   563
    apply (rule continuous_on_cases_le)
immler@69620
   564
    apply (rule_tac [2] continuous_on_compose [of _ _ p, unfolded o_def])
immler@69620
   565
    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
immler@69620
   566
    apply (auto intro!: continuous_intros simp del: eq_divide_eq_numeral1)
immler@69620
   567
    apply (force elim!: continuous_on_subset simp add: mult_le_one)+
immler@69620
   568
    done
immler@69620
   569
  then show ?thesis
immler@69620
   570
    using assms
immler@69620
   571
    apply (subst homotopic_paths_sym_eq)
immler@69620
   572
    unfolding homotopic_paths_def homotopic_with_def
immler@69620
   573
    apply (rule_tac x="(\<lambda>y. (subpath 0 (fst y) p +++ reversepath(subpath 0 (fst y) p)) (snd y))" in exI)
immler@69620
   574
    apply (simp add: path_defs joinpaths_def subpath_def reversepath_def)
immler@69620
   575
    apply (force simp: mult_le_one)
immler@69620
   576
    done
immler@69620
   577
qed
immler@69620
   578
immler@69620
   579
proposition homotopic_paths_linv:
immler@69620
   580
  assumes "path p" "path_image p \<subseteq> s"
immler@69620
   581
    shows "homotopic_paths s (reversepath p +++ p) (linepath (pathfinish p) (pathfinish p))"
immler@69620
   582
  using homotopic_paths_rinv [of "reversepath p" s] assms by simp
immler@69620
   583
immler@69620
   584
immler@69620
   585
subsection\<open>Homotopy of loops without requiring preservation of endpoints\<close>
immler@69620
   586
immler@69620
   587
definition%important homotopic_loops :: "'a::topological_space set \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool"  where
immler@69620
   588
 "homotopic_loops s p q \<equiv>
immler@69620
   589
     homotopic_with (\<lambda>r. pathfinish r = pathstart r) {0..1} s p q"
immler@69620
   590
immler@69620
   591
lemma homotopic_loops:
immler@69620
   592
   "homotopic_loops s p q \<longleftrightarrow>
immler@69620
   593
      (\<exists>h. continuous_on ({0..1::real} \<times> {0..1}) h \<and>
immler@69620
   594
          image h ({0..1} \<times> {0..1}) \<subseteq> s \<and>
immler@69620
   595
          (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
immler@69620
   596
          (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
immler@69620
   597
          (\<forall>t \<in> {0..1}. pathfinish(h \<circ> Pair t) = pathstart(h \<circ> Pair t)))"
immler@69620
   598
  by (simp add: homotopic_loops_def pathstart_def pathfinish_def homotopic_with)
immler@69620
   599
immler@69620
   600
proposition homotopic_loops_imp_loop:
immler@69620
   601
     "homotopic_loops s p q \<Longrightarrow> pathfinish p = pathstart p \<and> pathfinish q = pathstart q"
immler@69620
   602
using homotopic_with_imp_property homotopic_loops_def by blast
immler@69620
   603
immler@69620
   604
proposition homotopic_loops_imp_path:
immler@69620
   605
     "homotopic_loops s p q \<Longrightarrow> path p \<and> path q"
immler@69620
   606
  unfolding homotopic_loops_def path_def
immler@69620
   607
  using homotopic_with_imp_continuous by blast
immler@69620
   608
immler@69620
   609
proposition homotopic_loops_imp_subset:
immler@69620
   610
     "homotopic_loops s p q \<Longrightarrow> path_image p \<subseteq> s \<and> path_image q \<subseteq> s"
immler@69620
   611
  unfolding homotopic_loops_def path_image_def
immler@69620
   612
  by (metis homotopic_with_imp_subset1 homotopic_with_imp_subset2)
immler@69620
   613
immler@69620
   614
proposition homotopic_loops_refl:
immler@69620
   615
     "homotopic_loops s p p \<longleftrightarrow>
immler@69620
   616
      path p \<and> path_image p \<subseteq> s \<and> pathfinish p = pathstart p"
immler@69620
   617
  by (simp add: homotopic_loops_def homotopic_with_refl path_image_def path_def)
immler@69620
   618
immler@69620
   619
proposition homotopic_loops_sym: "homotopic_loops s p q \<Longrightarrow> homotopic_loops s q p"
immler@69620
   620
  by (simp add: homotopic_loops_def homotopic_with_sym)
immler@69620
   621
immler@69620
   622
proposition homotopic_loops_sym_eq: "homotopic_loops s p q \<longleftrightarrow> homotopic_loops s q p"
immler@69620
   623
  by (metis homotopic_loops_sym)
immler@69620
   624
immler@69620
   625
proposition homotopic_loops_trans:
immler@69620
   626
   "\<lbrakk>homotopic_loops s p q; homotopic_loops s q r\<rbrakk> \<Longrightarrow> homotopic_loops s p r"
immler@69620
   627
  unfolding homotopic_loops_def by (blast intro: homotopic_with_trans)
immler@69620
   628
immler@69620
   629
proposition homotopic_loops_subset:
immler@69620
   630
   "\<lbrakk>homotopic_loops s p q; s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t p q"
immler@69620
   631
  by (simp add: homotopic_loops_def homotopic_with_subset_right)
immler@69620
   632
immler@69620
   633
proposition homotopic_loops_eq:
immler@69620
   634
   "\<lbrakk>path p; path_image p \<subseteq> s; pathfinish p = pathstart p; \<And>t. t \<in> {0..1} \<Longrightarrow> p(t) = q(t)\<rbrakk>
immler@69620
   635
          \<Longrightarrow> homotopic_loops s p q"
immler@69620
   636
  unfolding homotopic_loops_def
immler@69620
   637
  apply (rule homotopic_with_eq)
immler@69620
   638
  apply (rule homotopic_with_refl [where f = p, THEN iffD2])
immler@69620
   639
  apply (simp_all add: path_image_def path_def pathstart_def pathfinish_def)
immler@69620
   640
  done
immler@69620
   641
immler@69620
   642
proposition homotopic_loops_continuous_image:
immler@69620
   643
   "\<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)"
immler@69620
   644
  unfolding homotopic_loops_def
immler@69620
   645
  apply (rule homotopic_with_compose_continuous_left)
immler@69620
   646
  apply (erule homotopic_with_mono)
immler@69620
   647
  by (simp add: pathfinish_def pathstart_def)
immler@69620
   648
immler@69620
   649
immler@69620
   650
subsection\<open>Relations between the two variants of homotopy\<close>
immler@69620
   651
immler@69620
   652
proposition homotopic_paths_imp_homotopic_loops:
immler@69620
   653
    "\<lbrakk>homotopic_paths s p q; pathfinish p = pathstart p; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> homotopic_loops s p q"
immler@69620
   654
  by (auto simp: homotopic_paths_def homotopic_loops_def intro: homotopic_with_mono)
immler@69620
   655
immler@69620
   656
proposition homotopic_loops_imp_homotopic_paths_null:
immler@69620
   657
  assumes "homotopic_loops s p (linepath a a)"
immler@69620
   658
    shows "homotopic_paths s p (linepath (pathstart p) (pathstart p))"
immler@69620
   659
proof -
immler@69620
   660
  have "path p" by (metis assms homotopic_loops_imp_path)
immler@69620
   661
  have ploop: "pathfinish p = pathstart p" by (metis assms homotopic_loops_imp_loop)
immler@69620
   662
  have pip: "path_image p \<subseteq> s" by (metis assms homotopic_loops_imp_subset)
immler@69620
   663
  obtain h where conth: "continuous_on ({0..1::real} \<times> {0..1}) h"
immler@69620
   664
             and hs: "h ` ({0..1} \<times> {0..1}) \<subseteq> s"
immler@69620
   665
             and [simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(0,x) = p x"
immler@69620
   666
             and [simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(1,x) = a"
immler@69620
   667
             and ends: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish (h \<circ> Pair t) = pathstart (h \<circ> Pair t)"
immler@69620
   668
    using assms by (auto simp: homotopic_loops homotopic_with)
immler@69620
   669
  have conth0: "path (\<lambda>u. h (u, 0))"
immler@69620
   670
    unfolding path_def
immler@69620
   671
    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
immler@69620
   672
    apply (force intro: continuous_intros continuous_on_subset [OF conth])+
immler@69620
   673
    done
immler@69620
   674
  have pih0: "path_image (\<lambda>u. h (u, 0)) \<subseteq> s"
immler@69620
   675
    using hs by (force simp: path_image_def)
immler@69620
   676
  have c1: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. h (fst x * snd x, 0))"
immler@69620
   677
    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
immler@69620
   678
    apply (force simp: mult_le_one intro: continuous_intros continuous_on_subset [OF conth])+
immler@69620
   679
    done
immler@69620
   680
  have c2: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. h (fst x - fst x * snd x, 0))"
immler@69620
   681
    apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
immler@69620
   682
    apply (force simp: mult_left_le mult_le_one intro: continuous_intros continuous_on_subset [OF conth])+
immler@69620
   683
    apply (rule continuous_on_subset [OF conth])
immler@69620
   684
    apply (auto simp: algebra_simps add_increasing2 mult_left_le)
immler@69620
   685
    done
immler@69620
   686
  have [simp]: "\<And>t. \<lbrakk>0 \<le> t \<and> t \<le> 1\<rbrakk> \<Longrightarrow> h (t, 1) = h (t, 0)"
immler@69620
   687
    using ends by (simp add: pathfinish_def pathstart_def)
immler@69620
   688
  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
immler@69620
   689
  proof -
immler@69620
   690
    have "c * 3 \<le> c * (d * 4)" using that less_eq_real_def by auto
immler@69620
   691
    with \<open>c \<le> 1\<close> show ?thesis by fastforce
immler@69620
   692
  qed
immler@69620
   693
  have *: "\<And>p x. (path p \<and> path(reversepath p)) \<and>
immler@69620
   694
                  (path_image p \<subseteq> s \<and> path_image(reversepath p) \<subseteq> s) \<and>
immler@69620
   695
                  (pathfinish p = pathstart(linepath a a +++ reversepath p) \<and>
immler@69620
   696
                   pathstart(reversepath p) = a) \<and> pathstart p = x
immler@69620
   697
                  \<Longrightarrow> homotopic_paths s (p +++ linepath a a +++ reversepath p) (linepath x x)"
immler@69620
   698
    by (metis homotopic_paths_lid homotopic_paths_join
immler@69620
   699
              homotopic_paths_trans homotopic_paths_sym homotopic_paths_rinv)
immler@69620
   700
  have 1: "homotopic_paths s p (p +++ linepath (pathfinish p) (pathfinish p))"
immler@69620
   701
    using \<open>path p\<close> homotopic_paths_rid homotopic_paths_sym pip by blast
immler@69620
   702
  moreover have "homotopic_paths s (p +++ linepath (pathfinish p) (pathfinish p))
immler@69620
   703
                                   (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))"
immler@69620
   704
    apply (rule homotopic_paths_sym)
immler@69620
   705
    using homotopic_paths_lid [of "p +++ linepath (pathfinish p) (pathfinish p)" s]
immler@69620
   706
    by (metis 1 homotopic_paths_imp_path homotopic_paths_imp_pathstart homotopic_paths_imp_subset)
immler@69620
   707
  moreover have "homotopic_paths s (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))
immler@69620
   708
                                   ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))"
immler@69620
   709
    apply (simp add: homotopic_paths_def homotopic_with_def)
immler@69620
   710
    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)
immler@69620
   711
    apply (simp add: subpath_reversepath)
immler@69620
   712
    apply (intro conjI homotopic_join_lemma)
immler@69620
   713
    using ploop
immler@69620
   714
    apply (simp_all add: path_defs joinpaths_def o_def subpath_def conth c1 c2)
immler@69620
   715
    apply (force simp: algebra_simps mult_le_one mult_left_le intro: hs [THEN subsetD] adhoc_le)
immler@69620
   716
    done
immler@69620
   717
  moreover have "homotopic_paths s ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))
immler@69620
   718
                                   (linepath (pathstart p) (pathstart p))"
immler@69620
   719
    apply (rule *)
immler@69620
   720
    apply (simp add: pih0 pathstart_def pathfinish_def conth0)
immler@69620
   721
    apply (simp add: reversepath_def joinpaths_def)
immler@69620
   722
    done
immler@69620
   723
  ultimately show ?thesis
immler@69620
   724
    by (blast intro: homotopic_paths_trans)
immler@69620
   725
qed
immler@69620
   726
immler@69620
   727
proposition homotopic_loops_conjugate:
immler@69620
   728
  fixes s :: "'a::real_normed_vector set"
immler@69620
   729
  assumes "path p" "path q" and pip: "path_image p \<subseteq> s" and piq: "path_image q \<subseteq> s"
immler@69620
   730
      and papp: "pathfinish p = pathstart q" and qloop: "pathfinish q = pathstart q"
immler@69620
   731
    shows "homotopic_loops s (p +++ q +++ reversepath p) q"
immler@69620
   732
proof -
immler@69620
   733
  have contp: "continuous_on {0..1} p"  using \<open>path p\<close> [unfolded path_def] by blast
immler@69620
   734
  have contq: "continuous_on {0..1} q"  using \<open>path q\<close> [unfolded path_def] by blast
immler@69620
   735
  have c1: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. p ((1 - fst x) * snd x + fst x))"
immler@69620
   736
    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
immler@69620
   737
    apply (force simp: mult_le_one intro!: continuous_intros)
immler@69620
   738
    apply (rule continuous_on_subset [OF contp])
immler@69620
   739
    apply (auto simp: algebra_simps add_increasing2 mult_right_le_one_le sum_le_prod1)
immler@69620
   740
    done
immler@69620
   741
  have c2: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. p ((fst x - 1) * snd x + 1))"
immler@69620
   742
    apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
immler@69620
   743
    apply (force simp: mult_le_one intro!: continuous_intros)
immler@69620
   744
    apply (rule continuous_on_subset [OF contp])
immler@69620
   745
    apply (auto simp: algebra_simps add_increasing2 mult_left_le_one_le)
immler@69620
   746
    done
immler@69620
   747
  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"
immler@69620
   748
    using sum_le_prod1
immler@69620
   749
    by (force simp: algebra_simps add_increasing2 mult_left_le intro: pip [unfolded path_image_def, THEN subsetD])
immler@69620
   750
  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"
immler@69620
   751
    apply (rule pip [unfolded path_image_def, THEN subsetD])
immler@69620
   752
    apply (rule image_eqI, blast)
immler@69620
   753
    apply (simp add: algebra_simps)
immler@69620
   754
    by (metis add_mono_thms_linordered_semiring(1) affine_ineq linear mult.commute mult.left_neutral mult_right_mono not_le
immler@69620
   755
              add.commute zero_le_numeral)
immler@69620
   756
  have qs: "\<And>a b. \<lbrakk>4 * b \<le> 3; \<not> b * 2 \<le> 1\<rbrakk> \<Longrightarrow> q (4 * b - 2) \<in> s"
immler@69620
   757
    using path_image_def piq by fastforce
immler@69620
   758
  have "homotopic_loops s (p +++ q +++ reversepath p)
immler@69620
   759
                          (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q))"
immler@69620
   760
    apply (simp add: homotopic_loops_def homotopic_with_def)
immler@69620
   761
    apply (rule_tac x="(\<lambda>y. (subpath (fst y) 1 p +++ q +++ subpath 1 (fst y) p) (snd y))" in exI)
immler@69620
   762
    apply (simp add: subpath_refl subpath_reversepath)
immler@69620
   763
    apply (intro conjI homotopic_join_lemma)
immler@69620
   764
    using papp qloop
immler@69620
   765
    apply (simp_all add: path_defs joinpaths_def o_def subpath_def c1 c2)
immler@69620
   766
    apply (force simp: contq intro: continuous_on_compose [of _ _ q, unfolded o_def] continuous_on_id continuous_on_snd)
immler@69620
   767
    apply (auto simp: ps1 ps2 qs)
immler@69620
   768
    done
immler@69620
   769
  moreover have "homotopic_loops s (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q)) q"
immler@69620
   770
  proof -
immler@69620
   771
    have "homotopic_paths s (linepath (pathfinish q) (pathfinish q) +++ q) q"
immler@69620
   772
      using \<open>path q\<close> homotopic_paths_lid qloop piq by auto
immler@69620
   773
    hence 1: "\<And>f. homotopic_paths s f q \<or> \<not> homotopic_paths s f (linepath (pathfinish q) (pathfinish q) +++ q)"
immler@69620
   774
      using homotopic_paths_trans by blast
immler@69620
   775
    hence "homotopic_paths s (linepath (pathfinish q) (pathfinish q) +++ q +++ linepath (pathfinish q) (pathfinish q)) q"
immler@69620
   776
    proof -
immler@69620
   777
      have "homotopic_paths s (q +++ linepath (pathfinish q) (pathfinish q)) q"
immler@69620
   778
        by (simp add: \<open>path q\<close> homotopic_paths_rid piq)
immler@69620
   779
      thus ?thesis
immler@69620
   780
        by (metis (no_types) 1 \<open>path q\<close> homotopic_paths_join homotopic_paths_rinv homotopic_paths_sym
immler@69620
   781
                  homotopic_paths_trans qloop pathfinish_linepath piq)
immler@69620
   782
    qed
immler@69620
   783
    thus ?thesis
immler@69620
   784
      by (metis (no_types) qloop homotopic_loops_sym homotopic_paths_imp_homotopic_loops homotopic_paths_imp_pathfinish homotopic_paths_sym)
immler@69620
   785
  qed
immler@69620
   786
  ultimately show ?thesis
immler@69620
   787
    by (blast intro: homotopic_loops_trans)
immler@69620
   788
qed
immler@69620
   789
immler@69620
   790
lemma homotopic_paths_loop_parts:
immler@69620
   791
  assumes loops: "homotopic_loops S (p +++ reversepath q) (linepath a a)" and "path q"
immler@69620
   792
  shows "homotopic_paths S p q"
immler@69620
   793
proof -
immler@69620
   794
  have paths: "homotopic_paths S (p +++ reversepath q) (linepath (pathstart p) (pathstart p))"
immler@69620
   795
    using homotopic_loops_imp_homotopic_paths_null [OF loops] by simp
immler@69620
   796
  then have "path p"
immler@69620
   797
    using \<open>path q\<close> homotopic_loops_imp_path loops path_join path_join_path_ends path_reversepath by blast
immler@69620
   798
  show ?thesis
immler@69620
   799
  proof (cases "pathfinish p = pathfinish q")
immler@69620
   800
    case True
immler@69620
   801
    have pipq: "path_image p \<subseteq> S" "path_image q \<subseteq> S"
immler@69620
   802
      by (metis Un_subset_iff paths \<open>path p\<close> \<open>path q\<close> homotopic_loops_imp_subset homotopic_paths_imp_path loops
immler@69620
   803
           path_image_join path_image_reversepath path_imp_reversepath path_join_eq)+
immler@69620
   804
    have "homotopic_paths S p (p +++ (linepath (pathfinish p) (pathfinish p)))"
immler@69620
   805
      using \<open>path p\<close> \<open>path_image p \<subseteq> S\<close> homotopic_paths_rid homotopic_paths_sym by blast
immler@69620
   806
    moreover have "homotopic_paths S (p +++ (linepath (pathfinish p) (pathfinish p))) (p +++ (reversepath q +++ q))"
immler@69620
   807
      by (simp add: True \<open>path p\<close> \<open>path q\<close> pipq homotopic_paths_join homotopic_paths_linv homotopic_paths_sym)
immler@69620
   808
    moreover have "homotopic_paths S (p +++ (reversepath q +++ q)) ((p +++ reversepath q) +++ q)"
immler@69620
   809
      by (simp add: True \<open>path p\<close> \<open>path q\<close> homotopic_paths_assoc pipq)
immler@69620
   810
    moreover have "homotopic_paths S ((p +++ reversepath q) +++ q) (linepath (pathstart p) (pathstart p) +++ q)"
immler@69620
   811
      by (simp add: \<open>path q\<close> homotopic_paths_join paths pipq)
immler@69620
   812
    moreover then have "homotopic_paths S (linepath (pathstart p) (pathstart p) +++ q) q"
immler@69620
   813
      by (metis \<open>path q\<close> homotopic_paths_imp_path homotopic_paths_lid linepath_trivial path_join_path_ends pathfinish_def pipq(2))
immler@69620
   814
    ultimately show ?thesis
immler@69620
   815
      using homotopic_paths_trans by metis
immler@69620
   816
  next
immler@69620
   817
    case False
immler@69620
   818
    then show ?thesis
immler@69620
   819
      using \<open>path q\<close> homotopic_loops_imp_path loops path_join_path_ends by fastforce
immler@69620
   820
  qed
immler@69620
   821
qed
immler@69620
   822
immler@69620
   823
immler@69620
   824
subsection%unimportant\<open>Homotopy of "nearby" function, paths and loops\<close>
immler@69620
   825
immler@69620
   826
lemma homotopic_with_linear:
immler@69620
   827
  fixes f g :: "_ \<Rightarrow> 'b::real_normed_vector"
immler@69620
   828
  assumes contf: "continuous_on s f"
immler@69620
   829
      and contg:"continuous_on s g"
immler@69620
   830
      and sub: "\<And>x. x \<in> s \<Longrightarrow> closed_segment (f x) (g x) \<subseteq> t"
immler@69620
   831
    shows "homotopic_with (\<lambda>z. True) s t f g"
immler@69620
   832
  apply (simp add: homotopic_with_def)
immler@69620
   833
  apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R f(snd y) + (fst y) *\<^sub>R g(snd y))" in exI)
immler@69620
   834
  apply (intro conjI)
immler@69620
   835
  apply (rule subset_refl continuous_intros continuous_on_subset [OF contf] continuous_on_compose2 [where g=f]
immler@69620
   836
                                            continuous_on_subset [OF contg] continuous_on_compose2 [where g=g]| simp)+
immler@69620
   837
  using sub closed_segment_def apply fastforce+
immler@69620
   838
  done
immler@69620
   839
immler@69620
   840
lemma homotopic_paths_linear:
immler@69620
   841
  fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
immler@69620
   842
  assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
immler@69620
   843
          "\<And>t. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> s"
immler@69620
   844
    shows "homotopic_paths s g h"
immler@69620
   845
  using assms
immler@69620
   846
  unfolding path_def
immler@69620
   847
  apply (simp add: closed_segment_def pathstart_def pathfinish_def homotopic_paths_def homotopic_with_def)
immler@69620
   848
  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)
immler@69620
   849
  apply (intro conjI subsetI continuous_intros; force)
immler@69620
   850
  done
immler@69620
   851
immler@69620
   852
lemma homotopic_loops_linear:
immler@69620
   853
  fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
immler@69620
   854
  assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
immler@69620
   855
          "\<And>t x. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> s"
immler@69620
   856
    shows "homotopic_loops s g h"
immler@69620
   857
  using assms
immler@69620
   858
  unfolding path_def
immler@69620
   859
  apply (simp add: pathstart_def pathfinish_def homotopic_loops_def homotopic_with_def)
immler@69620
   860
  apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R g(snd y) + (fst y) *\<^sub>R h(snd y))" in exI)
immler@69620
   861
  apply (auto intro!: continuous_intros intro: continuous_on_compose2 [where g=g] continuous_on_compose2 [where g=h])
immler@69620
   862
  apply (force simp: closed_segment_def)
immler@69620
   863
  done
immler@69620
   864
immler@69620
   865
lemma homotopic_paths_nearby_explicit:
immler@69620
   866
  assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
immler@69620
   867
      and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> s\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
immler@69620
   868
    shows "homotopic_paths s g h"
immler@69620
   869
  apply (rule homotopic_paths_linear [OF assms(1-4)])
immler@69620
   870
  by (metis no segment_bound(1) subsetI norm_minus_commute not_le)
immler@69620
   871
immler@69620
   872
lemma homotopic_loops_nearby_explicit:
immler@69620
   873
  assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
immler@69620
   874
      and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> s\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
immler@69620
   875
    shows "homotopic_loops s g h"
immler@69620
   876
  apply (rule homotopic_loops_linear [OF assms(1-4)])
immler@69620
   877
  by (metis no segment_bound(1) subsetI norm_minus_commute not_le)
immler@69620
   878
immler@69620
   879
lemma homotopic_nearby_paths:
immler@69620
   880
  fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
immler@69620
   881
  assumes "path g" "open s" "path_image g \<subseteq> s"
immler@69620
   882
    shows "\<exists>e. 0 < e \<and>
immler@69620
   883
               (\<forall>h. path h \<and>
immler@69620
   884
                    pathstart h = pathstart g \<and> pathfinish h = pathfinish g \<and>
immler@69620
   885
                    (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_paths s g h)"
immler@69620
   886
proof -
immler@69620
   887
  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"
immler@69620
   888
    using separate_compact_closed [of "path_image g" "-s"] assms by force
immler@69620
   889
  show ?thesis
immler@69620
   890
    apply (intro exI conjI)
immler@69620
   891
    using e [unfolded dist_norm]
immler@69620
   892
    apply (auto simp: intro!: homotopic_paths_nearby_explicit assms  \<open>e > 0\<close>)
immler@69620
   893
    by (metis atLeastAtMost_iff imageI le_less_trans not_le path_image_def)
immler@69620
   894
qed
immler@69620
   895
immler@69620
   896
lemma homotopic_nearby_loops:
immler@69620
   897
  fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
immler@69620
   898
  assumes "path g" "open s" "path_image g \<subseteq> s" "pathfinish g = pathstart g"
immler@69620
   899
    shows "\<exists>e. 0 < e \<and>
immler@69620
   900
               (\<forall>h. path h \<and> pathfinish h = pathstart h \<and>
immler@69620
   901
                    (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_loops s g h)"
immler@69620
   902
proof -
immler@69620
   903
  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"
immler@69620
   904
    using separate_compact_closed [of "path_image g" "-s"] assms by force
immler@69620
   905
  show ?thesis
immler@69620
   906
    apply (intro exI conjI)
immler@69620
   907
    using e [unfolded dist_norm]
immler@69620
   908
    apply (auto simp: intro!: homotopic_loops_nearby_explicit assms  \<open>e > 0\<close>)
immler@69620
   909
    by (metis atLeastAtMost_iff imageI le_less_trans not_le path_image_def)
immler@69620
   910
qed
immler@69620
   911
immler@69620
   912
immler@69620
   913
subsection\<open> Homotopy and subpaths\<close>
immler@69620
   914
immler@69620
   915
lemma homotopic_join_subpaths1:
immler@69620
   916
  assumes "path g" and pag: "path_image g \<subseteq> s"
immler@69620
   917
      and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}" "u \<le> v" "v \<le> w"
immler@69620
   918
    shows "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
immler@69620
   919
proof -
immler@69620
   920
  have 1: "t * 2 \<le> 1 \<Longrightarrow> u + t * (v * 2) \<le> v + t * (u * 2)" for t
immler@69620
   921
    using affine_ineq \<open>u \<le> v\<close> by fastforce
immler@69620
   922
  have 2: "t * 2 > 1 \<Longrightarrow> u + (2*t - 1) * v \<le> v + (2*t - 1) * w" for t
immler@69620
   923
    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>)
immler@69620
   924
  have t2: "\<And>t::real. t*2 = 1 \<Longrightarrow> t = 1/2" by auto
immler@69620
   925
  show ?thesis
immler@69620
   926
    apply (rule homotopic_paths_subset [OF _ pag])
immler@69620
   927
    using assms
immler@69620
   928
    apply (cases "w = u")
immler@69620
   929
    using homotopic_paths_rinv [of "subpath u v g" "path_image g"]
immler@69620
   930
    apply (force simp: closed_segment_eq_real_ivl image_mono path_image_def subpath_refl)
immler@69620
   931
      apply (rule homotopic_paths_sym)
immler@69620
   932
      apply (rule homotopic_paths_reparametrize
immler@69620
   933
             [where f = "\<lambda>t. if  t \<le> 1 / 2
immler@69620
   934
                             then inverse((w - u)) *\<^sub>R (2 * (v - u)) *\<^sub>R t
immler@69620
   935
                             else inverse((w - u)) *\<^sub>R ((v - u) + (w - v) *\<^sub>R (2 *\<^sub>R t - 1))"])
immler@69620
   936
      using \<open>path g\<close> path_subpath u w apply blast
immler@69620
   937
      using \<open>path g\<close> path_image_subpath_subset u w(1) apply blast
immler@69620
   938
      apply simp_all
immler@69620
   939
      apply (subst split_01)
immler@69620
   940
      apply (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
immler@69620
   941
      apply (simp_all add: field_simps not_le)
immler@69620
   942
      apply (force dest!: t2)
immler@69620
   943
      apply (force simp: algebra_simps mult_left_mono affine_ineq dest!: 1 2)
immler@69620
   944
      apply (simp add: joinpaths_def subpath_def)
immler@69620
   945
      apply (force simp: algebra_simps)
immler@69620
   946
      done
immler@69620
   947
qed
immler@69620
   948
immler@69620
   949
lemma homotopic_join_subpaths2:
immler@69620
   950
  assumes "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
immler@69620
   951
    shows "homotopic_paths s (subpath w v g +++ subpath v u g) (subpath w u g)"
immler@69620
   952
by (metis assms homotopic_paths_reversepath_D pathfinish_subpath pathstart_subpath reversepath_joinpaths reversepath_subpath)
immler@69620
   953
immler@69620
   954
lemma homotopic_join_subpaths3:
immler@69620
   955
  assumes hom: "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
immler@69620
   956
      and "path g" and pag: "path_image g \<subseteq> s"
immler@69620
   957
      and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}"
immler@69620
   958
    shows "homotopic_paths s (subpath v w g +++ subpath w u g) (subpath v u g)"
immler@69620
   959
proof -
immler@69620
   960
  have "homotopic_paths s (subpath u w g +++ subpath w v g) ((subpath u v g +++ subpath v w g) +++ subpath w v g)"
immler@69620
   961
    apply (rule homotopic_paths_join)
immler@69620
   962
    using hom homotopic_paths_sym_eq apply blast
immler@69620
   963
    apply (metis \<open>path g\<close> homotopic_paths_eq pag path_image_subpath_subset path_subpath subset_trans v w, simp)
immler@69620
   964
    done
immler@69620
   965
  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)"
immler@69620
   966
    apply (rule homotopic_paths_sym [OF homotopic_paths_assoc])
immler@69620
   967
    using assms by (simp_all add: path_image_subpath_subset [THEN order_trans])
immler@69620
   968
  also have "homotopic_paths s (subpath u v g +++ subpath v w g +++ subpath w v g)
immler@69620
   969
                               (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g)))"
immler@69620
   970
    apply (rule homotopic_paths_join)
immler@69620
   971
    apply (metis \<open>path g\<close> homotopic_paths_eq order.trans pag path_image_subpath_subset path_subpath u v)
immler@69620
   972
    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)
immler@69620
   973
    apply simp
immler@69620
   974
    done
immler@69620
   975
  also have "homotopic_paths s (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g))) (subpath u v g)"
immler@69620
   976
    apply (rule homotopic_paths_rid)
immler@69620
   977
    using \<open>path g\<close> path_subpath u v apply blast
immler@69620
   978
    apply (meson \<open>path g\<close> order.trans pag path_image_subpath_subset u v)
immler@69620
   979
    done
immler@69620
   980
  finally have "homotopic_paths s (subpath u w g +++ subpath w v g) (subpath u v g)" .
immler@69620
   981
  then show ?thesis
immler@69620
   982
    using homotopic_join_subpaths2 by blast
immler@69620
   983
qed
immler@69620
   984
immler@69620
   985
proposition homotopic_join_subpaths:
immler@69620
   986
   "\<lbrakk>path g; path_image g \<subseteq> s; u \<in> {0..1}; v \<in> {0..1}; w \<in> {0..1}\<rbrakk>
immler@69620
   987
    \<Longrightarrow> homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
immler@69620
   988
  apply (rule le_cases3 [of u v w])
immler@69620
   989
using homotopic_join_subpaths1 homotopic_join_subpaths2 homotopic_join_subpaths3 by metis+
immler@69620
   990
immler@69620
   991
text\<open>Relating homotopy of trivial loops to path-connectedness.\<close>
immler@69620
   992
immler@69620
   993
lemma path_component_imp_homotopic_points:
immler@69620
   994
    "path_component S a b \<Longrightarrow> homotopic_loops S (linepath a a) (linepath b b)"
immler@69620
   995
apply (simp add: path_component_def homotopic_loops_def homotopic_with_def
immler@69620
   996
                 pathstart_def pathfinish_def path_image_def path_def, clarify)
immler@69620
   997
apply (rule_tac x="g \<circ> fst" in exI)
immler@69620
   998
apply (intro conjI continuous_intros continuous_on_compose)+
immler@69620
   999
apply (auto elim!: continuous_on_subset)
immler@69620
  1000
done
immler@69620
  1001
immler@69620
  1002
lemma homotopic_loops_imp_path_component_value:
immler@69620
  1003
   "\<lbrakk>homotopic_loops S p q; 0 \<le> t; t \<le> 1\<rbrakk>
immler@69620
  1004
        \<Longrightarrow> path_component S (p t) (q t)"
immler@69620
  1005
apply (simp add: path_component_def homotopic_loops_def homotopic_with_def
immler@69620
  1006
                 pathstart_def pathfinish_def path_image_def path_def, clarify)
immler@69620
  1007
apply (rule_tac x="h \<circ> (\<lambda>u. (u, t))" in exI)
immler@69620
  1008
apply (intro conjI continuous_intros continuous_on_compose)+
immler@69620
  1009
apply (auto elim!: continuous_on_subset)
immler@69620
  1010
done
immler@69620
  1011
immler@69620
  1012
lemma homotopic_points_eq_path_component:
immler@69620
  1013
   "homotopic_loops S (linepath a a) (linepath b b) \<longleftrightarrow>
immler@69620
  1014
        path_component S a b"
immler@69620
  1015
by (auto simp: path_component_imp_homotopic_points
immler@69620
  1016
         dest: homotopic_loops_imp_path_component_value [where t=1])
immler@69620
  1017
immler@69620
  1018
lemma path_connected_eq_homotopic_points:
immler@69620
  1019
    "path_connected S \<longleftrightarrow>
immler@69620
  1020
      (\<forall>a b. a \<in> S \<and> b \<in> S \<longrightarrow> homotopic_loops S (linepath a a) (linepath b b))"
immler@69620
  1021
by (auto simp: path_connected_def path_component_def homotopic_points_eq_path_component)
immler@69620
  1022
immler@69620
  1023
immler@69620
  1024
subsection\<open>Simply connected sets\<close>
immler@69620
  1025
immler@69620
  1026
text%important\<open>defined as "all loops are homotopic (as loops)\<close>
immler@69620
  1027
immler@69620
  1028
definition%important simply_connected where
immler@69620
  1029
  "simply_connected S \<equiv>
immler@69620
  1030
        \<forall>p q. path p \<and> pathfinish p = pathstart p \<and> path_image p \<subseteq> S \<and>
immler@69620
  1031
              path q \<and> pathfinish q = pathstart q \<and> path_image q \<subseteq> S
immler@69620
  1032
              \<longrightarrow> homotopic_loops S p q"
immler@69620
  1033
immler@69620
  1034
lemma simply_connected_empty [iff]: "simply_connected {}"
immler@69620
  1035
  by (simp add: simply_connected_def)
immler@69620
  1036
immler@69620
  1037
lemma simply_connected_imp_path_connected:
immler@69620
  1038
  fixes S :: "_::real_normed_vector set"
immler@69620
  1039
  shows "simply_connected S \<Longrightarrow> path_connected S"
immler@69620
  1040
by (simp add: simply_connected_def path_connected_eq_homotopic_points)
immler@69620
  1041
immler@69620
  1042
lemma simply_connected_imp_connected:
immler@69620
  1043
  fixes S :: "_::real_normed_vector set"
immler@69620
  1044
  shows "simply_connected S \<Longrightarrow> connected S"
immler@69620
  1045
by (simp add: path_connected_imp_connected simply_connected_imp_path_connected)
immler@69620
  1046
immler@69620
  1047
lemma simply_connected_eq_contractible_loop_any:
immler@69620
  1048
  fixes S :: "_::real_normed_vector set"
immler@69620
  1049
  shows "simply_connected S \<longleftrightarrow>
immler@69620
  1050
            (\<forall>p a. path p \<and> path_image p \<subseteq> S \<and>
immler@69620
  1051
                  pathfinish p = pathstart p \<and> a \<in> S
immler@69620
  1052
                  \<longrightarrow> homotopic_loops S p (linepath a a))"
immler@69620
  1053
apply (simp add: simply_connected_def)
immler@69620
  1054
apply (rule iffI, force, clarify)
immler@69620
  1055
apply (rule_tac q = "linepath (pathstart p) (pathstart p)" in homotopic_loops_trans)
immler@69620
  1056
apply (fastforce simp add:)
immler@69620
  1057
using homotopic_loops_sym apply blast
immler@69620
  1058
done
immler@69620
  1059
immler@69620
  1060
lemma simply_connected_eq_contractible_loop_some:
immler@69620
  1061
  fixes S :: "_::real_normed_vector set"
immler@69620
  1062
  shows "simply_connected S \<longleftrightarrow>
immler@69620
  1063
                path_connected S \<and>
immler@69620
  1064
                (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
immler@69620
  1065
                    \<longrightarrow> (\<exists>a. a \<in> S \<and> homotopic_loops S p (linepath a a)))"
immler@69620
  1066
apply (rule iffI)
immler@69620
  1067
 apply (fastforce simp: simply_connected_imp_path_connected simply_connected_eq_contractible_loop_any)
immler@69620
  1068
apply (clarsimp simp add: simply_connected_eq_contractible_loop_any)
immler@69620
  1069
apply (drule_tac x=p in spec)
immler@69620
  1070
using homotopic_loops_trans path_connected_eq_homotopic_points
immler@69620
  1071
  apply blast
immler@69620
  1072
done
immler@69620
  1073
immler@69620
  1074
lemma simply_connected_eq_contractible_loop_all:
immler@69620
  1075
  fixes S :: "_::real_normed_vector set"
immler@69620
  1076
  shows "simply_connected S \<longleftrightarrow>
immler@69620
  1077
         S = {} \<or>
immler@69620
  1078
         (\<exists>a \<in> S. \<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
immler@69620
  1079
                \<longrightarrow> homotopic_loops S p (linepath a a))"
immler@69620
  1080
        (is "?lhs = ?rhs")
immler@69620
  1081
proof (cases "S = {}")
immler@69620
  1082
  case True then show ?thesis by force
immler@69620
  1083
next
immler@69620
  1084
  case False
immler@69620
  1085
  then obtain a where "a \<in> S" by blast
immler@69620
  1086
  show ?thesis
immler@69620
  1087
  proof
immler@69620
  1088
    assume "simply_connected S"
immler@69620
  1089
    then show ?rhs
immler@69620
  1090
      using \<open>a \<in> S\<close> \<open>simply_connected S\<close> simply_connected_eq_contractible_loop_any
immler@69620
  1091
      by blast
immler@69620
  1092
  next
immler@69620
  1093
    assume ?rhs
immler@69620
  1094
    then show "simply_connected S"
immler@69620
  1095
      apply (simp add: simply_connected_eq_contractible_loop_any False)
immler@69620
  1096
      by (meson homotopic_loops_refl homotopic_loops_sym homotopic_loops_trans
immler@69620
  1097
             path_component_imp_homotopic_points path_component_refl)
immler@69620
  1098
  qed
immler@69620
  1099
qed
immler@69620
  1100
immler@69620
  1101
lemma simply_connected_eq_contractible_path:
immler@69620
  1102
  fixes S :: "_::real_normed_vector set"
immler@69620
  1103
  shows "simply_connected S \<longleftrightarrow>
immler@69620
  1104
           path_connected S \<and>
immler@69620
  1105
           (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
immler@69620
  1106
            \<longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p)))"
immler@69620
  1107
apply (rule iffI)
immler@69620
  1108
 apply (simp add: simply_connected_imp_path_connected)
immler@69620
  1109
 apply (metis simply_connected_eq_contractible_loop_some homotopic_loops_imp_homotopic_paths_null)
immler@69620
  1110
by (meson homotopic_paths_imp_homotopic_loops pathfinish_linepath pathstart_in_path_image
immler@69620
  1111
         simply_connected_eq_contractible_loop_some subset_iff)
immler@69620
  1112
immler@69620
  1113
lemma simply_connected_eq_homotopic_paths:
immler@69620
  1114
  fixes S :: "_::real_normed_vector set"
immler@69620
  1115
  shows "simply_connected S \<longleftrightarrow>
immler@69620
  1116
          path_connected S \<and>
immler@69620
  1117
          (\<forall>p q. path p \<and> path_image p \<subseteq> S \<and>
immler@69620
  1118
                path q \<and> path_image q \<subseteq> S \<and>
immler@69620
  1119
                pathstart q = pathstart p \<and> pathfinish q = pathfinish p
immler@69620
  1120
                \<longrightarrow> homotopic_paths S p q)"
immler@69620
  1121
         (is "?lhs = ?rhs")
immler@69620
  1122
proof
immler@69620
  1123
  assume ?lhs
immler@69620
  1124
  then have pc: "path_connected S"
immler@69620
  1125
        and *:  "\<And>p. \<lbrakk>path p; path_image p \<subseteq> S;
immler@69620
  1126
                       pathfinish p = pathstart p\<rbrakk>
immler@69620
  1127
                      \<Longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p))"
immler@69620
  1128
    by (auto simp: simply_connected_eq_contractible_path)
immler@69620
  1129
  have "homotopic_paths S p q"
immler@69620
  1130
        if "path p" "path_image p \<subseteq> S" "path q"
immler@69620
  1131
           "path_image q \<subseteq> S" "pathstart q = pathstart p"
immler@69620
  1132
           "pathfinish q = pathfinish p" for p q
immler@69620
  1133
  proof -
immler@69620
  1134
    have "homotopic_paths S p (p +++ linepath (pathfinish p) (pathfinish p))"
immler@69620
  1135
      by (simp add: homotopic_paths_rid homotopic_paths_sym that)
immler@69620
  1136
    also have "homotopic_paths S (p +++ linepath (pathfinish p) (pathfinish p))
immler@69620
  1137
                                 (p +++ reversepath q +++ q)"
immler@69620
  1138
      using that
immler@69620
  1139
      by (metis homotopic_paths_join homotopic_paths_linv homotopic_paths_refl homotopic_paths_sym_eq pathstart_linepath)
immler@69620
  1140
    also have "homotopic_paths S (p +++ reversepath q +++ q)
immler@69620
  1141
                                 ((p +++ reversepath q) +++ q)"
immler@69620
  1142
      by (simp add: that homotopic_paths_assoc)
immler@69620
  1143
    also have "homotopic_paths S ((p +++ reversepath q) +++ q)
immler@69620
  1144
                                 (linepath (pathstart q) (pathstart q) +++ q)"
immler@69620
  1145
      using * [of "p +++ reversepath q"] that
immler@69620
  1146
      by (simp add: homotopic_paths_join path_image_join)
immler@69620
  1147
    also have "homotopic_paths S (linepath (pathstart q) (pathstart q) +++ q) q"
immler@69620
  1148
      using that homotopic_paths_lid by blast
immler@69620
  1149
    finally show ?thesis .
immler@69620
  1150
  qed
immler@69620
  1151
  then show ?rhs
immler@69620
  1152
    by (blast intro: pc *)
immler@69620
  1153
next
immler@69620
  1154
  assume ?rhs
immler@69620
  1155
  then show ?lhs
immler@69620
  1156
    by (force simp: simply_connected_eq_contractible_path)
immler@69620
  1157
qed
immler@69620
  1158
immler@69620
  1159
proposition simply_connected_Times:
immler@69620
  1160
  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
immler@69620
  1161
  assumes S: "simply_connected S" and T: "simply_connected T"
immler@69620
  1162
    shows "simply_connected(S \<times> T)"
immler@69620
  1163
proof -
immler@69620
  1164
  have "homotopic_loops (S \<times> T) p (linepath (a, b) (a, b))"
immler@69620
  1165
       if "path p" "path_image p \<subseteq> S \<times> T" "p 1 = p 0" "a \<in> S" "b \<in> T"
immler@69620
  1166
       for p a b
immler@69620
  1167
  proof -
immler@69620
  1168
    have "path (fst \<circ> p)"
immler@69620
  1169
      apply (rule Path_Connected.path_continuous_image [OF \<open>path p\<close>])
immler@69620
  1170
      apply (rule continuous_intros)+
immler@69620
  1171
      done
immler@69620
  1172
    moreover have "path_image (fst \<circ> p) \<subseteq> S"
immler@69620
  1173
      using that apply (simp add: path_image_def) by force
immler@69620
  1174
    ultimately have p1: "homotopic_loops S (fst \<circ> p) (linepath a a)"
immler@69620
  1175
      using S that
immler@69620
  1176
      apply (simp add: simply_connected_eq_contractible_loop_any)
immler@69620
  1177
      apply (drule_tac x="fst \<circ> p" in spec)
immler@69620
  1178
      apply (drule_tac x=a in spec)
immler@69620
  1179
      apply (auto simp: pathstart_def pathfinish_def)
immler@69620
  1180
      done
immler@69620
  1181
    have "path (snd \<circ> p)"
immler@69620
  1182
      apply (rule Path_Connected.path_continuous_image [OF \<open>path p\<close>])
immler@69620
  1183
      apply (rule continuous_intros)+
immler@69620
  1184
      done
immler@69620
  1185
    moreover have "path_image (snd \<circ> p) \<subseteq> T"
immler@69620
  1186
      using that apply (simp add: path_image_def) by force
immler@69620
  1187
    ultimately have p2: "homotopic_loops T (snd \<circ> p) (linepath b b)"
immler@69620
  1188
      using T that
immler@69620
  1189
      apply (simp add: simply_connected_eq_contractible_loop_any)
immler@69620
  1190
      apply (drule_tac x="snd \<circ> p" in spec)
immler@69620
  1191
      apply (drule_tac x=b in spec)
immler@69620
  1192
      apply (auto simp: pathstart_def pathfinish_def)
immler@69620
  1193
      done
immler@69620
  1194
    show ?thesis
immler@69620
  1195
      using p1 p2
immler@69620
  1196
      apply (simp add: homotopic_loops, clarify)
immler@69620
  1197
      apply (rename_tac h k)
immler@69620
  1198
      apply (rule_tac x="\<lambda>z. Pair (h z) (k z)" in exI)
immler@69620
  1199
      apply (intro conjI continuous_intros | assumption)+
immler@69620
  1200
      apply (auto simp: pathstart_def pathfinish_def)
immler@69620
  1201
      done
immler@69620
  1202
  qed
immler@69620
  1203
  with assms show ?thesis
immler@69620
  1204
    by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
immler@69620
  1205
qed
immler@69620
  1206
immler@69620
  1207
immler@69620
  1208
subsection\<open>Contractible sets\<close>
immler@69620
  1209
immler@69620
  1210
definition%important contractible where
immler@69620
  1211
 "contractible S \<equiv> \<exists>a. homotopic_with (\<lambda>x. True) S S id (\<lambda>x. a)"
immler@69620
  1212
immler@69620
  1213
proposition contractible_imp_simply_connected:
immler@69620
  1214
  fixes S :: "_::real_normed_vector set"
immler@69620
  1215
  assumes "contractible S" shows "simply_connected S"
immler@69620
  1216
proof (cases "S = {}")
immler@69620
  1217
  case True then show ?thesis by force
immler@69620
  1218
next
immler@69620
  1219
  case False
immler@69620
  1220
  obtain a where a: "homotopic_with (\<lambda>x. True) S S id (\<lambda>x. a)"
immler@69620
  1221
    using assms by (force simp: contractible_def)
immler@69620
  1222
  then have "a \<in> S"
immler@69620
  1223
    by (metis False homotopic_constant_maps homotopic_with_symD homotopic_with_trans path_component_mem(2))
immler@69620
  1224
  show ?thesis
immler@69620
  1225
    apply (simp add: simply_connected_eq_contractible_loop_all False)
immler@69620
  1226
    apply (rule bexI [OF _ \<open>a \<in> S\<close>])
immler@69620
  1227
    using a apply (simp add: homotopic_loops_def homotopic_with_def path_def path_image_def pathfinish_def pathstart_def, clarify)
immler@69620
  1228
    apply (rule_tac x="(h \<circ> (\<lambda>y. (fst y, (p \<circ> snd) y)))" in exI)
immler@69620
  1229
    apply (intro conjI continuous_on_compose continuous_intros)
immler@69620
  1230
    apply (erule continuous_on_subset | force)+
immler@69620
  1231
    done
immler@69620
  1232
qed
immler@69620
  1233
immler@69620
  1234
corollary contractible_imp_connected:
immler@69620
  1235
  fixes S :: "_::real_normed_vector set"
immler@69620
  1236
  shows "contractible S \<Longrightarrow> connected S"
immler@69620
  1237
by (simp add: contractible_imp_simply_connected simply_connected_imp_connected)
immler@69620
  1238
immler@69620
  1239
lemma contractible_imp_path_connected:
immler@69620
  1240
  fixes S :: "_::real_normed_vector set"
immler@69620
  1241
  shows "contractible S \<Longrightarrow> path_connected S"
immler@69620
  1242
by (simp add: contractible_imp_simply_connected simply_connected_imp_path_connected)
immler@69620
  1243
immler@69620
  1244
lemma nullhomotopic_through_contractible:
immler@69620
  1245
  fixes S :: "_::topological_space set"
immler@69620
  1246
  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
immler@69620
  1247
      and g: "continuous_on T g" "g ` T \<subseteq> U"
immler@69620
  1248
      and T: "contractible T"
immler@69620
  1249
    obtains c where "homotopic_with (\<lambda>h. True) S U (g \<circ> f) (\<lambda>x. c)"
immler@69620
  1250
proof -
immler@69620
  1251
  obtain b where b: "homotopic_with (\<lambda>x. True) T T id (\<lambda>x. b)"
immler@69620
  1252
    using assms by (force simp: contractible_def)
immler@69620
  1253
  have "homotopic_with (\<lambda>f. True) T U (g \<circ> id) (g \<circ> (\<lambda>x. b))"
immler@69620
  1254
    by (rule homotopic_compose_continuous_left [OF b g])
immler@69620
  1255
  then have "homotopic_with (\<lambda>f. True) S U (g \<circ> id \<circ> f) (g \<circ> (\<lambda>x. b) \<circ> f)"
immler@69620
  1256
    by (rule homotopic_compose_continuous_right [OF _ f])
immler@69620
  1257
  then show ?thesis
immler@69620
  1258
    by (simp add: comp_def that)
immler@69620
  1259
qed
immler@69620
  1260
immler@69620
  1261
lemma nullhomotopic_into_contractible:
immler@69620
  1262
  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
immler@69620
  1263
      and T: "contractible T"
immler@69620
  1264
    obtains c where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. c)"
immler@69620
  1265
apply (rule nullhomotopic_through_contractible [OF f, of id T])
immler@69620
  1266
using assms
immler@69620
  1267
apply (auto simp: continuous_on_id)
immler@69620
  1268
done
immler@69620
  1269
immler@69620
  1270
lemma nullhomotopic_from_contractible:
immler@69620
  1271
  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
immler@69620
  1272
      and S: "contractible S"
immler@69620
  1273
    obtains c where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. c)"
immler@69620
  1274
apply (rule nullhomotopic_through_contractible [OF continuous_on_id _ f S, of S])
immler@69620
  1275
using assms
immler@69620
  1276
apply (auto simp: comp_def)
immler@69620
  1277
done
immler@69620
  1278
immler@69620
  1279
lemma homotopic_through_contractible:
immler@69620
  1280
  fixes S :: "_::real_normed_vector set"
immler@69620
  1281
  assumes "continuous_on S f1" "f1 ` S \<subseteq> T"
immler@69620
  1282
          "continuous_on T g1" "g1 ` T \<subseteq> U"
immler@69620
  1283
          "continuous_on S f2" "f2 ` S \<subseteq> T"
immler@69620
  1284
          "continuous_on T g2" "g2 ` T \<subseteq> U"
immler@69620
  1285
          "contractible T" "path_connected U"
immler@69620
  1286
   shows "homotopic_with (\<lambda>h. True) S U (g1 \<circ> f1) (g2 \<circ> f2)"
immler@69620
  1287
proof -
immler@69620
  1288
  obtain c1 where c1: "homotopic_with (\<lambda>h. True) S U (g1 \<circ> f1) (\<lambda>x. c1)"
immler@69620
  1289
    apply (rule nullhomotopic_through_contractible [of S f1 T g1 U])
immler@69620
  1290
    using assms apply auto
immler@69620
  1291
    done
immler@69620
  1292
  obtain c2 where c2: "homotopic_with (\<lambda>h. True) S U (g2 \<circ> f2) (\<lambda>x. c2)"
immler@69620
  1293
    apply (rule nullhomotopic_through_contractible [of S f2 T g2 U])
immler@69620
  1294
    using assms apply auto
immler@69620
  1295
    done
immler@69620
  1296
  have *: "S = {} \<or> (\<exists>t. path_connected t \<and> t \<subseteq> U \<and> c2 \<in> t \<and> c1 \<in> t)"
immler@69620
  1297
  proof (cases "S = {}")
immler@69620
  1298
    case True then show ?thesis by force
immler@69620
  1299
  next
immler@69620
  1300
    case False
immler@69620
  1301
    with c1 c2 have "c1 \<in> U" "c2 \<in> U"
immler@69620
  1302
      using homotopic_with_imp_subset2 all_not_in_conv image_subset_iff by blast+
immler@69620
  1303
    with \<open>path_connected U\<close> show ?thesis by blast
immler@69620
  1304
  qed
immler@69620
  1305
  show ?thesis
immler@69620
  1306
    apply (rule homotopic_with_trans [OF c1])
immler@69620
  1307
    apply (rule homotopic_with_symD)
immler@69620
  1308
    apply (rule homotopic_with_trans [OF c2])
immler@69620
  1309
    apply (simp add: path_component homotopic_constant_maps *)
immler@69620
  1310
    done
immler@69620
  1311
qed
immler@69620
  1312
immler@69620
  1313
lemma homotopic_into_contractible:
immler@69620
  1314
  fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
immler@69620
  1315
  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
immler@69620
  1316
      and g: "continuous_on S g" "g ` S \<subseteq> T"
immler@69620
  1317
      and T: "contractible T"
immler@69620
  1318
    shows "homotopic_with (\<lambda>h. True) S T f g"
immler@69620
  1319
using homotopic_through_contractible [of S f T id T g id]
immler@69620
  1320
by (simp add: assms contractible_imp_path_connected continuous_on_id)
immler@69620
  1321
immler@69620
  1322
lemma homotopic_from_contractible:
immler@69620
  1323
  fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
immler@69620
  1324
  assumes f: "continuous_on S f" "f ` S \<subseteq> T"
immler@69620
  1325
      and g: "continuous_on S g" "g ` S \<subseteq> T"
immler@69620
  1326
      and "contractible S" "path_connected T"
immler@69620
  1327
    shows "homotopic_with (\<lambda>h. True) S T f g"
immler@69620
  1328
using homotopic_through_contractible [of S id S f T id g]
immler@69620
  1329
by (simp add: assms contractible_imp_path_connected continuous_on_id)
immler@69620
  1330
immler@69620
  1331
lemma starlike_imp_contractible_gen:
immler@69620
  1332
  fixes S :: "'a::real_normed_vector set"
immler@69620
  1333
  assumes S: "starlike S"
immler@69620
  1334
      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)"
immler@69620
  1335
    obtains a where "homotopic_with P S S (\<lambda>x. x) (\<lambda>x. a)"
immler@69620
  1336
proof -
immler@69620
  1337
  obtain a where "a \<in> S" and a: "\<And>x. x \<in> S \<Longrightarrow> closed_segment a x \<subseteq> S"
immler@69620
  1338
    using S by (auto simp: starlike_def)
immler@69620
  1339
  have "(\<lambda>y. (1 - fst y) *\<^sub>R snd y + fst y *\<^sub>R a) ` ({0..1} \<times> S) \<subseteq> S"
immler@69620
  1340
    apply clarify
immler@69620
  1341
    apply (erule a [unfolded closed_segment_def, THEN subsetD], simp)
immler@69620
  1342
    apply (metis add_diff_cancel_right' diff_ge_0_iff_ge le_add_diff_inverse pth_c(1))
immler@69620
  1343
    done
immler@69620
  1344
  then show ?thesis
immler@69620
  1345
    apply (rule_tac a=a in that)
immler@69620
  1346
    using \<open>a \<in> S\<close>
immler@69620
  1347
    apply (simp add: homotopic_with_def)
immler@69620
  1348
    apply (rule_tac x="\<lambda>y. (1 - (fst y)) *\<^sub>R snd y + (fst y) *\<^sub>R a" in exI)
immler@69620
  1349
    apply (intro conjI ballI continuous_on_compose continuous_intros)
immler@69620
  1350
    apply (simp_all add: P)
immler@69620
  1351
    done
immler@69620
  1352
qed
immler@69620
  1353
immler@69620
  1354
lemma starlike_imp_contractible:
immler@69620
  1355
  fixes S :: "'a::real_normed_vector set"
immler@69620
  1356
  shows "starlike S \<Longrightarrow> contractible S"
immler@69620
  1357
using starlike_imp_contractible_gen contractible_def by (fastforce simp: id_def)
immler@69620
  1358
immler@69620
  1359
lemma contractible_UNIV [simp]: "contractible (UNIV :: 'a::real_normed_vector set)"
immler@69620
  1360
  by (simp add: starlike_imp_contractible)
immler@69620
  1361
immler@69620
  1362
lemma starlike_imp_simply_connected:
immler@69620
  1363
  fixes S :: "'a::real_normed_vector set"
immler@69620
  1364
  shows "starlike S \<Longrightarrow> simply_connected S"
immler@69620
  1365
by (simp add: contractible_imp_simply_connected starlike_imp_contractible)
immler@69620
  1366
immler@69620
  1367
lemma convex_imp_simply_connected:
immler@69620
  1368
  fixes S :: "'a::real_normed_vector set"
immler@69620
  1369
  shows "convex S \<Longrightarrow> simply_connected S"
immler@69620
  1370
using convex_imp_starlike starlike_imp_simply_connected by blast
immler@69620
  1371
immler@69620
  1372
lemma starlike_imp_path_connected:
immler@69620
  1373
  fixes S :: "'a::real_normed_vector set"
immler@69620
  1374
  shows "starlike S \<Longrightarrow> path_connected S"
immler@69620
  1375
by (simp add: simply_connected_imp_path_connected starlike_imp_simply_connected)
immler@69620
  1376
immler@69620
  1377
lemma starlike_imp_connected:
immler@69620
  1378
  fixes S :: "'a::real_normed_vector set"
immler@69620
  1379
  shows "starlike S \<Longrightarrow> connected S"
immler@69620
  1380
by (simp add: path_connected_imp_connected starlike_imp_path_connected)
immler@69620
  1381
immler@69620
  1382
lemma is_interval_simply_connected_1:
immler@69620
  1383
  fixes S :: "real set"
immler@69620
  1384
  shows "is_interval S \<longleftrightarrow> simply_connected S"
immler@69620
  1385
using convex_imp_simply_connected is_interval_convex_1 is_interval_path_connected_1 simply_connected_imp_path_connected by auto
immler@69620
  1386
immler@69620
  1387
lemma contractible_empty [simp]: "contractible {}"
immler@69620
  1388
  by (simp add: contractible_def homotopic_with)
immler@69620
  1389
immler@69620
  1390
lemma contractible_convex_tweak_boundary_points:
immler@69620
  1391
  fixes S :: "'a::euclidean_space set"
immler@69620
  1392
  assumes "convex S" and TS: "rel_interior S \<subseteq> T" "T \<subseteq> closure S"
immler@69620
  1393
  shows "contractible T"
immler@69620
  1394
proof (cases "S = {}")
immler@69620
  1395
  case True
immler@69620
  1396
  with assms show ?thesis
immler@69620
  1397
    by (simp add: subsetCE)
immler@69620
  1398
next
immler@69620
  1399
  case False
immler@69620
  1400
  show ?thesis
immler@69620
  1401
    apply (rule starlike_imp_contractible)
immler@69620
  1402
    apply (rule starlike_convex_tweak_boundary_points [OF \<open>convex S\<close> False TS])
immler@69620
  1403
    done
immler@69620
  1404
qed
immler@69620
  1405
immler@69620
  1406
lemma convex_imp_contractible:
immler@69620
  1407
  fixes S :: "'a::real_normed_vector set"
immler@69620
  1408
  shows "convex S \<Longrightarrow> contractible S"
immler@69620
  1409
  using contractible_empty convex_imp_starlike starlike_imp_contractible by blast
immler@69620
  1410
immler@69620
  1411
lemma contractible_sing [simp]:
immler@69620
  1412
  fixes a :: "'a::real_normed_vector"
immler@69620
  1413
  shows "contractible {a}"
immler@69620
  1414
by (rule convex_imp_contractible [OF convex_singleton])
immler@69620
  1415
immler@69620
  1416
lemma is_interval_contractible_1:
immler@69620
  1417
  fixes S :: "real set"
immler@69620
  1418
  shows  "is_interval S \<longleftrightarrow> contractible S"
immler@69620
  1419
using contractible_imp_simply_connected convex_imp_contractible is_interval_convex_1
immler@69620
  1420
      is_interval_simply_connected_1 by auto
immler@69620
  1421
immler@69620
  1422
lemma contractible_Times:
immler@69620
  1423
  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
immler@69620
  1424
  assumes S: "contractible S" and T: "contractible T"
immler@69620
  1425
  shows "contractible (S \<times> T)"
immler@69620
  1426
proof -
immler@69620
  1427
  obtain a h where conth: "continuous_on ({0..1} \<times> S) h"
immler@69620
  1428
             and hsub: "h ` ({0..1} \<times> S) \<subseteq> S"
immler@69620
  1429
             and [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (0, x) = x"
immler@69620
  1430
             and [simp]: "\<And>x. x \<in> S \<Longrightarrow>  h (1::real, x) = a"
immler@69620
  1431
    using S by (auto simp: contractible_def homotopic_with)
immler@69620
  1432
  obtain b k where contk: "continuous_on ({0..1} \<times> T) k"
immler@69620
  1433
             and ksub: "k ` ({0..1} \<times> T) \<subseteq> T"
immler@69620
  1434
             and [simp]: "\<And>x. x \<in> T \<Longrightarrow> k (0, x) = x"
immler@69620
  1435
             and [simp]: "\<And>x. x \<in> T \<Longrightarrow>  k (1::real, x) = b"
immler@69620
  1436
    using T by (auto simp: contractible_def homotopic_with)
immler@69620
  1437
  show ?thesis
immler@69620
  1438
    apply (simp add: contractible_def homotopic_with)
immler@69620
  1439
    apply (rule exI [where x=a])
immler@69620
  1440
    apply (rule exI [where x=b])
immler@69620
  1441
    apply (rule exI [where x = "\<lambda>z. (h (fst z, fst(snd z)), k (fst z, snd(snd z)))"])
immler@69620
  1442
    apply (intro conjI ballI continuous_intros continuous_on_compose2 [OF conth] continuous_on_compose2 [OF contk])
immler@69620
  1443
    using hsub ksub
immler@69620
  1444
    apply auto
immler@69620
  1445
    done
immler@69620
  1446
qed
immler@69620
  1447
immler@69620
  1448
lemma homotopy_dominated_contractibility:
immler@69620
  1449
  fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
immler@69620
  1450
  assumes S: "contractible S"
immler@69620
  1451
      and f: "continuous_on S f" "image f S \<subseteq> T"
immler@69620
  1452
      and g: "continuous_on T g" "image g T \<subseteq> S"
immler@69620
  1453
      and hom: "homotopic_with (\<lambda>x. True) T T (f \<circ> g) id"
immler@69620
  1454
    shows "contractible T"
immler@69620
  1455
proof -
immler@69620
  1456
  obtain b where "homotopic_with (\<lambda>h. True) S T f (\<lambda>x. b)"
immler@69620
  1457
    using nullhomotopic_from_contractible [OF f S] .
immler@69620
  1458
  then have homg: "homotopic_with (\<lambda>x. True) T T ((\<lambda>x. b) \<circ> g) (f \<circ> g)"
immler@69620
  1459
    by (rule homotopic_with_compose_continuous_right [OF homotopic_with_symD g])
immler@69620
  1460
  show ?thesis
immler@69620
  1461
    apply (simp add: contractible_def)
immler@69620
  1462
    apply (rule exI [where x = b])
immler@69620
  1463
    apply (rule homotopic_with_symD)
immler@69620
  1464
    apply (rule homotopic_with_trans [OF _ hom])
immler@69620
  1465
    using homg apply (simp add: o_def)
immler@69620
  1466
    done
immler@69620
  1467
qed
immler@69620
  1468
immler@69620
  1469
immler@69620
  1470
subsection\<open>Local versions of topological properties in general\<close>
immler@69620
  1471
immler@69620
  1472
definition%important locally :: "('a::topological_space set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
immler@69620
  1473
where
immler@69620
  1474
 "locally P S \<equiv>
immler@69620
  1475
        \<forall>w x. openin (subtopology euclidean S) w \<and> x \<in> w
immler@69620
  1476
              \<longrightarrow> (\<exists>u v. openin (subtopology euclidean S) u \<and> P v \<and>
immler@69620
  1477
                        x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w)"
immler@69620
  1478
immler@69620
  1479
lemma locallyI:
immler@69620
  1480
  assumes "\<And>w x. \<lbrakk>openin (subtopology euclidean S) w; x \<in> w\<rbrakk>
immler@69620
  1481
                  \<Longrightarrow> \<exists>u v. openin (subtopology euclidean S) u \<and> P v \<and>
immler@69620
  1482
                        x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w"
immler@69620
  1483
    shows "locally P S"
immler@69620
  1484
using assms by (force simp: locally_def)
immler@69620
  1485
immler@69620
  1486
lemma locallyE:
immler@69620
  1487
  assumes "locally P S" "openin (subtopology euclidean S) w" "x \<in> w"
immler@69620
  1488
  obtains u v where "openin (subtopology euclidean S) u"
immler@69620
  1489
                    "P v" "x \<in> u" "u \<subseteq> v" "v \<subseteq> w"
immler@69620
  1490
  using assms unfolding locally_def by meson
immler@69620
  1491
immler@69620
  1492
lemma locally_mono:
immler@69620
  1493
  assumes "locally P S" "\<And>t. P t \<Longrightarrow> Q t"
immler@69620
  1494
    shows "locally Q S"
immler@69620
  1495
by (metis assms locally_def)
immler@69620
  1496
immler@69620
  1497
lemma locally_open_subset:
immler@69620
  1498
  assumes "locally P S" "openin (subtopology euclidean S) t"
immler@69620
  1499
    shows "locally P t"
immler@69620
  1500
using assms
immler@69620
  1501
apply (simp add: locally_def)
immler@69620
  1502
apply (erule all_forward)+
immler@69620
  1503
apply (rule impI)
immler@69620
  1504
apply (erule impCE)
immler@69620
  1505
 using openin_trans apply blast
immler@69620
  1506
apply (erule ex_forward)
immler@69620
  1507
by (metis (no_types, hide_lams) Int_absorb1 Int_lower1 Int_subset_iff openin_open openin_subtopology_Int_subset)
immler@69620
  1508
immler@69620
  1509
lemma locally_diff_closed:
immler@69620
  1510
    "\<lbrakk>locally P S; closedin (subtopology euclidean S) t\<rbrakk> \<Longrightarrow> locally P (S - t)"
immler@69620
  1511
  using locally_open_subset closedin_def by fastforce
immler@69620
  1512
immler@69620
  1513
lemma locally_empty [iff]: "locally P {}"
immler@69620
  1514
  by (simp add: locally_def openin_subtopology)
immler@69620
  1515
immler@69620
  1516
lemma locally_singleton [iff]:
immler@69620
  1517
  fixes a :: "'a::metric_space"
immler@69620
  1518
  shows "locally P {a} \<longleftrightarrow> P {a}"
immler@69620
  1519
apply (simp add: locally_def openin_euclidean_subtopology_iff subset_singleton_iff conj_disj_distribR cong: conj_cong)
immler@69620
  1520
using zero_less_one by blast
immler@69620
  1521
immler@69620
  1522
lemma locally_iff:
immler@69620
  1523
    "locally P S \<longleftrightarrow>
immler@69620
  1524
     (\<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)))"
immler@69620
  1525
apply (simp add: le_inf_iff locally_def openin_open, safe)
immler@69620
  1526
apply (metis IntE IntI le_inf_iff)
immler@69620
  1527
apply (metis IntI Int_subset_iff)
immler@69620
  1528
done
immler@69620
  1529
immler@69620
  1530
lemma locally_Int:
immler@69620
  1531
  assumes S: "locally P S" and t: "locally P t"
immler@69620
  1532
      and P: "\<And>S t. P S \<and> P t \<Longrightarrow> P(S \<inter> t)"
immler@69620
  1533
    shows "locally P (S \<inter> t)"
immler@69620
  1534
using S t unfolding locally_iff
immler@69620
  1535
apply clarify
immler@69620
  1536
apply (drule_tac x=T in spec)+
immler@69620
  1537
apply (drule_tac x=x in spec)+
immler@69620
  1538
apply clarsimp
immler@69620
  1539
apply (rename_tac U1 U2 V1 V2)
immler@69620
  1540
apply (rule_tac x="U1 \<inter> U2" in exI)
immler@69620
  1541
apply (simp add: open_Int)
immler@69620
  1542
apply (rule_tac x="V1 \<inter> V2" in exI)
immler@69620
  1543
apply (auto intro: P)
immler@69620
  1544
done
immler@69620
  1545
immler@69620
  1546
lemma locally_Times:
immler@69620
  1547
  fixes S :: "('a::metric_space) set" and T :: "('b::metric_space) set"
immler@69620
  1548
  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)"
immler@69620
  1549
  shows "locally R (S \<times> T)"
immler@69620
  1550
    unfolding locally_def
immler@69620
  1551
proof (clarify)
immler@69620
  1552
  fix W x y
immler@69620
  1553
  assume W: "openin (subtopology euclidean (S \<times> T)) W" and xy: "(x, y) \<in> W"
immler@69620
  1554
  then obtain U V where "openin (subtopology euclidean S) U" "x \<in> U"
immler@69620
  1555
                        "openin (subtopology euclidean T) V" "y \<in> V" "U \<times> V \<subseteq> W"
immler@69620
  1556
    using Times_in_interior_subtopology by metis
immler@69620
  1557
  then obtain U1 U2 V1 V2
immler@69620
  1558
         where opeS: "openin (subtopology euclidean S) U1 \<and> P U2 \<and> x \<in> U1 \<and> U1 \<subseteq> U2 \<and> U2 \<subseteq> U"
immler@69620
  1559
           and opeT: "openin (subtopology euclidean T) V1 \<and> Q V2 \<and> y \<in> V1 \<and> V1 \<subseteq> V2 \<and> V2 \<subseteq> V"
immler@69620
  1560
    by (meson PS QT locallyE)
immler@69620
  1561
  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"
immler@69620
  1562
    apply (rule_tac x="U1 \<times> V1" in exI)
immler@69620
  1563
    apply (rule_tac x="U2 \<times> V2" in exI)
immler@69620
  1564
    apply (auto simp: openin_Times R)
immler@69620
  1565
    done
immler@69620
  1566
qed
immler@69620
  1567
immler@69620
  1568
immler@69620
  1569
proposition homeomorphism_locally_imp:
immler@69620
  1570
  fixes S :: "'a::metric_space set" and t :: "'b::t2_space set"
immler@69620
  1571
  assumes S: "locally P S" and hom: "homeomorphism S t f g"
immler@69620
  1572
      and Q: "\<And>S S'. \<lbrakk>P S; homeomorphism S S' f g\<rbrakk> \<Longrightarrow> Q S'"
immler@69620
  1573
    shows "locally Q t"
immler@69620
  1574
proof (clarsimp simp: locally_def)
immler@69620
  1575
  fix W y
immler@69620
  1576
  assume "y \<in> W" and "openin (subtopology euclidean t) W"
immler@69620
  1577
  then obtain T where T: "open T" "W = t \<inter> T"
immler@69620
  1578
    by (force simp: openin_open)
immler@69620
  1579
  then have "W \<subseteq> t" by auto
immler@69620
  1580
  have f: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "f ` S = t" "continuous_on S f"
immler@69620
  1581
   and g: "\<And>y. y \<in> t \<Longrightarrow> f(g y) = y" "g ` t = S" "continuous_on t g"
immler@69620
  1582
    using hom by (auto simp: homeomorphism_def)
immler@69620
  1583
  have gw: "g ` W = S \<inter> f -` W"
immler@69620
  1584
    using \<open>W \<subseteq> t\<close>
immler@69620
  1585
    apply auto
immler@69620
  1586
    using \<open>g ` t = S\<close> \<open>W \<subseteq> t\<close> apply blast
immler@69620
  1587
    using g \<open>W \<subseteq> t\<close> apply auto[1]
immler@69620
  1588
    by (simp add: f rev_image_eqI)
immler@69620
  1589
  have \<circ>: "openin (subtopology euclidean S) (g ` W)"
immler@69620
  1590
  proof -
immler@69620
  1591
    have "continuous_on S f"
immler@69620
  1592
      using f(3) by blast
immler@69620
  1593
    then show "openin (subtopology euclidean S) (g ` W)"
immler@69620
  1594
      by (simp add: gw Collect_conj_eq \<open>openin (subtopology euclidean t) W\<close> continuous_on_open f(2))
immler@69620
  1595
  qed
immler@69620
  1596
  then obtain u v
immler@69620
  1597
    where osu: "openin (subtopology euclidean S) u" and uv: "P v" "g y \<in> u" "u \<subseteq> v" "v \<subseteq> g ` W"
immler@69620
  1598
    using S [unfolded locally_def, rule_format, of "g ` W" "g y"] \<open>y \<in> W\<close> by force
immler@69620
  1599
  have "v \<subseteq> S" using uv by (simp add: gw)
immler@69620
  1600
  have fv: "f ` v = t \<inter> {x. g x \<in> v}"
immler@69620
  1601
    using \<open>f ` S = t\<close> f \<open>v \<subseteq> S\<close> by auto
immler@69620
  1602
  have "f ` v \<subseteq> W"
immler@69620
  1603
    using uv using Int_lower2 gw image_subsetI mem_Collect_eq subset_iff by auto
immler@69620
  1604
  have contvf: "continuous_on v f"
immler@69620
  1605
    using \<open>v \<subseteq> S\<close> continuous_on_subset f(3) by blast
immler@69620
  1606
  have contvg: "continuous_on (f ` v) g"
immler@69620
  1607
    using \<open>f ` v \<subseteq> W\<close> \<open>W \<subseteq> t\<close> continuous_on_subset [OF g(3)] by blast
immler@69620
  1608
  have homv: "homeomorphism v (f ` v) f g"
immler@69620
  1609
    using \<open>v \<subseteq> S\<close> \<open>W \<subseteq> t\<close> f
immler@69620
  1610
    apply (simp add: homeomorphism_def contvf contvg, auto)
immler@69620
  1611
    by (metis f(1) rev_image_eqI rev_subsetD)
immler@69620
  1612
  have 1: "openin (subtopology euclidean t) (t \<inter> g -` u)"
immler@69620
  1613
    apply (rule continuous_on_open [THEN iffD1, rule_format])
immler@69620
  1614
    apply (rule \<open>continuous_on t g\<close>)
immler@69620
  1615
    using \<open>g ` t = S\<close> apply (simp add: osu)
immler@69620
  1616
    done
immler@69620
  1617
  have 2: "\<exists>V. Q V \<and> y \<in> (t \<inter> g -` u) \<and> (t \<inter> g -` u) \<subseteq> V \<and> V \<subseteq> W"
immler@69620
  1618
    apply (rule_tac x="f ` v" in exI)
immler@69620
  1619
    apply (intro conjI Q [OF \<open>P v\<close> homv])
immler@69620
  1620
    using \<open>W \<subseteq> t\<close> \<open>y \<in> W\<close>  \<open>f ` v \<subseteq> W\<close>  uv  apply (auto simp: fv)
immler@69620
  1621
    done
immler@69620
  1622
  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)"
immler@69620
  1623
    by (meson 1 2)
immler@69620
  1624
qed
immler@69620
  1625
immler@69620
  1626
lemma homeomorphism_locally:
immler@69620
  1627
  fixes f:: "'a::metric_space \<Rightarrow> 'b::metric_space"
immler@69620
  1628
  assumes hom: "homeomorphism S t f g"
immler@69620
  1629
      and eq: "\<And>S t. homeomorphism S t f g \<Longrightarrow> (P S \<longleftrightarrow> Q t)"
immler@69620
  1630
    shows "locally P S \<longleftrightarrow> locally Q t"
immler@69620
  1631
apply (rule iffI)
immler@69620
  1632
apply (erule homeomorphism_locally_imp [OF _ hom])
immler@69620
  1633
apply (simp add: eq)
immler@69620
  1634
apply (erule homeomorphism_locally_imp)
immler@69620
  1635
using eq homeomorphism_sym homeomorphism_symD [OF hom] apply blast+
immler@69620
  1636
done
immler@69620
  1637
immler@69620
  1638
lemma homeomorphic_locally:
immler@69620
  1639
  fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
immler@69620
  1640
  assumes hom: "S homeomorphic T"
immler@69620
  1641
          and iff: "\<And>X Y. X homeomorphic Y \<Longrightarrow> (P X \<longleftrightarrow> Q Y)"
immler@69620
  1642
    shows "locally P S \<longleftrightarrow> locally Q T"
immler@69620
  1643
proof -
immler@69620
  1644
  obtain f g where hom: "homeomorphism S T f g"
immler@69620
  1645
    using assms by (force simp: homeomorphic_def)
immler@69620
  1646
  then show ?thesis
immler@69620
  1647
    using homeomorphic_def local.iff
immler@69620
  1648
    by (blast intro!: homeomorphism_locally)
immler@69620
  1649
qed
immler@69620
  1650
immler@69620
  1651
lemma homeomorphic_local_compactness:
immler@69620
  1652
  fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
immler@69620
  1653
  shows "S homeomorphic T \<Longrightarrow> locally compact S \<longleftrightarrow> locally compact T"
immler@69620
  1654
by (simp add: homeomorphic_compactness homeomorphic_locally)
immler@69620
  1655
immler@69620
  1656
lemma locally_translation:
immler@69620
  1657
  fixes P :: "'a :: real_normed_vector set \<Rightarrow> bool"
immler@69620
  1658
  shows
immler@69620
  1659
   "(\<And>S. P (image (\<lambda>x. a + x) S) \<longleftrightarrow> P S)
immler@69620
  1660
        \<Longrightarrow> locally P (image (\<lambda>x. a + x) S) \<longleftrightarrow> locally P S"
immler@69620
  1661
apply (rule homeomorphism_locally [OF homeomorphism_translation])
immler@69620
  1662
apply (simp add: homeomorphism_def)
immler@69620
  1663
by metis
immler@69620
  1664
immler@69620
  1665
lemma locally_injective_linear_image:
immler@69620
  1666
  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
immler@69620
  1667
  assumes f: "linear f" "inj f" and iff: "\<And>S. P (f ` S) \<longleftrightarrow> Q S"
immler@69620
  1668
    shows "locally P (f ` S) \<longleftrightarrow> locally Q S"
immler@69620
  1669
apply (rule linear_homeomorphism_image [OF f])
immler@69620
  1670
apply (rule_tac f=g and g = f in homeomorphism_locally, assumption)
immler@69620
  1671
by (metis iff homeomorphism_def)
immler@69620
  1672
immler@69620
  1673
lemma locally_open_map_image:
immler@69620
  1674
  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
immler@69620
  1675
  assumes P: "locally P S"
immler@69620
  1676
      and f: "continuous_on S f"
immler@69620
  1677
      and oo: "\<And>t. openin (subtopology euclidean S) t
immler@69620
  1678
                   \<Longrightarrow> openin (subtopology euclidean (f ` S)) (f ` t)"
immler@69620
  1679
      and Q: "\<And>t. \<lbrakk>t \<subseteq> S; P t\<rbrakk> \<Longrightarrow> Q(f ` t)"
immler@69620
  1680
    shows "locally Q (f ` S)"
immler@69620
  1681
proof (clarsimp simp add: locally_def)
immler@69620
  1682
  fix W y
immler@69620
  1683
  assume oiw: "openin (subtopology euclidean (f ` S)) W" and "y \<in> W"
immler@69620
  1684
  then have "W \<subseteq> f ` S" by (simp add: openin_euclidean_subtopology_iff)
immler@69620
  1685
  have oivf: "openin (subtopology euclidean S) (S \<inter> f -` W)"
immler@69620
  1686
    by (rule continuous_on_open [THEN iffD1, rule_format, OF f oiw])
immler@69620
  1687
  then obtain x where "x \<in> S" "f x = y"
immler@69620
  1688
    using \<open>W \<subseteq> f ` S\<close> \<open>y \<in> W\<close> by blast
immler@69620
  1689
  then obtain U V
immler@69620
  1690
    where "openin (subtopology euclidean S) U" "P V" "x \<in> U" "U \<subseteq> V" "V \<subseteq> S \<inter> f -` W"
immler@69620
  1691
    using P [unfolded locally_def, rule_format, of "(S \<inter> f -` W)" x] oivf \<open>y \<in> W\<close>
immler@69620
  1692
    by auto
immler@69620
  1693
  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)"
immler@69620
  1694
    apply (rule_tac x="f ` U" in exI)
immler@69620
  1695
    apply (rule conjI, blast intro!: oo)
immler@69620
  1696
    apply (rule_tac x="f ` V" in exI)
immler@69620
  1697
    apply (force simp: \<open>f x = y\<close> rev_image_eqI intro: Q)
immler@69620
  1698
    done
immler@69620
  1699
qed
immler@69620
  1700
immler@69620
  1701
immler@69620
  1702
subsection\<open>An induction principle for connected sets\<close>
immler@69620
  1703
immler@69620
  1704
proposition connected_induction:
immler@69620
  1705
  assumes "connected S"
immler@69620
  1706
      and opD: "\<And>T a. \<lbrakk>openin (subtopology euclidean S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
immler@69620
  1707
      and opI: "\<And>a. a \<in> S
immler@69620
  1708
             \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and>
immler@69620
  1709
                     (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<and> Q x \<longrightarrow> Q y)"
immler@69620
  1710
      and etc: "a \<in> S" "b \<in> S" "P a" "P b" "Q a"
immler@69620
  1711
    shows "Q b"
immler@69620
  1712
proof -
immler@69620
  1713
  have 1: "openin (subtopology euclidean S)
immler@69620
  1714
             {b. \<exists>T. openin (subtopology euclidean S) T \<and>
immler@69620
  1715
                     b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> Q x)}"
immler@69620
  1716
    apply (subst openin_subopen, clarify)
immler@69620
  1717
    apply (rule_tac x=T in exI, auto)
immler@69620
  1718
    done
immler@69620
  1719
  have 2: "openin (subtopology euclidean S)
immler@69620
  1720
             {b. \<exists>T. openin (subtopology euclidean S) T \<and>
immler@69620
  1721
                     b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> \<not> Q x)}"
immler@69620
  1722
    apply (subst openin_subopen, clarify)
immler@69620
  1723
    apply (rule_tac x=T in exI, auto)
immler@69620
  1724
    done
immler@69620
  1725
  show ?thesis
immler@69620
  1726
    using \<open>connected S\<close>
immler@69620
  1727
    apply (simp only: connected_openin HOL.not_ex HOL.de_Morgan_conj)
immler@69620
  1728
    apply (elim disjE allE)
immler@69620
  1729
         apply (blast intro: 1)
immler@69620
  1730
        apply (blast intro: 2, simp_all)
immler@69620
  1731
       apply clarify apply (metis opI)
immler@69620
  1732
      using opD apply (blast intro: etc elim: dest:)
immler@69620
  1733
     using opI etc apply meson+
immler@69620
  1734
    done
immler@69620
  1735
qed
immler@69620
  1736
immler@69620
  1737
lemma connected_equivalence_relation_gen:
immler@69620
  1738
  assumes "connected S"
immler@69620
  1739
      and etc: "a \<in> S" "b \<in> S" "P a" "P b"
immler@69620
  1740
      and trans: "\<And>x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z"
immler@69620
  1741
      and opD: "\<And>T a. \<lbrakk>openin (subtopology euclidean S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
immler@69620
  1742
      and opI: "\<And>a. a \<in> S
immler@69620
  1743
             \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and>
immler@69620
  1744
                     (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<longrightarrow> R x y)"
immler@69620
  1745
    shows "R a b"
immler@69620
  1746
proof -
immler@69620
  1747
  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"
immler@69620
  1748
    apply (rule connected_induction [OF \<open>connected S\<close> opD], simp_all)
immler@69620
  1749
    by (meson trans opI)
immler@69620
  1750
  then show ?thesis by (metis etc opI)
immler@69620
  1751
qed
immler@69620
  1752
immler@69620
  1753
lemma connected_induction_simple:
immler@69620
  1754
  assumes "connected S"
immler@69620
  1755
      and etc: "a \<in> S" "b \<in> S" "P a"
immler@69620
  1756
      and opI: "\<And>a. a \<in> S
immler@69620
  1757
             \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and>
immler@69620
  1758
                     (\<forall>x \<in> T. \<forall>y \<in> T. P x \<longrightarrow> P y)"
immler@69620
  1759
    shows "P b"
immler@69620
  1760
apply (rule connected_induction [OF \<open>connected S\<close> _, where P = "\<lambda>x. True"], blast)
immler@69620
  1761
apply (frule opI)
immler@69620
  1762
using etc apply simp_all
immler@69620
  1763
done
immler@69620
  1764
immler@69620
  1765
lemma connected_equivalence_relation:
immler@69620
  1766
  assumes "connected S"
immler@69620
  1767
      and etc: "a \<in> S" "b \<in> S"
immler@69620
  1768
      and sym: "\<And>x y. \<lbrakk>R x y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> R y x"
immler@69620
  1769
      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"
immler@69620
  1770
      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)"
immler@69620
  1771
    shows "R a b"
immler@69620
  1772
proof -
immler@69620
  1773
  have "\<And>a b c. \<lbrakk>a \<in> S; b \<in> S; c \<in> S; R a b\<rbrakk> \<Longrightarrow> R a c"
immler@69620
  1774
    apply (rule connected_induction_simple [OF \<open>connected S\<close>], simp_all)
immler@69620
  1775
    by (meson local.sym local.trans opI openin_imp_subset subsetCE)
immler@69620
  1776
  then show ?thesis by (metis etc opI)
immler@69620
  1777
qed
immler@69620
  1778
immler@69620
  1779
lemma locally_constant_imp_constant:
immler@69620
  1780
  assumes "connected S"
immler@69620
  1781
      and opI: "\<And>a. a \<in> S
immler@69620
  1782
             \<Longrightarrow> \<exists>T. openin (subtopology euclidean S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. f x = f a)"
immler@69620
  1783
    shows "f constant_on S"
immler@69620
  1784
proof -
immler@69620
  1785
  have "\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f x = f y"
immler@69620
  1786
    apply (rule connected_equivalence_relation [OF \<open>connected S\<close>], simp_all)
immler@69620
  1787
    by (metis opI)
immler@69620
  1788
  then show ?thesis
immler@69620
  1789
    by (metis constant_on_def)
immler@69620
  1790
qed
immler@69620
  1791
immler@69620
  1792
lemma locally_constant:
immler@69620
  1793
     "connected S \<Longrightarrow> locally (\<lambda>U. f constant_on U) S \<longleftrightarrow> f constant_on S"
immler@69620
  1794
apply (simp add: locally_def)
immler@69620
  1795
apply (rule iffI)
immler@69620
  1796
 apply (rule locally_constant_imp_constant, assumption)
immler@69620
  1797
 apply (metis (mono_tags, hide_lams) constant_on_def constant_on_subset openin_subtopology_self)
immler@69620
  1798
by (meson constant_on_subset openin_imp_subset order_refl)
immler@69620
  1799
immler@69620
  1800
immler@69620
  1801
subsection\<open>Basic properties of local compactness\<close>
immler@69620
  1802
immler@69620
  1803
proposition locally_compact:
immler@69620
  1804
  fixes s :: "'a :: metric_space set"
immler@69620
  1805
  shows
immler@69620
  1806
    "locally compact s \<longleftrightarrow>
immler@69620
  1807
     (\<forall>x \<in> s. \<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
immler@69620
  1808
                    openin (subtopology euclidean s) u \<and> compact v)"
immler@69620
  1809
     (is "?lhs = ?rhs")
immler@69620
  1810
proof
immler@69620
  1811
  assume ?lhs
immler@69620
  1812
  then show ?rhs
immler@69620
  1813
    apply clarify
immler@69620
  1814
    apply (erule_tac w = "s \<inter> ball x 1" in locallyE)
immler@69620
  1815
    by auto
immler@69620
  1816
next
immler@69620
  1817
  assume r [rule_format]: ?rhs
immler@69620
  1818
  have *: "\<exists>u v.
immler@69620
  1819
              openin (subtopology euclidean s) u \<and>
immler@69620
  1820
              compact v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<inter> T"
immler@69620
  1821
          if "open T" "x \<in> s" "x \<in> T" for x T
immler@69620
  1822
  proof -
immler@69620
  1823
    obtain u v where uv: "x \<in> u" "u \<subseteq> v" "v \<subseteq> s" "compact v" "openin (subtopology euclidean s) u"
immler@69620
  1824
      using r [OF \<open>x \<in> s\<close>] by auto
immler@69620
  1825
    obtain e where "e>0" and e: "cball x e \<subseteq> T"
immler@69620
  1826
      using open_contains_cball \<open>open T\<close> \<open>x \<in> T\<close> by blast
immler@69620
  1827
    show ?thesis
immler@69620
  1828
      apply (rule_tac x="(s \<inter> ball x e) \<inter> u" in exI)
immler@69620
  1829
      apply (rule_tac x="cball x e \<inter> v" in exI)
immler@69620
  1830
      using that \<open>e > 0\<close> e uv
immler@69620
  1831
      apply auto
immler@69620
  1832
      done
immler@69620
  1833
  qed
immler@69620
  1834
  show ?lhs
immler@69620
  1835
    apply (rule locallyI)
immler@69620
  1836
    apply (subst (asm) openin_open)
immler@69620
  1837
    apply (blast intro: *)
immler@69620
  1838
    done
immler@69620
  1839
qed
immler@69620
  1840
immler@69620
  1841
lemma locally_compactE:
immler@69620
  1842
  fixes s :: "'a :: metric_space set"
immler@69620
  1843
  assumes "locally compact s"
immler@69620
  1844
  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>
immler@69620
  1845
                             openin (subtopology euclidean s) (u x) \<and> compact (v x)"
immler@69620
  1846
using assms
immler@69620
  1847
unfolding locally_compact by metis
immler@69620
  1848
immler@69620
  1849
lemma locally_compact_alt:
immler@69620
  1850
  fixes s :: "'a :: heine_borel set"
immler@69620
  1851
  shows "locally compact s \<longleftrightarrow>
immler@69620
  1852
         (\<forall>x \<in> s. \<exists>u. x \<in> u \<and>
immler@69620
  1853
                    openin (subtopology euclidean s) u \<and> compact(closure u) \<and> closure u \<subseteq> s)"
immler@69620
  1854
apply (simp add: locally_compact)
immler@69620
  1855
apply (intro ball_cong ex_cong refl iffI)
immler@69620
  1856
apply (metis bounded_subset closure_eq closure_mono compact_eq_bounded_closed dual_order.trans)
immler@69620
  1857
by (meson closure_subset compact_closure)
immler@69620
  1858
immler@69620
  1859
lemma locally_compact_Int_cball:
immler@69620
  1860
  fixes s :: "'a :: heine_borel set"
immler@69620
  1861
  shows "locally compact s \<longleftrightarrow> (\<forall>x \<in> s. \<exists>e. 0 < e \<and> closed(cball x e \<inter> s))"
immler@69620
  1862
        (is "?lhs = ?rhs")
immler@69620
  1863
proof
immler@69620
  1864
  assume ?lhs
immler@69620
  1865
  then show ?rhs
immler@69620
  1866
    apply (simp add: locally_compact openin_contains_cball)
immler@69620
  1867
    apply (clarify | assumption | drule bspec)+
immler@69620
  1868
    by (metis (no_types, lifting)  compact_cball compact_imp_closed compact_Int inf.absorb_iff2 inf.orderE inf_sup_aci(2))
immler@69620
  1869
next
immler@69620
  1870
  assume ?rhs
immler@69620
  1871
  then show ?lhs
immler@69620
  1872
    apply (simp add: locally_compact openin_contains_cball)
immler@69620
  1873
    apply (clarify | assumption | drule bspec)+
immler@69620
  1874
    apply (rule_tac x="ball x e \<inter> s" in exI, simp)
immler@69620
  1875
    apply (rule_tac x="cball x e \<inter> s" in exI)
immler@69620
  1876
    using compact_eq_bounded_closed
immler@69620
  1877
    apply auto
immler@69620
  1878
    apply (metis open_ball le_infI1 mem_ball open_contains_cball_eq)
immler@69620
  1879
    done
immler@69620
  1880
qed
immler@69620
  1881
immler@69620
  1882
lemma locally_compact_compact:
immler@69620
  1883
  fixes s :: "'a :: heine_borel set"
immler@69620
  1884
  shows "locally compact s \<longleftrightarrow>
immler@69620
  1885
         (\<forall>k. k \<subseteq> s \<and> compact k
immler@69620
  1886
              \<longrightarrow> (\<exists>u v. k \<subseteq> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
immler@69620
  1887
                         openin (subtopology euclidean s) u \<and> compact v))"
immler@69620
  1888
        (is "?lhs = ?rhs")
immler@69620
  1889
proof
immler@69620
  1890
  assume ?lhs
immler@69620
  1891
  then obtain u v where
immler@69620
  1892
    uv: "\<And>x. x \<in> s \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> s \<and>
immler@69620
  1893
                             openin (subtopology euclidean s) (u x) \<and> compact (v x)"
immler@69620
  1894
    by (metis locally_compactE)
immler@69620
  1895
  have *: "\<exists>u v. k \<subseteq> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and> openin (subtopology euclidean s) u \<and> compact v"
immler@69620
  1896
          if "k \<subseteq> s" "compact k" for k
immler@69620
  1897
  proof -
immler@69620
  1898
    have "\<And>C. (\<forall>c\<in>C. openin (subtopology euclidean k) c) \<and> k \<subseteq> \<Union>C \<Longrightarrow>
immler@69620
  1899
                    \<exists>D\<subseteq>C. finite D \<and> k \<subseteq> \<Union>D"
immler@69620
  1900
      using that by (simp add: compact_eq_openin_cover)
immler@69620
  1901
    moreover have "\<forall>c \<in> (\<lambda>x. k \<inter> u x) ` k. openin (subtopology euclidean k) c"
immler@69620
  1902
      using that by clarify (metis subsetD inf.absorb_iff2 openin_subset openin_subtopology_Int_subset topspace_euclidean_subtopology uv)
immler@69620
  1903
    moreover have "k \<subseteq> \<Union>((\<lambda>x. k \<inter> u x) ` k)"
immler@69620
  1904
      using that by clarsimp (meson subsetCE uv)
immler@69620
  1905
    ultimately obtain D where "D \<subseteq> (\<lambda>x. k \<inter> u x) ` k" "finite D" "k \<subseteq> \<Union>D"
immler@69620
  1906
      by metis
immler@69620
  1907
    then obtain T where T: "T \<subseteq> k" "finite T" "k \<subseteq> \<Union>((\<lambda>x. k \<inter> u x) ` T)"
immler@69620
  1908
      by (metis finite_subset_image)
immler@69620
  1909
    have Tuv: "\<Union>(u ` T) \<subseteq> \<Union>(v ` T)"
immler@69620
  1910
      using T that by (force simp: dest!: uv)
immler@69620
  1911
    show ?thesis
immler@69620
  1912
      apply (rule_tac x="\<Union>(u ` T)" in exI)
immler@69620
  1913
      apply (rule_tac x="\<Union>(v ` T)" in exI)
immler@69620
  1914
      apply (simp add: Tuv)
immler@69620
  1915
      using T that
immler@69620
  1916
      apply (auto simp: dest!: uv)
immler@69620
  1917
      done
immler@69620
  1918
  qed
immler@69620
  1919
  show ?rhs
immler@69620
  1920
    by (blast intro: *)
immler@69620
  1921
next
immler@69620
  1922
  assume ?rhs
immler@69620
  1923
  then show ?lhs
immler@69620
  1924
    apply (clarsimp simp add: locally_compact)
immler@69620
  1925
    apply (drule_tac x="{x}" in spec, simp)
immler@69620
  1926
    done
immler@69620
  1927
qed
immler@69620
  1928
immler@69620
  1929
lemma open_imp_locally_compact:
immler@69620
  1930
  fixes s :: "'a :: heine_borel set"
immler@69620
  1931
  assumes "open s"
immler@69620
  1932
    shows "locally compact s"
immler@69620
  1933
proof -
immler@69620
  1934
  have *: "\<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and> openin (subtopology euclidean s) u \<and> compact v"
immler@69620
  1935
          if "x \<in> s" for x
immler@69620
  1936
  proof -
immler@69620
  1937
    obtain e where "e>0" and e: "cball x e \<subseteq> s"
immler@69620
  1938
      using open_contains_cball assms \<open>x \<in> s\<close> by blast
immler@69620
  1939
    have ope: "openin (subtopology euclidean s) (ball x e)"
immler@69620
  1940
      by (meson e open_ball ball_subset_cball dual_order.trans open_subset)
immler@69620
  1941
    show ?thesis
immler@69620
  1942
      apply (rule_tac x="ball x e" in exI)
immler@69620
  1943
      apply (rule_tac x="cball x e" in exI)
immler@69620
  1944
      using \<open>e > 0\<close> e apply (auto simp: ope)
immler@69620
  1945
      done
immler@69620
  1946
  qed
immler@69620
  1947
  show ?thesis
immler@69620
  1948
    unfolding locally_compact
immler@69620
  1949
    by (blast intro: *)
immler@69620
  1950
qed
immler@69620
  1951
immler@69620
  1952
lemma closed_imp_locally_compact:
immler@69620
  1953
  fixes s :: "'a :: heine_borel set"
immler@69620
  1954
  assumes "closed s"
immler@69620
  1955
    shows "locally compact s"
immler@69620
  1956
proof -
immler@69620
  1957
  have *: "\<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
immler@69620
  1958
                 openin (subtopology euclidean s) u \<and> compact v"
immler@69620
  1959
          if "x \<in> s" for x
immler@69620
  1960
  proof -
immler@69620
  1961
    show ?thesis
immler@69620
  1962
      apply (rule_tac x = "s \<inter> ball x 1" in exI)
immler@69620
  1963
      apply (rule_tac x = "s \<inter> cball x 1" in exI)
immler@69620
  1964
      using \<open>x \<in> s\<close> assms apply auto
immler@69620
  1965
      done
immler@69620
  1966
  qed
immler@69620
  1967
  show ?thesis
immler@69620
  1968
    unfolding locally_compact
immler@69620
  1969
    by (blast intro: *)
immler@69620
  1970
qed
immler@69620
  1971
immler@69620
  1972
lemma locally_compact_UNIV: "locally compact (UNIV :: 'a :: heine_borel set)"
immler@69620
  1973
  by (simp add: closed_imp_locally_compact)
immler@69620
  1974
immler@69620
  1975
lemma locally_compact_Int:
immler@69620
  1976
  fixes s :: "'a :: t2_space set"
immler@69620
  1977
  shows "\<lbrakk>locally compact s; locally compact t\<rbrakk> \<Longrightarrow> locally compact (s \<inter> t)"
immler@69620
  1978
by (simp add: compact_Int locally_Int)
immler@69620
  1979
immler@69620
  1980
lemma locally_compact_closedin:
immler@69620
  1981
  fixes s :: "'a :: heine_borel set"
immler@69620
  1982
  shows "\<lbrakk>closedin (subtopology euclidean s) t; locally compact s\<rbrakk>
immler@69620
  1983
        \<Longrightarrow> locally compact t"
immler@69620
  1984
unfolding closedin_closed
immler@69620
  1985
using closed_imp_locally_compact locally_compact_Int by blast
immler@69620
  1986
immler@69620
  1987
lemma locally_compact_delete:
immler@69620
  1988
     fixes s :: "'a :: t1_space set"
immler@69620
  1989
     shows "locally compact s \<Longrightarrow> locally compact (s - {a})"
immler@69620
  1990
  by (auto simp: openin_delete locally_open_subset)
immler@69620
  1991
immler@69620
  1992
lemma locally_closed:
immler@69620
  1993
  fixes s :: "'a :: heine_borel set"
immler@69620
  1994
  shows "locally closed s \<longleftrightarrow> locally compact s"
immler@69620
  1995
        (is "?lhs = ?rhs")
immler@69620
  1996
proof
immler@69620
  1997
  assume ?lhs
immler@69620
  1998
  then show ?rhs
immler@69620
  1999
    apply (simp only: locally_def)
immler@69620
  2000
    apply (erule all_forward imp_forward asm_rl exE)+
immler@69620
  2001
    apply (rule_tac x = "u \<inter> ball x 1" in exI)
immler@69620
  2002
    apply (rule_tac x = "v \<inter> cball x 1" in exI)
immler@69620
  2003
    apply (force intro: openin_trans)
immler@69620
  2004
    done
immler@69620
  2005
next
immler@69620
  2006
  assume ?rhs then show ?lhs
immler@69620
  2007
    using compact_eq_bounded_closed locally_mono by blast
immler@69620
  2008
qed
immler@69620
  2009
immler@69620
  2010
lemma locally_compact_openin_Un:
immler@69620
  2011
  fixes S :: "'a::euclidean_space set"
immler@69620
  2012
  assumes LCS: "locally compact S" and LCT:"locally compact T"
immler@69620
  2013
      and opS: "openin (subtopology euclidean (S \<union> T)) S"
immler@69620
  2014
      and opT: "openin (subtopology euclidean (S \<union> T)) T"
immler@69620
  2015
    shows "locally compact (S \<union> T)"
immler@69620
  2016
proof -
immler@69620
  2017
  have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" for x
immler@69620
  2018
  proof -
immler@69620
  2019
    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
immler@69620
  2020
      using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
immler@69620
  2021
    moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> S"
immler@69620
  2022
      by (meson \<open>x \<in> S\<close> opS openin_contains_cball)
immler@69620
  2023
    then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> S"
immler@69620
  2024
      by force
immler@69620
  2025
    ultimately show ?thesis
immler@69620
  2026
      apply (rule_tac x="min e1 e2" in exI)
immler@69620
  2027
      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int)
immler@69620
  2028
      by (metis closed_Int closed_cball inf_left_commute)
immler@69620
  2029
  qed
immler@69620
  2030
  moreover have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> T" for x
immler@69620
  2031
  proof -
immler@69620
  2032
    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
immler@69620
  2033
      using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
immler@69620
  2034
    moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> T"
immler@69620
  2035
      by (meson \<open>x \<in> T\<close> opT openin_contains_cball)
immler@69620
  2036
    then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> T"
immler@69620
  2037
      by force
immler@69620
  2038
    ultimately show ?thesis
immler@69620
  2039
      apply (rule_tac x="min e1 e2" in exI)
immler@69620
  2040
      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int)
immler@69620
  2041
      by (metis closed_Int closed_cball inf_left_commute)
immler@69620
  2042
  qed
immler@69620
  2043
  ultimately show ?thesis
immler@69620
  2044
    by (force simp: locally_compact_Int_cball)
immler@69620
  2045
qed
immler@69620
  2046
immler@69620
  2047
lemma locally_compact_closedin_Un:
immler@69620
  2048
  fixes S :: "'a::euclidean_space set"
immler@69620
  2049
  assumes LCS: "locally compact S" and LCT:"locally compact T"
immler@69620
  2050
      and clS: "closedin (subtopology euclidean (S \<union> T)) S"
immler@69620
  2051
      and clT: "closedin (subtopology euclidean (S \<union> T)) T"
immler@69620
  2052
    shows "locally compact (S \<union> T)"
immler@69620
  2053
proof -
immler@69620
  2054
  have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" "x \<in> T" for x
immler@69620
  2055
  proof -
immler@69620
  2056
    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
immler@69620
  2057
      using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
immler@69620
  2058
    moreover
immler@69620
  2059
    obtain e2 where "e2 > 0" and e2: "closed (cball x e2 \<inter> T)"
immler@69620
  2060
      using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
immler@69620
  2061
    ultimately show ?thesis
immler@69620
  2062
      apply (rule_tac x="min e1 e2" in exI)
immler@69620
  2063
      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
immler@69620
  2064
      by (metis closed_Int closed_Un closed_cball inf_left_commute)
immler@69620
  2065
  qed
immler@69620
  2066
  moreover
immler@69620
  2067
  have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<in> S" "x \<notin> T" for x
immler@69620
  2068
  proof -
immler@69620
  2069
    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
immler@69620
  2070
      using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
immler@69620
  2071
    moreover
immler@69620
  2072
    obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S - T"
immler@69620
  2073
      using clT x by (fastforce simp: openin_contains_cball closedin_def)
immler@69620
  2074
    then have "closed (cball x e2 \<inter> T)"
immler@69620
  2075
    proof -
immler@69620
  2076
      have "{} = T - (T - cball x e2)"
immler@69620
  2077
        using Diff_subset Int_Diff \<open>cball x e2 \<inter> (S \<union> T) \<subseteq> S - T\<close> by auto
immler@69620
  2078
      then show ?thesis
immler@69620
  2079
        by (simp add: Diff_Diff_Int inf_commute)
immler@69620
  2080
    qed
immler@69620
  2081
    ultimately show ?thesis
immler@69620
  2082
      apply (rule_tac x="min e1 e2" in exI)
immler@69620
  2083
      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
immler@69620
  2084
      by (metis closed_Int closed_Un closed_cball inf_left_commute)
immler@69620
  2085
  qed
immler@69620
  2086
  moreover
immler@69620
  2087
  have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<notin> S" "x \<in> T" for x
immler@69620
  2088
  proof -
immler@69620
  2089
    obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
immler@69620
  2090
      using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
immler@69620
  2091
    moreover
immler@69620
  2092
    obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S \<union> T - S"
immler@69620
  2093
      using clS x by (fastforce simp: openin_contains_cball closedin_def)
immler@69620
  2094
    then have "closed (cball x e2 \<inter> S)"
immler@69620
  2095
      by (metis Diff_disjoint Int_empty_right closed_empty inf.left_commute inf.orderE inf_sup_absorb)
immler@69620
  2096
    ultimately show ?thesis
immler@69620
  2097
      apply (rule_tac x="min e1 e2" in exI)
immler@69620
  2098
      apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
immler@69620
  2099
      by (metis closed_Int closed_Un closed_cball inf_left_commute)
immler@69620
  2100
  qed
immler@69620
  2101
  ultimately show ?thesis
immler@69620
  2102
    by (auto simp: locally_compact_Int_cball)
immler@69620
  2103
qed
immler@69620
  2104
immler@69620
  2105
lemma locally_compact_Times:
immler@69620
  2106
  fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
immler@69620
  2107
  shows "\<lbrakk>locally compact S; locally compact T\<rbrakk> \<Longrightarrow> locally compact (S \<times> T)"
immler@69620
  2108
  by (auto simp: compact_Times locally_Times)
immler@69620
  2109
immler@69620
  2110
lemma locally_compact_compact_subopen:
immler@69620
  2111
  fixes S :: "'a :: heine_borel set"
immler@69620
  2112
  shows
immler@69620
  2113
   "locally compact S \<longleftrightarrow>
immler@69620
  2114
    (\<forall>K T. K \<subseteq> S \<and> compact K \<and> open T \<and> K \<subseteq> T
immler@69620
  2115
          \<longrightarrow> (\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
immler@69620
  2116
                     openin (subtopology euclidean S) U \<and> compact V))"
immler@69620
  2117
   (is "?lhs = ?rhs")
immler@69620
  2118
proof
immler@69620
  2119
  assume L: ?lhs
immler@69620
  2120
  show ?rhs
immler@69620
  2121
  proof clarify
immler@69620
  2122
    fix K :: "'a set" and T :: "'a set"
immler@69620
  2123
    assume "K \<subseteq> S" and "compact K" and "open T" and "K \<subseteq> T"
immler@69620
  2124
    obtain U V where "K \<subseteq> U" "U \<subseteq> V" "V \<subseteq> S" "compact V"
immler@69620
  2125
                 and ope: "openin (subtopology euclidean S) U"
immler@69620
  2126
      using L unfolding locally_compact_compact by (meson \<open>K \<subseteq> S\<close> \<open>compact K\<close>)
immler@69620
  2127
    show "\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
immler@69620
  2128
                openin (subtopology euclidean S) U \<and> compact V"
immler@69620
  2129
    proof (intro exI conjI)
immler@69620
  2130
      show "K \<subseteq> U \<inter> T"
immler@69620
  2131
        by (simp add: \<open>K \<subseteq> T\<close> \<open>K \<subseteq> U\<close>)
immler@69620
  2132
      show "U \<inter> T \<subseteq> closure(U \<inter> T)"
immler@69620
  2133
        by (rule closure_subset)
immler@69620
  2134
      show "closure (U \<inter> T) \<subseteq> S"
immler@69620
  2135
        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)
immler@69620
  2136
      show "openin (subtopology euclidean S) (U \<inter> T)"
immler@69620
  2137
        by (simp add: \<open>open T\<close> ope openin_Int_open)
immler@69620
  2138
      show "compact (closure (U \<inter> T))"
immler@69620
  2139
        by (meson Int_lower1 \<open>U \<subseteq> V\<close> \<open>compact V\<close> bounded_subset compact_closure compact_eq_bounded_closed)
immler@69620
  2140
    qed auto
immler@69620
  2141
  qed
immler@69620
  2142
next
immler@69620
  2143
  assume ?rhs then show ?lhs
immler@69620
  2144
    unfolding locally_compact_compact
immler@69620
  2145
    by (metis open_openin openin_topspace subtopology_superset top.extremum topspace_euclidean_subtopology)
immler@69620
  2146
qed
immler@69620
  2147
immler@69620
  2148
immler@69620
  2149
subsection\<open>Sura-Bura's results about compact components of sets\<close>
immler@69620
  2150
immler@69620
  2151
proposition Sura_Bura_compact:
immler@69620
  2152
  fixes S :: "'a::euclidean_space set"
immler@69620
  2153
  assumes "compact S" and C: "C \<in> components S"
immler@69620
  2154
  shows "C = \<Inter>{T. C \<subseteq> T \<and> openin (subtopology euclidean S) T \<and>
immler@69620
  2155
                           closedin (subtopology euclidean S) T}"
immler@69620
  2156
         (is "C = \<Inter>?\<T>")
immler@69620
  2157
proof
immler@69620
  2158
  obtain x where x: "C = connected_component_set S x" and "x \<in> S"
immler@69620
  2159
    using C by (auto simp: components_def)
immler@69620
  2160
  have "C \<subseteq> S"
immler@69620
  2161
    by (simp add: C in_components_subset)
immler@69620
  2162
  have "\<Inter>?\<T> \<subseteq> connected_component_set S x"
immler@69620
  2163
  proof (rule connected_component_maximal)
immler@69620
  2164
    have "x \<in> C"
immler@69620
  2165
      by (simp add: \<open>x \<in> S\<close> x)
immler@69620
  2166
    then show "x \<in> \<Inter>?\<T>"
immler@69620
  2167
      by blast
immler@69620
  2168
    have clo: "closed (\<Inter>?\<T>)"
immler@69620
  2169
      by (simp add: \<open>compact S\<close> closed_Inter closedin_compact_eq compact_imp_closed)
immler@69620
  2170
    have False
immler@69620
  2171
      if K1: "closedin (subtopology euclidean (\<Inter>?\<T>)) K1" and
immler@69620
  2172
         K2: "closedin (subtopology euclidean (\<Inter>?\<T>)) K2" and
immler@69620
  2173
         K12_Int: "K1 \<inter> K2 = {}" and K12_Un: "K1 \<union> K2 = \<Inter>?\<T>" and "K1 \<noteq> {}" "K2 \<noteq> {}"
immler@69620
  2174
       for K1 K2
immler@69620
  2175
    proof -
immler@69620
  2176
      have "closed K1" "closed K2"
immler@69620
  2177
        using closedin_closed_trans clo K1 K2 by blast+
immler@69620
  2178
      then obtain V1 V2 where "open V1" "open V2" "K1 \<subseteq> V1" "K2 \<subseteq> V2" and V12: "V1 \<inter> V2 = {}"
immler@69620
  2179
        using separation_normal \<open>K1 \<inter> K2 = {}\<close> by metis
immler@69620
  2180
      have SV12_ne: "(S - (V1 \<union> V2)) \<inter> (\<Inter>?\<T>) \<noteq> {}"
immler@69620
  2181
      proof (rule compact_imp_fip)
immler@69620
  2182
        show "compact (S - (V1 \<union> V2))"
immler@69620
  2183
          by (simp add: \<open>open V1\<close> \<open>open V2\<close> \<open>compact S\<close> compact_diff open_Un)
immler@69620
  2184
        show clo\<T>: "closed T" if "T \<in> ?\<T>" for T
immler@69620
  2185
          using that \<open>compact S\<close>
immler@69620
  2186
          by (force intro: closedin_closed_trans simp add: compact_imp_closed)
immler@69620
  2187
        show "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> \<noteq> {}" if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
immler@69620
  2188
        proof
immler@69620
  2189
          assume djo: "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> = {}"
immler@69620
  2190
          obtain D where opeD: "openin (subtopology euclidean S) D"
immler@69620
  2191
                   and cloD: "closedin (subtopology euclidean S) D"
immler@69620
  2192
                   and "C \<subseteq> D" and DV12: "D \<subseteq> V1 \<union> V2"
immler@69620
  2193
          proof (cases "\<F> = {}")
immler@69620
  2194
            case True
immler@69620
  2195
            with \<open>C \<subseteq> S\<close> djo that show ?thesis
immler@69620
  2196
              by force
immler@69620
  2197
          next
immler@69620
  2198
            case False show ?thesis
immler@69620
  2199
            proof
immler@69620
  2200
              show ope: "openin (subtopology euclidean S) (\<Inter>\<F>)"
immler@69620
  2201
                using openin_Inter \<open>finite \<F>\<close> False \<F> by blast
immler@69620
  2202
              then show "closedin (subtopology euclidean S) (\<Inter>\<F>)"
immler@69620
  2203
                by (meson clo\<T> \<F> closed_Inter closed_subset openin_imp_subset subset_eq)
immler@69620
  2204
              show "C \<subseteq> \<Inter>\<F>"
immler@69620
  2205
                using \<F> by auto
immler@69620
  2206
              show "\<Inter>\<F> \<subseteq> V1 \<union> V2"
immler@69620
  2207
                using ope djo openin_imp_subset by fastforce
immler@69620
  2208
            qed
immler@69620
  2209
          qed
immler@69620
  2210
          have "connected C"
immler@69620
  2211
            by (simp add: x)
immler@69620
  2212
          have "closed D"
immler@69620
  2213
            using \<open>compact S\<close> cloD closedin_closed_trans compact_imp_closed by blast
immler@69620
  2214
          have cloV1: "closedin (subtopology euclidean D) (D \<inter> closure V1)"
immler@69620
  2215
            and cloV2: "closedin (subtopology euclidean D) (D \<inter> closure V2)"
immler@69620
  2216
            by (simp_all add: closedin_closed_Int)
immler@69620
  2217
          moreover have "D \<inter> closure V1 = D \<inter> V1" "D \<inter> closure V2 = D \<inter> V2"
immler@69620
  2218
            apply safe
immler@69620
  2219
            using \<open>D \<subseteq> V1 \<union> V2\<close> \<open>open V1\<close> \<open>open V2\<close> V12
immler@69620
  2220
               apply (simp_all add: closure_subset [THEN subsetD] closure_iff_nhds_not_empty, blast+)
immler@69620
  2221
            done
immler@69620
  2222
          ultimately have cloDV1: "closedin (subtopology euclidean D) (D \<inter> V1)"
immler@69620
  2223
                      and cloDV2:  "closedin (subtopology euclidean D) (D \<inter> V2)"
immler@69620
  2224
            by metis+
immler@69620
  2225
          then obtain U1 U2 where "closed U1" "closed U2"
immler@69620
  2226
               and D1: "D \<inter> V1 = D \<inter> U1" and D2: "D \<inter> V2 = D \<inter> U2"
immler@69620
  2227
            by (auto simp: closedin_closed)
immler@69620
  2228
          have "D \<inter> U1 \<inter> C \<noteq> {}"
immler@69620
  2229
          proof
immler@69620
  2230
            assume "D \<inter> U1 \<inter> C = {}"
immler@69620
  2231
            then have *: "C \<subseteq> D \<inter> V2"
immler@69620
  2232
              using D1 DV12 \<open>C \<subseteq> D\<close> by auto
immler@69620
  2233
            have "\<Inter>?\<T> \<subseteq> D \<inter> V2"
immler@69620
  2234
              apply (rule Inter_lower)
immler@69620
  2235
              using * apply simp
immler@69620
  2236
              by (meson cloDV2 \<open>open V2\<close> cloD closedin_trans le_inf_iff opeD openin_Int_open)
immler@69620
  2237
            then show False
immler@69620
  2238
              using K1 V12 \<open>K1 \<noteq> {}\<close> \<open>K1 \<subseteq> V1\<close> closedin_imp_subset by blast
immler@69620
  2239
          qed
immler@69620
  2240
          moreover have "D \<inter> U2 \<inter> C \<noteq> {}"
immler@69620
  2241
          proof
immler@69620
  2242
            assume "D \<inter> U2 \<inter> C = {}"
immler@69620
  2243
            then have *: "C \<subseteq> D \<inter> V1"
immler@69620
  2244
              using D2 DV12 \<open>C \<subseteq> D\<close> by auto
immler@69620
  2245
            have "\<Inter>?\<T> \<subseteq> D \<inter> V1"
immler@69620
  2246
              apply (rule Inter_lower)
immler@69620
  2247
              using * apply simp
immler@69620
  2248
              by (meson cloDV1 \<open>open V1\<close> cloD closedin_trans le_inf_iff opeD openin_Int_open)
immler@69620
  2249
            then show False
immler@69620
  2250
              using K2 V12 \<open>K2 \<noteq> {}\<close> \<open>K2 \<subseteq> V2\<close> closedin_imp_subset by blast
immler@69620
  2251
          qed
immler@69620
  2252
          ultimately show False
immler@69620
  2253
            using \<open>connected C\<close> unfolding connected_closed
immler@69620
  2254
            apply (simp only: not_ex)
immler@69620
  2255
            apply (drule_tac x="D \<inter> U1" in spec)
immler@69620
  2256
            apply (drule_tac x="D \<inter> U2" in spec)
immler@69620
  2257
            using \<open>C \<subseteq> D\<close> D1 D2 V12 DV12 \<open>closed U1\<close> \<open>closed U2\<close> \<open>closed D\<close>
immler@69620
  2258
            by blast
immler@69620
  2259
        qed
immler@69620
  2260
      qed
immler@69620
  2261
      show False
immler@69620
  2262
        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)
immler@69620
  2263
    qed
immler@69620
  2264
    then show "connected (\<Inter>?\<T>)"
immler@69620
  2265
      by (auto simp: connected_closedin_eq)
immler@69620
  2266
    show "\<Inter>?\<T> \<subseteq> S"
immler@69620
  2267
      by (fastforce simp: C in_components_subset)
immler@69620
  2268
  qed
immler@69620
  2269
  with x show "\<Inter>?\<T> \<subseteq> C" by simp
immler@69620
  2270
qed auto
immler@69620
  2271
immler@69620
  2272
immler@69620
  2273
corollary Sura_Bura_clopen_subset:
immler@69620
  2274
  fixes S :: "'a::euclidean_space set"
immler@69620
  2275
  assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
immler@69620
  2276
      and U: "open U" "C \<subseteq> U"
immler@69620
  2277
  obtains K where "openin (subtopology euclidean S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
immler@69620
  2278
proof (rule ccontr)
immler@69620
  2279
  assume "\<not> thesis"
immler@69620
  2280
  with that have neg: "\<nexists>K. openin (subtopology euclidean S) K \<and> compact K \<and> C \<subseteq> K \<and> K \<subseteq> U"
immler@69620
  2281
    by metis
immler@69620
  2282
  obtain V K where "C \<subseteq> V" "V \<subseteq> U" "V \<subseteq> K" "K \<subseteq> S" "compact K"
immler@69620
  2283
               and opeSV: "openin (subtopology euclidean S) V"
immler@69620
  2284
    using S U \<open>compact C\<close>
immler@69620
  2285
    apply (simp add: locally_compact_compact_subopen)
immler@69620
  2286
    by (meson C in_components_subset)
immler@69620
  2287
  let ?\<T> = "{T. C \<subseteq> T \<and> openin (subtopology euclidean K) T \<and> compact T \<and> T \<subseteq> K}"
immler@69620
  2288
  have CK: "C \<in> components K"
immler@69620
  2289
    by (meson C \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> components_intermediate_subset subset_trans)
immler@69620
  2290
  with \<open>compact K\<close>
immler@69620
  2291
  have "C = \<Inter>{T. C \<subseteq> T \<and> openin (subtopology euclidean K) T \<and> closedin (subtopology euclidean K) T}"
immler@69620
  2292
    by (simp add: Sura_Bura_compact)
immler@69620
  2293
  then have Ceq: "C = \<Inter>?\<T>"
immler@69620
  2294
    by (simp add: closedin_compact_eq \<open>compact K\<close>)
immler@69620
  2295
  obtain W where "open W" and W: "V = S \<inter> W"
immler@69620
  2296
    using opeSV by (auto simp: openin_open)
immler@69620
  2297
  have "-(U \<inter> W) \<inter> \<Inter>?\<T> \<noteq> {}"
immler@69620
  2298
  proof (rule closed_imp_fip_compact)
immler@69620
  2299
    show "- (U \<inter> W) \<inter> \<Inter>\<F> \<noteq> {}"
immler@69620
  2300
      if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
immler@69620
  2301
    proof (cases "\<F> = {}")
immler@69620
  2302
      case True
immler@69620
  2303
      have False if "U = UNIV" "W = UNIV"
immler@69620
  2304
      proof -
immler@69620
  2305
        have "V = S"
immler@69620
  2306
          by (simp add: W \<open>W = UNIV\<close>)
immler@69620
  2307
        with neg show False
immler@69620
  2308
          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
immler@69620
  2309
      qed
immler@69620
  2310
      with True show ?thesis
immler@69620
  2311
        by auto
immler@69620
  2312
    next
immler@69620
  2313
      case False
immler@69620
  2314
      show ?thesis
immler@69620
  2315
      proof
immler@69620
  2316
        assume "- (U \<inter> W) \<inter> \<Inter>\<F> = {}"
immler@69620
  2317
        then have FUW: "\<Inter>\<F> \<subseteq> U \<inter> W"
immler@69620
  2318
          by blast
immler@69620
  2319
        have "C \<subseteq> \<Inter>\<F>"
immler@69620
  2320
          using \<F> by auto
immler@69620
  2321
        moreover have "compact (\<Inter>\<F>)"
immler@69620
  2322
          by (metis (no_types, lifting) compact_Inter False mem_Collect_eq subsetCE \<F>)
immler@69620
  2323
        moreover have "\<Inter>\<F> \<subseteq> K"
immler@69620
  2324
          using False that(2) by fastforce
immler@69620
  2325
        moreover have opeKF: "openin (subtopology euclidean K) (\<Inter>\<F>)"
immler@69620
  2326
          using False \<F> \<open>finite \<F>\<close> by blast
immler@69620
  2327
        then have opeVF: "openin (subtopology euclidean V) (\<Inter>\<F>)"
immler@69620
  2328
          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
immler@69620
  2329
        then have "openin (subtopology euclidean S) (\<Inter>\<F>)"
immler@69620
  2330
          by (metis opeSV openin_trans)
immler@69620
  2331
        moreover have "\<Inter>\<F> \<subseteq> U"
immler@69620
  2332
          by (meson \<open>V \<subseteq> U\<close> opeVF dual_order.trans openin_imp_subset)
immler@69620
  2333
        ultimately show False
immler@69620
  2334
          using neg by blast
immler@69620
  2335
      qed
immler@69620
  2336
    qed
immler@69620
  2337
  qed (use \<open>open W\<close> \<open>open U\<close> in auto)
immler@69620
  2338
  with W Ceq \<open>C \<subseteq> V\<close> \<open>C \<subseteq> U\<close> show False
immler@69620
  2339
    by auto
immler@69620
  2340
qed
immler@69620
  2341
immler@69620
  2342
immler@69620
  2343
corollary Sura_Bura_clopen_subset_alt:
immler@69620
  2344
  fixes S :: "'a::euclidean_space set"
immler@69620
  2345
  assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
immler@69620
  2346
      and opeSU: "openin (subtopology euclidean S) U" and "C \<subseteq> U"
immler@69620
  2347
  obtains K where "openin (subtopology euclidean S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
immler@69620
  2348
proof -
immler@69620
  2349
  obtain V where "open V" "U = S \<inter> V"
immler@69620
  2350
    using opeSU by (auto simp: openin_open)
immler@69620
  2351
  with \<open>C \<subseteq> U\<close> have "C \<subseteq> V"
immler@69620
  2352
    by auto
immler@69620
  2353
  then show ?thesis
immler@69620
  2354
    using Sura_Bura_clopen_subset [OF S C \<open>compact C\<close> \<open>open V\<close>]
immler@69620
  2355
    by (metis \<open>U = S \<inter> V\<close> inf.bounded_iff openin_imp_subset that)
immler@69620
  2356
qed
immler@69620
  2357
immler@69620
  2358
corollary Sura_Bura:
immler@69620
  2359
  fixes S :: "'a::euclidean_space set"
immler@69620
  2360
  assumes "locally compact S" "C \<in> components S" "compact C"
immler@69620
  2361
  shows "C = \<Inter> {K. C \<subseteq> K \<and> compact K \<and> openin (subtopology euclidean S) K}"
immler@69620
  2362
         (is "C = ?rhs")
immler@69620
  2363
proof
immler@69620
  2364
  show "?rhs \<subseteq> C"
immler@69620
  2365
  proof (clarsimp, rule ccontr)
immler@69620
  2366
    fix x
immler@69620
  2367
    assume *: "\<forall>X. C \<subseteq> X \<and> compact X \<and> openin (subtopology euclidean S) X \<longrightarrow> x \<in> X"
immler@69620
  2368
      and "x \<notin> C"
immler@69620
  2369
    obtain U V where "open U" "open V" "{x} \<subseteq> U" "C \<subseteq> V" "U \<inter> V = {}"
immler@69620
  2370
      using separation_normal [of "{x}" C]
immler@69620
  2371
      by (metis Int_empty_left \<open>x \<notin> C\<close> \<open>compact C\<close> closed_empty closed_insert compact_imp_closed insert_disjoint(1))
immler@69620
  2372
    have "x \<notin> V"
immler@69620
  2373
      using \<open>U \<inter> V = {}\<close> \<open>{x} \<subseteq> U\<close> by blast
immler@69620
  2374
    then show False
immler@69620
  2375
      by (meson "*" Sura_Bura_clopen_subset \<open>C \<subseteq> V\<close> \<open>open V\<close> assms(1) assms(2) assms(3) subsetCE)
immler@69620
  2376
  qed
immler@69620
  2377
qed blast
immler@69620
  2378
immler@69620
  2379
immler@69620
  2380
subsection\<open>Special cases of local connectedness and path connectedness\<close>
immler@69620
  2381
immler@69620
  2382
lemma locally_connected_1:
immler@69620
  2383
  assumes
immler@69620
  2384
    "\<And>v x. \<lbrakk>openin (subtopology euclidean S) v; x \<in> v\<rbrakk>
immler@69620
  2385
              \<Longrightarrow> \<exists>u. openin (subtopology euclidean S) u \<and>
immler@69620
  2386
                      connected u \<and> x \<in> u \<and> u \<subseteq> v"
immler@69620
  2387
   shows "locally connected S"
immler@69620
  2388
apply (clarsimp simp add: locally_def)
immler@69620
  2389
apply (drule assms; blast)
immler@69620
  2390
done
immler@69620
  2391
immler@69620
  2392
lemma locally_connected_2:
immler@69620
  2393
  assumes "locally connected S"
immler@69620
  2394
          "openin (subtopology euclidean S) t"
immler@69620
  2395
          "x \<in> t"
immler@69620
  2396
   shows "openin (subtopology euclidean S) (connected_component_set t x)"
immler@69620
  2397
proof -
immler@69620
  2398
  { fix y :: 'a
immler@69620
  2399
    let ?SS = "subtopology euclidean S"
immler@69620
  2400
    assume 1: "openin ?SS t"
immler@69620
  2401
              "\<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))"
immler@69620
  2402
    and "connected_component t x y"
immler@69620
  2403
    then have "y \<in> t" and y: "y \<in> connected_component_set t x"
immler@69620
  2404
      using connected_component_subset by blast+
immler@69620
  2405
    obtain F where
immler@69620
  2406
      "\<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))"
immler@69620
  2407
      by moura
immler@69620
  2408
    then obtain G where
immler@69620
  2409
       "\<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)"
immler@69620
  2410
      by moura
immler@69620
  2411
    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"
immler@69620
  2412
      using 1 \<open>y \<in> t\<close> by presburger
immler@69620
  2413
    have "G y t \<subseteq> connected_component_set t y"
immler@69620
  2414
      by (metis (no_types) * connected_component_eq_self connected_component_mono contra_subsetD)
immler@69620
  2415
    then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> connected_component_set t x"
immler@69620
  2416
      by (metis (no_types) * connected_component_eq dual_order.trans y)
immler@69620
  2417
  }
immler@69620
  2418
  then show ?thesis
immler@69620
  2419
    using assms openin_subopen by (force simp: locally_def)
immler@69620
  2420
qed
immler@69620
  2421
immler@69620
  2422
lemma locally_connected_3:
immler@69620
  2423
  assumes "\<And>t x. \<lbrakk>openin (subtopology euclidean S) t; x \<in> t\<rbrakk>
immler@69620
  2424
              \<Longrightarrow> openin (subtopology euclidean S)
immler@69620
  2425
                          (connected_component_set t x)"
immler@69620
  2426
          "openin (subtopology euclidean S) v" "x \<in> v"
immler@69620
  2427
   shows  "\<exists>u. openin (subtopology euclidean S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v"
immler@69620
  2428
using assms connected_component_subset by fastforce
immler@69620
  2429
immler@69620
  2430
lemma locally_connected:
immler@69620
  2431
  "locally connected S \<longleftrightarrow>
immler@69620
  2432
   (\<forall>v x. openin (subtopology euclidean S) v \<and> x \<in> v
immler@69620
  2433
          \<longrightarrow> (\<exists>u. openin (subtopology euclidean S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v))"
immler@69620
  2434
by (metis locally_connected_1 locally_connected_2 locally_connected_3)
immler@69620
  2435
immler@69620
  2436
lemma locally_connected_open_connected_component:
immler@69620
  2437
  "locally connected S \<longleftrightarrow>
immler@69620
  2438
   (\<forall>t x. openin (subtopology euclidean S) t \<and> x \<in> t
immler@69620
  2439
          \<longrightarrow> openin (subtopology euclidean S) (connected_component_set t x))"
immler@69620
  2440
by (metis locally_connected_1 locally_connected_2 locally_connected_3)
immler@69620
  2441
immler@69620
  2442
lemma locally_path_connected_1:
immler@69620
  2443
  assumes
immler@69620
  2444
    "\<And>v x. \<lbrakk>openin (subtopology euclidean S) v; x \<in> v\<rbrakk>
immler@69620
  2445
              \<Longrightarrow> \<exists>u. openin (subtopology euclidean S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
immler@69620
  2446
   shows "locally path_connected S"
immler@69620
  2447
apply (clarsimp simp add: locally_def)
immler@69620
  2448
apply (drule assms; blast)
immler@69620
  2449
done
immler@69620
  2450
immler@69620
  2451
lemma locally_path_connected_2:
immler@69620
  2452
  assumes "locally path_connected S"
immler@69620
  2453
          "openin (subtopology euclidean S) t"
immler@69620
  2454
          "x \<in> t"
immler@69620
  2455
   shows "openin (subtopology euclidean S) (path_component_set t x)"
immler@69620
  2456
proof -
immler@69620
  2457
  { fix y :: 'a
immler@69620
  2458
    let ?SS = "subtopology euclidean S"
immler@69620
  2459
    assume 1: "openin ?SS t"
immler@69620
  2460
              "\<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))"
immler@69620
  2461
    and "path_component t x y"
immler@69620
  2462
    then have "y \<in> t" and y: "y \<in> path_component_set t x"
immler@69620
  2463
      using path_component_mem(2) by blast+
immler@69620
  2464
    obtain F where
immler@69620
  2465
      "\<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))"
immler@69620
  2466
      by moura
immler@69620
  2467
    then obtain G where
immler@69620
  2468
       "\<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)"
immler@69620
  2469
      by moura
immler@69620
  2470
    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"
immler@69620
  2471
      using 1 \<open>y \<in> t\<close> by presburger
immler@69620
  2472
    have "G y t \<subseteq> path_component_set t y"
immler@69620
  2473
      using * path_component_maximal set_rev_mp by blast
immler@69620
  2474
    then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> path_component_set t x"
immler@69620
  2475
      by (metis "*" \<open>G y t \<subseteq> path_component_set t y\<close> dual_order.trans path_component_eq y)
immler@69620
  2476
  }
immler@69620
  2477
  then show ?thesis
immler@69620
  2478
    using assms openin_subopen by (force simp: locally_def)
immler@69620
  2479
qed
immler@69620
  2480
immler@69620
  2481
lemma locally_path_connected_3:
immler@69620
  2482
  assumes "\<And>t x. \<lbrakk>openin (subtopology euclidean S) t; x \<in> t\<rbrakk>
immler@69620
  2483
              \<Longrightarrow> openin (subtopology euclidean S) (path_component_set t x)"
immler@69620
  2484
          "openin (subtopology euclidean S) v" "x \<in> v"
immler@69620
  2485
   shows  "\<exists>u. openin (subtopology euclidean S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
immler@69620
  2486
proof -
immler@69620
  2487
  have "path_component v x x"
immler@69620
  2488
    by (meson assms(3) path_component_refl)
immler@69620
  2489
  then show ?thesis
immler@69620
  2490
    by (metis assms(1) assms(2) assms(3) mem_Collect_eq path_component_subset path_connected_path_component)
immler@69620
  2491
qed
immler@69620
  2492
immler@69620
  2493
proposition locally_path_connected:
immler@69620
  2494
  "locally path_connected S \<longleftrightarrow>
immler@69620
  2495
   (\<forall>v x. openin (subtopology euclidean S) v \<and> x \<in> v
immler@69620
  2496
          \<longrightarrow> (\<exists>u. openin (subtopology euclidean S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v))"
immler@69620
  2497
  by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
immler@69620
  2498
immler@69620
  2499
proposition locally_path_connected_open_path_component:
immler@69620
  2500
  "locally path_connected S \<longleftrightarrow>
immler@69620
  2501
   (\<forall>t x. openin (subtopology euclidean S) t \<and> x \<in> t
immler@69620
  2502
          \<longrightarrow> openin (subtopology euclidean S) (path_component_set t x))"
immler@69620
  2503
  by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
immler@69620
  2504
immler@69620
  2505
lemma locally_connected_open_component:
immler@69620
  2506
  "locally connected S \<longleftrightarrow>
immler@69620
  2507
   (\<forall>t c. openin (subtopology euclidean S) t \<and> c \<in> components t
immler@69620
  2508
          \<longrightarrow> openin (subtopology euclidean S) c)"
immler@69620
  2509
by (metis components_iff locally_connected_open_connected_component)
immler@69620
  2510
immler@69620
  2511
proposition locally_connected_im_kleinen:
immler@69620
  2512
  "locally connected S \<longleftrightarrow>
immler@69620
  2513
   (\<forall>v x. openin (subtopology euclidean S) v \<and> x \<in> v
immler@69620
  2514
       \<longrightarrow> (\<exists>u. openin (subtopology euclidean S) u \<and>
immler@69620
  2515
                x \<in> u \<and> u \<subseteq> v \<and>
immler@69620
  2516
                (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> v \<and> x \<in> c \<and> y \<in> c))))"
immler@69620
  2517
   (is "?lhs = ?rhs")
immler@69620
  2518
proof
immler@69620
  2519
  assume ?lhs
immler@69620
  2520
  then show ?rhs
immler@69620
  2521
    by (fastforce simp add: locally_connected)
immler@69620
  2522
next
immler@69620
  2523
  assume ?rhs
immler@69620
  2524
  have *: "\<exists>T. openin (subtopology euclidean S) T \<and> x \<in> T \<and> T \<subseteq> c"
immler@69620
  2525
       if "openin (subtopology euclidean S) t" and c: "c \<in> components t" and "x \<in> c" for t c x
immler@69620
  2526
  proof -
immler@69620
  2527
    from that \<open>?rhs\<close> [rule_format, of t x]
immler@69620
  2528
    obtain u where u:
immler@69620
  2529
      "openin (subtopology euclidean S) u \<and> x \<in> u \<and> u \<subseteq> t \<and>
immler@69620
  2530
       (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> t \<and> x \<in> c \<and> y \<in> c))"
immler@69620
  2531
      using in_components_subset by auto
immler@69620
  2532
    obtain F :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
immler@69620
  2533
      "\<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))"
immler@69620
  2534
      by moura
immler@69620
  2535
    then have F: "F t c \<in> t \<and> c = connected_component_set t (F t c)"
immler@69620
  2536
      by (meson components_iff c)
immler@69620
  2537
    obtain G :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
immler@69620
  2538
        G: "\<forall>x y. (\<exists>z. z \<in> y \<and> z \<notin> x) = (G x y \<in> y \<and> G x y \<notin> x)"
immler@69620
  2539
      by moura
immler@69620
  2540
     have "G c u \<notin> u \<or> G c u \<in> c"
immler@69620
  2541
      using F by (metis (full_types) u connected_componentI connected_component_eq mem_Collect_eq that(3))
immler@69620
  2542
    then show ?thesis
immler@69620
  2543
      using G u by auto
immler@69620
  2544
  qed
immler@69620
  2545
  show ?lhs
immler@69620
  2546
    apply (clarsimp simp add: locally_connected_open_component)
immler@69620
  2547
    apply (subst openin_subopen)
immler@69620
  2548
    apply (blast intro: *)
immler@69620
  2549
    done
immler@69620
  2550
qed
immler@69620
  2551
immler@69620
  2552
proposition locally_path_connected_im_kleinen:
immler@69620
  2553
  "locally path_connected S \<longleftrightarrow>
immler@69620
  2554
   (\<forall>v x. openin (subtopology euclidean S) v \<and> x \<in> v
immler@69620
  2555
       \<longrightarrow> (\<exists>u. openin (subtopology euclidean S) u \<and>
immler@69620
  2556
                x \<in> u \<and> u \<subseteq> v \<and>
immler@69620
  2557
                (\<forall>y. y \<in> u \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> v \<and>