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